import Network.HTTP.Lucu.DefaultPage
import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Interaction
import Network.HTTP.Lucu.DefaultPage
import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Interaction
import Network.HTTP.Lucu.Postprocess
import Network.HTTP.Lucu.Preprocess
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Postprocess
import Network.HTTP.Lucu.Preprocess
import Network.HTTP.Lucu.Request
-
-requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> SockAddr -> InteractionQueue -> IO ()
-requestReader !cnf !tree !fbs !h !addr !tQueue
+requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> PortNumber -> SockAddr -> InteractionQueue -> IO ()
+requestReader !cnf !tree !fbs !h !port !addr !tQueue
acceptNonparsableRequest :: StatusCode -> IO ()
acceptNonparsableRequest status
= {-# SCC "acceptNonparsableRequest" #-}
acceptNonparsableRequest :: StatusCode -> IO ()
acceptNonparsableRequest status
= {-# SCC "acceptNonparsableRequest" #-}
acceptParsableRequest req input
= {-# SCC "acceptParsableRequest" #-}
do cert <- hGetPeerCert h
acceptParsableRequest req input
= {-# SCC "acceptParsableRequest" #-}
do cert <- hGetPeerCert h
= do writeItr itr itrReqChunkRemaining newRemaining
writeItr itr itrReqBodyWanted newWanted
updateItr itr itrReceivedBody $ flip B.append chunk
= do writeItr itr itrReqChunkRemaining newRemaining
writeItr itr itrReqBodyWanted newWanted
updateItr itr itrReceivedBody $ flip B.append chunk
let wanted = fromJust wantedM
bytesToRead = fromIntegral $ maybe wanted (min wanted) remainingM
(chunk, input') = B.splitAt bytesToRead input
let wanted = fromJust wantedM
bytesToRead = fromIntegral $ maybe wanted (min wanted) remainingM
(chunk, input') = B.splitAt bytesToRead input
- newRemaining = fmap
- (\ x -> x - (fromIntegral $ B.length chunk))
- remainingM
- isOver = B.length chunk < bytesToRead || newRemaining == Just 0
+ actualReadBytes = fromIntegral $ B.length chunk
+ newRemaining = (- actualReadBytes) <$> remainingM
+ isOver = actualReadBytes < bytesToRead ∨ newRemaining ≡ Just 0
writeItr itr itrReqChunkRemaining newRemaining
writeItr itr itrReqChunkIsOver isOver
writeItr itr itrReqBodyWanted Nothing
writeItr itr itrReceivedBody chunk
writeItr itr itrReqChunkRemaining newRemaining
writeItr itr itrReqChunkIsOver isOver
writeItr itr itrReqBodyWanted Nothing
writeItr itr itrReceivedBody chunk