{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
module Http.Mock
( stub,
Stub,
mkStub,
getHeader,
getTextBody,
getJsonBody,
getBytesBody,
)
where
import qualified Data.Aeson as Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy
import qualified Data.Dynamic as Dynamic
import qualified Data.IORef
import Data.String (fromString)
import qualified Data.Text.Encoding
import qualified Debug
import qualified Expect
import qualified GHC.Stack as Stack
import qualified Http.Internal as Internal
import qualified Platform
import qualified Task
import qualified Type.Reflection
import qualified Prelude
data Stub a where
Stub ::
Dynamic.Typeable expect =>
(Internal.Request expect -> Task Internal.Error (a, expect)) ->
Stub a
mkStub ::
Dynamic.Typeable expect =>
(Internal.Request expect -> Task Internal.Error (a, expect)) ->
Stub a
mkStub :: (Request expect -> Task Error (a, expect)) -> Stub a
mkStub = (Request expect -> Task Error (a, expect)) -> Stub a
forall expect a.
Typeable expect =>
(Request expect -> Task Error (a, expect)) -> Stub a
Stub
stub ::
( Stack.HasCallStack,
Dynamic.Typeable a
) =>
(List (Stub a)) ->
(Internal.Handler -> Expect.Expectation) ->
Expect.Expectation' (List a)
stub :: List (Stub a) -> (Handler -> Expectation) -> Expectation' (List a)
stub List (Stub a)
responders Handler -> Expectation
stubbedTestBody = do
IORef (List a)
logRef <- IO (IORef (List a)) -> Expectation' (IORef (List a))
forall a. IO a -> Expectation' a
Expect.fromIO (List a -> IO (IORef (List a))
forall a. a -> IO (IORef a)
Data.IORef.newIORef [])
Handler
doAnything <- IO Handler -> Expectation' Handler
forall a. IO a -> Expectation' a
Expect.fromIO IO Handler
Platform.doAnythingHandler
let mockHandler :: Handler
mockHandler =
(forall expect.
Typeable expect =>
Request expect -> Task Error expect)
-> (forall a e. (Manager -> Task e a) -> Task e a)
-> (forall a. LogHandler -> (Manager -> IO a) -> IO a)
-> Handler
Internal.Handler
( \Request expect
req -> do
(a
log, expect
res) <-
List (Stub a) -> Error -> Request expect -> Task Error (a, expect)
forall expect a.
(Typeable expect, Typeable a) =>
List (Stub a) -> Error -> Request expect -> Task Error (a, expect)
tryRespond
List (Stub a)
responders
( Text -> Error
Internal.NetworkError
( Text
"Http request was made with expected return type "
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Request expect -> Text
forall expect (proxy :: * -> *).
Typeable expect =>
proxy expect -> Text
printType Request expect
req
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
", but I don't how to create a mock response of this type. Please add a `mkStub` entry for this type in the test."
)
)
Request expect
req
IORef (List a) -> (List a -> List a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
Data.IORef.modifyIORef' IORef (List a)
logRef (\List a
prev -> a
log a -> List a -> List a
forall a. a -> [a] -> [a]
: List a
prev)
IO () -> (IO () -> IO (Result Error ())) -> IO (Result Error ())
forall a b. a -> (a -> b) -> b
|> (() -> Result Error ()) -> IO () -> IO (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map () -> Result Error ()
forall error value. value -> Result error value
Ok
IO (Result Error ())
-> (IO (Result Error ()) -> Task Error ()) -> Task Error ()
forall a b. a -> (a -> b) -> b
|> Handler -> IO (Result Error ()) -> Task Error ()
forall e a. Handler -> IO (Result e a) -> Task e a
Platform.doAnything Handler
doAnything
expect -> Task Error expect
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure expect
res
)
(\Manager -> Task e a
_ -> Text -> Task e a
forall a. HasCallStack => Text -> a
Debug.todo Text
"We don't mock third party HTTP calls yet")
(\LogHandler
_ -> Text -> (Manager -> IO a) -> IO a
forall a. HasCallStack => Text -> a
Debug.todo Text
"We don't mock third party HTTP calls yet")
(forall e a. (Handler -> Task e a) -> Task e a)
-> (Handler -> Expectation) -> Expectation
forall arg.
(forall e a. (arg -> Task e a) -> Task e a)
-> (arg -> Expectation) -> Expectation
Expect.around (\Handler -> Task e a
f -> Handler -> Task e a
f Handler
mockHandler) ((HasCallStack => Handler -> Expectation) -> Handler -> Expectation
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Handler -> Expectation
Handler -> Expectation
stubbedTestBody)
IO (List a) -> Expectation' (List a)
forall a. IO a -> Expectation' a
Expect.fromIO (IORef (List a) -> IO (List a)
forall a. IORef a -> IO a
Data.IORef.readIORef IORef (List a)
logRef)
Expectation' (List a)
-> (Expectation' (List a) -> Expectation' (List a))
-> Expectation' (List a)
forall a b. a -> (a -> b) -> b
|> (List a -> List a)
-> Expectation' (List a) -> Expectation' (List a)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map List a -> List a
forall a. List a -> List a
List.reverse
getTextBody :: Internal.Request expect -> Maybe Text
getTextBody :: Request expect -> Maybe Text
getTextBody Request expect
req =
ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' (Request expect -> ByteString
forall expect. Request expect -> ByteString
getBytesBody Request expect
req)
Either UnicodeException Text
-> (Either UnicodeException Text -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe
getJsonBody :: Aeson.FromJSON a => Internal.Request expect -> Result Text a
getJsonBody :: Request expect -> Result Text a
getJsonBody Request expect
req =
case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict (Request expect -> ByteString
forall expect. Request expect -> ByteString
getBytesBody Request expect
req) of
Prelude.Left String
err -> Text -> Result Text a
forall error value. error -> Result error value
Err (String -> Text
Text.fromList String
err)
Prelude.Right a
decoded -> a -> Result Text a
forall error value. value -> Result error value
Ok a
decoded
getBytesBody :: Internal.Request expect -> ByteString
getBytesBody :: Request expect -> ByteString
getBytesBody Request expect
req =
Request expect -> Body
forall a. Request a -> Body
Internal.body Request expect
req
Body -> (Body -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> Body -> ByteString
Internal.bodyContents
ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString
Data.ByteString.Lazy.toStrict
getHeader :: Text -> Internal.Request expect -> Maybe Text
Text
name Request expect
req =
Request expect -> [Header]
forall a. Request a -> [Header]
Internal.headers Request expect
req
[Header] -> ([Header] -> List Header) -> List Header
forall a b. a -> (a -> b) -> b
|> (Header -> Header) -> [Header] -> List Header
forall a b. (a -> b) -> List a -> List b
List.map Header -> Header
Internal.unHeader
List Header
-> (List Header -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
|> HeaderName -> List Header -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup (String -> HeaderName
forall a. IsString a => String -> a
fromString (Text -> String
Text.toList Text
name))
Maybe ByteString -> (Maybe ByteString -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> (ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen (Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8')
eitherToMaybe :: Prelude.Either a b -> Maybe b
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe Either a b
either =
case Either a b
either of
Prelude.Left a
_ -> Maybe b
forall a. Maybe a
Nothing
Prelude.Right b
x -> b -> Maybe b
forall a. a -> Maybe a
Just b
x
tryRespond ::
( Dynamic.Typeable expect,
Dynamic.Typeable a
) =>
List (Stub a) ->
Internal.Error ->
Internal.Request expect ->
Task Internal.Error (a, expect)
tryRespond :: List (Stub a) -> Error -> Request expect -> Task Error (a, expect)
tryRespond [] Error
err Request expect
_ = Error -> Task Error (a, expect)
forall x a. x -> Task x a
Task.fail Error
err
tryRespond (Stub Request expect -> Task Error (a, expect)
respond : List (Stub a)
rest) Error
err Request expect
req =
Dynamic -> Dynamic -> Maybe Dynamic
Dynamic.dynApply ((Request expect -> Task Error (a, expect)) -> Dynamic
forall a. Typeable a => a -> Dynamic
Dynamic.toDyn Request expect -> Task Error (a, expect)
respond) (Request expect -> Dynamic
forall a. Typeable a => a -> Dynamic
Dynamic.toDyn Request expect
req)
Maybe Dynamic
-> (Maybe Dynamic -> Maybe (Task Error (a, expect)))
-> Maybe (Task Error (a, expect))
forall a b. a -> (a -> b) -> b
|> (Dynamic -> Maybe (Task Error (a, expect)))
-> Maybe Dynamic -> Maybe (Task Error (a, expect))
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen Dynamic -> Maybe (Task Error (a, expect))
forall a. Typeable a => Dynamic -> Maybe a
Dynamic.fromDynamic
Maybe (Task Error (a, expect))
-> (Maybe (Task Error (a, expect)) -> Task Error (a, expect))
-> Task Error (a, expect)
forall a b. a -> (a -> b) -> b
|> Task Error (a, expect)
-> Maybe (Task Error (a, expect)) -> Task Error (a, expect)
forall a. a -> Maybe a -> a
Maybe.withDefault (List (Stub a) -> Error -> Request expect -> Task Error (a, expect)
forall expect a.
(Typeable expect, Typeable a) =>
List (Stub a) -> Error -> Request expect -> Task Error (a, expect)
tryRespond List (Stub a)
rest Error
err Request expect
req)
printType :: Dynamic.Typeable expect => proxy expect -> Text
printType :: proxy expect -> Text
printType proxy expect
expect =
proxy expect -> SomeTypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
Type.Reflection.someTypeRep proxy expect
expect
SomeTypeRep -> (SomeTypeRep -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> SomeTypeRep -> Text
forall a. Show a => a -> Text
Debug.toString