- → let p = do d ← contDispoP
- endOfInput
- return d
- bs = A.toByteString str
- in
- case parseOnly p bs of
- Right d → return d
- Left err → fail (concat [ "Unparsable Content-Disposition: "
- , BS.unpack bs
- , ": "
- , err
- ])
-
-contDispoP ∷ Parser ContDispo
-contDispoP = try $
- do dispoType ← A.toCIAscii <$> token
- params ← many paramP
- return $ ContDispo dispoType params
+ → case parseOnly (finishOff contentDisposition) $ A.toByteString str of
+ Right d → return d
+ Left err → throwError $ "malformed Content-Disposition: "
+ ⧺ A.toString str
+ ⧺ ": "
+ ⧺ err
+
+contentDisposition ∷ Parser ContDispo
+contentDisposition
+ = (ContDispo <$> (A.toCIAscii <$> token) ⊛ mimeParams)
+ <?>
+ "contentDisposition"
+
+getContType ∷ MonadError String m ⇒ Headers → m (Maybe MIMEType)
+{-# INLINEABLE getContType #-}
+getContType hdrs
+ = case getHeader "Content-Type" hdrs of
+ Nothing
+ → return Nothing
+ Just str
+ → case parseOnly (finishOff MT.mimeType) $ A.toByteString str of
+ Right d → return $ Just d
+ Left err → throwError $ "malformed Content-Type: "
+ ⧺ A.toString str
+ ⧺ ": "
+ ⧺ err
+
+getBody ∷ MonadError String m
+ ⇒ Ascii
+ → LS.ByteString
+ → m (LS.ByteString, LS.ByteString)
+{-# INLINEABLE getBody #-}
+getBody (("\r\n--" ⊕) ∘ A.toByteString → boundary) src
+ = case breakOn boundary src of
+ (before, after)
+ | LS.null after
+ → throwError "missing boundary"
+ | otherwise
+ → let len = fromIntegral $ BS.length boundary
+ after' = LS.drop len after
+ in
+ return (before, after')
+
+partToFormPair ∷ MonadError String m ⇒ Part → m (Ascii, FormData)
+{-# INLINEABLE partToFormPair #-}
+partToFormPair pt@(Part {..})
+ | dType ptContDispo ≡ "form-data"
+ = do name ← partName pt
+ let fd = FormData {
+ fdFileName = partFileName pt
+ , fdMIMEType = ptContType
+ , fdContent = ptBody
+ }
+ return (name, fd)
+ | otherwise
+ = throwError $ "disposition type is not \"form-data\": "
+ ⧺ A.toString (A.fromCIAscii $ dType ptContDispo)
+
+partName ∷ MonadError String m ⇒ Part → m Ascii
+{-# INLINEABLE partName #-}
+partName (Part {..})
+ = case M.lookup "name" params of
+ Just name
+ → case A.fromText name of
+ Just a → return a
+ Nothing → throwError $ "Non-ascii part name: "
+ ⧺ T.unpack name
+ Nothing
+ → throwError $ "form-data without name: "
+ ⧺ A.toString (printContDispo ptContDispo)