import qualified Data.Attoparsec.Lazy as LP
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
import Data.List
import Data.Maybe
import Data.Monoid.Unicode
import qualified Data.Sequence as S
-import qualified Data.Text as T
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.Chunk
data Context h
= Context {
- cConfig ∷ !Config
- , cSchemeMap ∷ !SchemeMap
- , cHandle ∷ !h
- , cPort ∷ !PortNumber
- , cAddr ∷ !SockAddr
- , cQueue ∷ !InteractionQueue
+ cConfig ∷ !Config
+ , cHostMap ∷ !HostMap
+ , cHandle ∷ !h
+ , cPort ∷ !PortNumber
+ , cAddr ∷ !SockAddr
+ , cQueue ∷ !InteractionQueue
}
data ChunkReceivingState
| InChunk !Int -- ^Number of remaining octets in the current
-- chunk. It's always positive.
-requestReader ∷ HandleLike h
+requestReader ∷ (HostMapper hm, HandleLike h)
⇒ Config
- → SchemeMap
+ → hm
→ h
→ PortNumber
→ SockAddr
→ InteractionQueue
→ IO ()
-requestReader cnf sm h port addr tQueue
+requestReader cnf hm h port addr tQueue
= do input ← hGetLBS h
- acceptRequest (Context cnf sm h port addr tQueue) input
+ acceptRequest (Context cnf (hostMap hm) h port addr tQueue) input
`catches`
[ Handler handleAsyncE
, Handler handleOthers
if isError $ arInitialStatus ar then
acceptSemanticallyInvalidRequest ctx ar input
else
- do rsrc ← runMaybeT $ dispatch (reqURI $ arRequest ar) cSchemeMap
+ do rsrc ← runMaybeT $ dispatch (reqURI $ arRequest ar) cHostMap
case rsrc of
Nothing
→ do let ar' = ar {
= let abo = mkAbortion BadRequest [("Connection", "close")]
$ Just
$ "chunkWasMalformed: "
- ⊕ T.pack msg
+ ⊕ cs msg
⊕ ": "
- ⊕ T.pack (intercalate ", " eCtx)
+ ⊕ cs (intercalate ", " eCtx)
⊕ ": "
- ⊕ T.pack e
+ ⊕ cs e
in
throwTo tid abo