import Control.Monad
import Control.Monad.Unicode
import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
-import qualified Data.Ascii as A
+import Data.Convertible.Base
import Data.Maybe
import Data.Monoid.Unicode
import GHC.Conc (unsafeIOToSTM)
, isError
])
$ abort'
- $ A.toAsciiBuilder "Inappropriate status code for a response: "
- ⊕ printStatusCode resStatus
+ $ cs ("Inappropriate status code for a response: " ∷ Ascii)
+ ⊕ cs resStatus
- when ( resStatus â\89\88 MethodNotAllowed ∧
- hasHeader "Allow" res )
+ when ( resStatus â\89¡ cs MethodNotAllowed ∧
+ (¬) (hasHeader "Allow" res) )
$ abort'
- $ A.toAsciiBuilder "The status was "
- ⊕ printStatusCode resStatus
- ⊕ A.toAsciiBuilder " but no \"Allow\" header."
+ $ cs ("The status was " ∷ Ascii)
+ ⊕ cs resStatus
+ ⊕ cs (" but no \"Allow\" header." ∷ Ascii)
- when ( resStatus â\89\89 NotModified ∧
- isRedirection resStatus ∧
- hasHeader "Location" res )
+ when ( resStatus â\89¢ cs NotModified ∧
+ isRedirection resStatus ∧
+ (¬) (hasHeader "Location" res) )
$ abort'
- $ A.toAsciiBuilder "The status code was "
- ⊕ printStatusCode resStatus
- ⊕ A.toAsciiBuilder " but no Location header."
+ $ cs ("The status code was " ∷ Ascii)
+ ⊕ cs resStatus
+ ⊕ cs (" but no Location header." ∷ Ascii)
abort' ∷ AsciiBuilder → STM ()
abort' = throwSTM
∘ mkAbortion' InternalServerError
- ∘ A.toText
- ∘ A.fromAsciiBuilder
+ ∘ cs
postprocessWithRequest ∷ NormalInteraction → STM ()
postprocessWithRequest ni@(NI {..})
- = do willDiscardBody ← readTVar niWillDiscardBody
- canHaveBody ← if willDiscardBody then
- return False
- else
- resCanHaveBody <$> readTVar niResponse
-
- updateRes ni
+ = do updateRes ni
$ deleteHeader "Content-Length"
∘ deleteHeader "Transfer-Encoding"
+ canHaveBody ← resCanHaveBody <$> readTVar niResponse
if canHaveBody then
- do when niWillChunkBody $
- writeHeader ni "Transfer-Encoding" (Just "chunked")
- writeDefaultPageIfNeeded ni
- else
- do writeTVar niWillDiscardBody True
- -- These headers make sense for HEAD requests even
- -- when there won't be a response entity body.
+ do when niWillChunkBody
+ $ writeHeader ni "Transfer-Encoding" (Just "chunked")
when (reqMethod niRequest ≢ HEAD)
- $ updateRes ni
- $ deleteHeader "Content-Type"
- ∘ deleteHeader "Etag"
- ∘ deleteHeader "Last-Modified"
+ $ writeDefaultPageIfNeeded ni
+ else
+ -- These headers make sense for HEAD requests even when
+ -- there won't be a response entity body.
+ when (reqMethod niRequest ≢ HEAD)
+ $ updateRes ni
+ $ deleteHeader "Content-Type"
+ ∘ deleteHeader "Etag"
+ ∘ deleteHeader "Last-Modified"
hasConnClose ← (≡ Just "close") <$> readCIHeader ni "Connection"
willClose ← readTVar niWillClose