content: {-# LANGUAGE CPP #-}
  
  module Servant.API.RoutesSpec
    ( spec
    )
  where
  
  import Data.Function
  import qualified Data.Set as Set
  import qualified Data.Text as T
  import GHC.Generics
  import Lens.Micro
  import Servant.API
  import Servant.API.Routes
  import Servant.API.Routes.Internal.Response
  import Servant.API.Routes.Route
  import Servant.API.Routes.RouteSpec ()
  import Test.Hspec as H
  import Test.Hspec.QuickCheck as H
  import Test.QuickCheck as Q
  
  instance Q.Arbitrary Routes where
    -- we use the 'Routes' pattern to handle removing duplicates etc
    arbitrary = Routes <$> Q.arbitrary
    shrink (Routes routes) = Routes <$> Q.shrink routes
  
  type SubAPI = ReqBody '[JSON] String :> Post '[JSON] Int
  
  type DescriptionEP1 =
    "ep1" :> Description "This has a description" :> Get '[JSON] Int
  
  type DescriptionEP2 =
    "ep2" :> Get '[JSON] String
  
  type DescriptionAPI = DescriptionEP1 :<|> DescriptionEP2
  
  type SummaryEP1 =
    "ep1" :> Summary "This has a description" :> Get '[JSON] Int
  
  type SummaryEP2 =
    "ep2" :> Get '[JSON] String
  
  type SummaryAPI = SummaryEP1 :<|> SummaryEP2
  
  type SubAPI2 = Header "h1" T.Text :> "x" :> ("y" :> Put '[JSON] String :<|> SubAPI)
  
  type SubAPI3 =
    Header "h1" T.Text
      :> "x"
      :> ( "y" :> Put '[JSON] String
            :<|> "z" :> Header' '[Optional] "h2" Int :> Get '[JSON] [Integer]
         )
  
  intRequest :: Request
  intRequest = oneRequest @Int
  
  intResponse :: Responses
  intResponse = oneResponse @Int
  
  strResponse :: Responses
  strResponse = oneResponse @String
  
  #if MIN_VERSION_servant(0,19,0)
  data API mode = API
    { ep1 :: mode :- SubAPI
    , ep2 :: mode :- SubAPI2
    , ep3 :: mode :- SubAPI3
    } deriving Generic
  #endif
  
  sameRoutes ::
    forall l r.
    (HasRoutes l, HasRoutes r) =>
    Expectation
  sameRoutes = getRoutes @l `shouldMatchList` getRoutes @r
  
  sameRoutesAsSub ::
    forall l.
    (HasRoutes l) =>
    Expectation
  sameRoutesAsSub = sameRoutes @l @SubAPI
  
  unchanged ::
    forall l.
    (HasRoutes (l :> SubAPI)) =>
    Expectation
  unchanged = sameRoutesAsSub @(l :> SubAPI)
  
  spec :: Spec
  spec = do
    describe "Routes" $ do
      describe "makeRoutes/unmakeRoutes" $
        prop "correctly removes duplicates" $
          \routes ->
            let -- ~ routesList = unmakeRoutes routes
                Routes routesList = routes
                -- ~ routes2 = unmakeRoutes (routesList <> routesList)
                routes2 = Routes (routesList <> routesList)
            in  routes2 === routes
    describe "HasRoutes" $ do
      describe "base cases" $ do
        it "EmptyAPI" $ getRoutes @EmptyAPI `shouldMatchList` []
        it "UVerb" $ do
          getRoutes @(UVerb 'POST '[JSON] '[])
            `shouldMatchList` [ defRoute "POST"
                              ]
          getRoutes @(UVerb 'POST '[JSON] '[Int])
            `shouldMatchList` [ defRoute "POST"
                                  & routeResponse .~ intResponse
                              ]
          getRoutes @(UVerb 'POST '[JSON] '[Int, String])
            `shouldMatchList` [ defRoute "POST"
                                  & routeResponse .~ intResponse <> strResponse
                              ]
          getRoutes @(UVerb 'POST '[JSON] '[Headers '[] Int, String])
            `shouldMatchList` [ defRoute "POST"
                                  & routeResponse .~ strResponse <> intResponse
                              ]
          getRoutes
            @( UVerb
                'POST
                '[JSON]
                '[ Headers '[] (Headers '[Header "h2" String] Int)
                 , Headers '[Header "h1" [Int], Header "h3" Int] String
                 ]
             )
            `shouldMatchList` [ defRoute "POST"
                                  & routeResponse
                                    .~ ( strResponse
                                          & unResponses . traversed . responseHeaders
                                            <>~ Set.fromList
                                              [ mkHeaderRep @"h1" @[Int]
                                              , mkHeaderRep @"h3" @Int
                                              ]
                                       )
                                      <> ( intResponse
                                            & (unResponses . traversed . responseHeaders)
                                              `add` (mkHeaderRep @"h2" @String)
                                         )
                              ]
        it "Verb" $ do
          getRoutes @(Post '[JSON] Int) `shouldMatchList` [defRoute "POST" & routeResponse .~ intResponse]
          getRoutes @(Post '[JSON] (Headers '[Header "h1" String] Int))
            `shouldMatchList` [ defRoute "POST"
                                  & routeResponse .~ oneResponse @(Headers '[Header "h1" String] Int)
                              ]
        it "Stream" $ do
          getRoutes @(Stream 'POST 201 NoFraming JSON Int) `shouldMatchList` [defRoute "POST" & routeResponse .~ intResponse]
  
      describe "boring: combinators that don't change routes" $ do
        it "Fragment" $ unchanged @(Fragment Int)
        it "Vault" $ unchanged @Vault
        it "HttpVersion" $ unchanged @HttpVersion
        it "IsSecure" $ unchanged @IsSecure
        it "RemoteHost" $ unchanged @RemoteHost
        it "WithNamedContext" $ sameRoutesAsSub @(WithNamedContext "name" '[] SubAPI)
  
      describe "recursive: some combinators combine or alter routes" $ do
        it ":<|>" $ getRoutes @(SubAPI :<|> SubAPI2) `shouldMatchList` getRoutes @SubAPI <> getRoutes @SubAPI2
        it "NoContentVerb" $
          renderRoute <$> getRoutes @(NoContentVerb 'POST) `shouldMatchList` ["POST /"]
        describe "Description" $ do
          it "Should work as intended" $
            getRoutes @(Description "desc" :> SubAPI)
              `shouldMatchList` (getRoutes @SubAPI <&> routeDescription ?~ "desc")
          it "Should not override more specific descriptions" $
            getRoutes @(Description "desc1" :> Description "desc2" :> SubAPI)
              `shouldMatchList` getRoutes @(Description "desc2" :> SubAPI)
          it "Should set description for sub-routes without descriptions" $
            let epRoute1 = getRoutes @DescriptionEP1
                epRoute2 = getRoutes @DescriptionEP2
                withAddedDescRoutes = getRoutes @(Description "Overall" :> DescriptionAPI)
                expectedRoutes = epRoute1 <> (epRoute2 & traversed . routeDescription ?~ "Overall")
            in  withAddedDescRoutes `shouldMatchList` expectedRoutes
        describe "Summary" $ do
          it "Should work as intended" $
            getRoutes @(Summary "summ" :> SubAPI)
              `shouldMatchList` (getRoutes @SubAPI <&> routeSummary ?~ "summ")
          it "Should not override more specific summaries" $
            getRoutes @(Summary "summ1" :> Summary "summ2" :> SubAPI)
              `shouldMatchList` getRoutes @(Summary "summ2" :> SubAPI)
          it "Should set summary for sub-routes without summaries" $
            let epRoute1 = getRoutes @SummaryEP1
                epRoute2 = getRoutes @SummaryEP2
                withAddedSummRoutes = getRoutes @(Summary "Overall" :> SummaryAPI)
                expectedRoutes = epRoute1 <> (epRoute2 & traversed . routeSummary ?~ "Overall")
            in  withAddedSummRoutes `shouldMatchList` expectedRoutes
        it "Symbol :>" $ do
          let prep = routePath %~ prependPathPart "sym"
          getRoutes @("sym" :> SubAPI) `shouldMatchList` prep <$> getRoutes @SubAPI
          getRoutes @("sym" :> SubAPI2) `shouldMatchList` prep <$> getRoutes @SubAPI2
          getRoutes @("sym" :> SubAPI3) `shouldMatchList` prep <$> getRoutes @SubAPI3
        it "Header' :>" $ do
          let addH = routeRequestHeaders `add` (mkHeaderRep @"h1" @Int)
          getRoutes @(Header' '[Required] "h1" Int :> SubAPI) `shouldMatchList` addH <$> getRoutes @SubAPI
          getRoutes @(Header' '[Required] "h1" Int :> SubAPI2) `shouldMatchList` addH <$> getRoutes @SubAPI2
          getRoutes @(Header' '[Required] "h1" Int :> SubAPI3) `shouldMatchList` addH <$> getRoutes @SubAPI3
          let addHOptional = routeRequestHeaders `add` (mkHeaderRep @"h1" @(Maybe Int))
          getRoutes @(Header' '[Optional] "h1" Int :> SubAPI) `shouldMatchList` addHOptional <$> getRoutes @SubAPI
          getRoutes @(Header' '[Optional] "h1" Int :> SubAPI2) `shouldMatchList` addHOptional <$> getRoutes @SubAPI2
          getRoutes @(Header' '[Optional] "h1" Int :> SubAPI3) `shouldMatchList` addHOptional <$> getRoutes @SubAPI3
        it "BasicAuth :>" $ do
          let addAuth = routeAuths `add` basicAuth @"realm"
          getRoutes @(BasicAuth "realm" String :> SubAPI) `shouldMatchList` addAuth <$> getRoutes @SubAPI
          getRoutes @(BasicAuth "realm" String :> SubAPI2) `shouldMatchList` addAuth <$> getRoutes @SubAPI2
          getRoutes @(BasicAuth "realm" String :> SubAPI3) `shouldMatchList` addAuth <$> getRoutes @SubAPI3
        it "AuthProtect :>" $ do
          let addAuth = routeAuths `add` customAuth @"my-special-auth"
          getRoutes @(AuthProtect "my-special-auth" :> SubAPI) `shouldMatchList` addAuth <$> getRoutes @SubAPI
          getRoutes @(AuthProtect "my-special-auth" :> SubAPI2) `shouldMatchList` addAuth <$> getRoutes @SubAPI2
          getRoutes @(AuthProtect "my-special-auth" :> SubAPI3) `shouldMatchList` addAuth <$> getRoutes @SubAPI3
        it "QueryFlag :>" $ do
          let addFlag = routeParams `add` (flagParam @"sym")
          getRoutes @(QueryFlag "sym" :> SubAPI) `shouldMatchList` addFlag <$> getRoutes @SubAPI
          getRoutes @(QueryFlag "sym" :> SubAPI2) `shouldMatchList` addFlag <$> getRoutes @SubAPI2
          getRoutes @(QueryFlag "sym" :> SubAPI3) `shouldMatchList` addFlag <$> getRoutes @SubAPI3
        it "QueryParam' :>" $ do
          let addP = routeParams `add` (singleParam @"h1" @Int)
          getRoutes @(QueryParam' '[Required] "h1" Int :> SubAPI) `shouldMatchList` addP <$> getRoutes @SubAPI
          getRoutes @(QueryParam' '[Required] "h1" Int :> SubAPI2) `shouldMatchList` addP <$> getRoutes @SubAPI2
          getRoutes @(QueryParam' '[Required] "h1" Int :> SubAPI3) `shouldMatchList` addP <$> getRoutes @SubAPI3
          let addPOptional = routeParams `add` (singleParam @"h1" @(Maybe Int))
          getRoutes @(QueryParam' '[Optional] "h1" Int :> SubAPI) `shouldMatchList` addPOptional <$> getRoutes @SubAPI
          getRoutes @(QueryParam' '[Optional] "h1" Int :> SubAPI2) `shouldMatchList` addPOptional <$> getRoutes @SubAPI2
          getRoutes @(QueryParam' '[Optional] "h1" Int :> SubAPI3) `shouldMatchList` addPOptional <$> getRoutes @SubAPI3
        it "QueryParams :>" $ do
          let addP = routeParams `add` (arrayElemParam @"h1" @Int)
          getRoutes @(QueryParams "h1" Int :> SubAPI) `shouldMatchList` addP <$> getRoutes @SubAPI
          getRoutes @(QueryParams "h1" Int :> SubAPI2) `shouldMatchList` addP <$> getRoutes @SubAPI2
          getRoutes @(QueryParams "h1" Int :> SubAPI3) `shouldMatchList` addP <$> getRoutes @SubAPI3
        it "ReqBody' :>" $ do
          let addB = routeRequestBody <>~ intRequest
          getRoutes @(ReqBody '[JSON] Int :> SubAPI) `shouldMatchList` addB <$> getRoutes @SubAPI
          getRoutes @(ReqBody '[JSON] Int :> SubAPI2) `shouldMatchList` addB <$> getRoutes @SubAPI2
          getRoutes @(ReqBody '[JSON] Int :> SubAPI3) `shouldMatchList` addB <$> getRoutes @SubAPI3
        it "StreamBody' :>" $ do
          let addB = routeRequestBody <>~ intRequest
          getRoutes @(ReqBody '[JSON] Int :> SubAPI) `shouldMatchList` addB <$> getRoutes @SubAPI
          getRoutes @(ReqBody '[JSON] Int :> SubAPI2) `shouldMatchList` addB <$> getRoutes @SubAPI2
          getRoutes @(StreamBody NoFraming JSON Int :> SubAPI3) `shouldMatchList` addB <$> getRoutes @SubAPI3
        it "Capture' :>" $ do
          let addC = routePath %~ prependCapturePart @Int "cap"
          getRoutes @(Capture "cap" Int :> SubAPI) `shouldMatchList` addC <$> getRoutes @SubAPI
          getRoutes @(Capture "cap" Int :> SubAPI2) `shouldMatchList` addC <$> getRoutes @SubAPI2
          getRoutes @(Capture "cap" Int :> SubAPI3) `shouldMatchList` addC <$> getRoutes @SubAPI3
        it "CaptureAll :>" $ do
          let addC = routePath %~ prependCaptureAllPart @Int "cap"
          getRoutes @(CaptureAll "cap" Int :> SubAPI) `shouldMatchList` addC <$> getRoutes @SubAPI
          getRoutes @(CaptureAll "cap" Int :> SubAPI2) `shouldMatchList` addC <$> getRoutes @SubAPI2
          getRoutes @(CaptureAll "cap" Int :> SubAPI3) `shouldMatchList` addC <$> getRoutes @SubAPI3
  #if MIN_VERSION_servant(0,19,0)
        it "NamedRoutes" $
          getRoutes @(NamedRoutes API) `shouldMatchList` getRoutes @SubAPI <> getRoutes @SubAPI2 <> getRoutes @SubAPI3
  #endif
  