import Control.Monad.Error (MonadError, throwError)
import Control.Monad.Unicode
import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
-import qualified Data.Ascii as A
+import Data.Attempt
import Data.Attoparsec
import qualified Data.Attoparsec.Lazy as LP
import qualified Data.ByteString as BS
import Data.Monoid.Unicode
import Data.Sequence (Seq)
import Data.Text (Text)
-import qualified Data.Text as T
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.MIMEParams
import Network.HTTP.Lucu.MIMEType (MIMEType)
prologue boundary
= ( (string "--" <?> "prefix")
*>
- (string (A.toByteString boundary) <?> "boundary")
+ (string (cs boundary) <?> "boundary")
*>
pure ()
)
Nothing
→ throwError "Content-Disposition is missing"
Just str
- → case parseOnly (finishOff contentDisposition) $ A.toByteString str of
+ → case parseOnly (finishOff contentDisposition) $ cs str of
Right d → return d
Left err → throwError $ "malformed Content-Disposition: "
- ⧺ A.toString str
- ⧺ ": "
- ⧺ err
+ â\8a\95 cs str
+ â\8a\95 ": "
+ â\8a\95 err
contentDisposition ∷ Parser ContDispo
contentDisposition
- = (ContDispo <$> (A.toCIAscii <$> token) ⊛ mimeParams)
+ = (ContDispo <$> (cs <$> token) ⊛ mimeParams)
<?>
"contentDisposition"
Nothing
→ return Nothing
Just str
- → case parseOnly (finishOff MT.mimeType) $ A.toByteString str of
+ → case parseOnly (finishOff MT.mimeType) $ cs str of
Right d → return $ Just d
Left err → throwError $ "malformed Content-Type: "
- ⧺ A.toString str
- ⧺ ": "
- ⧺ err
+ â\8a\95 cs str
+ â\8a\95 ": "
+ â\8a\95 err
getBody ∷ MonadError String m
⇒ Ascii
→ LS.ByteString
→ m (LS.ByteString, LS.ByteString)
{-# INLINEABLE getBody #-}
-getBody (("\r\n--" ⊕) ∘ A.toByteString → boundary) src
+getBody (("\r\n--" ⊕) ∘ cs → boundary) src
= case breakOn boundary src of
(before, after)
| LS.null after
return (name, fd)
| otherwise
= throwError $ "disposition type is not \"form-data\": "
- ⧺ A.toString (A.fromCIAscii $ dType ptContDispo)
+ â\8a\95 cs (dType ptContDispo)
partName ∷ MonadError String m ⇒ Part → m Ascii
{-# INLINEABLE partName #-}
partName (Part {..})
= case lookup "name" $ dParams ptContDispo of
Just name
- → case A.fromText name of
- Just a → return a
- Nothing → throwError $ "Non-ascii part name: "
- ⧺ T.unpack name
+ → case ca name of
+ Success a → return a
+ Failure e → throwError $ show e
Nothing
→ throwError $ "form-data without name: "
⊕ convertSuccessVia ((⊥) ∷ Ascii) ptContDispo