{-# options_haddock prune #-}

-- |Description: Pure Http Interpreters, Internal
module Polysemy.Http.Interpreter.Pure where

import Network.HTTP.Client.Internal (CookieJar (CJ))
import Polysemy.Internal.Tactics (liftT)

import Polysemy.Http.Data.Response (Response (Response))
import qualified Polysemy.Http.Effect.Http as Http
import Polysemy.Http.Effect.Http (Http)

takeResponse ::
  Member (State [Response LByteString]) r =>
  [Response LByteString] ->
  Sem r (Response LByteString)
takeResponse :: forall (r :: EffectRow).
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Response LByteString)
takeResponse (Response LByteString
response : [Response LByteString]
rest) =
  Response LByteString
response Response LByteString -> Sem r () -> Sem r (Response LByteString)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Response LByteString] -> Sem r ()
forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put [Response LByteString]
rest
takeResponse [] =
  Response LByteString -> Sem r (Response LByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status
-> LByteString -> [Header] -> CookieJar -> Response LByteString
forall b. Status -> b -> [Header] -> CookieJar -> Response b
Response (Int -> Status
forall a. Enum a => Int -> a
toEnum Int
502) LByteString
"test responses exhausted" [] ([Cookie] -> CookieJar
CJ [Cookie]
forall a. Monoid a => a
mempty))

takeChunk ::
  Member (State [ByteString]) r =>
  [ByteString] ->
  Sem r ByteString
takeChunk :: forall (r :: EffectRow).
Member (State [ByteString]) r =>
[ByteString] -> Sem r ByteString
takeChunk (ByteString
chunk : [ByteString]
rest) =
  ByteString
chunk ByteString -> Sem r () -> Sem r ByteString
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [ByteString] -> Sem r ()
forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put [ByteString]
rest
takeChunk [] =
  ByteString -> Sem r ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""

interpretHttpPureWithState ::
  Members [State [ByteString], State [Response LByteString], Embed IO] r =>
  InterpreterFor (Http LByteString) r
interpretHttpPureWithState :: forall (r :: EffectRow).
Members
  '[State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http LByteString) r
interpretHttpPureWithState =
  (forall (rInitial :: EffectRow) x.
 Http LByteString (Sem rInitial) x
 -> Tactical (Http LByteString) (Sem rInitial) r x)
-> Sem (Http LByteString : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
    Http.Response Request
_ Response LByteString -> Sem rInitial a1
f -> do
      f (Response LByteString)
res <- Sem r (Response LByteString)
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Response LByteString))
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (Sem r (Response LByteString)
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Response LByteString)))
-> ([Response LByteString] -> Sem r (Response LByteString))
-> [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Response LByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Response LByteString] -> Sem r (Response LByteString)
forall (r :: EffectRow).
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Response LByteString)
takeResponse ([Response LByteString]
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Response LByteString)))
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Response LByteString))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     [Response LByteString]
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise Sem r [Response LByteString]
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
      (a1 -> Either HttpError a1) -> f a1 -> f (Either HttpError a1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a1 -> Either HttpError a1
forall a b. b -> Either a b
Right (f a1 -> f (Either HttpError a1))
-> Sem (WithTactics (Http LByteString) f (Sem rInitial) r) (f a1)
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError a1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Response LByteString -> Sem rInitial a1)
-> f (Response LByteString)
-> Sem (WithTactics (Http LByteString) f (Sem rInitial) r) (f a1)
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a b.
(a -> m b) -> f a -> Sem (WithTactics e f m r) (f b)
bindTSimple Response LByteString -> Sem rInitial a1
f f (Response LByteString)
res
    Http.Request Request
_ ->
      Sem r (Either HttpError (Response LByteString))
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError (Response LByteString)))
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (Sem r (Either HttpError (Response LByteString))
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Either HttpError (Response LByteString))))
-> ([Response LByteString]
    -> Sem r (Either HttpError (Response LByteString)))
-> [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError (Response LByteString)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Response LByteString -> Either HttpError (Response LByteString))
-> Sem r (Response LByteString)
-> Sem r (Either HttpError (Response LByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response LByteString -> Either HttpError (Response LByteString)
forall a b. b -> Either a b
Right (Sem r (Response LByteString)
 -> Sem r (Either HttpError (Response LByteString)))
-> ([Response LByteString] -> Sem r (Response LByteString))
-> [Response LByteString]
-> Sem r (Either HttpError (Response LByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Response LByteString] -> Sem r (Response LByteString)
forall (r :: EffectRow).
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Response LByteString)
takeResponse ([Response LByteString]
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Either HttpError (Response LByteString))))
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError (Response LByteString)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     [Response LByteString]
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise Sem r [Response LByteString]
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
    Http.Stream Request
_ Response LByteString -> Sem rInitial a1
handler -> do
      f (Response LByteString) -> Sem (Http LByteString : r) (f a1)
handle <- (Response LByteString -> Sem rInitial a1)
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Response LByteString) -> Sem (Http LByteString : r) (f a1))
forall a (m :: * -> *) b (e :: (* -> *) -> * -> *) (f :: * -> *)
       (r :: EffectRow).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT Response LByteString -> Sem rInitial a1
handler
      f (Response LByteString)
res <- Sem r (Response LByteString)
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Response LByteString))
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (Sem r (Response LByteString)
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Response LByteString)))
-> ([Response LByteString] -> Sem r (Response LByteString))
-> [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Response LByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Response LByteString] -> Sem r (Response LByteString)
forall (r :: EffectRow).
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Response LByteString)
takeResponse ([Response LByteString]
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Response LByteString)))
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Response LByteString))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [Response LByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     [Response LByteString]
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise Sem r [Response LByteString]
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
      (a1 -> Either HttpError a1) -> f a1 -> f (Either HttpError a1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a1 -> Either HttpError a1
forall a b. b -> Either a b
Right (f a1 -> f (Either HttpError a1))
-> Sem (WithTactics (Http LByteString) f (Sem rInitial) r) (f a1)
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError a1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (f a1)
-> Sem (WithTactics (Http LByteString) f (Sem rInitial) r) (f a1)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem (Http LByteString : r) (f a1) -> Sem r (f a1)
forall (r :: EffectRow).
Members
  '[State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http LByteString) r
interpretHttpPureWithState (f (Response LByteString) -> Sem (Http LByteString : r) (f a1)
handle f (Response LByteString)
res))
    Http.ConsumeChunk LByteString
_ ->
      Sem r (Either HttpError ByteString)
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError ByteString))
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (Sem r (Either HttpError ByteString)
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Either HttpError ByteString)))
-> ([ByteString] -> Sem r (Either HttpError ByteString))
-> [ByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either HttpError ByteString)
-> Sem r ByteString -> Sem r (Either HttpError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either HttpError ByteString
forall a b. b -> Either a b
Right (Sem r ByteString -> Sem r (Either HttpError ByteString))
-> ([ByteString] -> Sem r ByteString)
-> [ByteString]
-> Sem r (Either HttpError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Sem r ByteString
forall (r :: EffectRow).
Member (State [ByteString]) r =>
[ByteString] -> Sem r ByteString
takeChunk ([ByteString]
 -> Sem
      (WithTactics (Http LByteString) f (Sem rInitial) r)
      (f (Either HttpError ByteString)))
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r) [ByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r)
     (f (Either HttpError ByteString))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [ByteString]
-> Sem
     (WithTactics (Http LByteString) f (Sem rInitial) r) [ByteString]
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise Sem r [ByteString]
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
{-# inline interpretHttpPureWithState #-}

-- |In-Memory interpreter for 'Http'.
interpretHttpPure ::
  Member (Embed IO) r =>
  -- |When a request is made, one response is popped of the list and returned.
  --   If the list is exhausted, a 502 response is returned.
  [Response LByteString] ->
  -- |Chunks used for streaming responses.
  [ByteString] ->
  InterpretersFor [Http LByteString, State [Response LByteString], State [ByteString]] r
interpretHttpPure :: forall (r :: EffectRow).
Member (Embed IO) r =>
[Response LByteString]
-> [ByteString]
-> InterpretersFor
     '[Http LByteString, State [Response LByteString],
       State [ByteString]]
     r
interpretHttpPure [Response LByteString]
responses [ByteString]
chunks =
  [ByteString] -> Sem (State [ByteString] : r) a -> Sem r a
forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState [ByteString]
chunks (Sem (State [ByteString] : r) a -> Sem r a)
-> (Sem
      (Http LByteString
         : State [Response LByteString] : State [ByteString] : r)
      a
    -> Sem (State [ByteString] : r) a)
-> Sem
     (Http LByteString
        : State [Response LByteString] : State [ByteString] : r)
     a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [Response LByteString]
-> Sem (State [Response LByteString] : State [ByteString] : r) a
-> Sem (State [ByteString] : r) a
forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState [Response LByteString]
responses (Sem (State [Response LByteString] : State [ByteString] : r) a
 -> Sem (State [ByteString] : r) a)
-> (Sem
      (Http LByteString
         : State [Response LByteString] : State [ByteString] : r)
      a
    -> Sem (State [Response LByteString] : State [ByteString] : r) a)
-> Sem
     (Http LByteString
        : State [Response LByteString] : State [ByteString] : r)
     a
-> Sem (State [ByteString] : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (Http LByteString
     : State [Response LByteString] : State [ByteString] : r)
  a
-> Sem (State [Response LByteString] : State [ByteString] : r) a
forall (r :: EffectRow).
Members
  '[State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http LByteString) r
interpretHttpPureWithState
{-# inline interpretHttpPure #-}