( Interaction(..)
, InteractionState(..)
, InteractionQueue
+ , GetBodyRequest(..)
, newInteractionQueue
, newInteraction
where
import Blaze.ByteString.Builder (Builder)
import Control.Concurrent.STM
-import qualified Data.ByteString as BS
+import qualified Data.ByteString as Strict
import Data.Monoid.Unicode
import Data.Sequence (Seq)
import qualified Data.Sequence as S
, itrExpectedContinue ∷ !(Maybe Bool)
, itrReqBodyLength ∷ !(Maybe RequestBodyLength)
- , itrReqBodyWanted ∷ !(TVar Int)
- , itrReqBodyWasteAll ∷ !(TVar Bool)
- , itrReqChunkIsOver ∷ !(TVar Bool)
- , itrReceivedBody ∷ !(TVar (Seq BS.ByteString))
- , itrReceivedBodyLen ∷ !(TVar Int)
+ , itrGetBodyRequest ∷ !(TMVar GetBodyRequest)
+ , itrGotBody ∷ !(TMVar Strict.ByteString)
, itrResponse ∷ !(TVar Response)
, itrWillChunkBody ∷ !(TVar Bool)
-- |The interaction state of Resource monad. 'ExaminingRequest' is the
-- initial state.
-data InteractionState = ExaminingRequest
- | GettingBody
- | DecidingHeader
- | DecidingBody
- | Done
- deriving (Show, Eq, Ord, Enum)
+data InteractionState
+ = ExaminingRequest
+ | GettingBody
+ | DecidingHeader
+ | DecidingBody
+ | Done
+ deriving (Show, Eq, Ord, Enum)
type InteractionQueue = TVar (Seq Interaction)
+data GetBodyRequest
+ = GetBody !Int -- ^ Maximum number of bytes.
+ | WasteAll
+ deriving (Show, Eq)
+
newInteractionQueue ∷ IO InteractionQueue
newInteractionQueue = newTVarIO S.empty
, resHeaders = (∅)
}
- reqBodyWanted ← newTVarIO 0
- reqBodyWasteAll ← newTVarIO False
- reqChunkIsOver ← newTVarIO False
- receivedBody ← newTVarIO S.empty
- receivedBodyLen ← newTVarIO 0
+ getBodyRequest ← newEmptyTMVarIO
+ gotBody ← newEmptyTMVarIO
response ← newTVarIO res
willChunkBody ← newTVarIO False
state ← newTVarIO ExaminingRequest
return Interaction {
- itrConfig = conf
- , itrLocalPort = port
- , itrRemoteAddr = addr
- , itrRemoteCert = cert
- , itrResourcePath = Nothing
- , itrRequest = arRequest ar
+ itrConfig = conf
+ , itrLocalPort = port
+ , itrRemoteAddr = addr
+ , itrRemoteCert = cert
+ , itrResourcePath = Nothing
+ , itrRequest = arRequest ar
, itrExpectedContinue = arExpectedContinue ar
, itrReqBodyLength = arReqBodyLength ar
- , itrReqBodyWanted = reqBodyWanted
- , itrReqBodyWasteAll = reqBodyWasteAll
- , itrReqChunkIsOver = reqChunkIsOver
- , itrReceivedBody = receivedBody
- , itrReceivedBodyLen = receivedBodyLen
+ , itrGetBodyRequest = getBodyRequest
+ , itrGotBody = gotBody
, itrResponse = response
, itrWillChunkBody = willChunkBody