servant/servant-server/test/Servant/Server/RouterSpec.hs

463 lines
13 KiB
Haskell
Raw Normal View History

2018-06-29 21:08:26 +02:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
2018-06-29 21:08:26 +02:00
{-# LANGUAGE TypeOperators #-}
module Servant.Server.RouterSpec (spec) where
2018-06-29 21:08:26 +02:00
import Control.Monad
(unless)
import Data.Proxy
(Proxy (..))
import Data.Text
(Text, unpack)
import Data.Typeable
(typeRep)
2018-06-29 21:08:26 +02:00
import Network.HTTP.Types
(Status (..))
import Network.Wai
(responseBuilder)
import Network.Wai.Internal
(Response (ResponseBuilder))
import Servant.API
import Servant.Server
import Servant.Server.Internal
2018-06-29 21:08:26 +02:00
import Test.Hspec
import Test.Hspec.Wai
(get, shouldRespondWith, with)
2016-04-18 12:07:23 +02:00
spec :: Spec
spec = describe "Servant.Server.Internal.Router" $ do
routerSpec
distributivitySpec
2022-03-14 10:48:38 +01:00
serverLayoutSpec
routerSpec :: Spec
routerSpec = do
describe "tweakResponse" $ do
let app' :: Application
app' = toApplication $ runRouter (const err404) 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
with (return app') $ do
it "calls f on route result" $ do
get "" `shouldRespondWith` 202
describe "runRouter" $ do
let toApp :: Router () -> Application
toApp = toApplication . runRouter (const err404)
cap :: Router ()
cap = CaptureRouter [hint] $
let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)
in leafRouter
$ \env req res ->
runAction delayed env req res
. const
$ Route success
hint :: CaptureHint
hint = CaptureHint "anything" $ typeRep (Proxy :: Proxy ())
router :: Router ()
router = leafRouter (\_ _ res -> res $ Route success)
`Choice` cap
success :: Response
success = responseBuilder (Status 200 "") [] ""
with (pure $ toApp router) $ do
it "capture failure returns a 400 response" $ do
get "/badcapture" `shouldRespondWith` 400
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 QueryParams" $ do
permuteQuery `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
2022-03-14 10:48:38 +01:00
serverLayoutSpec :: Spec
serverLayoutSpec =
describe "serverLayout" $ do
it "correctly represents the example API" $ do
exampleLayout `shouldHaveLayout` expectedExampleLayout
it "aggregates capture hints when different" $ do
captureDifferentTypes `shouldHaveLayout` expectedCaptureDifferentTypes
it "nubs capture hints when equal" $ do
captureSameType `shouldHaveLayout` expectedCaptureSameType
it "properly displays CaptureAll hints" $ do
captureAllLayout `shouldHaveLayout` expectedCaptureAllLayout
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))
2022-03-14 10:48:38 +01:00
shouldHaveLayout ::
(HasServer api '[]) => Proxy api -> Text -> Expectation
shouldHaveLayout p l =
unless (routerLayout (makeTrivialRouter p) == l) $
expectationFailure ("expected:\n" ++ unpack l ++ "\nbut got:\n" ++ unpack (layout p))
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 "foo" Int :> "c" :> End
:<|> "a" :> Capture "foo" Int :> "d" :> End
type DynamicRef =
"a" :> Capture "foo" Int :>
("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 "QueryParam" should not affect structure
type PermuteQuery =
QueryParam "1" Int :> "a" :> "b" :> "c" :> End
:<|> QueryParam "2" Int :> "b" :> "a" :> "c" :> End
:<|> QueryParam "3" Int :> "a" :> "c" :> "b" :> End
:<|> QueryParam "4" Int :> "c" :> "a" :> "b" :> End
:<|> QueryParam "5" Int :> "b" :> "c" :> "a" :> End
:<|> QueryParam "6" Int :> "c" :> "b" :> "a" :> End
permuteQuery :: Proxy PermuteQuery
permuteQuery = 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
2022-03-14 10:48:38 +01:00
-- The example API for the 'layout' function.
-- Should get factorized by the 'choice' smart constructor.
type ExampleLayout =
"a" :> "d" :> Get '[JSON] NoContent
:<|> "b" :> Capture "x" Int :> Get '[JSON] Bool
:<|> "c" :> Put '[JSON] Bool
:<|> "a" :> "e" :> Get '[JSON] Int
:<|> "b" :> Capture "x" Int :> Put '[JSON] Bool
:<|> Raw
exampleLayout :: Proxy ExampleLayout
exampleLayout = Proxy
-- The expected representation of the example API layout
--
expectedExampleLayout :: Text
expectedExampleLayout =
"/\n\
\ a/\n\
\ d/\n\
\ \n\
\ e/\n\
\ \n\
\ b/\n\
\ <x::Int>/\n\
\ \n\
\ \n\
\ \n\
\ c/\n\
\ \n\
\\n\
\ <raw>\n"
-- A capture API with all capture types being the same
--
type CaptureSameType =
"a" :> Capture "foo" Int :> "b" :> End
:<|> "a" :> Capture "foo" Int :> "c" :> End
:<|> "a" :> Capture "foo" Int :> "d" :> End
captureSameType :: Proxy CaptureSameType
captureSameType = Proxy
-- The expected representation of the CaptureSameType API layout.
--
expectedCaptureSameType :: Text
expectedCaptureSameType =
"/\n\
\ a/\n\
\ <foo::Int>/\n\
\ b/\n\
\ \n\
\ c/\n\
\ \n\
\ d/\n\
\ \n"
-- A capture API capturing different types
--
type CaptureDifferentTypes =
"a" :> Capture "foo" Int :> "b" :> End
:<|> "a" :> Capture "bar" Bool :> "c" :> End
:<|> "a" :> Capture "baz" Char :> "d" :> End
captureDifferentTypes :: Proxy CaptureDifferentTypes
captureDifferentTypes = Proxy
-- The expected representation of the CaptureDifferentTypes API layout.
--
expectedCaptureDifferentTypes :: Text
expectedCaptureDifferentTypes =
"/\n\
\ a/\n\
\ <foo::Int|bar::Bool|baz::Char>/\n\
\ b/\n\
\ \n\
\ c/\n\
\ \n\
\ d/\n\
\ \n"
-- An API with a CaptureAll part
type CaptureAllLayout = "a" :> CaptureAll "foos" Int :> End
captureAllLayout :: Proxy CaptureAllLayout
captureAllLayout = Proxy
-- The expected representation of the CaptureAllLayout API.
--
expectedCaptureAllLayout :: Text
expectedCaptureAllLayout =
"/\n\
\ a/\n\
\ <foos::[Int]>/\n\
\ \n"