{-# 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 (Text, unpack) import Data.Typeable (typeRep) 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 import Test.Hspec import Test.Hspec.Wai (get, shouldRespondWith, with) spec :: Spec spec = describe "Servant.Server.Internal.Router" $ do routerSpec distributivitySpec 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 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)) 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 -- 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\ \│ └─ /\n\ \│ ├─•\n\ \│ ┆\n\ \│ └─•\n\ \├─ c/\n\ \│ └─•\n\ \┆\n\ \└─ \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\ \ └─ /\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\ \ └─ /\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\ \ └─ /\n\ \ └─•\n"