@@ -0,0 +1,295 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE TypeOperators #-}
5+module Servant.Server.RouterSpec (spec) where
6+
7+import Control.Monad (unless)
8+import Data.Proxy (Proxy(..))
9+import Data.Text (unpack)
10+import Network.HTTP.Types (Status (..))
11+import Network.Wai (Application, responseBuilder)
12+import Network.Wai.Internal (Response (ResponseBuilder))
13+import Test.Hspec
14+import Test.Hspec.Wai (get, shouldRespondWith, with)
15+import Servant.API
16+import Servant.Server
17+import Servant.Server.Internal
18+
19+spec = describe "Servant.Server.Internal.Router" $ do
20+ routerSpec
21+ distributivitySpec
22+
23+routerSpec :: Spec
24+routerSpec = do
25+ let app' :: Application
26+ app' = toApplication $ runRouter router'
27+
28+ router', router :: Router
29+ router' = tweakResponse (fmap twk) router
30+ router = leafRouter $ \_ cont -> cont (Route $ responseBuilder (Status 201 "") [] "")
31+
32+ twk :: Response -> Response
33+ twk (ResponseBuilder (Status i s) hs b) = ResponseBuilder (Status (i + 1) s) hs b
34+ twk b = b
35+
36+ describe "tweakResponse" . with (return app') $ do
37+ it "calls f on route result" $ do
38+ get "" `shouldRespondWith` 202
39+
40+distributivitySpec :: Spec
41+distributivitySpec =
42+ describe "choice" $ do
43+ it "distributes endpoints through static paths" $ do
44+ endpoint `shouldHaveSameStructureAs` endpointRef
45+ it "distributes nested routes through static paths" $ do
46+ static `shouldHaveSameStructureAs` staticRef
47+ it "distributes nested routes through dynamic paths" $ do
48+ dynamic `shouldHaveSameStructureAs` dynamicRef
49+ it "properly reorders permuted static paths" $ do
50+ permute `shouldHaveSameStructureAs` permuteRef
51+ it "properly reorders permuted static paths in the presence of Raw in end" $ do
52+ permuteRawEnd `shouldHaveSameStructureAs` permuteRawEndRef
53+ it "properly reorders permuted static paths in the presence of Raw in beginning" $ do
54+ permuteRawBegin `shouldHaveSameStructureAs` permuteRawBeginRef
55+ it "properly reorders permuted static paths in the presence of Raw in middle" $ do
56+ permuteRawMiddle `shouldHaveSameStructureAs` permuteRawMiddleRef
57+ it "properly reorders permuted static paths in the presence of a root endpoint in end" $ do
58+ permuteEndEnd `shouldHaveSameStructureAs` permuteEndRef
59+ it "properly reorders permuted static paths in the presence of a root endpoint in beginning" $ do
60+ permuteEndBegin `shouldHaveSameStructureAs` permuteEndRef
61+ it "properly reorders permuted static paths in the presence of a root endpoint in middle" $ do
62+ permuteEndMiddle `shouldHaveSameStructureAs` permuteEndRef
63+ it "properly handles mixing static paths at different levels" $ do
64+ level `shouldHaveSameStructureAs` levelRef
65+
66+shouldHaveSameStructureAs ::
67+ (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
68+shouldHaveSameStructureAs p1 p2 =
69+ unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
70+ expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
71+
72+makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router
73+makeTrivialRouter p = route p EmptyContext d
74+ where
75+ d = Delayed r r r r (\ _ _ _ -> FailFatal err501)
76+ r = return (Route ())
77+
78+type End = Get '[JSON] ()
79+
80+-- The latter version looks more efficient,
81+-- but the former should be compiled to the
82+-- same layout:
83+
84+type Endpoint = "a" :> End :<|> "a" :> End
85+type EndpointRef = "a" :> (End :<|> End)
86+
87+endpoint :: Proxy Endpoint
88+endpoint = Proxy
89+
90+endpointRef :: Proxy EndpointRef
91+endpointRef = Proxy
92+
93+-- Again, the latter version looks more efficient,
94+-- but the former should be compiled to the same
95+-- layout:
96+
97+type Static = "a" :> "b" :> End :<|> "a" :> "c" :> End
98+type StaticRef = "a" :> ("b" :> End :<|> "c" :> End)
99+
100+static :: Proxy Static
101+static = Proxy
102+
103+staticRef :: Proxy StaticRef
104+staticRef = Proxy
105+
106+-- Even for dynamic path components, we expect the
107+-- router to simplify the layout, because captures
108+-- are delayed and only actually performed once
109+-- reaching an endpoint. So the former version and
110+-- the latter should be compiled to the same router
111+-- structure:
112+
113+type Dynamic =
114+ "a" :> Capture "foo" Int :> "b" :> End
115+ :<|> "a" :> Capture "bar" Bool :> "c" :> End
116+ :<|> "a" :> Capture "baz" Char :> "d" :> End
117+
118+type DynamicRef =
119+ "a" :> Capture "anything" () :>
120+ ("b" :> End :<|> "c" :> End :<|> "d" :> End)
121+
122+dynamic :: Proxy Dynamic
123+dynamic = Proxy
124+
125+dynamicRef :: Proxy DynamicRef
126+dynamicRef = Proxy
127+
128+-- A more complicated example of static route reordering.
129+-- All the permuted paths should be correctly grouped,
130+-- so both 'Permute' and 'PermuteRef' should compile to
131+-- the same layout:
132+
133+type Permute =
134+ "a" :> "b" :> "c" :> End
135+ :<|> "b" :> "a" :> "c" :> End
136+ :<|> "a" :> "c" :> "b" :> End
137+ :<|> "c" :> "a" :> "b" :> End
138+ :<|> "b" :> "c" :> "a" :> End
139+ :<|> "c" :> "b" :> "a" :> End
140+
141+type PermuteRef =
142+ "a" :> ( "b" :> "c" :> End
143+ :<|> "c" :> "b" :> End
144+ )
145+ :<|> "b" :> ( "a" :> "c" :> End
146+ :<|> "c" :> "a" :> End
147+ )
148+ :<|> "c" :> ( "a" :> "b" :> End
149+ :<|> "b" :> "a" :> End
150+ )
151+
152+permute :: Proxy Permute
153+permute = Proxy
154+
155+permuteRef :: Proxy PermuteRef
156+permuteRef = Proxy
157+
158+-- Adding a 'Raw' in one of the ends should have minimal
159+-- effect on the grouping.
160+
161+type PermuteRawEnd =
162+ "a" :> "b" :> "c" :> End
163+ :<|> "b" :> "a" :> "c" :> End
164+ :<|> "a" :> "c" :> "b" :> End
165+ :<|> "c" :> "a" :> "b" :> End
166+ :<|> "b" :> "c" :> "a" :> End
167+ :<|> "c" :> "b" :> "a" :> End
168+ :<|> Raw
169+
170+type PermuteRawEndRef = PermuteRef :<|> Raw
171+
172+type PermuteRawBegin =
173+ Raw
174+ :<|> "a" :> "b" :> "c" :> End
175+ :<|> "b" :> "a" :> "c" :> End
176+ :<|> "a" :> "c" :> "b" :> End
177+ :<|> "c" :> "a" :> "b" :> End
178+ :<|> "b" :> "c" :> "a" :> End
179+ :<|> "c" :> "b" :> "a" :> End
180+
181+type PermuteRawBeginRef = Raw :<|> PermuteRef
182+
183+permuteRawBegin :: Proxy PermuteRawBegin
184+permuteRawBegin = Proxy
185+
186+permuteRawBeginRef :: Proxy PermuteRawBeginRef
187+permuteRawBeginRef = Proxy
188+
189+permuteRawEnd :: Proxy PermuteRawEnd
190+permuteRawEnd = Proxy
191+
192+permuteRawEndRef :: Proxy PermuteRawEndRef
193+permuteRawEndRef = Proxy
194+
195+-- Adding a 'Raw' in the middle will disrupt grouping,
196+-- because we commute things past a 'Raw'. But the two
197+-- halves should still be grouped.
198+
199+type PermuteRawMiddle =
200+ "a" :> "b" :> "c" :> End
201+ :<|> "b" :> "a" :> "c" :> End
202+ :<|> "a" :> "c" :> "b" :> End
203+ :<|> Raw
204+ :<|> "c" :> "a" :> "b" :> End
205+ :<|> "b" :> "c" :> "a" :> End
206+ :<|> "c" :> "b" :> "a" :> End
207+
208+type PermuteRawMiddleRef =
209+ "a" :> ( "b" :> "c" :> End
210+ :<|> "c" :> "b" :> End
211+ )
212+ :<|> "b" :> "a" :> "c" :> End
213+ :<|> Raw
214+ :<|> "b" :> "c" :> "a" :> End
215+ :<|> "c" :> ( "a" :> "b" :> End
216+ :<|> "b" :> "a" :> End
217+ )
218+
219+permuteRawMiddle :: Proxy PermuteRawMiddle
220+permuteRawMiddle = Proxy
221+
222+permuteRawMiddleRef :: Proxy PermuteRawMiddleRef
223+permuteRawMiddleRef = Proxy
224+
225+-- Adding an endpoint at the top-level in various places
226+-- is also somewhat critical for grouping, but it should
227+-- not disrupt grouping at all, even if it is placed in
228+-- the middle.
229+
230+type PermuteEndEnd =
231+ "a" :> "b" :> "c" :> End
232+ :<|> "b" :> "a" :> "c" :> End
233+ :<|> "a" :> "c" :> "b" :> End
234+ :<|> "c" :> "a" :> "b" :> End
235+ :<|> "b" :> "c" :> "a" :> End
236+ :<|> "c" :> "b" :> "a" :> End
237+ :<|> End
238+
239+type PermuteEndBegin =
240+ End
241+ :<|> "a" :> "b" :> "c" :> End
242+ :<|> "b" :> "a" :> "c" :> End
243+ :<|> "a" :> "c" :> "b" :> End
244+ :<|> "c" :> "a" :> "b" :> End
245+ :<|> "b" :> "c" :> "a" :> End
246+ :<|> "c" :> "b" :> "a" :> End
247+
248+type PermuteEndMiddle =
249+ "a" :> "b" :> "c" :> End
250+ :<|> "b" :> "a" :> "c" :> End
251+ :<|> "a" :> "c" :> "b" :> End
252+ :<|> End
253+ :<|> "c" :> "a" :> "b" :> End
254+ :<|> "b" :> "c" :> "a" :> End
255+ :<|> "c" :> "b" :> "a" :> End
256+
257+type PermuteEndRef = PermuteRef :<|> End
258+
259+permuteEndEnd :: Proxy PermuteEndEnd
260+permuteEndEnd = Proxy
261+
262+permuteEndBegin :: Proxy PermuteEndBegin
263+permuteEndBegin = Proxy
264+
265+permuteEndMiddle :: Proxy PermuteEndMiddle
266+permuteEndMiddle = Proxy
267+
268+permuteEndRef :: Proxy PermuteEndRef
269+permuteEndRef = Proxy
270+
271+-- An API with routes on different nesting levels that
272+-- is composed out of different fragments should still
273+-- be reordered correctly.
274+
275+type LevelFragment1 =
276+ "a" :> "b" :> End
277+ :<|> "a" :> End
278+
279+type LevelFragment2 =
280+ "b" :> End
281+ :<|> "a" :> "c" :> End
282+ :<|> End
283+
284+type Level = LevelFragment1 :<|> LevelFragment2
285+
286+type LevelRef =
287+ "a" :> ("b" :> End :<|> "c" :> End :<|> End)
288+ :<|> "b" :> End
289+ :<|> End
290+
291+level :: Proxy Level
292+level = Proxy
293+
294+levelRef :: Proxy LevelRef
295+levelRef = Proxy