module Polysemy.Http.Strict where
import Polysemy (interpretH)
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.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 #-}
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 #-}