05379ed7e3
We use NoContent to signify an empty response nowadays. This commit replaces all occurences of () with NoContent so that all packages use the new semantics.
294 lines
8.7 KiB
Haskell
294 lines
8.7 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
module Servant.Server.RouterSpec (spec) where
|
|
|
|
import Control.Monad (unless)
|
|
import Data.Proxy (Proxy(..))
|
|
import Data.Text (unpack)
|
|
import Network.HTTP.Types (Status (..))
|
|
import Network.Wai (responseBuilder)
|
|
import Network.Wai.Internal (Response (ResponseBuilder))
|
|
import Test.Hspec
|
|
import Test.Hspec.Wai (get, shouldRespondWith, with)
|
|
import Servant.API
|
|
import Servant.Server
|
|
import Servant.Server.Internal
|
|
|
|
spec :: Spec
|
|
spec = describe "Servant.Server.Internal.Router" $ do
|
|
routerSpec
|
|
distributivitySpec
|
|
|
|
routerSpec :: Spec
|
|
routerSpec = do
|
|
let app' :: Application
|
|
app' = toApplication $ runRouter router'
|
|
|
|
router', router :: Router ()
|
|
router' = tweakResponse (fmap twk) router
|
|
router = leafRouter $ \_ _ cont -> cont (Route $ responseBuilder (Status 201 "") [] "")
|
|
|
|
twk :: Response -> Response
|
|
twk (ResponseBuilder (Status i s) hs b) = ResponseBuilder (Status (i + 1) s) hs b
|
|
twk b = b
|
|
|
|
describe "tweakResponse" . with (return app') $ do
|
|
it "calls f on route result" $ do
|
|
get "" `shouldRespondWith` 202
|
|
|
|
distributivitySpec :: Spec
|
|
distributivitySpec =
|
|
describe "choice" $ do
|
|
it "distributes endpoints through static paths" $ do
|
|
endpoint `shouldHaveSameStructureAs` endpointRef
|
|
it "distributes nested routes through static paths" $ do
|
|
static `shouldHaveSameStructureAs` staticRef
|
|
it "distributes nested routes through dynamic paths" $ do
|
|
dynamic `shouldHaveSameStructureAs` dynamicRef
|
|
it "properly reorders permuted static paths" $ do
|
|
permute `shouldHaveSameStructureAs` permuteRef
|
|
it "properly reorders permuted static paths in the presence of Raw in end" $ do
|
|
permuteRawEnd `shouldHaveSameStructureAs` permuteRawEndRef
|
|
it "properly reorders permuted static paths in the presence of Raw in beginning" $ do
|
|
permuteRawBegin `shouldHaveSameStructureAs` permuteRawBeginRef
|
|
it "properly reorders permuted static paths in the presence of Raw in middle" $ do
|
|
permuteRawMiddle `shouldHaveSameStructureAs` permuteRawMiddleRef
|
|
it "properly reorders permuted static paths in the presence of a root endpoint in end" $ do
|
|
permuteEndEnd `shouldHaveSameStructureAs` permuteEndRef
|
|
it "properly reorders permuted static paths in the presence of a root endpoint in beginning" $ do
|
|
permuteEndBegin `shouldHaveSameStructureAs` permuteEndRef
|
|
it "properly reorders permuted static paths in the presence of a root endpoint in middle" $ do
|
|
permuteEndMiddle `shouldHaveSameStructureAs` permuteEndRef
|
|
it "properly handles mixing static paths at different levels" $ do
|
|
level `shouldHaveSameStructureAs` levelRef
|
|
|
|
shouldHaveSameStructureAs ::
|
|
(HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
|
|
shouldHaveSameStructureAs p1 p2 =
|
|
unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
|
|
expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
|
|
|
|
makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()
|
|
makeTrivialRouter p =
|
|
route p EmptyContext (emptyDelayed (FailFatal err501))
|
|
|
|
type End = Get '[JSON] NoContent
|
|
|
|
-- The latter version looks more efficient,
|
|
-- but the former should be compiled to the
|
|
-- same layout:
|
|
|
|
type Endpoint = "a" :> End :<|> "a" :> End
|
|
type EndpointRef = "a" :> (End :<|> End)
|
|
|
|
endpoint :: Proxy Endpoint
|
|
endpoint = Proxy
|
|
|
|
endpointRef :: Proxy EndpointRef
|
|
endpointRef = Proxy
|
|
|
|
-- Again, the latter version looks more efficient,
|
|
-- but the former should be compiled to the same
|
|
-- layout:
|
|
|
|
type Static = "a" :> "b" :> End :<|> "a" :> "c" :> End
|
|
type StaticRef = "a" :> ("b" :> End :<|> "c" :> End)
|
|
|
|
static :: Proxy Static
|
|
static = Proxy
|
|
|
|
staticRef :: Proxy StaticRef
|
|
staticRef = Proxy
|
|
|
|
-- Even for dynamic path components, we expect the
|
|
-- router to simplify the layout, because captures
|
|
-- are delayed and only actually performed once
|
|
-- reaching an endpoint. So the former version and
|
|
-- the latter should be compiled to the same router
|
|
-- structure:
|
|
|
|
type Dynamic =
|
|
"a" :> Capture "foo" Int :> "b" :> End
|
|
:<|> "a" :> Capture "bar" Bool :> "c" :> End
|
|
:<|> "a" :> Capture "baz" Char :> "d" :> End
|
|
|
|
type DynamicRef =
|
|
"a" :> Capture "anything" () :>
|
|
("b" :> End :<|> "c" :> End :<|> "d" :> End)
|
|
|
|
dynamic :: Proxy Dynamic
|
|
dynamic = Proxy
|
|
|
|
dynamicRef :: Proxy DynamicRef
|
|
dynamicRef = Proxy
|
|
|
|
-- A more complicated example of static route reordering.
|
|
-- All the permuted paths should be correctly grouped,
|
|
-- so both 'Permute' and 'PermuteRef' should compile to
|
|
-- the same layout:
|
|
|
|
type Permute =
|
|
"a" :> "b" :> "c" :> End
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> "a" :> "c" :> "b" :> End
|
|
:<|> "c" :> "a" :> "b" :> End
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> "b" :> "a" :> End
|
|
|
|
type PermuteRef =
|
|
"a" :> ( "b" :> "c" :> End
|
|
:<|> "c" :> "b" :> End
|
|
)
|
|
:<|> "b" :> ( "a" :> "c" :> End
|
|
:<|> "c" :> "a" :> End
|
|
)
|
|
:<|> "c" :> ( "a" :> "b" :> End
|
|
:<|> "b" :> "a" :> End
|
|
)
|
|
|
|
permute :: Proxy Permute
|
|
permute = Proxy
|
|
|
|
permuteRef :: Proxy PermuteRef
|
|
permuteRef = Proxy
|
|
|
|
-- Adding a 'Raw' in one of the ends should have minimal
|
|
-- effect on the grouping.
|
|
|
|
type PermuteRawEnd =
|
|
"a" :> "b" :> "c" :> End
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> "a" :> "c" :> "b" :> End
|
|
:<|> "c" :> "a" :> "b" :> End
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> "b" :> "a" :> End
|
|
:<|> Raw
|
|
|
|
type PermuteRawEndRef = PermuteRef :<|> Raw
|
|
|
|
type PermuteRawBegin =
|
|
Raw
|
|
:<|> "a" :> "b" :> "c" :> End
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> "a" :> "c" :> "b" :> End
|
|
:<|> "c" :> "a" :> "b" :> End
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> "b" :> "a" :> End
|
|
|
|
type PermuteRawBeginRef = Raw :<|> PermuteRef
|
|
|
|
permuteRawBegin :: Proxy PermuteRawBegin
|
|
permuteRawBegin = Proxy
|
|
|
|
permuteRawBeginRef :: Proxy PermuteRawBeginRef
|
|
permuteRawBeginRef = Proxy
|
|
|
|
permuteRawEnd :: Proxy PermuteRawEnd
|
|
permuteRawEnd = Proxy
|
|
|
|
permuteRawEndRef :: Proxy PermuteRawEndRef
|
|
permuteRawEndRef = Proxy
|
|
|
|
-- Adding a 'Raw' in the middle will disrupt grouping,
|
|
-- because we commute things past a 'Raw'. But the two
|
|
-- halves should still be grouped.
|
|
|
|
type PermuteRawMiddle =
|
|
"a" :> "b" :> "c" :> End
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> "a" :> "c" :> "b" :> End
|
|
:<|> Raw
|
|
:<|> "c" :> "a" :> "b" :> End
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> "b" :> "a" :> End
|
|
|
|
type PermuteRawMiddleRef =
|
|
"a" :> ( "b" :> "c" :> End
|
|
:<|> "c" :> "b" :> End
|
|
)
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> Raw
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> ( "a" :> "b" :> End
|
|
:<|> "b" :> "a" :> End
|
|
)
|
|
|
|
permuteRawMiddle :: Proxy PermuteRawMiddle
|
|
permuteRawMiddle = Proxy
|
|
|
|
permuteRawMiddleRef :: Proxy PermuteRawMiddleRef
|
|
permuteRawMiddleRef = Proxy
|
|
|
|
-- Adding an endpoint at the top-level in various places
|
|
-- is also somewhat critical for grouping, but it should
|
|
-- not disrupt grouping at all, even if it is placed in
|
|
-- the middle.
|
|
|
|
type PermuteEndEnd =
|
|
"a" :> "b" :> "c" :> End
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> "a" :> "c" :> "b" :> End
|
|
:<|> "c" :> "a" :> "b" :> End
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> "b" :> "a" :> End
|
|
:<|> End
|
|
|
|
type PermuteEndBegin =
|
|
End
|
|
:<|> "a" :> "b" :> "c" :> End
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> "a" :> "c" :> "b" :> End
|
|
:<|> "c" :> "a" :> "b" :> End
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> "b" :> "a" :> End
|
|
|
|
type PermuteEndMiddle =
|
|
"a" :> "b" :> "c" :> End
|
|
:<|> "b" :> "a" :> "c" :> End
|
|
:<|> "a" :> "c" :> "b" :> End
|
|
:<|> End
|
|
:<|> "c" :> "a" :> "b" :> End
|
|
:<|> "b" :> "c" :> "a" :> End
|
|
:<|> "c" :> "b" :> "a" :> End
|
|
|
|
type PermuteEndRef = PermuteRef :<|> End
|
|
|
|
permuteEndEnd :: Proxy PermuteEndEnd
|
|
permuteEndEnd = Proxy
|
|
|
|
permuteEndBegin :: Proxy PermuteEndBegin
|
|
permuteEndBegin = Proxy
|
|
|
|
permuteEndMiddle :: Proxy PermuteEndMiddle
|
|
permuteEndMiddle = Proxy
|
|
|
|
permuteEndRef :: Proxy PermuteEndRef
|
|
permuteEndRef = Proxy
|
|
|
|
-- An API with routes on different nesting levels that
|
|
-- is composed out of different fragments should still
|
|
-- be reordered correctly.
|
|
|
|
type LevelFragment1 =
|
|
"a" :> "b" :> End
|
|
:<|> "a" :> End
|
|
|
|
type LevelFragment2 =
|
|
"b" :> End
|
|
:<|> "a" :> "c" :> End
|
|
:<|> End
|
|
|
|
type Level = LevelFragment1 :<|> LevelFragment2
|
|
|
|
type LevelRef =
|
|
"a" :> ("b" :> End :<|> "c" :> End :<|> End)
|
|
:<|> "b" :> End
|
|
:<|> End
|
|
|
|
level :: Proxy Level
|
|
level = Proxy
|
|
|
|
levelRef :: Proxy LevelRef
|
|
levelRef = Proxy
|