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