{-# LANGUAGE CPP        #-}
{-# LANGUAGE PolyKinds  #-}
{-# LANGUAGE StarIsType #-}
module Servant.QuickCheck.Internal.HasGenRequest where

import           Data.Kind                (Type)
import           Data.String              (fromString)
import qualified Data.Text.Encoding as Text
import qualified Data.ByteString.Char8 as BS8
import           GHC.TypeLits             (KnownSymbol, Nat, symbolVal)
import           Network.HTTP.Client      (Request, RequestBody (..),
                                           defaultRequest, host, method, path,
                                           port, queryString, requestBody,
                                           requestHeaders, secure)
import           Network.HTTP.Media       (renderHeader)
import           Prelude.Compat
import           Servant
import           Servant.API.ContentTypes (AllMimeRender (..))
import           Servant.Client           (BaseUrl (..), Scheme (..))
import           Test.QuickCheck          (Arbitrary (..), Gen, elements,
                                           frequency)

import qualified Data.ByteString          as BS
import qualified Data.ByteString.Internal as BS (c2w)


-- -----------------------------------------------------------------------------
-- runGenRequest

-- | This function returns a QuickCheck `Gen a` when passed a servant API value,
-- typically a `Proxy API`. The generator returned is a function
-- that accepts a `BaseUrl` and returns a `Request`, which can then be used
-- to issue network requests. This `Gen` type makes it easier to compare distinct
-- APIs across different `BaseUrl`s.
runGenRequest :: HasGenRequest a => Proxy a -> Gen (BaseUrl -> Request)
runGenRequest :: forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> Gen (BaseUrl -> Request)
runGenRequest = (Int, Gen (BaseUrl -> Request)) -> Gen (BaseUrl -> Request)
forall a b. (a, b) -> b
snd ((Int, Gen (BaseUrl -> Request)) -> Gen (BaseUrl -> Request))
-> (Proxy a -> (Int, Gen (BaseUrl -> Request)))
-> Proxy a
-> Gen (BaseUrl -> Request)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest


-- -----------------------------------------------------------------------------
-- HasGenRequest

-- | This is the core Servant-Quickcheck generator, which, when given a `Proxy API`
-- will return a pair of `Int` and `Gen a`, where `a` is a function from
-- `BaseUrl` to a `Network.Http.Client.Request`. The `Int` is a weight for the
-- QuickCheck `frequency` function which ensures a random distribution across
-- all endpoints in an API.
class HasGenRequest a where
    genRequest :: Proxy a -> (Int, Gen (BaseUrl -> Request))


instance (HasGenRequest a, HasGenRequest b) => HasGenRequest (a :<|> b) where
    genRequest :: Proxy (a :<|> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (a :<|> b)
_
      = (Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rf, [(Int, Gen (BaseUrl -> Request))] -> Gen (BaseUrl -> Request)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int, Gen (BaseUrl -> Request))
l, (Int, Gen (BaseUrl -> Request))
r])
      where
        l :: (Int, Gen (BaseUrl -> Request))
l@(Int
lf, Gen (BaseUrl -> Request)
_) = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
        r :: (Int, Gen (BaseUrl -> Request))
r@(Int
rf, Gen (BaseUrl -> Request)
_) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)


instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where
    genRequest :: Proxy (path :> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (path :> b)
_ = (Int
oldf, do
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl
                            oldPath :: ByteString
oldPath = Request -> ByteString
path Request
r
                            oldPath' :: ByteString
oldPath' = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
BS.c2w Char
'/') ByteString
oldPath
                            paths :: [ByteString]
paths = (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) [ByteString
new, ByteString
oldPath']
                            in Request
r { path = "/" <> BS.intercalate "/" paths })
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        new :: ByteString
new = String -> ByteString
BS8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path)

instance HasGenRequest EmptyAPI where
  genRequest :: Proxy EmptyAPI -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy EmptyAPI
_ = (Int
0, String -> Gen (BaseUrl -> Request)
forall a. HasCallStack => String -> a
error String
"EmptyAPIs cannot be queried.")

-- | capture all path pieces that do not have semantics relevant to 'HasGenRequest'; this is to maintain backwards compatibility
--   without having to introduce CPP for every new URL piece that basically is irrelevant for this class
instance {-# OVERLAPPABLE #-} HasGenRequest api => HasGenRequest (f d :> api) where
  genRequest :: Proxy (f d :> api) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (f d :> api)
_ = Proxy api -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy api
forall {k} (t :: k). Proxy t
Proxy :: Proxy api)

instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
    => HasGenRequest (Capture' mods x c :> b) where
    genRequest :: Proxy (Capture' mods x c :> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (Capture' mods x c :> b)
_ = (Int
oldf, do
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old
      Text
new' <- c -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (c -> Text) -> Gen c -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen c
new
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl in Request
r { path = Text.encodeUtf8 new' <> path r })
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        new :: Gen c
new = Gen c
forall a. Arbitrary a => Gen a
arbitrary :: Gen c

instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
    => HasGenRequest (CaptureAll x c :> b) where
    genRequest :: Proxy (CaptureAll x c :> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (CaptureAll x c :> b)
_ = (Int
oldf, do
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old
      [ByteString]
new' <- (c -> ByteString) -> [c] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (c -> Text) -> c -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece) ([c] -> [ByteString]) -> Gen [c] -> Gen [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [c]
new
      let new'' :: ByteString
new'' = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"/" [ByteString]
new'
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl in Request
r { path = new'' <> path r })
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        new :: Gen [c]
new = Gen [c]
forall a. Arbitrary a => Gen a
arbitrary :: Gen [c]

instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
    => HasGenRequest (Header' mods h c :> b) where
    genRequest :: Proxy (Header' mods h c :> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (Header' mods h c :> b)
_ = (Int
oldf, do
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old
      Text
new' <- c -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (c -> Text) -> Gen c -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen c
new  -- TODO: generate lenient or/and optional
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl in Request
r {
          requestHeaders = (hdr, Text.encodeUtf8 new') : requestHeaders r })
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        hdr :: HeaderName
hdr = String -> HeaderName
forall a. IsString a => String -> a
fromString (String -> HeaderName) -> String -> HeaderName
forall a b. (a -> b) -> a -> b
$ Proxy h -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy h
forall {k} (t :: k). Proxy t
Proxy :: Proxy h)
        new :: Gen c
new = Gen c
forall a. Arbitrary a => Gen a
arbitrary :: Gen c

instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
    => HasGenRequest (ReqBody' mods x c :> b) where
    genRequest :: Proxy (ReqBody' mods x c :> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (ReqBody' mods x c :> b)
_ = (Int
oldf, do
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old  -- TODO: generate lenient
      c
new' <- Gen c
new
      (MediaType
ct, ByteString
bd) <- [(MediaType, ByteString)] -> Gen (MediaType, ByteString)
forall a. HasCallStack => [a] -> Gen a
elements ([(MediaType, ByteString)] -> Gen (MediaType, ByteString))
-> [(MediaType, ByteString)] -> Gen (MediaType, ByteString)
forall a b. (a -> b) -> a -> b
$ Proxy x -> c -> [(MediaType, ByteString)]
forall (list :: [*]) a.
AllMimeRender list a =>
Proxy list -> a -> [(MediaType, ByteString)]
allMimeRender (Proxy x
forall {k} (t :: k). Proxy t
Proxy :: Proxy x) c
new'
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl in Request
r {
          requestBody = RequestBodyLBS bd
        , requestHeaders = ("Content-Type", renderHeader ct) : requestHeaders r
        })
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        new :: Gen c
new = Gen c
forall a. Arbitrary a => Gen a
arbitrary :: Gen c

instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
    => HasGenRequest (QueryParam' mods x c :> b) where
    genRequest :: Proxy (QueryParam' mods x c :> b)
-> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (QueryParam' mods x c :> b)
_ = (Int
oldf, do
      c
new' <- Gen c
new  -- TODO: generate lenient or/and optional
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl
                            newExpr :: ByteString
newExpr = ByteString
param ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
Text.encodeUtf8 (c -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam c
new')
                            qs :: ByteString
qs = Request -> ByteString
queryString Request
r in Request
r {
          queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs })
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        param :: ByteString
param = String -> ByteString
BS8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy x
forall {k} (t :: k). Proxy t
Proxy :: Proxy x)
        new :: Gen c
new = Gen c
forall a. Arbitrary a => Gen a
arbitrary :: Gen c

instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
    => HasGenRequest (QueryParams x c :> b) where
    genRequest :: Proxy (QueryParams x c :> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (QueryParams x c :> b)
_ = (Int
oldf, do
      [c]
new' <- Gen [c]
new
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl in Request
r {
          queryString = queryString r
                     <> if not (null new') then fold (toParam <$> new') else ""})
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        param :: ByteString
param = String -> ByteString
BS8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy x
forall {k} (t :: k). Proxy t
Proxy :: Proxy x)
        new :: Gen [c]
new = Gen [c]
forall a. Arbitrary a => Gen a
arbitrary :: Gen [c]
        toParam :: c -> ByteString
toParam c
c = ByteString
param ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"[]=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
Text.encodeUtf8 (c -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam c
c)
        fold :: [ByteString] -> ByteString
fold = (ByteString -> ByteString -> ByteString)
-> [ByteString] -> ByteString
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\ByteString
a ByteString
b -> ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"&" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b)

instance (KnownSymbol x, HasGenRequest b)
    => HasGenRequest (QueryFlag x :> b) where
    genRequest :: Proxy (QueryFlag x :> b) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (QueryFlag x :> b)
_ = (Int
oldf, do
      BaseUrl -> Request
old' <- Gen (BaseUrl -> Request)
old
      (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> let r :: Request
r = BaseUrl -> Request
old' BaseUrl
burl
                            qs :: ByteString
qs = Request -> ByteString
queryString Request
r in Request
r {
          queryString = if BS.null qs then param else param <> "&" <> qs })
      where
        (Int
oldf, Gen (BaseUrl -> Request)
old) = Proxy b -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
        param :: ByteString
param = String -> ByteString
BS8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy x
forall {k} (t :: k). Proxy t
Proxy :: Proxy x)

instance (ReflectMethod method)
    => HasGenRequest (Verb (method :: k) (status :: Nat) (cts :: [Type]) a) where
    genRequest :: Proxy (Verb method status cts a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (Verb method status cts a)
_ = (Int
1, (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> Request
defaultRequest
       { host = BS8.pack $ baseUrlHost burl
       , port = baseUrlPort burl
       , secure = baseUrlScheme burl == Https
       , method = reflectMethod (Proxy :: Proxy method)
       })

instance (ReflectMethod method)
    => HasGenRequest (NoContentVerb (method :: k)) where
    genRequest :: Proxy (NoContentVerb method) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (NoContentVerb method)
_ = (Int
1, (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((BaseUrl -> Request) -> Gen (BaseUrl -> Request))
-> (BaseUrl -> Request) -> Gen (BaseUrl -> Request)
forall a b. (a -> b) -> a -> b
$ \BaseUrl
burl -> Request
defaultRequest
       { host = BS8.pack $ baseUrlHost burl
       , port = baseUrlPort burl
       , secure = baseUrlScheme burl == Https
       , method = reflectMethod (Proxy :: Proxy method)
       })

instance (HasGenRequest a) => HasGenRequest (RemoteHost :> a) where
    genRequest :: Proxy (RemoteHost :> a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (RemoteHost :> a)
_ = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasGenRequest a) => HasGenRequest (IsSecure :> a) where
    genRequest :: Proxy (IsSecure :> a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (IsSecure :> a)
_ = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasGenRequest a) => HasGenRequest (HttpVersion :> a) where
    genRequest :: Proxy (HttpVersion :> a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (HttpVersion :> a)
_ = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasGenRequest a) => HasGenRequest (Vault :> a) where
    genRequest :: Proxy (Vault :> a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (Vault :> a)
_ = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasGenRequest a) => HasGenRequest (WithNamedContext x y a) where
    genRequest :: Proxy (WithNamedContext x y a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (WithNamedContext x y a)
_ = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

-- TODO: Try logging in
instance (HasGenRequest a) => HasGenRequest (BasicAuth x y :> a) where
    genRequest :: Proxy (BasicAuth x y :> a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (BasicAuth x y :> a)
_ = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasGenRequest a) => HasGenRequest (Fragment v :> a) where
    genRequest :: Proxy (Fragment v :> a) -> (Int, Gen (BaseUrl -> Request))
genRequest Proxy (Fragment v :> a)
_ = Proxy a -> (Int, Gen (BaseUrl -> Request))
forall {k} (a :: k).
HasGenRequest a =>
Proxy a -> (Int, Gen (BaseUrl -> Request))
genRequest (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)