import Data.Text (Text)
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.Chunk
-import Network.HTTP.Lucu.DefaultPage
import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Interaction
import Network.HTTP.Lucu.Postprocess
= do itr ← newInteraction cConfig cPort cAddr Nothing (Left sc)
atomically $
do writeTVar (itrState itr) Done
- writeDefaultPage itr
postprocess itr
enqueue ctx itr
→ STM (IO ())
acceptSemanticallyInvalidRequest ctx itr input
= do writeTVar (itrState itr) Done
- writeDefaultPage itr
postprocess itr
enqueue ctx itr
return $ acceptRequest ctx input
= do atomically $
do setResponseStatus itr NotFound
writeTVar (itrState itr) Done
- writeDefaultPage itr
postprocess itr
enqueue ctx itr
acceptRequest ctx input
= do let itr = oldItr { itrResourcePath = Just rsrcPath }
atomically $ enqueue ctx itr
do _ ← runResource rsrcDef itr
- if reqHasBody $ fromJust $ itrRequest itr then
+ if reqMustHaveBody $ fromJust $ itrRequest itr then
observeRequest ctx itr input
else
acceptRequest ctx input
if isOver then
return $ acceptRequest ctx input
else
- do wantedM ← readTVar $ itrReqBodyWanted itr
- case wantedM of
- Nothing
- → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
- if wasteAll then
- return $ wasteCurrentChunk ctx itr input remaining
- else
- retry
- Just wanted
- → return $ readCurrentChunk ctx itr input wanted remaining
+ do wanted ← readTVar $ itrReqBodyWanted itr
+ case wanted of
+ 0 → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
+ if wasteAll then
+ return $ wasteCurrentChunk ctx itr input remaining
+ else
+ retry
+ _ → return $ readCurrentChunk ctx itr input wanted remaining
wasteCurrentChunk ∷ HandleLike h
⇒ Context h
= do let bytesToRead = fromIntegral $ min wanted remaining
(chunk, input') = Lazy.splitAt bytesToRead input
actualReadBytes = fromIntegral $ Lazy.length chunk
- newWanted = case wanted - actualReadBytes of
- 0 → Nothing
- n → Just n
+ newWanted = wanted - actualReadBytes
newRemaining = remaining - actualReadBytes
chunk' = S.fromList $ Lazy.toChunks chunk
updateStates = atomically $
do setResponseStatus itr BadRequest
writeTVar (itrWillClose itr) True
writeTVar (itrState itr) Done
- writeDefaultPage itr
postprocess itr
observeNonChunkedRequest ∷ HandleLike h
observeNonChunkedRequest ctx itr input remaining
= join $
atomically $
- do wantedM ← readTVar $ itrReqBodyWanted itr
- case wantedM of
- Nothing
- → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
- if wasteAll then
- return $ wasteNonChunkedRequestBody ctx itr input remaining
- else
- retry
- Just wanted
- → return $ readNonChunkedRequestBody ctx itr input wanted remaining
+ do wanted ← readTVar $ itrReqBodyWanted itr
+ case wanted of
+ 0 → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
+ if wasteAll then
+ return $ wasteNonChunkedRequestBody ctx itr input remaining
+ else
+ retry
+ _ → return $ readNonChunkedRequestBody ctx itr input wanted remaining
wasteNonChunkedRequestBody ∷ HandleLike h
⇒ Context h
= do let bytesToRead = min wanted remaining
(chunk, input') = Lazy.splitAt (fromIntegral bytesToRead) input
actualReadBytes = fromIntegral $ Lazy.length chunk
+ newWanted = wanted - actualReadBytes
newRemaining = remaining - actualReadBytes
isOver = actualReadBytes < bytesToRead ∨ newRemaining ≡ 0
chunk' = S.fromList $ Lazy.toChunks chunk
atomically $
do writeTVar (itrReqChunkIsOver itr) isOver
- writeTVar (itrReqBodyWanted itr) Nothing
+ writeTVar (itrReqBodyWanted itr) newWanted
writeTVar (itrReceivedBody itr) chunk'
writeTVar (itrReceivedBodyLen itr) actualReadBytes
if isOver then