RouteSpec.hs

module Servant.API.Routes.RouteSpec
  ( spec
  )
where

import Data.Coerce
import Data.Function
import qualified Data.Set as Set
import qualified Data.Text as T
import Lens.Micro
import Network.HTTP.Types.Method
import Servant.API.Routes.HeaderSpec hiding (spec)
import Servant.API.Routes.Internal.Auth
import Servant.API.Routes.Internal.Path
import Servant.API.Routes.Internal.Route
import Servant.API.Routes.ParamSpec hiding (spec)
import Servant.API.Routes.PathSpec (genAlphaText, shrinkText)
import Servant.API.Routes.RequestSpec ()
import Servant.API.Routes.ResponseSpec ()
import Servant.API.Routes.Route
import Servant.API.Routes.Util
import Test.Hspec as H
import Test.QuickCheck as Q

instance Q.Arbitrary Route where
  arbitrary = do
    _routeMethod <- renderStdMethod <$> Q.arbitraryBoundedEnum
    _routePath <- arbitrary
    _routeParams <- Set.fromList <$> Q.sublistOf [sing, arrayElem, flag]
    _routeRequestHeaders <- Set.fromList <$> Q.sublistOf sampleReps
    _routeRequestBody <- arbitrary
    _routeResponse <- arbitrary
    _routeAuths <- Set.fromList <$> Q.listOf genAuths
    _routeDescription <- Q.liftArbitrary genDescription
    _routeSummary <- Q.liftArbitrary genSummary

    pure Route {..}
    where
      genAuths =
        Q.oneof
          [ Basic <$> genAlphaText
          , Custom <$> genAlphaText
          ]
      genDescription = RouteDescription . T.unwords <$> Q.listOf genAlphaText
      genSummary = RouteSummary . T.unwords <$> Q.scale (`div` 2) (Q.listOf genAlphaText)

  shrink r =
    routeMethod shrinkMethod r
      <> routePath Q.shrink r
      <> routeParams shrinkSubset r
      <> routeRequestHeaders shrinkSubset r
      <> routeRequestBody Q.shrink r
      <> routeResponse Q.shrink r
      <> routeAuths (shrinkSet shrinkAuth) r
      <> routeDescription (Q.liftShrink (coerce shrinkText)) r
      <> routeSummary (Q.liftShrink (coerce shrinkText)) r
    where
      shrinkMethod = either (const []) (fmap renderStdMethod . Q.shrinkBoundedEnum) . parseMethod
      shrinkSet shr = fmap Set.fromList . Q.shrinkList shr . Set.toList
      shrinkSubset :: (Ord a) => Set.Set a -> [Set.Set a]
      shrinkSubset = shrinkSet (const [])
      shrinkAuth = \case
        Basic realm -> Basic <$> shrinkText realm
        Custom tag -> Custom <$> shrinkText tag

spec :: Spec
spec = do
  describe "Route" $ do
    describe "renderRoute" $ do
      it "renders default route correctly" $
        renderRoute (defRoute "POST") `shouldBe` "POST " <> pathSeparator
      it "renders path correctly" $
        let route =
              defRoute "GET"
                & routePath .~ Path ["api", "v2"]
            expected = "GET /api/v2"
        in  renderRoute route `shouldBe` expected
      it "renders query params correctly" $
        let route =
              defRoute "PUT"
                & routePath .~ Path ["api", "v2"]
                & routeParams .~ Set.fromList [sing, arrayElem, flag]
            expected = "PUT /api/v2?" <> T.intercalate "&" [singExpected, arrayElemExpected, flagExpected]
        in  renderRoute route `shouldBe` expected
  describe "Hand-rolled instances" $ do
    testEqInstances @ParamBasicQInstance
    testOrdInstances @ParamBasicQInstance