{-# 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 qualified Data.List.NonEmpty as NonEmpty
import Data.Proxy (Proxy (Proxy))
import qualified Data.Semigroup
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',
    Header,
    QueryFlag,
    Raw,
    ReqBody',
    Summary,
    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 -> [(Text, SomeType)]
headers :: [(Text, SomeType)],
    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, [(Text, SomeType)]
headers :: [(Text, SomeType)]
headers :: Route -> [(Text, SomeType)]
headers} ->
          ( Route
route,
            case (Maybe SomeType
requestBody, SomeType
responseBody) of
              (Maybe SomeType
Nothing, SomeType Proxy t
t) ->
                ((Text, SomeType) -> Examples)
-> [(Text, SomeType)] -> List Examples
forall a b. (a -> b) -> List a -> List b
List.map (Text, SomeType) -> Examples
forall a. (a, SomeType) -> Examples
headersToExamples [(Text, SomeType)]
headers
                  List Examples
-> (List Examples -> NonEmpty Examples) -> NonEmpty Examples
forall a b. a -> (a -> b) -> b
|> Examples -> List Examples -> NonEmpty Examples
forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) (Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
t)
                  NonEmpty Examples -> (NonEmpty Examples -> Examples) -> Examples
forall a b. a -> (a -> b) -> b
|> NonEmpty Examples -> Examples
forall a. Semigroup a => NonEmpty a -> a
Data.Semigroup.sconcat
              (Just (SomeType Proxy t
s), SomeType Proxy t
t) ->
                ((Text, SomeType) -> Examples)
-> [(Text, SomeType)] -> List Examples
forall a b. (a -> b) -> List a -> List b
List.map (Text, SomeType) -> Examples
forall a. (a, SomeType) -> Examples
headersToExamples [(Text, SomeType)]
headers
                  List Examples
-> (List Examples -> NonEmpty Examples) -> NonEmpty Examples
forall a b. a -> (a -> b) -> b
|> Examples -> List Examples -> NonEmpty Examples
forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) (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)
                  NonEmpty Examples -> (NonEmpty Examples -> Examples) -> Examples
forall a b. a -> (a -> b) -> b
|> NonEmpty Examples -> Examples
forall a. Semigroup a => NonEmpty a -> a
Data.Semigroup.sconcat
          )
      )
  where
    headersToExamples :: (a, SomeType) -> Examples
headersToExamples (a
_, SomeType Proxy t
t) = 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] -> List (Maybe Text)) -> List (Maybe Text)
forall a b. a -> (a -> b) -> b
|> (Route -> List (Maybe Text)) -> [Route] -> List (Maybe Text)
forall a b. (a -> List b) -> List a -> List b
List.concatMap
      ( \Route
route ->
          [ case Route -> [(Text, SomeType)]
headers Route
route of
              [] -> Maybe Text
forall a. Maybe a
Nothing
              [(Text, SomeType)]
headers' ->
                Text -> Maybe Text
forall a. a -> Maybe a
Just
                  (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
<| Text -> [Text] -> Text
Text.join
                    Text
" "
                    ( Route -> Text
routeName Route
route Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
                      Text
"headers" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
                      ((Text, SomeType) -> Text) -> [(Text, SomeType)] -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (Text, SomeType) -> Text
printHeaders [(Text, SomeType)]
headers'
                    ),
            Text -> Maybe Text
forall a. a -> Maybe a
Just
              (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
<| Text -> [Text] -> Text
Text.join
                Text
" "
                [ Route -> Text
routeName Route
route,
                  Text
"response",
                  SomeType -> Text
printType (Route -> SomeType
responseBody Route
route)
                ],
            case Route -> Maybe SomeType
requestBody Route
route of
              Maybe SomeType
Nothing -> Maybe Text
forall a. Maybe a
Nothing
              Just SomeType
body ->
                Text -> Maybe Text
forall a. a -> Maybe a
Just
                  (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
<| Text -> [Text] -> Text
Text.join
                    Text
" "
                    [ Route -> Text
routeName Route
route,
                      Text
"request",
                      SomeType -> Text
printType SomeType
body
                    ]
          ]
      )
    List (Maybe Text) -> (List (Maybe Text) -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
|> (Maybe Text -> Maybe Text) -> List (Maybe Text) -> [Text]
forall a b. (a -> Maybe b) -> List a -> List b
List.filterMap Maybe Text -> Maybe Text
forall a. a -> a
identity
    [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"

printHeaders :: (Text, SomeType) -> Text
printHeaders :: (Text, SomeType) -> Text
printHeaders (Text
key, SomeType
val) =
  Text
"(" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
", " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ SomeType -> Text
printType SomeType
val Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
")"

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 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
-> [(Text, SomeType)]
-> Maybe SomeType
-> SomeType
-> Route
Route
        { path :: [Text]
path = [],
          headers :: [(Text, SomeType)]
headers = [],
          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 (Typeable.Typeable body, Examples.HasExamples body, IsApi a) => IsApi (ReqBody' x encodings body :> a) where
  crawl :: Proxy (ReqBody' x encodings body :> a) -> [Route]
crawl Proxy (ReqBody' x 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
  ( KnownSymbol key,
    Typeable.Typeable val,
    Examples.HasExamples val,
    IsApi a
  ) =>
  IsApi (Header key val :> a)
  where
  crawl :: Proxy (Header key val :> a) -> [Route]
crawl Proxy (Header key val :> 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
              { headers :: [(Text, SomeType)]
headers =
                  ( List Char -> Text
Text.fromList (Proxy key -> List Char
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> List Char
symbolVal (Proxy key
forall k (t :: k). Proxy t
Proxy :: Proxy key)),
                    Proxy val -> SomeType
forall k (t :: k).
(Typeable t, HasExamples t) =>
Proxy t -> SomeType
SomeType (Proxy val
forall k (t :: k). Proxy t
Proxy :: Proxy val)
                  ) (Text, SomeType) -> [(Text, SomeType)] -> [(Text, SomeType)]
forall a. a -> [a] -> [a]
:
                  Route -> [(Text, SomeType)]
headers Route
route
              }
        )

instance (IsApi a) => IsApi (Summary x :> a) where
  crawl :: Proxy (Summary x :> a) -> [Route]
crawl Proxy (Summary x :> 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" ()