{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

-- | Stub out Http requests in tests.
module Http.Mock
  ( stub,
    Stub,
    mkStub,

    -- * Read request data
    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

-- | A stub for a single request type. If your test body can perform multiple
-- different kinds of http requests, you'll want one of these per request type.
data Stub a where
  Stub ::
    Dynamic.Typeable expect =>
    (Internal.Request expect -> Task Internal.Error (a, expect)) ->
    Stub a

-- | Create a 'Stub'.
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 out http requests in a bit of code. You can use this if you don't
-- want your tests to make real http requests, and to listen in on the http
-- requests it is attempting to make.
--
-- 'stub' takes a function that it calls instead of making a real http request.
-- That function should return the response string and a optionally some
-- information about the http request. You'll get back the information collected
-- for each outgoing http request so you can run assertions against it.
--
-- > test "Stubbed HTTP requests" <| \_ -> do
-- >   urlsAccessed <-
-- >     Http.Mock.stub
-- >       [mkStub (\req -> Task.succeed (Http.url req, "Response!" :: Text))]
-- >       ( \http ->
-- >           Expect.succeeds <| do
-- >             _ <- Http.get http "example.com/one" Http.expectText
-- >             _ <- Http.get http "example.com/two" Http.expectText
-- >             Task.succeed ()
-- >       )
-- >   urlsAccessed
-- >     |> Expect.equal ["example.com/one", "example.com/two"]
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

-- | Read the body of the request as text. Useful to check what data got
-- submitted inside a 'stub' function.
--
-- This will return 'Nothing' if the body cannot be parsed as UTF8 text.
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

-- | Read the body of the request as json. Useful to check what data got
-- submitted inside a 'stub' function.
--
-- This will return an error if parsing the JSON body fails.
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

-- | Read the body of the request as bytes. Useful to check what data got
-- submitted inside a 'stub' function.
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

-- | Read a header of the request. Useful to check what data got submitted
-- inside a 'stub' function.
--
-- This will return 'Nothing' if no header with that name was set on the
-- request.
getHeader :: Text -> Internal.Request expect -> Maybe Text
getHeader :: Text -> Request expect -> Maybe Text
getHeader 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