{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Test helpers to ensure we don't change types or encodings of types
-- used in our request and response bodies by accident. `crawl` will
-- traverse our entire `Routes` API for request and response body types,
-- and fail to compile if we don't provide example values for each. We
-- can then run a golden result test for each, meaning we encode each
-- example value to JSON and check it matches a known-good encoding we
-- have comitted to the repo.
module Test.Encoding.Routes (tests, IsApi (..)) where

import Data.Proxy (Proxy (Proxy))
import qualified Data.Typeable as Typeable
import qualified Debug
import qualified Examples
import qualified Expect
import GHC.TypeLits (KnownSymbol, symbolVal)
import qualified List
import NriPrelude
import qualified Servant
import Servant.API (Capture', QueryFlag, Raw, ReqBody, Verb, (:<|>), (:>))
import Servant.API.Generic (ToServantApi)
import qualified Servant.Auth.Server
import Test (Test, describe, test)
import qualified Test.Encoding
import qualified Text

-- | Creates tests for routes and custom types used in routes.
--
-- Example usage:
--   describe
--     "Spec.ApiEncoding"
--     (TestEncoding.tests (Proxy :: Proxy Routes.Routes))
tests :: forall routes. IsApi (ToServantApi routes) => Proxy routes -> List Test
tests :: Proxy routes -> List Test
tests Proxy routes
_ =
  let routes :: [Route]
routes = Proxy (GToServant (Rep (routes AsApi))) -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy (GToServant (Rep (routes AsApi)))
forall k (t :: k). Proxy t
Proxy :: Proxy (ToServantApi routes))
   in [ HasCallStack => Text -> (() -> Expectation) -> Test
Text -> (() -> Expectation) -> Test
test Text
"route types haven't changed" ((() -> Expectation) -> Test) -> (() -> Expectation) -> Test
forall a b. (a -> b) -> a -> b
<| \() ->
          [Route]
routes
            [Route] -> ([Route] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> [Route] -> Text
routesToText
            Text -> (Text -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> HasCallStack => Text -> Text -> Expectation
Text -> Text -> Expectation
Expect.equalToContentsOf Text
"test/golden-results/route-types.json",
        Text -> List Test -> Test
describe
          Text
"encodings of custom types"
          ( [Route]
routes
              [Route]
-> ([Route] -> List (Route, Examples)) -> List (Route, Examples)
forall a b. a -> (a -> b) -> b
|> [Route] -> List (Route, Examples)
routesWithExamples
              List (Route, Examples)
-> (List (Route, Examples) -> List Test) -> List Test
forall a b. a -> (a -> b) -> b
|> ((Route, Examples) -> Test) -> List (Route, Examples) -> List Test
forall a b. (a -> b) -> List a -> List b
List.map
                ( \(Route
route, Examples
examples) ->
                    Text -> Text -> Examples -> Test
Test.Encoding.examplesToTest (Text
"Examples for route `" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Route -> Text
routeName Route
route Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"`") (Route -> Text
routeToFileName Route
route) Examples
examples
                )
          )
      ]

data Route = Route
  { Route -> [Text]
path :: [Text],
    Route -> Text
method :: Text,
    Route -> Maybe SomeType
requestBody :: Maybe SomeType,
    Route -> SomeType
responseBody :: SomeType
  }

data SomeType where
  SomeType :: (Typeable.Typeable t, Examples.HasExamples t) => Proxy t -> SomeType

routesWithExamples :: List Route -> List (Route, Examples.Examples)
routesWithExamples :: [Route] -> List (Route, Examples)
routesWithExamples [Route]
routes =
  [Route]
routes
    [Route]
-> ([Route] -> List (Route, Examples)) -> List (Route, Examples)
forall a b. a -> (a -> b) -> b
|> (Route -> (Route, Examples)) -> [Route] -> List (Route, Examples)
forall a b. (a -> b) -> List a -> List b
List.map
      ( \route :: Route
route@Route {Maybe SomeType
requestBody :: Maybe SomeType
requestBody :: Route -> Maybe SomeType
requestBody, SomeType
responseBody :: SomeType
responseBody :: Route -> SomeType
responseBody} ->
          ( Route
route,
            case (Maybe SomeType
requestBody, SomeType
responseBody) of
              (Maybe SomeType
Nothing, SomeType Proxy t
t) -> Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
t
              (Just (SomeType Proxy t
s), SomeType Proxy t
t) -> Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
s Examples -> Examples -> Examples
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
t
          )
      )

routeName :: Route -> Text
routeName :: Route -> Text
routeName Route
route =
  Text -> [Text] -> Text
Text.join Text
" " [Route -> Text
method Route
route, Text -> [Text] -> Text
Text.join Text
"/" (Route -> [Text]
path Route
route)]

routeToFileName :: Route -> Text
routeToFileName :: Route -> Text
routeToFileName Route
route =
  Route -> Text
method Route
route Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"-" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> [Text] -> Text
Text.join Text
"-" (Route -> [Text]
path Route
route) Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
".json"

routesToText :: List Route -> Text
routesToText :: [Route] -> Text
routesToText [Route]
routes =
  [Route]
routes
    [Route] -> ([Route] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
|> (Route -> [Text]) -> [Route] -> [Text]
forall a b. (a -> List b) -> List a -> List b
List.concatMap
      ( \Route
route ->
          case Route -> Maybe SomeType
requestBody Route
route of
            Maybe SomeType
Nothing ->
              [ Text -> [Text] -> Text
Text.join
                  Text
" "
                  [ Route -> Text
routeName Route
route,
                    Text
"response",
                    SomeType -> Text
printType (Route -> SomeType
responseBody Route
route)
                  ]
              ]
            Just SomeType
body ->
              [ Text -> [Text] -> Text
Text.join
                  Text
" "
                  [ Route -> Text
routeName Route
route,
                    Text
"response",
                    SomeType -> Text
printType (Route -> SomeType
responseBody Route
route)
                  ],
                Text -> [Text] -> Text
Text.join
                  Text
" "
                  [ Route -> Text
routeName Route
route,
                    Text
"request",
                    SomeType -> Text
printType SomeType
body
                  ]
              ]
      )
    [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
|> [Text] -> [Text]
forall a. Ord a => List a -> List a
List.sort
    [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> [Text] -> Text
Text.join Text
"\n"

printType :: SomeType -> Text
printType :: SomeType -> Text
printType (SomeType Proxy t
t) =
  Proxy t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep Proxy t
t
    TypeRep -> (TypeRep -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> TypeRep -> Text
forall a. Show a => a -> Text
Debug.toString

-- | A helper type class that provides us example values of particular types.
-- The `IsApi` typeclass below will demand we define an instance of this type
-- class for each type used in a request or response body.

-- | A helper type class that can crawl our servant `Routes` type and return us
-- JSON-encoded examples for each request and response body type in that API.
-- Example usage:
--
--   routes = crawl (Proxy :: Proxy (ToServantApi Routes.Routes))
class IsApi a where
  crawl :: Proxy a -> [Route]

instance (IsApi a, IsApi b) => IsApi (a :<|> b) where
  crawl :: Proxy (a :<|> b) -> [Route]
crawl Proxy (a :<|> b)
_ = Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) [Route] -> [Route] -> [Route]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Proxy b -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)

instance (KnownSymbol s, IsApi a) => IsApi (s :> a) where
  crawl :: Proxy (s :> a) -> [Route]
crawl Proxy (s :> a)
_ =
    Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
      [Route] -> ([Route] -> [Route]) -> [Route]
forall a b. a -> (a -> b) -> b
|> (Route -> Route) -> [Route] -> [Route]
forall a b. (a -> b) -> List a -> List b
List.map
        ( \Route
route ->
            Route
route
              { path :: [Text]
path =
                  List Char -> Text
Text.fromList (Proxy s -> List Char
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> List Char
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
                  Route -> [Text]
path Route
route
              }
        )

instance (KnownSymbol s, IsApi a) => IsApi (Capture' mods s paramType :> a) where
  crawl :: Proxy (Capture' mods s paramType :> a) -> [Route]
crawl Proxy (Capture' mods s paramType :> a)
_ =
    Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
      [Route] -> ([Route] -> [Route]) -> [Route]
forall a b. a -> (a -> b) -> b
|> (Route -> Route) -> [Route] -> [Route]
forall a b. (a -> b) -> List a -> List b
List.map
        ( \Route
route ->
            Route
route
              { path :: [Text]
path = (Text
":" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ List Char -> Text
Text.fromList (Proxy s -> List Char
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> List Char
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Route -> [Text]
path Route
route
              }
        )

instance (Typeable.Typeable body, Examples.HasExamples body, IsApi a) => IsApi (ReqBody encodings body :> a) where
  crawl :: Proxy (ReqBody encodings body :> a) -> [Route]
crawl Proxy (ReqBody encodings body :> a)
_ =
    Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
      [Route] -> ([Route] -> [Route]) -> [Route]
forall a b. a -> (a -> b) -> b
|> (Route -> Route) -> [Route] -> [Route]
forall a b. (a -> b) -> List a -> List b
List.map
        ( \Route
route ->
            Route
route
              { requestBody :: Maybe SomeType
requestBody = SomeType -> Maybe SomeType
forall a. a -> Maybe a
Just (Proxy body -> SomeType
forall k (t :: k).
(Typeable t, HasExamples t) =>
Proxy t -> SomeType
SomeType (Proxy body
forall k (t :: k). Proxy t
Proxy :: Proxy body))
              }
        )

instance
  (Typeable.Typeable method, Typeable.Typeable body, Examples.HasExamples body) =>
  IsApi (Verb method status encodings body)
  where
  crawl :: Proxy (Verb method status encodings body) -> [Route]
crawl Proxy (Verb method status encodings body)
_ =
    [ Route :: [Text] -> Text -> Maybe SomeType -> SomeType -> Route
Route
        { path :: [Text]
path = [],
          requestBody :: Maybe SomeType
requestBody = Maybe SomeType
forall a. Maybe a
Nothing,
          method :: Text
method =
            Proxy method -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
              TypeRep -> (TypeRep -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> TypeRep -> Text
forall a. Show a => a -> Text
Debug.toString,
          responseBody :: SomeType
responseBody = Proxy body -> SomeType
forall k (t :: k).
(Typeable t, HasExamples t) =>
Proxy t -> SomeType
SomeType (Proxy body
forall k (t :: k). Proxy t
Proxy :: Proxy body)
        }
    ]

instance (IsApi a) => IsApi (Servant.Auth.Server.Auth types user :> a) where
  crawl :: Proxy (Auth types user :> a) -> [Route]
crawl Proxy (Auth types user :> a)
_ = Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance IsApi Raw where
  crawl :: Proxy Raw -> [Route]
crawl Proxy Raw
_ = []

instance (IsApi a) => IsApi (QueryFlag flag :> a) where
  crawl :: Proxy (QueryFlag flag :> a) -> [Route]
crawl Proxy (QueryFlag flag :> a)
_ = Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance Examples.HasExamples Servant.NoContent where
  examples :: Proxy NoContent -> Examples
examples Proxy NoContent
_ = Text -> () -> Examples
forall a. ToJSON a => Text -> a -> Examples
Examples.example Text
"NoContent" ()