import qualified Data.Attoparsec.Lazy as LP
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
+import Data.List
import qualified Data.Strict.Maybe as S
import Data.Monoid.Unicode
import qualified Data.Sequence as S
= do cert ← hGetPeerCert cHandle
ni ← mkNormalInteraction cConfig cAddr cert ar rsrcPath
tid ← spawnResource rsrcDef ni
+ enqueue ctx ni
if reqMustHaveBody arRequest then
waitForReceiveBodyReq ctx ni tid input
else
LP.Done input' chunkLen
| chunkLen ≡ 0 → gotFinalChunk input'
| otherwise → gotChunk input' chunkLen
- LP.Fail _ _ msg
- → chunkWasMalformed rsrcTid
- $ "wasteAllChunks: chunkHeaderP: " ⧺ msg
+ LP.Fail _ eCtx e
+ → chunkWasMalformed rsrcTid eCtx e
+ "wasteAllChunks: chunkHeaderP"
go input (InChunk chunkLen)
= gotChunk input chunkLen
case LP.parse chunkFooterP input' of
LP.Done input'' _
→ go input'' Initial
- LP.Fail _ _ msg
- → chunkWasMalformed rsrcTid
- $ "wasteAllChunks: chunkFooterP: " ⧺ msg
+ LP.Fail _ eCtx e
+ → chunkWasMalformed rsrcTid eCtx e
+ "wasteAllChunks: chunkFooterP"
gotFinalChunk ∷ Lazy.ByteString → IO ()
gotFinalChunk input
= case LP.parse chunkTrailerP input of
LP.Done input' _
→ acceptRequest ctx input'
- LP.Fail _ _ msg
- → chunkWasMalformed rsrcTid
- $ "wasteAllChunks: chunkTrailerP: " ⧺ msg
+ LP.Fail _ eCtx e
+ → chunkWasMalformed rsrcTid eCtx e
+ "wasteAllChunks: chunkTrailerP"
readCurrentChunk ∷ HandleLike h
⇒ Context h
→ gotFinalChunk input'
| otherwise
→ gotChunk input' chunkLen
- LP.Fail _ _ msg
- → chunkWasMalformed rsrcTid
- $ "readCurrentChunk: chunkHeaderP: " ⧺ msg
+ LP.Fail _ eCtx e
+ → chunkWasMalformed rsrcTid eCtx e
+ "readCurrentChunk: chunkHeaderP"
go input (InChunk chunkLen)
= gotChunk input chunkLen
case LP.parse chunkFooterP input' of
LP.Done input'' _
→ waitForReceiveChunkedBodyReq ctx ni rsrcTid input'' Initial
- LP.Fail _ _ msg
- → chunkWasMalformed rsrcTid
- $ "readCurrentChunk: chunkFooterP: " ⧺ msg
+ LP.Fail _ eCtx e
+ → chunkWasMalformed rsrcTid eCtx e
+ "readCurrentChunk: chunkFooterP: "
else
waitForReceiveChunkedBodyReq ctx ni rsrcTid input' $ InChunk chunkLen'
case LP.parse chunkTrailerP input of
LP.Done input' _
→ acceptRequest ctx input'
- LP.Fail _ _ msg
- → chunkWasMalformed rsrcTid
- $ "readCurrentChunk: chunkTrailerP: " ⧺ msg
+ LP.Fail _ eCtx e
+ → chunkWasMalformed rsrcTid eCtx e
+ "readCurrentChunk: chunkTrailerP"
-chunkWasMalformed ∷ ThreadId → String → IO ()
-chunkWasMalformed tid msg
+chunkWasMalformed ∷ ThreadId → [String] → String → String → IO ()
+chunkWasMalformed tid eCtx e msg
= let abo = mkAbortion BadRequest [("Connection", "close")]
$ Just
- $ "chunkWasMalformed: " ⊕ T.pack msg
+ $ "chunkWasMalformed: "
+ ⊕ T.pack msg
+ ⊕ ": "
+ ⊕ T.pack (intercalate ", " eCtx)
+ ⊕ ": "
+ ⊕ T.pack e
in
throwTo tid abo