- toAB = A.toAsciiBuilder ∘ A.fromCIAscii
-
--- |Computation of @'setWWWAuthenticate' challenge@ sets the response
--- header \"WWW-Authenticate\" to @challenge@.
-setWWWAuthenticate ∷ AuthChallenge → Resource ()
-setWWWAuthenticate challenge
- = setHeader "WWW-Authenticate" (printAuthChallenge challenge)
-
-
-{- DecidingBody 時に使用するアクション群 -}
-
--- | Computation of @'output' str@ writes @str@ as a response body,
--- and then make the 'Resource' transit to /Done/ state. It is safe to
--- apply 'output' to an infinite string, such as a lazy stream of
--- \/dev\/random.
-output ∷ Lazy.ByteString → Resource ()
-{-# INLINE output #-}
-output str = outputChunk str *> driftTo Done
-
--- | Computation of @'outputChunk' str@ writes @str@ as a part of
--- response body. You can compute this action multiple times to write
--- a body little at a time. It is safe to apply 'outputChunk' to an
--- infinite string.
-outputChunk ∷ Lazy.ByteString → Resource ()
-outputChunk wholeChunk
- = do driftTo DecidingBody
- itr ← getInteraction
-
- let limit = cnfMaxOutputChunkLength $ itrConfig itr
- when (limit ≤ 0)
- $ abort InternalServerError []
- (Just $ "cnfMaxOutputChunkLength must be positive: " ⊕ T.pack (show limit))
-
- discardBody ← liftIO $ atomically $
- readItr itrWillDiscardBody id itr
-
- unless (discardBody)
- $ sendChunks wholeChunk limit
-
- unless (Lazy.null wholeChunk)
- $ liftIO $ atomically $
- writeItr itrBodyIsNull False itr
- where
- sendChunks ∷ Lazy.ByteString → Int → Resource ()
- sendChunks str limit
- | Lazy.null str = return ()
- | otherwise = do let (chunk, remaining) = Lazy.splitAt (fromIntegral limit) str
- itr ← getInteraction
- liftIO $ atomically
- $ putTMVar (itrBodyToSend itr) (chunkToBuilder chunk)
- sendChunks remaining limit
-
- chunkToBuilder ∷ Lazy.ByteString → Builder
- chunkToBuilder = mconcat ∘ map BB.fromByteString ∘ Lazy.toChunks
-
-{-
-
- [GettingBody からそれ以降の状態に遷移する時]
-
- body を讀み終へてゐなければ、殘りの body を讀み捨てる。
-
-
- [DecidingHeader からそれ以降の状態に遷移する時]
-
- postprocess する。
-
-
- [Done に遷移する時]
-
- bodyIsNull が False ならば何もしない。True だった場合は出力補完す
- る。
-
--}
-
-driftTo ∷ InteractionState → Resource ()
-driftTo newState
- = do itr ← getInteraction
- liftIO $ atomically $ do oldState ← readItr itrState id itr
- if newState < oldState then
- throwStateError oldState newState
- else
- do let a = [oldState .. newState]
- b = tail a
- c = zip a b
- mapM_ (uncurry $ drift itr) c
- writeItr itrState newState itr
- where
- throwStateError ∷ Monad m => InteractionState → InteractionState → m a
-
- throwStateError Done DecidingBody
- = fail "It makes no sense to output something after finishing to output."
-
- throwStateError old new
- = fail ("state error: " ⧺ show old ⧺ " ==> " ⧺ show new)
-
-
- drift ∷ Interaction → InteractionState → InteractionState → STM ()
-
- drift itr GettingBody _
- = writeItr itrReqBodyWasteAll True itr
-
- drift itr DecidingHeader _
- = postprocess itr
-
- drift itr _ Done
- = do bodyIsNull ← readItr itrBodyIsNull id itr
- when bodyIsNull
- $ writeDefaultPage itr
-
- drift _ _ _
- = return ()
+ toAB ∷ ConvertSuccess α AsciiBuilder ⇒ α → AsciiBuilder
+ toAB = cs
+
+-- |@'setWWWAuthenticate' challenge@ declares the response header
+-- \"WWW-Authenticate\" as @challenge@.
+setWWWAuthenticate ∷ AuthChallenge → Rsrc ()
+setWWWAuthenticate = setHeader "WWW-Authenticate" ∘ cs
+
+-- |Write a chunk in 'Strict.ByteString' to the response body. You
+-- must first declare the response header \"Content-Type\" before
+-- applying this function. See 'setContentType'.
+putChunk ∷ Strict.ByteString → Rsrc ()
+putChunk = putBuilder ∘ BB.fromByteString
+
+-- |Write a chunk in lazy 'Lazy.ByteString' to the response body. It
+-- can be safely applied to an infinitely long 'Lazy.ByteString'.
+--
+-- Note that you must first declare the response header
+-- \"Content-Type\" before applying this function. See
+-- 'setContentType'.
+putChunks ∷ Lazy.ByteString → Rsrc ()
+putChunks = putBuilder ∘ BB.fromLazyByteString