{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
module Freckle.App.Test.Http
(
httpStubbed
, HttpStub (..)
, httpStub
, httpStubUrl
, labelL
, MatchRequest (..)
, matchL
, statusL
, headersL
, bodyL
, json
, loadHttpStubsDirectory
, HasHttpStubs (..)
, ReaderHttpStubs (..)
, HttpStubsT
, runHttpStubsT
) where
import Freckle.App.Prelude
import Control.Lens (Lens', lens, view, (&), (.~), (<>~))
import Control.Monad (filterM)
import Control.Monad.Reader (runReaderT)
import Data.Aeson (ToJSON, encode)
import qualified Data.ByteString.Lazy as BSL
import Data.List (stripPrefix)
import Data.String (IsString (..))
import Freckle.App.Http (MonadHttp (..))
import Freckle.App.Test.Http.MatchRequest
import Network.HTTP.Client (Request, Response)
import qualified Network.HTTP.Client.Internal as HTTP
import Network.HTTP.Types.Header (ResponseHeaders, hAccept, hContentType)
import Network.HTTP.Types.Status (Status, status200)
import System.Directory (doesFileExist)
import System.FilePath (addTrailingPathSeparator)
import System.FilePath.Glob (globDir1)
httpStubbed
:: HasCallStack
=> [HttpStub]
-> Request
-> Response BSL.ByteString
httpStubbed :: HasCallStack => [HttpStub] -> Request -> Response ByteString
httpStubbed [HttpStub]
stubs Request
req =
Response ByteString
-> (HttpStubResponse -> Response ByteString)
-> Maybe HttpStubResponse
-> Response ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Response ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
errorMessage) (Request -> HttpStubResponse -> Response ByteString
toResponse Request
req) (Maybe HttpStubResponse -> Response ByteString)
-> Maybe HttpStubResponse -> Response ByteString
forall a b. (a -> b) -> a -> b
$ [HttpStubResponse] -> Maybe HttpStubResponse
forall a. [a] -> Maybe a
headMay [HttpStubResponse]
matched
where
([(HttpStub, [Char])]
unmatched, [HttpStubResponse]
matched) =
[Either (HttpStub, [Char]) HttpStubResponse]
-> ([(HttpStub, [Char])], [HttpStubResponse])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (HttpStub, [Char]) HttpStubResponse]
-> ([(HttpStub, [Char])], [HttpStubResponse]))
-> [Either (HttpStub, [Char]) HttpStubResponse]
-> ([(HttpStub, [Char])], [HttpStubResponse])
forall a b. (a -> b) -> a -> b
$
(HttpStub -> Either (HttpStub, [Char]) HttpStubResponse)
-> [HttpStub] -> [Either (HttpStub, [Char]) HttpStubResponse]
forall a b. (a -> b) -> [a] -> [b]
map
( \HttpStub
stub ->
([Char] -> (HttpStub, [Char]))
-> (() -> HttpStubResponse)
-> Either [Char] ()
-> Either (HttpStub, [Char]) HttpStubResponse
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (HttpStub
stub,) (HttpStubResponse -> () -> HttpStubResponse
forall a b. a -> b -> a
const HttpStub
stub.response) (Either [Char] () -> Either (HttpStub, [Char]) HttpStubResponse)
-> Either [Char] () -> Either (HttpStub, [Char]) HttpStubResponse
forall a b. (a -> b) -> a -> b
$
Request -> MatchRequest -> Either [Char] ()
matchRequest Request
req HttpStub
stub.match
)
[HttpStub]
stubs
errorMessage :: [Char]
errorMessage =
[Char]
"No stubs were found that matched:\n"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Request -> [Char]
forall a. Show a => a -> [Char]
show Request
req
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ((HttpStub, [Char]) -> [Char]) -> [(HttpStub, [Char])] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((HttpStub -> [Char] -> [Char]) -> (HttpStub, [Char]) -> [Char]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HttpStub -> [Char] -> [Char]
forall {a} {r}.
(Semigroup a, IsString a, HasField "label" r a) =>
r -> a -> a
unmatchedMessage) [(HttpStub, [Char])]
unmatched
unmatchedMessage :: r -> a -> a
unmatchedMessage r
stub a
err = a
"\n== " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> r
stub.label a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" ==\n" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
err
data HttpStubResponse = HttpStubResponse
{ HttpStubResponse -> Status
status :: Status
, :: ResponseHeaders
, HttpStubResponse -> ByteString
body :: BSL.ByteString
}
toResponse :: Request -> HttpStubResponse -> Response BSL.ByteString
toResponse :: Request -> HttpStubResponse -> Response ByteString
toResponse Request
req HttpStubResponse
stub =
HTTP.Response
{ responseStatus :: Status
HTTP.responseStatus = HttpStubResponse
stub.status
, responseVersion :: HttpVersion
HTTP.responseVersion = Request -> HttpVersion
HTTP.requestVersion Request
req
, responseHeaders :: ResponseHeaders
HTTP.responseHeaders = HttpStubResponse
stub.headers
, responseBody :: ByteString
HTTP.responseBody = HttpStubResponse
stub.body
, responseCookieJar :: CookieJar
HTTP.responseCookieJar = CookieJar
forall a. Monoid a => a
mempty
, responseClose' :: ResponseClose
HTTP.responseClose' = IO () -> ResponseClose
HTTP.ResponseClose (IO () -> ResponseClose) -> IO () -> ResponseClose
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, responseOriginalRequest :: Request
HTTP.responseOriginalRequest = Request
req
#if MIN_VERSION_http_client(0,7,16)
, responseEarlyHints :: ResponseHeaders
HTTP.responseEarlyHints = []
#endif
}
rstatusL :: Lens' HttpStubResponse Status
rstatusL :: Lens' HttpStubResponse Status
rstatusL = (HttpStubResponse -> Status)
-> (HttpStubResponse -> Status -> HttpStubResponse)
-> Lens' HttpStubResponse Status
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.status) ((HttpStubResponse -> Status -> HttpStubResponse)
-> Lens' HttpStubResponse Status)
-> (HttpStubResponse -> Status -> HttpStubResponse)
-> Lens' HttpStubResponse Status
forall a b. (a -> b) -> a -> b
$ \HttpStubResponse
x Status
y -> HttpStubResponse
x {status = y}
rheadersL :: Lens' HttpStubResponse ResponseHeaders
= (HttpStubResponse -> ResponseHeaders)
-> (HttpStubResponse -> ResponseHeaders -> HttpStubResponse)
-> Lens' HttpStubResponse ResponseHeaders
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.headers) ((HttpStubResponse -> ResponseHeaders -> HttpStubResponse)
-> Lens' HttpStubResponse ResponseHeaders)
-> (HttpStubResponse -> ResponseHeaders -> HttpStubResponse)
-> Lens' HttpStubResponse ResponseHeaders
forall a b. (a -> b) -> a -> b
$ \HttpStubResponse
x ResponseHeaders
y -> HttpStubResponse
x {headers = y}
rbodyL :: Lens' HttpStubResponse BSL.ByteString
rbodyL :: Lens' HttpStubResponse ByteString
rbodyL = (HttpStubResponse -> ByteString)
-> (HttpStubResponse -> ByteString -> HttpStubResponse)
-> Lens' HttpStubResponse ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.body) ((HttpStubResponse -> ByteString -> HttpStubResponse)
-> Lens' HttpStubResponse ByteString)
-> (HttpStubResponse -> ByteString -> HttpStubResponse)
-> Lens' HttpStubResponse ByteString
forall a b. (a -> b) -> a -> b
$ \HttpStubResponse
x ByteString
y -> HttpStubResponse
x {body = y}
data HttpStub = HttpStub
{ HttpStub -> [Char]
label :: String
, HttpStub -> MatchRequest
match :: MatchRequest
, HttpStub -> HttpStubResponse
response :: HttpStubResponse
}
instance IsString HttpStub where
fromString :: [Char] -> HttpStub
fromString = [Char] -> HttpStub
httpStubUrl
labelL :: Lens' HttpStub String
labelL :: Lens' HttpStub [Char]
labelL = (HttpStub -> [Char])
-> (HttpStub -> [Char] -> HttpStub) -> Lens' HttpStub [Char]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.label) ((HttpStub -> [Char] -> HttpStub) -> Lens' HttpStub [Char])
-> (HttpStub -> [Char] -> HttpStub) -> Lens' HttpStub [Char]
forall a b. (a -> b) -> a -> b
$ \HttpStub
x [Char]
y -> HttpStub
x {label = y}
matchL :: Lens' HttpStub MatchRequest
matchL :: Lens' HttpStub MatchRequest
matchL = (HttpStub -> MatchRequest)
-> (HttpStub -> MatchRequest -> HttpStub)
-> Lens' HttpStub MatchRequest
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.match) ((HttpStub -> MatchRequest -> HttpStub)
-> Lens' HttpStub MatchRequest)
-> (HttpStub -> MatchRequest -> HttpStub)
-> Lens' HttpStub MatchRequest
forall a b. (a -> b) -> a -> b
$ \HttpStub
x MatchRequest
y -> HttpStub
x {match = y}
responseL :: Lens' HttpStub HttpStubResponse
responseL :: Lens' HttpStub HttpStubResponse
responseL = (HttpStub -> HttpStubResponse)
-> (HttpStub -> HttpStubResponse -> HttpStub)
-> Lens' HttpStub HttpStubResponse
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.response) ((HttpStub -> HttpStubResponse -> HttpStub)
-> Lens' HttpStub HttpStubResponse)
-> (HttpStub -> HttpStubResponse -> HttpStub)
-> Lens' HttpStub HttpStubResponse
forall a b. (a -> b) -> a -> b
$ \HttpStub
x HttpStubResponse
y -> HttpStub
x {response = y}
httpStub :: String -> MatchRequest -> HttpStub
httpStub :: [Char] -> MatchRequest -> HttpStub
httpStub [Char]
label MatchRequest
match = HttpStub {[Char]
$sel:label:HttpStub :: [Char]
label :: [Char]
label, MatchRequest
$sel:match:HttpStub :: MatchRequest
match :: MatchRequest
match, HttpStubResponse
$sel:response:HttpStub :: HttpStubResponse
response :: HttpStubResponse
response}
where
response :: HttpStubResponse
response =
HttpStubResponse
{ $sel:status:HttpStubResponse :: Status
status = Status
status200
, $sel:headers:HttpStubResponse :: ResponseHeaders
headers = []
, $sel:body:HttpStubResponse :: ByteString
body = ByteString
""
}
httpStubUrl :: String -> HttpStub
httpStubUrl :: [Char] -> HttpStub
httpStubUrl [Char]
url = [Char] -> MatchRequest -> HttpStub
httpStub [Char]
url (MatchRequest -> HttpStub) -> MatchRequest -> HttpStub
forall a b. (a -> b) -> a -> b
$ [Char] -> MatchRequest
matchRequestFromUrl [Char]
url
statusL :: Lens' HttpStub Status
statusL :: Lens' HttpStub Status
statusL = (HttpStubResponse -> f HttpStubResponse) -> HttpStub -> f HttpStub
Lens' HttpStub HttpStubResponse
responseL ((HttpStubResponse -> f HttpStubResponse)
-> HttpStub -> f HttpStub)
-> ((Status -> f Status) -> HttpStubResponse -> f HttpStubResponse)
-> (Status -> f Status)
-> HttpStub
-> f HttpStub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Status -> f Status) -> HttpStubResponse -> f HttpStubResponse
Lens' HttpStubResponse Status
rstatusL
headersL :: Lens' HttpStub ResponseHeaders
= (HttpStubResponse -> f HttpStubResponse) -> HttpStub -> f HttpStub
Lens' HttpStub HttpStubResponse
responseL ((HttpStubResponse -> f HttpStubResponse)
-> HttpStub -> f HttpStub)
-> ((ResponseHeaders -> f ResponseHeaders)
-> HttpStubResponse -> f HttpStubResponse)
-> (ResponseHeaders -> f ResponseHeaders)
-> HttpStub
-> f HttpStub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResponseHeaders -> f ResponseHeaders)
-> HttpStubResponse -> f HttpStubResponse
Lens' HttpStubResponse ResponseHeaders
rheadersL
bodyL :: Lens' HttpStub BSL.ByteString
bodyL :: Lens' HttpStub ByteString
bodyL = (HttpStubResponse -> f HttpStubResponse) -> HttpStub -> f HttpStub
Lens' HttpStub HttpStubResponse
responseL ((HttpStubResponse -> f HttpStubResponse)
-> HttpStub -> f HttpStub)
-> ((ByteString -> f ByteString)
-> HttpStubResponse -> f HttpStubResponse)
-> (ByteString -> f ByteString)
-> HttpStub
-> f HttpStub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> f ByteString)
-> HttpStubResponse -> f HttpStubResponse
Lens' HttpStubResponse ByteString
rbodyL
json :: ToJSON a => a -> HttpStub -> HttpStub
json :: forall a. ToJSON a => a -> HttpStub -> HttpStub
json a
a HttpStub
stub =
HttpStub
stub
HttpStub -> (HttpStub -> HttpStub) -> HttpStub
forall a b. a -> (a -> b) -> b
& (MatchRequest -> Identity MatchRequest)
-> HttpStub -> Identity HttpStub
Lens' HttpStub MatchRequest
matchL ((MatchRequest -> Identity MatchRequest)
-> HttpStub -> Identity HttpStub)
-> MatchRequest -> HttpStub -> HttpStub
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Header -> MatchRequest
MatchHeader (HeaderName
hAccept, ByteString
"application/json")
HttpStub -> (HttpStub -> HttpStub) -> HttpStub
forall a b. a -> (a -> b) -> b
& (ResponseHeaders -> Identity ResponseHeaders)
-> HttpStub -> Identity HttpStub
Lens' HttpStub ResponseHeaders
headersL ((ResponseHeaders -> Identity ResponseHeaders)
-> HttpStub -> Identity HttpStub)
-> ResponseHeaders -> HttpStub -> HttpStub
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(HeaderName
hContentType, ByteString
"application/json")]
HttpStub -> (HttpStub -> HttpStub) -> HttpStub
forall a b. a -> (a -> b) -> b
& (ByteString -> Identity ByteString)
-> HttpStub -> Identity HttpStub
Lens' HttpStub ByteString
bodyL ((ByteString -> Identity ByteString)
-> HttpStub -> Identity HttpStub)
-> ByteString -> HttpStub -> HttpStub
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
a
loadHttpStubsDirectory :: FilePath -> IO [HttpStub]
loadHttpStubsDirectory :: [Char] -> IO [HttpStub]
loadHttpStubsDirectory [Char]
dir = do
[[Char]]
paths <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist ([[Char]] -> IO [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> [Char] -> IO [[Char]]
globDir1 Pattern
"**/*" [Char]
dir
let pathUrls :: [([Char], [Char])]
pathUrls = ([Char] -> Maybe ([Char], [Char]))
-> [[Char]] -> [([Char], [Char])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[Char]
p -> (,) [Char]
p ([Char] -> ([Char], [Char]))
-> Maybe [Char] -> Maybe ([Char], [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe [Char]
toUrl [Char]
p) [[Char]]
paths
[([Char], [Char])]
-> (([Char], [Char]) -> IO HttpStub) -> IO [HttpStub]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [([Char], [Char])]
pathUrls ((([Char], [Char]) -> IO HttpStub) -> IO [HttpStub])
-> (([Char], [Char]) -> IO HttpStub) -> IO [HttpStub]
forall a b. (a -> b) -> a -> b
$ \([Char]
path, [Char]
url) -> do
ByteString
bs <- [Char] -> IO ByteString
BSL.readFile [Char]
path
HttpStub -> IO HttpStub
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpStub -> IO HttpStub) -> HttpStub -> IO HttpStub
forall a b. (a -> b) -> a -> b
$ [Char] -> HttpStub
httpStubUrl [Char]
url HttpStub -> (HttpStub -> HttpStub) -> HttpStub
forall a b. a -> (a -> b) -> b
& (ByteString -> Identity ByteString)
-> HttpStub -> Identity HttpStub
Lens' HttpStub ByteString
bodyL ((ByteString -> Identity ByteString)
-> HttpStub -> Identity HttpStub)
-> ByteString -> HttpStub -> HttpStub
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
bs
where
toUrl :: [Char] -> Maybe [Char]
toUrl [Char]
p = do
[Char]
relative <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([Char] -> [Char]
addTrailingPathSeparator [Char]
dir) [Char]
p
[Maybe [Char]] -> Maybe [Char]
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ ([Char]
"https://" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"https/" [Char]
relative
, ([Char]
"http://" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"http/" [Char]
relative
]
class HasHttpStubs env where
httpStubsL :: Lens' env [HttpStub]
instance HasHttpStubs [HttpStub] where
httpStubsL :: Lens' [HttpStub] [HttpStub]
httpStubsL = ([HttpStub] -> f [HttpStub]) -> [HttpStub] -> f [HttpStub]
forall a. a -> a
id
newtype ReaderHttpStubs m a = ReaderHttpStubs {forall (m :: * -> *) a. ReaderHttpStubs m a -> m a
unwrap :: m a}
deriving newtype ((forall a b.
(a -> b) -> ReaderHttpStubs m a -> ReaderHttpStubs m b)
-> (forall a b. a -> ReaderHttpStubs m b -> ReaderHttpStubs m a)
-> Functor (ReaderHttpStubs m)
forall a b. a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
forall a b. (a -> b) -> ReaderHttpStubs m a -> ReaderHttpStubs m b
forall (m :: * -> *) a b.
Functor m =>
a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReaderHttpStubs m a -> ReaderHttpStubs m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReaderHttpStubs m a -> ReaderHttpStubs m b
fmap :: forall a b. (a -> b) -> ReaderHttpStubs m a -> ReaderHttpStubs m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
<$ :: forall a b. a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
Functor, Functor (ReaderHttpStubs m)
Functor (ReaderHttpStubs m) =>
(forall a. a -> ReaderHttpStubs m a)
-> (forall a b.
ReaderHttpStubs m (a -> b)
-> ReaderHttpStubs m a -> ReaderHttpStubs m b)
-> (forall a b c.
(a -> b -> c)
-> ReaderHttpStubs m a
-> ReaderHttpStubs m b
-> ReaderHttpStubs m c)
-> (forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b)
-> (forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m a)
-> Applicative (ReaderHttpStubs m)
forall a. a -> ReaderHttpStubs m a
forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
forall a b.
ReaderHttpStubs m (a -> b)
-> ReaderHttpStubs m a -> ReaderHttpStubs m b
forall a b c.
(a -> b -> c)
-> ReaderHttpStubs m a
-> ReaderHttpStubs m b
-> ReaderHttpStubs m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (ReaderHttpStubs m)
forall (m :: * -> *) a. Applicative m => a -> ReaderHttpStubs m a
forall (m :: * -> *) a b.
Applicative m =>
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
forall (m :: * -> *) a b.
Applicative m =>
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
forall (m :: * -> *) a b.
Applicative m =>
ReaderHttpStubs m (a -> b)
-> ReaderHttpStubs m a -> ReaderHttpStubs m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ReaderHttpStubs m a
-> ReaderHttpStubs m b
-> ReaderHttpStubs m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> ReaderHttpStubs m a
pure :: forall a. a -> ReaderHttpStubs m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
ReaderHttpStubs m (a -> b)
-> ReaderHttpStubs m a -> ReaderHttpStubs m b
<*> :: forall a b.
ReaderHttpStubs m (a -> b)
-> ReaderHttpStubs m a -> ReaderHttpStubs m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ReaderHttpStubs m a
-> ReaderHttpStubs m b
-> ReaderHttpStubs m c
liftA2 :: forall a b c.
(a -> b -> c)
-> ReaderHttpStubs m a
-> ReaderHttpStubs m b
-> ReaderHttpStubs m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
*> :: forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
<* :: forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m a
Applicative, Applicative (ReaderHttpStubs m)
Applicative (ReaderHttpStubs m) =>
(forall a b.
ReaderHttpStubs m a
-> (a -> ReaderHttpStubs m b) -> ReaderHttpStubs m b)
-> (forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b)
-> (forall a. a -> ReaderHttpStubs m a)
-> Monad (ReaderHttpStubs m)
forall a. a -> ReaderHttpStubs m a
forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
forall a b.
ReaderHttpStubs m a
-> (a -> ReaderHttpStubs m b) -> ReaderHttpStubs m b
forall (m :: * -> *). Monad m => Applicative (ReaderHttpStubs m)
forall (m :: * -> *) a. Monad m => a -> ReaderHttpStubs m a
forall (m :: * -> *) a b.
Monad m =>
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
forall (m :: * -> *) a b.
Monad m =>
ReaderHttpStubs m a
-> (a -> ReaderHttpStubs m b) -> ReaderHttpStubs m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ReaderHttpStubs m a
-> (a -> ReaderHttpStubs m b) -> ReaderHttpStubs m b
>>= :: forall a b.
ReaderHttpStubs m a
-> (a -> ReaderHttpStubs m b) -> ReaderHttpStubs m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
>> :: forall a b.
ReaderHttpStubs m a -> ReaderHttpStubs m b -> ReaderHttpStubs m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> ReaderHttpStubs m a
return :: forall a. a -> ReaderHttpStubs m a
Monad, MonadReader env)
instance (MonadReader env m, HasHttpStubs env) => MonadHttp (ReaderHttpStubs m) where
httpLbs :: Request -> ReaderHttpStubs m (Response ByteString)
httpLbs Request
req = do
[HttpStub]
stubs <- Getting [HttpStub] env [HttpStub] -> ReaderHttpStubs m [HttpStub]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [HttpStub] env [HttpStub]
forall env. HasHttpStubs env => Lens' env [HttpStub]
Lens' env [HttpStub]
httpStubsL
Response ByteString -> ReaderHttpStubs m (Response ByteString)
forall a. a -> ReaderHttpStubs m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response ByteString -> ReaderHttpStubs m (Response ByteString))
-> Response ByteString -> ReaderHttpStubs m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ HasCallStack => [HttpStub] -> Request -> Response ByteString
[HttpStub] -> Request -> Response ByteString
httpStubbed [HttpStub]
stubs Request
req
newtype HttpStubsT m a = HttpStubsT {forall (m :: * -> *) a. HttpStubsT m a -> ReaderT [HttpStub] m a
unwrap :: ReaderT [HttpStub] m a}
deriving newtype ((forall a b. (a -> b) -> HttpStubsT m a -> HttpStubsT m b)
-> (forall a b. a -> HttpStubsT m b -> HttpStubsT m a)
-> Functor (HttpStubsT m)
forall a b. a -> HttpStubsT m b -> HttpStubsT m a
forall a b. (a -> b) -> HttpStubsT m a -> HttpStubsT m b
forall (m :: * -> *) a b.
Functor m =>
a -> HttpStubsT m b -> HttpStubsT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HttpStubsT m a -> HttpStubsT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HttpStubsT m a -> HttpStubsT m b
fmap :: forall a b. (a -> b) -> HttpStubsT m a -> HttpStubsT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> HttpStubsT m b -> HttpStubsT m a
<$ :: forall a b. a -> HttpStubsT m b -> HttpStubsT m a
Functor, Functor (HttpStubsT m)
Functor (HttpStubsT m) =>
(forall a. a -> HttpStubsT m a)
-> (forall a b.
HttpStubsT m (a -> b) -> HttpStubsT m a -> HttpStubsT m b)
-> (forall a b c.
(a -> b -> c)
-> HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m c)
-> (forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b)
-> (forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m a)
-> Applicative (HttpStubsT m)
forall a. a -> HttpStubsT m a
forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m a
forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
forall a b.
HttpStubsT m (a -> b) -> HttpStubsT m a -> HttpStubsT m b
forall a b c.
(a -> b -> c) -> HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (HttpStubsT m)
forall (m :: * -> *) a. Applicative m => a -> HttpStubsT m a
forall (m :: * -> *) a b.
Applicative m =>
HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m a
forall (m :: * -> *) a b.
Applicative m =>
HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
forall (m :: * -> *) a b.
Applicative m =>
HttpStubsT m (a -> b) -> HttpStubsT m a -> HttpStubsT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> HttpStubsT m a
pure :: forall a. a -> HttpStubsT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
HttpStubsT m (a -> b) -> HttpStubsT m a -> HttpStubsT m b
<*> :: forall a b.
HttpStubsT m (a -> b) -> HttpStubsT m a -> HttpStubsT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m c
liftA2 :: forall a b c.
(a -> b -> c) -> HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
*> :: forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m a
<* :: forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m a
Applicative, Applicative (HttpStubsT m)
Applicative (HttpStubsT m) =>
(forall a b.
HttpStubsT m a -> (a -> HttpStubsT m b) -> HttpStubsT m b)
-> (forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b)
-> (forall a. a -> HttpStubsT m a)
-> Monad (HttpStubsT m)
forall a. a -> HttpStubsT m a
forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
forall a b.
HttpStubsT m a -> (a -> HttpStubsT m b) -> HttpStubsT m b
forall (m :: * -> *). Monad m => Applicative (HttpStubsT m)
forall (m :: * -> *) a. Monad m => a -> HttpStubsT m a
forall (m :: * -> *) a b.
Monad m =>
HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
forall (m :: * -> *) a b.
Monad m =>
HttpStubsT m a -> (a -> HttpStubsT m b) -> HttpStubsT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
HttpStubsT m a -> (a -> HttpStubsT m b) -> HttpStubsT m b
>>= :: forall a b.
HttpStubsT m a -> (a -> HttpStubsT m b) -> HttpStubsT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
>> :: forall a b. HttpStubsT m a -> HttpStubsT m b -> HttpStubsT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> HttpStubsT m a
return :: forall a. a -> HttpStubsT m a
Monad, MonadReader [HttpStub])
deriving (Monad (HttpStubsT m)
Monad (HttpStubsT m) =>
(Request -> HttpStubsT m (Response ByteString))
-> MonadHttp (HttpStubsT m)
Request -> HttpStubsT m (Response ByteString)
forall (m :: * -> *). Monad m => Monad (HttpStubsT m)
forall (m :: * -> *).
Monad m =>
Request -> HttpStubsT m (Response ByteString)
forall (m :: * -> *).
Monad m =>
(Request -> m (Response ByteString)) -> MonadHttp m
$chttpLbs :: forall (m :: * -> *).
Monad m =>
Request -> HttpStubsT m (Response ByteString)
httpLbs :: Request -> HttpStubsT m (Response ByteString)
MonadHttp) via ReaderHttpStubs (HttpStubsT m)
runHttpStubsT :: HttpStubsT m a -> [HttpStub] -> m a
runHttpStubsT :: forall (m :: * -> *) a. HttpStubsT m a -> [HttpStub] -> m a
runHttpStubsT HttpStubsT m a
f = ReaderT [HttpStub] m a -> [HttpStub] -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HttpStubsT m a
f.unwrap