module Polysemy.Http.Strict where

import Polysemy (interpretH, pureT)
import Polysemy.Internal.Tactics hiding (liftT)

import Polysemy.Http.Data.Header (Header(Header))
import qualified Polysemy.Http.Data.Http as Http
import Polysemy.Http.Data.Http (Http)
import Polysemy.Http.Data.HttpError (HttpError)
import Polysemy.Http.Data.Response (Response(Response))

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

takeChunk ::
  Member (State [ByteString]) r =>
  [ByteString] ->
  Sem r ByteString
takeChunk :: [ByteString] -> Sem r ByteString
takeChunk (chunk :: ByteString
chunk : rest :: [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 :: [Effect]).
MemberWithError (State s) r =>
s -> Sem r ()
put [ByteString]
rest
takeChunk [] =
  ByteString -> Sem r ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ""

streamResponse :: Response Int
streamResponse :: Response Int
streamResponse =
  Status -> Int -> [Header] -> Response Int
forall b. Status -> b -> [Header] -> Response b
Response (Int -> Status
forall a. Enum a => Int -> a
toEnum 200) 1 [
    HeaderName -> HeaderValue -> Header
Header "content-disposition" [qt|filename="file.txt"|],
    HeaderName -> HeaderValue -> Header
Header "content-length" "5000000"
    ]

interpretHttpStrictWithState ::
  Members [State [ByteString], State [Response LByteString], Embed IO] r =>
  InterpreterFor (Http Int) r
interpretHttpStrictWithState :: InterpreterFor (Http Int) r
interpretHttpStrictWithState =
  (forall x (rInitial :: [Effect]).
 Http Int (Sem rInitial) x
 -> Tactical (Http Int) (Sem rInitial) r x)
-> Sem (Http Int : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
(forall x (rInitial :: [Effect]).
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
    Http.Request _ ->
      Sem r (Either HttpError (Response LByteString))
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     (f (Either HttpError (Response LByteString)))
forall (m :: * -> *) (f :: * -> *) (r :: [Effect]) (e :: Effect) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (Sem r (Either HttpError (Response LByteString))
 -> Sem
      (Tactics f (Sem rInitial) (Http Int : r) : r)
      (f (Either HttpError (Response LByteString))))
-> ([Response LByteString]
    -> Sem r (Either HttpError (Response LByteString)))
-> [Response LByteString]
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     (f (Either HttpError (Response LByteString)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Response LByteString]
-> Sem r (Either HttpError (Response LByteString))
forall (r :: [Effect]) a.
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Either a (Response LByteString))
takeResponse ([Response LByteString]
 -> Sem
      (Tactics f (Sem rInitial) (Http Int : r) : r)
      (f (Either HttpError (Response LByteString))))
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     [Response LByteString]
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     (f (Either HttpError (Response LByteString)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [Response LByteString]
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     [Response LByteString]
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise Sem r [Response LByteString]
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
get
    Http.Stream _ handler -> do
      f (Response Int) -> Sem (Http Int : r) (f (Either HttpError a))
handle <- (Response Int -> Sem rInitial (Either HttpError a))
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     (f (Response Int) -> Sem (Http Int : r) (f (Either HttpError a)))
forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
       (r :: [Effect]).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT Response Int -> Sem rInitial (Either HttpError a)
handler
      f (Response Int)
resp <- Response Int -> Tactical (Http Int) (Sem rInitial) r (Response Int)
forall a (e :: Effect) (m :: * -> *) (r :: [Effect]).
a -> Tactical e m r a
pureT Response Int
streamResponse
      Sem r (f (Either HttpError a))
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     (f (Either HttpError a))
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise (Sem (Http Int : r) (f (Either HttpError a))
-> Sem r (f (Either HttpError a))
forall (r :: [Effect]).
Members
  '[State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http Int) r
interpretHttpStrictWithState (f (Response Int) -> Sem (Http Int : r) (f (Either HttpError a))
handle f (Response Int)
resp))
    Http.ConsumeChunk _ ->
      Sem r (Either HttpError ByteString)
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     (f (Either HttpError ByteString))
forall (m :: * -> *) (f :: * -> *) (r :: [Effect]) (e :: Effect) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (Sem r (Either HttpError ByteString)
 -> Sem
      (Tactics f (Sem rInitial) (Http Int : r) : r)
      (f (Either HttpError ByteString)))
-> ([ByteString] -> Sem r (Either HttpError ByteString))
-> [ByteString]
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : 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 :: [Effect]).
Member (State [ByteString]) r =>
[ByteString] -> Sem r ByteString
takeChunk ([ByteString]
 -> Sem
      (Tactics f (Sem rInitial) (Http Int : r) : r)
      (f (Either HttpError ByteString)))
-> Sem (Tactics f (Sem rInitial) (Http Int : r) : r) [ByteString]
-> Sem
     (Tactics f (Sem rInitial) (Http Int : r) : r)
     (f (Either HttpError ByteString))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [ByteString]
-> Sem (Tactics f (Sem rInitial) (Http Int : r) : r) [ByteString]
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise Sem r [ByteString]
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
get
{-# INLINE interpretHttpStrictWithState #-}

-- |In-Memory interpreter for 'Http'.
-- The first parameter is a list of 'Response'. When a request is made, one response is popped of the head and returned.
-- If the list is exhausted, a 502 response is returned.
interpretHttpStrict ::
  Member (Embed IO) r =>
  [Response LByteString] ->
  [ByteString] ->
  InterpreterFor (Http Int) r
interpretHttpStrict :: [Response LByteString]
-> [ByteString] -> InterpreterFor (Http Int) r
interpretHttpStrict responses :: [Response LByteString]
responses chunks :: [ByteString]
chunks =
  [ByteString] -> Sem (State [ByteString] : r) a -> Sem r a
forall s (r :: [Effect]) a. s -> Sem (State s : r) a -> Sem r a
evalState [ByteString]
chunks (Sem (State [ByteString] : r) a -> Sem r a)
-> (Sem (Http Int : r) a -> Sem (State [ByteString] : r) a)
-> Sem (Http Int : 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 :: [Effect]) 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 Int : r) a
    -> Sem (State [Response LByteString] : State [ByteString] : r) a)
-> Sem (Http Int : r) a
-> Sem (State [ByteString] : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (Http Int : State [Response LByteString] : State [ByteString] : r)
  a
-> Sem (State [Response LByteString] : State [ByteString] : r) a
forall (r :: [Effect]).
Members
  '[State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http Int) r
interpretHttpStrictWithState (Sem
   (Http Int : State [Response LByteString] : State [ByteString] : r)
   a
 -> Sem (State [Response LByteString] : State [ByteString] : r) a)
-> (Sem (Http Int : r) a
    -> Sem
         (Http Int : State [Response LByteString] : State [ByteString] : r)
         a)
-> Sem (Http Int : r) a
-> Sem (State [Response LByteString] : State [ByteString] : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Http Int : State [ByteString] : r) a
-> Sem
     (Http Int : State [Response LByteString] : State [ByteString] : r)
     a
forall (e2 :: Effect) (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Http Int : State [ByteString] : r) a
 -> Sem
      (Http Int : State [Response LByteString] : State [ByteString] : r)
      a)
-> (Sem (Http Int : r) a
    -> Sem (Http Int : State [ByteString] : r) a)
-> Sem (Http Int : r) a
-> Sem
     (Http Int : State [Response LByteString] : State [ByteString] : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Http Int : r) a -> Sem (Http Int : State [ByteString] : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
{-# INLINE interpretHttpStrict #-}