RFC2231.printParams

Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa

diff --git a/Lucu.cabal b/Lucu.cabal
index de76987fde088a98b11d2c70ea4c437c0ad329e6..3ac356ea80c90bf24bf37e2319e004c3e1ebf117 100644 (file)
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -79,6 +79,7 @@ Library
         Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
         Network.HTTP.Lucu.MIMEType.Guess
         Network.HTTP.Lucu.Parser.Http
+        Network.HTTP.Lucu.RFC2231
         Network.HTTP.Lucu.Request
         Network.HTTP.Lucu.Resource
         Network.HTTP.Lucu.Resource.Tree

diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs
index 4128f53b91c3d58fbd560af850c8a6ae16b8f29d..318526d83402730e78ce52c59ca528779b1eb9b2 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType.hs
+++ b/Network/HTTP/Lucu/MIMEType.hs
@@ -19,7 +19,9 @@ import Data.Ascii (Ascii, CIAscii)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8 as P
 import qualified Data.ByteString.Char8 as C8
+import Data.Map (Map)
 import Data.Monoid.Unicode
+import Data.Text (Text)
 import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.Utils
 import Prelude hiding (min)
@@ -30,7 +32,7 @@ import Prelude.Unicode
 data MIMEType = MIMEType {
       mtMajor  ∷ !CIAscii
     , mtMinor  ∷ !CIAscii
-    , mtParams ∷ ![ (CIAscii, Ascii) ]
+    , mtParams ∷ !(Map CIAscii Text)
     } deriving (Eq, Show)
 
 -- |Convert a 'MIMEType' to 'Ascii'.

diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs
index 2319477f68dc3410fa69cbd6ae2cc5bce5173eea..3344f4b7351f1d545dc5a908f40457f65ad34cfe 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType/Guess.hs
+++ b/Network/HTTP/Lucu/MIMEType/Guess.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE
     BangPatterns
-  , UnboxedTuples
   , UnicodeSyntax
   #-}
 -- |MIME Type guessing by a file extension. This is a poor man's way

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 4dcf076c93c13be34f7fd3bc0986f24652601616..10d1f64276f07307c581e66d463492c3ef7358d6 100644 (file)
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -2,7 +2,6 @@
     DoAndIfThenElse
   , OverloadedStrings
   , ScopedTypeVariables
-  , UnboxedTuples
   , UnicodeSyntax
   #-}
 module Network.HTTP.Lucu.MultipartForm
@@ -16,15 +15,17 @@ import qualified Data.Ascii as A
 import Data.Attoparsec.Char8
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LS
-import           Data.Char
-import           Data.List
+import Data.Char
+import Data.List
+import Data.Map (Map)
 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Text (Text)
-import           Network.HTTP.Lucu.Headers
-import           Network.HTTP.Lucu.Parser.Http
-import           Network.HTTP.Lucu.Response
-import           Network.HTTP.Lucu.Utils
+import Network.HTTP.Lucu.Headers
+import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.RFC2231
+import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
 -- |This data type represents a form value and possibly an uploaded
@@ -49,7 +50,7 @@ instance HasHeaders Part where
 data ContDispo
     = ContDispo {
         dType   ∷ !CIAscii
-      , dParams ∷ ![(CIAscii, Ascii)]
+      , dParams ∷ !(Map CIAscii Text)
       }
 
 printContDispo ∷ ContDispo → Ascii
@@ -57,20 +58,7 @@ printContDispo d
     = A.fromAsciiBuilder $
       ( A.toAsciiBuilder (A.fromCIAscii $ dType d)
         ⊕
-        ( if null $ dParams d then
-              (∅)
-          else
-              A.toAsciiBuilder "; " ⊕
-              joinWith "; " (map printPair $ dParams d) ) )
-    where
-      printPair ∷ (CIAscii, Ascii) → AsciiBuilder
-      printPair (name, value)
-          = A.toAsciiBuilder (A.fromCIAscii name) ⊕
-            A.toAsciiBuilder "=" ⊕
-            ( if BS.any ((¬) ∘ isToken) $ A.toByteString value then
-                  quoteStr value
-              else
-                  A.toAsciiBuilder value )
+        printParams (dParams d) )
 
 multipartFormP ∷ Ascii → Parser [(Text, FormData)]
 multipartFormP boundary

diff --git a/Network/HTTP/Lucu/RFC2231.hs b/Network/HTTP/Lucu/RFC2231.hs
new file mode 100644 (file)
index 0000000..9e99829
--- /dev/null
+++ b/Network/HTTP/Lucu/RFC2231.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE
+    OverloadedStrings
+  , UnicodeSyntax
+  #-}
+-- |Provide facilities to encode/decode MIME parameter values in
+-- character sets other than US-ASCII. See:
+-- http://www.faqs.org/rfcs/rfc2231.html
+module Network.HTTP.Lucu.RFC2231
+    ( printParams
+--    , paramsP
+    )
+    where
+import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Bits
+import qualified Data.ByteString.Char8 as BS
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Monoid.Unicode
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding
+import Data.Word
+import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
+import Prelude.Unicode
+
+printParams ∷ Map CIAscii Text → AsciiBuilder
+printParams params
+    | M.null params = (∅)
+    | otherwise     = A.toAsciiBuilder "; " ⊕
+                      joinWith "; " (map printPair $ M.toList params)
+    where
+      printPair ∷ (CIAscii, Text) → AsciiBuilder
+      printPair (name, value)
+          | T.any (> '\xFF') value
+              = printPairInUTF8 name value
+          | otherwise
+              = printPairInAscii name (A.unsafeFromByteString $ encodeUtf8 value)
+
+      printPairInUTF8 ∷ CIAscii → Text → AsciiBuilder
+      printPairInUTF8 name value
+          = A.toAsciiBuilder (A.fromCIAscii name) ⊕
+            A.toAsciiBuilder "*=utf-8''" ⊕
+            escapeUnsafeChars (encodeUtf8 value) (∅)
+
+      printPairInAscii ∷ CIAscii → Ascii → AsciiBuilder
+      printPairInAscii name value
+          = A.toAsciiBuilder (A.fromCIAscii name) ⊕
+            A.toAsciiBuilder "=" ⊕
+            if BS.any ((¬) ∘ isToken) (A.toByteString value) then
+                quoteStr value
+            else
+                A.toAsciiBuilder value
+
+      escapeUnsafeChars ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
+      escapeUnsafeChars bs b
+          = case BS.uncons bs of
+              Nothing         → b
+              Just (c, bs')
+                  | isToken c → escapeUnsafeChars bs' $
+                                    b ⊕ A.toAsciiBuilder (A.unsafeFromString [c])
+                  | otherwise → escapeUnsafeChars bs' $
+                                    b ⊕ toHex (fromIntegral $ fromEnum c)
+
+      toHex ∷ Word8 → AsciiBuilder
+      toHex o = A.toAsciiBuilder "%" ⊕
+                A.toAsciiBuilder (A.unsafeFromString [ toHex' (o `shiftR` 8)
+                                                     , toHex' (o .&.   0x0F) ])
+
+      toHex' ∷ Word8 → Char
+      toHex' o
+          | o ≤ 0x09  = toEnum $ fromIntegral $ fromEnum '0' + fromIntegral o
+          | otherwise = toEnum $ fromIntegral $ fromEnum 'A' + fromIntegral (o - 0x0A)
+
+{-
+decode ∷ [(CIAscii, Ascii)] → Map CIAscii Text
+{-# INLINEABLE decode #-}
+decode = error "FIXME: not implemented"
+-}
\ No newline at end of file