{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

-- | 
-- This module is useful for testing by providing a concrete ByteString typed version of 'MonadDormouseClient' called `MonadDormouseTestClient`.  
--
-- The assumption is that, in most test cases, you probably want to verify the byte payload of the request (which you simply extract
-- from the request here as a @ByteString@) and provide a byte payload (also as a @ByteString@) in the response so that you can verify 
-- your repsonse payload can be decoded directly.
--
-- An implementation of `MonadDormouseTestClient` can be written in terms of either Strict or Lazy Bytestrings at your convenient and the other 
-- will be automatically provided for you.
--
-- The machinery in here uses orphan instances of 'MonadDormouseClient' so you should use this carefully and restrict this module to test 
-- cases only.
module Dormouse.Client.Test.Class
  ( MonadDormouseTestClient(..)
  ) where

import Control.Monad.IO.Class ( MonadIO(..) )
import qualified Data.ByteString  as SB
import qualified Data.ByteString.Lazy  as LB
import Data.Word ( Word8 )
import Dormouse.Client.Class ( MonadDormouseClient(..) )
import Dormouse.Client.Payload ( RawRequestPayload(..) )
import Dormouse.Client.Types ( HttpRequest(..), HttpResponse(..) )
import Dormouse.Url ( IsUrl )
import qualified Streamly.External.ByteString as SEB
import qualified Streamly.External.ByteString.Lazy as SEBL
import qualified Streamly.Data.Stream as Stream

-- | MonadDormouseTestClient describes the capability to send and receive specifically ByteString typed HTTP Requests and Responses
class Monad m => MonadDormouseTestClient m where
  -- | Make the supplied HTTP request, expecting an HTTP response with a Lazy ByteString body to be delivered in some @MonadDormouseTest m@
  expectLbs :: IsUrl url => HttpRequest url method LB.ByteString contentTag acceptTag -> m (HttpResponse LB.ByteString)
  expectLbs HttpRequest url method ByteString contentTag acceptTag
req = do
    HttpResponse ByteString
resp <- HttpRequest url method ByteString Any Any
-> m (HttpResponse ByteString)
forall url (method :: Symbol) contentTag acceptTag.
IsUrl url =>
HttpRequest url method ByteString contentTag acceptTag
-> m (HttpResponse ByteString)
forall (m :: * -> *) url (method :: Symbol) contentTag acceptTag.
(MonadDormouseTestClient m, IsUrl url) =>
HttpRequest url method ByteString contentTag acceptTag
-> m (HttpResponse ByteString)
expectBs (HttpRequest url method ByteString Any Any
 -> m (HttpResponse ByteString))
-> HttpRequest url method ByteString Any Any
-> m (HttpResponse ByteString)
forall a b. (a -> b) -> a -> b
$ HttpRequest url method ByteString contentTag acceptTag
req {requestBody = LB.toStrict $ requestBody req}
    HttpResponse ByteString -> m (HttpResponse ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpResponse ByteString -> m (HttpResponse ByteString))
-> HttpResponse ByteString -> m (HttpResponse ByteString)
forall a b. (a -> b) -> a -> b
$ HttpResponse ByteString
resp {responseBody = LB.fromStrict $ responseBody resp}
  -- | Make the supplied HTTP request, expecting an HTTP response with a Strict ByteString body to be delivered in some @MonadDormouseTest m@
  expectBs :: IsUrl url => HttpRequest url method SB.ByteString contentTag acceptTag -> m (HttpResponse SB.ByteString)
  expectBs HttpRequest url method ByteString contentTag acceptTag
req = do
    HttpResponse ByteString
resp <- HttpRequest url method ByteString Any Any
-> m (HttpResponse ByteString)
forall url (method :: Symbol) contentTag acceptTag.
IsUrl url =>
HttpRequest url method ByteString contentTag acceptTag
-> m (HttpResponse ByteString)
forall (m :: * -> *) url (method :: Symbol) contentTag acceptTag.
(MonadDormouseTestClient m, IsUrl url) =>
HttpRequest url method ByteString contentTag acceptTag
-> m (HttpResponse ByteString)
expectLbs (HttpRequest url method ByteString Any Any
 -> m (HttpResponse ByteString))
-> HttpRequest url method ByteString Any Any
-> m (HttpResponse ByteString)
forall a b. (a -> b) -> a -> b
$ HttpRequest url method ByteString contentTag acceptTag
req {requestBody = LB.fromStrict $ requestBody req}
    HttpResponse ByteString -> m (HttpResponse ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpResponse ByteString -> m (HttpResponse ByteString))
-> HttpResponse ByteString -> m (HttpResponse ByteString)
forall a b. (a -> b) -> a -> b
$ HttpResponse ByteString
resp {responseBody = LB.toStrict $ responseBody resp}
  {-# MINIMAL expectLbs | expectBs #-}

instance (Monad m, MonadIO m, MonadDormouseTestClient m) => MonadDormouseClient m where
  send :: forall url (method :: Symbol) contentTag acceptTag b.
IsUrl url =>
HttpRequest url method RawRequestPayload contentTag acceptTag
-> (HttpResponse (Stream IO Word8) -> IO (HttpResponse b))
-> m (HttpResponse b)
send HttpRequest url method RawRequestPayload contentTag acceptTag
req HttpResponse (Stream IO Word8) -> IO (HttpResponse b)
deserialiseResp = do
    ByteString
reqBody <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString)
-> (HttpRequest url method RawRequestPayload contentTag acceptTag
    -> IO ByteString)
-> HttpRequest url method RawRequestPayload contentTag acceptTag
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold IO Word8 ByteString -> Stream IO Word8 -> IO ByteString
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold IO Word8 ByteString
forall (m :: * -> *). MonadIO m => Fold m Word8 ByteString
SEB.write (Stream IO Word8 -> IO ByteString)
-> (HttpRequest url method RawRequestPayload contentTag acceptTag
    -> Stream IO Word8)
-> HttpRequest url method RawRequestPayload contentTag acceptTag
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawRequestPayload -> Stream IO Word8
extricateRequestStream (RawRequestPayload -> Stream IO Word8)
-> (HttpRequest url method RawRequestPayload contentTag acceptTag
    -> RawRequestPayload)
-> HttpRequest url method RawRequestPayload contentTag acceptTag
-> Stream IO Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpRequest url method RawRequestPayload contentTag acceptTag
-> RawRequestPayload
forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag -> body
requestBody (HttpRequest url method RawRequestPayload contentTag acceptTag
 -> m ByteString)
-> HttpRequest url method RawRequestPayload contentTag acceptTag
-> m ByteString
forall a b. (a -> b) -> a -> b
$ HttpRequest url method RawRequestPayload contentTag acceptTag
req
    let reqBs :: HttpRequest url method ByteString contentTag acceptTag
reqBs = HttpRequest url method RawRequestPayload contentTag acceptTag
req {requestBody = reqBody}
    HttpResponse ByteString
respBs <- HttpRequest url method ByteString Any Any
-> m (HttpResponse ByteString)
forall url (method :: Symbol) contentTag acceptTag.
IsUrl url =>
HttpRequest url method ByteString contentTag acceptTag
-> m (HttpResponse ByteString)
forall (m :: * -> *) url (method :: Symbol) contentTag acceptTag.
(MonadDormouseTestClient m, IsUrl url) =>
HttpRequest url method ByteString contentTag acceptTag
-> m (HttpResponse ByteString)
expectBs HttpRequest url method ByteString Any Any
forall {contentTag} {acceptTag}.
HttpRequest url method ByteString contentTag acceptTag
reqBs
    let respStream :: Stream IO Word8
respStream = Unfold IO ByteString Word8 -> ByteString -> Stream IO Word8
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
Stream.unfold Unfold IO ByteString Word8
forall (m :: * -> *). Monad m => Unfold m ByteString Word8
SEBL.reader (ByteString -> Stream IO Word8)
-> (ByteString -> ByteString) -> ByteString -> Stream IO Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.fromStrict (ByteString -> Stream IO Word8) -> ByteString -> Stream IO Word8
forall a b. (a -> b) -> a -> b
$ HttpResponse ByteString -> ByteString
forall body. HttpResponse body -> body
responseBody HttpResponse ByteString
respBs
    IO (HttpResponse b) -> m (HttpResponse b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HttpResponse b) -> m (HttpResponse b))
-> IO (HttpResponse b) -> m (HttpResponse b)
forall a b. (a -> b) -> a -> b
$ HttpResponse (Stream IO Word8) -> IO (HttpResponse b)
deserialiseResp (HttpResponse (Stream IO Word8) -> IO (HttpResponse b))
-> HttpResponse (Stream IO Word8) -> IO (HttpResponse b)
forall a b. (a -> b) -> a -> b
$ HttpResponse ByteString
respBs { responseBody = respStream }
    where 
      extricateRequestStream :: RawRequestPayload -> Stream.Stream IO Word8
      extricateRequestStream :: RawRequestPayload -> Stream IO Word8
extricateRequestStream (DefinedContentLength Word64
_ Stream IO Word8
s) = Stream IO Word8
s
      extricateRequestStream (ChunkedTransfer Stream IO Word8
s) = Stream IO Word8
s