import qualified Data.Ascii as A
import qualified Data.ByteString.Char8 as C8
import Data.Maybe
-import qualified Data.Strict.Maybe as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
data AugmentedRequest
= AugmentedRequest {
arRequest ∷ !Request
- , arInitialStatus ∷ !StatusCode
+ , arInitialStatus ∷ !SomeStatusCode
, arWillChunkBody ∷ !Bool
, arWillDiscardBody ∷ !Bool
, arWillClose ∷ !Bool
, arExpectedContinue ∷ !Bool
- , arReqBodyLength ∷ !(S.Maybe RequestBodyLength)
+ , arReqBodyLength ∷ !(Maybe RequestBodyLength)
}
data RequestBodyLength
initialAR ∷ AugmentedRequest
initialAR = AugmentedRequest {
arRequest = req
- , arInitialStatus = Ok
+ , arInitialStatus = fromStatusCode OK
, arWillChunkBody = False
, arWillDiscardBody = False
, arWillClose = False
, arExpectedContinue = False
- , arReqBodyLength = S.Nothing
+ , arReqBodyLength = Nothing
}
go ∷ State AugmentedRequest ()
go = do examineHttpVersion
setRequest req
= modify $ \ar → ar { arRequest = req }
-setStatus ∷ StatusCode → State AugmentedRequest ()
+setStatus ∷ StatusCode sc ⇒ sc → State AugmentedRequest ()
setStatus sc
- = modify $ \ar → ar { arInitialStatus = sc }
+ = modify $ \ar → ar { arInitialStatus = fromStatusCode sc }
setWillClose ∷ Bool → State AugmentedRequest ()
setWillClose b
= modify $ \ar → ar { arWillClose = b }
-setBodyLength ∷ S.Maybe RequestBodyLength → State AugmentedRequest ()
+setBodyLength ∷ Maybe RequestBodyLength → State AugmentedRequest ()
setBodyLength len
= modify $ \ar → ar { arReqBodyLength = len }
→ setWillClose True
HttpVersion 1 1
→ modify $ \ar → ar { arWillChunkBody = True }
- _ → do setStatus HttpVersionNotSupported
+ _ → do setStatus HTTPVersionNotSupported
setWillClose True
examineMethod ∷ State AugmentedRequest ()
| v ≡ "identity"
→ return ()
| v ≡ "chunked"
- → setBodyLength $ S.Just Chunked
+ → setBodyLength $ Just Chunked
| otherwise
→ setStatus NotImplemented
Just value → case C8.readInt value of
Just (len, garbage)
| C8.null garbage ∧ len ≥ 0
- → setBodyLength $ S.Just $ Fixed len
+ → setBodyLength $ Just $ Fixed len
_ → setStatus BadRequest
case getCIHeader "Connection" req of
len ← gets arReqBodyLength
if reqMustHaveBody req then
-- POST and PUT requests must have an entity body.
- when (S.isNothing len)
+ when (isNothing len)
$ setStatus LengthRequired
else
-- Other requests must NOT have an entity body.
- when (S.isJust len)
+ when (isJust len)
$ setStatus BadRequest