{-# LANGUAGE CPP #-}
module Hedgehog.Servant
  ( GList(..)
  , HasGen(..)
  , GenRequest(..)
  ) where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Internal as BS (c2w)
import qualified Data.CaseInsensitive as CI
import           Data.Proxy (Proxy(..))
import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.Text as Text
import           Data.String.Conversions (ConvertibleStrings, cs)
import           GHC.TypeLits (KnownSymbol, symbolVal)
import           Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import           Network.HTTP.Media (renderHeader)
import           Network.HTTP.Client (Request(..), RequestBody(..))
import           Network.HTTP.Client (defaultRequest)
import           Network.HTTP.Types (HeaderName)
import           Servant.API (ToHttpApiData(..))
import           Servant.API (Capture', CaptureAll, Header', Description, Summary)
import           Servant.API (QueryParam', QueryParams, QueryFlag)
import           Servant.API (ReqBody', Verb, ReflectMethod)
import           Servant.API (BasicAuth, HttpVersion, IsSecure, RemoteHost, Vault)
import           Servant.API (WithNamedContext)
import           Servant.API ((:>), (:<|>))
import           Servant.API (reflectMethod)
import           Servant.API.ContentTypes (AllMimeRender(..))
import           Servant.Client (BaseUrl(..), Scheme(..))

#if MIN_VERSION_servant(0, 17, 0)
import           Servant.API (NoContentVerb)
#endif

#if MIN_VERSION_servant(0, 18, 1)
import           Servant.API (UVerb)
#endif

-- | Data structure used in order to specify generators for API
--
-- Example usage:
--
-- @
-- type Api = "cats" :> ReqBody '[JSON] Cat :> Post '[JSON] ()
--
-- catGen :: Gen Cat
-- catGen = _
--
-- genApi :: Gen (BaseUrl -> Request)
-- genApi = genRequest (Proxy @Api) (catGen :*: GNil)
-- @
data GList (a :: [*]) where
  GNil :: GList '[]
  (:*:) :: Gen x -> GList xs -> GList (Gen x ': xs)

infixr 6 :*:

-- | Simple getter from a GList of possible generators
class HasGen (g :: *) (gens :: [*]) where
  getGen :: GList gens -> Gen g

instance {-# OVERLAPPING #-} HasGen h (Gen h ': rest) where
  getGen :: GList (Gen h : rest) -> Gen h
getGen (Gen x
ha :*: GList xs
_) = Gen h
Gen x
ha

instance {-# OVERLAPPABLE #-} (HasGen h rest) => HasGen h (first ': rest) where
  getGen :: GList (first : rest) -> Gen h
getGen (Gen x
_ :*: GList xs
hs) = GList xs -> Gen h
forall g (gens :: [*]). HasGen g gens => GList gens -> Gen g
getGen GList xs
hs

-- | Type class used to generate requests from a 'GList gens' for API @api@
class GenRequest (api :: *) (gens :: [*]) where
  genRequest :: Proxy api -> GList gens -> Gen (BaseUrl -> Request)

-- | Instance for composite APIs
instance
  ( GenRequest a reqs
  , GenRequest b reqs
  ) => GenRequest (a :<|> b) reqs where
  genRequest :: Proxy (a :<|> b) -> GList reqs -> Gen (BaseUrl -> Request)
genRequest Proxy (a :<|> b)
_ GList reqs
gens =
    [Gen (BaseUrl -> Request)] -> Gen (BaseUrl -> Request)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
      [ Proxy a -> GList reqs -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy a
forall k (t :: k). Proxy t
Proxy @a) GList reqs
gens
      , Proxy b -> GList reqs -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy b
forall k (t :: k). Proxy t
Proxy @b) GList reqs
gens
      ]

-- | Instance for description
instance
  ( GenRequest api reqs
  ) => GenRequest (Description d :> api) reqs where
  genRequest :: Proxy (Description d :> api)
-> GList reqs -> Gen (BaseUrl -> Request)
genRequest Proxy (Description d :> api)
_ = Proxy api -> GList reqs -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api)

-- | Instance for summary
instance
  ( GenRequest api reqs
  ) => GenRequest (Summary s :> api) reqs where
  genRequest :: Proxy (Summary s :> api) -> GList reqs -> Gen (BaseUrl -> Request)
genRequest Proxy (Summary s :> api)
_ = Proxy api -> GList reqs -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api)

-- | Instance for path part of API
instance
  ( KnownSymbol path
  , GenRequest api reqs
  ) => GenRequest (path :> api) reqs where
  genRequest :: Proxy (path :> api) -> GList reqs -> Gen (BaseUrl -> Request)
genRequest Proxy (path :> api)
_ GList reqs
gens = do
    BaseUrl -> Request
makeRequest <- Proxy api -> GList reqs -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList reqs
gens
    (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ String -> Request -> Request
forall s.
ConvertibleStrings s ByteString =>
s -> Request -> Request
prependPath (Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path -> String) -> Proxy path -> String
forall a b. (a -> b) -> a -> b
$ Proxy path
forall k (t :: k). Proxy t
Proxy @path) (Request -> Request) -> (BaseUrl -> Request) -> BaseUrl -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> Request
makeRequest

-- | Instance for path capture
instance
  ( ToHttpApiData a
  , HasGen a gens
  , GenRequest api gens
  ) => GenRequest (Capture' modifiers sym a :> api) gens where
    genRequest :: Proxy (Capture' modifiers sym a :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (Capture' modifiers sym a :> api)
_ GList gens
gens = do
      Text
capture <- a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (a -> Text) -> GenT Identity a -> GenT Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GList gens -> GenT Identity a
forall g (gens :: [*]). HasGen g gens => GList gens -> Gen g
getGen @a @gens GList gens
gens
      BaseUrl -> Request
makeRequest <- Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ Text -> Request -> Request
forall s.
ConvertibleStrings s ByteString =>
s -> Request -> Request
prependPath Text
capture (Request -> Request) -> (BaseUrl -> Request) -> BaseUrl -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> Request
makeRequest

-- | Instance for capture rest of path, e.g:
--
-- @
-- type Api = "cats" :> CaptureAll "rest" Text :> Get '[JSON] [Cat]
-- @
--
-- For simplicity this will generate a number of paths from 0 to 10 linearly
--
instance
  ( ToHttpApiData a
  , HasGen a gens
  , GenRequest api gens
  ) => GenRequest (CaptureAll sym a :> api) gens where
    genRequest :: Proxy (CaptureAll sym a :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (CaptureAll sym a :> api)
_ GList gens
gens = do
      [a]
captures <- Range Int -> GenT Identity a -> GenT Identity [a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) (GList gens -> GenT Identity a
forall g (gens :: [*]). HasGen g gens => GList gens -> Gen g
getGen @a @gens GList gens
gens)
      BaseUrl -> Request
makeRequest <- Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
baseUrl ->
        (a -> Request -> Request) -> Request -> [a] -> Request
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> Request -> Request
forall s.
ConvertibleStrings s ByteString =>
s -> Request -> Request
prependPath (Text -> Request -> Request)
-> (a -> Text) -> a -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece) (BaseUrl -> Request
makeRequest BaseUrl
baseUrl) [a]
captures

-- | Instance for headers
--
-- /Note: this instance currently makes all headers mandatory/
instance
  ( HasGen header gens
  , KnownSymbol headerName
  , ToHttpApiData header
  , GenRequest api gens
  ) => GenRequest (Header' mods headerName header :> api) gens where
    genRequest :: Proxy (Header' mods headerName header :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (Header' mods headerName header :> api)
_ GList gens
gens = do
      let headerName :: CI ByteString
headerName = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (Proxy headerName -> ByteString)
-> Proxy headerName
-> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString)
-> (Proxy headerName -> String) -> Proxy headerName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy headerName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy headerName -> CI ByteString)
-> Proxy headerName -> CI ByteString
forall a b. (a -> b) -> a -> b
$ Proxy headerName
forall k (t :: k). Proxy t
Proxy @headerName
      header
header <- GList gens -> Gen header
forall g (gens :: [*]). HasGen g gens => GList gens -> Gen g
getGen @header @gens GList gens
gens
      BaseUrl -> Request
makeRequest <- Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString -> Request -> Request
addHeader CI ByteString
headerName (header -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader header
header) (Request -> Request) -> (BaseUrl -> Request) -> BaseUrl -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> Request
makeRequest

-- | Instance for setting query flag
--
-- /Note: this instance currently makes all query flags mandatory/
instance
  ( KnownSymbol name
  , GenRequest api gens
  ) => GenRequest (QueryFlag name :> api) gens where
    genRequest :: Proxy (QueryFlag name :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (QueryFlag name :> api)
_ GList gens
gens = do
      let paramName :: Text
paramName = String -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (String -> Text) -> (Proxy name -> String) -> Proxy name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> Text) -> Proxy name -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name
forall k (t :: k). Proxy t
Proxy @name
      BaseUrl -> Request
makeRequest <- Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
baseUrl ->
        let
          partialReq :: Request
partialReq = BaseUrl -> Request
makeRequest BaseUrl
baseUrl
          oldQuery :: Text
oldQuery = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
partialReq
          newQuery :: Text
newQuery =
            if Text -> Bool
Text.null Text
oldQuery then Text
paramName
            else Text
paramName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldQuery
        in
          Request
partialReq { queryString :: ByteString
queryString = Text -> ByteString
encodeUtf8 Text
newQuery }

-- | Instance for setting query parameters
--
-- /Note: this instance currently makes all query params mandatory/
instance
  ( KnownSymbol paramName
  , ToHttpApiData param
  , HasGen param gens
  , GenRequest api gens
  ) => GenRequest (QueryParam' mods paramName param :> api) gens where
    genRequest :: Proxy (QueryParam' mods paramName param :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (QueryParam' mods paramName param :> api)
_ GList gens
gens = do
      Text
queryParam <- param -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (param -> Text) -> GenT Identity param -> GenT Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GList gens -> GenT Identity param
forall g (gens :: [*]). HasGen g gens => GList gens -> Gen g
getGen @param @gens GList gens
gens

      let
        paramName :: Text
paramName = String -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (String -> Text)
-> (Proxy paramName -> String) -> Proxy paramName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy paramName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy paramName -> Text) -> Proxy paramName -> Text
forall a b. (a -> b) -> a -> b
$ Proxy paramName
forall k (t :: k). Proxy t
Proxy @paramName
        query :: Text
query = Text
paramName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
queryParam

      BaseUrl -> Request
makeRequest <- Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
baseUrl ->
        let
          partialReq :: Request
partialReq = BaseUrl -> Request
makeRequest BaseUrl
baseUrl
          oldQuery :: Text
oldQuery = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
partialReq
          newQuery :: Text
newQuery =
            if Text -> Bool
Text.null Text
oldQuery then Text
query
            else Text
query Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldQuery
        in
          Request
partialReq { queryString :: ByteString
queryString = Text -> ByteString
encodeUtf8 Text
newQuery }

-- | Instance for generating query parameters for arrays of values
instance
  ( KnownSymbol paramName
  , HasGen param gens
  , ToHttpApiData param
  , GenRequest api gens
  ) => GenRequest (QueryParams paramName param :> api) gens where
    genRequest :: Proxy (QueryParams paramName param :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (QueryParams paramName param :> api)
_ GList gens
gens = do
      [param]
params <- Range Int -> GenT Identity param -> GenT Identity [param]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) (GList gens -> GenT Identity param
forall g (gens :: [*]). HasGen g gens => GList gens -> Gen g
getGen @param @gens GList gens
gens)

      let
        paramName :: Text
paramName = String -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (String -> Text)
-> (Proxy paramName -> String) -> Proxy paramName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy paramName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy paramName -> Text) -> Proxy paramName -> Text
forall a b. (a -> b) -> a -> b
$ Proxy paramName
forall k (t :: k). Proxy t
Proxy @paramName
        params' :: [Text]
params' = (param -> Text) -> [param] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Text
paramName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[]=") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (param -> Text) -> param -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. param -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece) [param]
params
        queryParams :: Text
queryParams = Text -> [Text] -> Text
Text.intercalate Text
"&" [Text]
params'

      BaseUrl -> Request
makeRequest <- Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
baseUrl ->
        let
          partialReq :: Request
partialReq = BaseUrl -> Request
makeRequest BaseUrl
baseUrl
          oldQuery :: Text
oldQuery = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
partialReq
          newQuery :: Text
newQuery =
            if Text -> Bool
Text.null Text
oldQuery then Text
queryParams
            else Text
queryParams Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldQuery
        in
          Request
partialReq { queryString :: ByteString
queryString = Text -> ByteString
encodeUtf8 Text
newQuery }

-- | Instance for request body
instance
  ( AllMimeRender contentTypes body
  , HasGen body gens
  , GenRequest api gens
  ) => GenRequest (ReqBody' mods contentTypes body :> api) gens where
    genRequest :: Proxy (ReqBody' mods contentTypes body :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (ReqBody' mods contentTypes body :> api)
_ GList gens
gens = do
      body
newBody <- GList gens -> Gen body
forall g (gens :: [*]). HasGen g gens => GList gens -> Gen g
getGen @body @gens GList gens
gens

      (MediaType
contentType, ByteString
body) <-
        [(MediaType, ByteString)] -> GenT Identity (MediaType, ByteString)
forall (m :: * -> *) a. MonadGen m => [a] -> m a
Gen.element ([(MediaType, ByteString)]
 -> GenT Identity (MediaType, ByteString))
-> [(MediaType, ByteString)]
-> GenT Identity (MediaType, ByteString)
forall a b. (a -> b) -> a -> b
$ Proxy contentTypes -> body -> [(MediaType, ByteString)]
forall (list :: [*]) a.
AllMimeRender list a =>
Proxy list -> a -> [(MediaType, ByteString)]
allMimeRender (Proxy contentTypes
forall k (t :: k). Proxy t
Proxy @contentTypes) body
newBody

      BaseUrl -> Request
makeRequest <- Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens

      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
setBody ByteString
body
           (Request -> Request) -> (BaseUrl -> Request) -> BaseUrl -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString -> Request -> Request
addHeader CI ByteString
"Content-Type" (MediaType -> ByteString
forall h. RenderHeader h => h -> ByteString
renderHeader MediaType
contentType)
           (Request -> Request) -> (BaseUrl -> Request) -> BaseUrl -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> Request
makeRequest

-- | Instnace for capturing verb e.g. @POST@ or @GET@
instance
  ( ReflectMethod method
  ) => GenRequest (Verb method status contentTypes body) gens where
    genRequest :: Proxy (Verb method status contentTypes body)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (Verb method status contentTypes body)
_ GList gens
_ =
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
baseUrl -> Request
defaultRequest
        { host :: ByteString
host = String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString)
-> (BaseUrl -> String) -> BaseUrl -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> String
baseUrlHost (BaseUrl -> ByteString) -> BaseUrl -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseUrl
baseUrl
        , port :: Int
port = BaseUrl -> Int
baseUrlPort BaseUrl
baseUrl
        , secure :: Bool
secure = BaseUrl -> Scheme
baseUrlScheme BaseUrl
baseUrl Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
Https
        , method :: ByteString
method = Proxy method -> ByteString
forall k (a :: k). ReflectMethod a => Proxy a -> ByteString
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy @method)
        }

#if MIN_VERSION_servant(0, 17, 0)
instance
  ( ReflectMethod method
  ) => GenRequest (NoContentVerb method) gens where
    genRequest :: Proxy (NoContentVerb method)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (NoContentVerb method)
_ GList gens
_ =
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
baseUrl -> Request
defaultRequest
        { host :: ByteString
host = String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString)
-> (BaseUrl -> String) -> BaseUrl -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> String
baseUrlHost (BaseUrl -> ByteString) -> BaseUrl -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseUrl
baseUrl
        , port :: Int
port = BaseUrl -> Int
baseUrlPort BaseUrl
baseUrl
        , secure :: Bool
secure = BaseUrl -> Scheme
baseUrlScheme BaseUrl
baseUrl Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
Https
        , method :: ByteString
method = Proxy method -> ByteString
forall k (a :: k). ReflectMethod a => Proxy a -> ByteString
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy @method)
        }
#endif

#if MIN_VERSION_servant(0, 18, 1)
instance
  ( ReflectMethod method
  ) => GenRequest (UVerb method contentTypes bodies) gens where
    genRequest :: Proxy (UVerb method contentTypes bodies)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (UVerb method contentTypes bodies)
_ GList gens
_ =
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
baseUrl -> Request
defaultRequest
        { host :: ByteString
host = String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString)
-> (BaseUrl -> String) -> BaseUrl -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> String
baseUrlHost (BaseUrl -> ByteString) -> BaseUrl -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseUrl
baseUrl
        , port :: Int
port = BaseUrl -> Int
baseUrlPort BaseUrl
baseUrl
        , secure :: Bool
secure = BaseUrl -> Scheme
baseUrlScheme BaseUrl
baseUrl Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
Https
        , method :: ByteString
method = Proxy method -> ByteString
forall k (a :: k). ReflectMethod a => Proxy a -> ByteString
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy @method)
        }
#endif

-- | This instance doees not do anything right now
--
-- /Note:/ in order to use features provided by this type in the API, you'll
-- need to manually adjust the generated request.
instance
  ( GenRequest api gens
  ) => GenRequest (BasicAuth x y :> api) gens where
    genRequest :: Proxy (BasicAuth x y :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (BasicAuth x y :> api)
_ GList gens
gens = Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens

-- | This instance doees not do anything right now
--
-- /Note:/ in order to use features provided by this type in the API, you'll
-- need to manually adjust the generated request.
instance
  ( GenRequest api gens
  ) => GenRequest (HttpVersion :> api) gens where
    genRequest :: Proxy (HttpVersion :> api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (HttpVersion :> api)
_ GList gens
gens = Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens

-- | This instance doees not do anything right now
--
-- /Note:/ in order to use features provided by this type in the API, you'll
-- need to manually adjust the generated request.
instance
  ( GenRequest api gens
  ) => GenRequest (IsSecure :> api) gens where
    genRequest :: Proxy (IsSecure :> api) -> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (IsSecure :> api)
_ GList gens
gens = Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens

-- | This instance doees not do anything right now
--
-- /Note:/ in order to use features provided by this type in the API, you'll
-- need to manually adjust the generated request.
instance
  ( GenRequest api gens
  ) => GenRequest (RemoteHost :> api) gens where
    genRequest :: Proxy (RemoteHost :> api) -> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (RemoteHost :> api)
_ GList gens
gens = Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens

-- | This instance doees not do anything right now
--
-- /Note:/ in order to use features provided by this type in the API, you'll
-- need to manually adjust the generated request.
instance
  ( GenRequest api gens
  ) => GenRequest (Vault :> api) gens where
    genRequest :: Proxy (Vault :> api) -> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (Vault :> api)
_ GList gens
gens = Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens

-- | This instance doees not do anything right now
--
-- /Note:/ in order to use features provided by this type in the API, you'll
-- need to manually adjust the generated request.
instance
  ( GenRequest api gens
  ) => GenRequest (WithNamedContext x y api) gens where
    genRequest :: Proxy (WithNamedContext x y api)
-> GList gens -> Gen (BaseUrl -> Request)
genRequest Proxy (WithNamedContext x y api)
_ GList gens
gens = Proxy api -> GList gens -> Gen (BaseUrl -> Request)
forall api (gens :: [*]).
GenRequest api gens =>
Proxy api -> GList gens -> Gen (BaseUrl -> Request)
genRequest (Proxy api
forall k (t :: k). Proxy t
Proxy @api) GList gens
gens

setBody :: LBS.ByteString -> Request -> Request
setBody :: ByteString -> Request -> Request
setBody ByteString
body Request
oldReq = Request
oldReq { requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
body }

addHeader :: HeaderName -> BS.ByteString -> Request -> Request
addHeader :: CI ByteString -> ByteString -> Request -> Request
addHeader CI ByteString
name ByteString
value Request
oldReq =
  let
    headers :: [(CI ByteString, ByteString)]
headers = (CI ByteString
name, ByteString
value) (CI ByteString, ByteString)
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. a -> [a] -> [a]
: Request -> [(CI ByteString, ByteString)]
requestHeaders Request
oldReq
  in
    Request
oldReq { requestHeaders :: [(CI ByteString, ByteString)]
requestHeaders = [(CI ByteString, ByteString)]
headers }

-- | Helper function for prepending a new URL piece
prependPath :: ConvertibleStrings s BS.ByteString => s -> Request -> Request
prependPath :: s -> Request -> Request
prependPath s
new Request
oldReq =
  let
    partialUrl :: ByteString
partialUrl = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
BS.c2w Char
'/') (ByteString -> ByteString)
-> (Request -> ByteString) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
path (Request -> ByteString) -> Request -> ByteString
forall a b. (a -> b) -> a -> b
$ Request
oldReq
    urlPieces :: [ByteString]
urlPieces = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [s -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs s
new, ByteString
partialUrl]
  in
    Request
oldReq { path :: ByteString
path = ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"/" [ByteString]
urlPieces }