Strict.hs

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 : rest) =
  Right response <$ put rest
takeResponse [] =
  pure (Right (Response (toEnum 502) "test responses exhausted" []))

takeChunk ::
  Member (State [ByteString]) r =>
  [ByteString] ->
  Sem r ByteString
takeChunk (chunk : rest) =
  chunk <$ put rest
takeChunk [] =
  pure ""

streamResponse :: Response Int
streamResponse =
  Response (toEnum 200) 1 [
    Header "content-disposition" [qt|filename="file.txt"|],
    Header "content-length" "5000000"
    ]

interpretHttpStrictWithState ::
  Members [State [ByteString], State [Response LByteString], Embed IO] r =>
  InterpreterFor (Http Int) r
interpretHttpStrictWithState =
  interpretH \case
    Http.Request _ ->
      liftT . takeResponse =<< raise get
    Http.Stream _ handler -> do
      handle <- bindT handler
      resp <- pureT streamResponse
      raise (interpretHttpStrictWithState (handle resp))
    Http.ConsumeChunk _ ->
      liftT . fmap Right . takeChunk =<< raise 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 responses chunks =
  evalState chunks .
  evalState responses .
  interpretHttpStrictWithState .
  raiseUnder .
  raiseUnder
{-# INLINE interpretHttpStrict #-}