http-types 0.1.1 → 0.2.0

raw patch · 2 files changed

+166/−73 lines, 2 filesdep +arrayPVP ok

version bump matches the API change (PVP)

Dependencies added: array

API changes (from Hackage documentation)

Files

• Network/HTTP/Types.hs +162/−71
• http-types.cabal +4/−2

@@ -1,8 +1,8 @@ module Network.HTTP.Types (   -- * Case insensitive HTTP ByteStrings-  HttpCIByteString(..)-, mkHttpCIByteString+  CIByteString(..)+, mkCIByteString   -- * Methods , Method , methodGet@@ -13,11 +13,9 @@ , methodTrace , methodConnect , methodOptions-, MethodADT(GET, POST, HEAD, PUT, DELETE, TRACE, CONNECT, OPTIONS)-, methodToADT-, methodFromADT-, stringToMethodADT-, methodADTToString+, StdMethod(..)+, parseMethod+, renderMethod   -- * Versions , HttpVersion(..) , http09@@ -37,70 +35,88 @@ , status405, statusNotAllowed , status500, statusServerError   -- * Headers+, Header , RequestHeaders , ResponseHeaders+, headerAccept+, headerCacheControl+, headerConnection+, headerContentLength+, headerContentType+, headerContentMD5+, headerDate   -- * Query string+, QueryItem , Query-, QuerySimple+, SimpleQueryItem+, SimpleQuery+, renderQuery+, renderSimpleQuery+, parseQuery+, parseSimpleQuery+  -- * URL encoding / decoding+, urlEncode+, urlDecode ) where +import           Control.Arrow         (second)+import           Data.Array import           Data.Char+import           Data.List import           Data.Maybe import           Data.String+import           Numeric import qualified Data.ByteString       as B import qualified Data.ByteString.Char8 as Ascii -localError :: String -> String -> a-localError f s = error $ "Network.HTTP.Types." ++ f ++ ": " ++ s- -- | Case-insensitive HTTP ByteStrings, mostly for use in Header names.-data HttpCIByteString-    = HttpCIByteString {+data CIByteString+    = CIByteString {         ciOriginal :: !B.ByteString       , ciLowerCase :: !B.ByteString       } -mkHttpCIByteString :: B.ByteString -> HttpCIByteString-mkHttpCIByteString orig = HttpCIByteString {+mkCIByteString :: B.ByteString -> CIByteString+mkCIByteString orig = CIByteString {                             ciOriginal = orig                           , ciLowerCase = Ascii.map toLower orig                           } -instance Eq HttpCIByteString where-    HttpCIByteString { ciLowerCase = a } == HttpCIByteString { ciLowerCase = b } +instance Eq CIByteString where+    CIByteString { ciLowerCase = a } == CIByteString { ciLowerCase = b }          = a == b -instance Ord HttpCIByteString where-    compare HttpCIByteString { ciLowerCase = a } HttpCIByteString { ciLowerCase = b } +instance Ord CIByteString where+    compare CIByteString { ciLowerCase = a } CIByteString { ciLowerCase = b }          = compare a b -instance Show HttpCIByteString where+instance Show CIByteString where     show = show . ciOriginal -instance IsString HttpCIByteString where-    fromString = mkHttpCIByteString . Ascii.pack+instance IsString CIByteString where+    fromString = mkCIByteString . Ascii.pack  -- | HTTP method (flat string type). type Method = B.ByteString  -- | HTTP Method constants. methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions :: Method-methodGet     = Ascii.pack "GET"-methodPost    = Ascii.pack "POST"-methodHead    = Ascii.pack "HEAD"-methodPut     = Ascii.pack "PUT"-methodDelete  = Ascii.pack "DELETE"-methodTrace   = Ascii.pack "TRACE"-methodConnect = Ascii.pack "CONNECT"-methodOptions = Ascii.pack "OPTIONS"+methodGet     = renderMethod GET+methodPost    = renderMethod POST+methodHead    = renderMethod HEAD+methodPut     = renderMethod PUT+methodDelete  = renderMethod DELETE+methodTrace   = renderMethod TRACE+methodConnect = renderMethod CONNECT+methodOptions = renderMethod OPTIONS --- | HTTP method (ADT version).+-- | HTTP standard method (as defined by RFC 2616). --  -- Note that the Show instance is only for debugging and should NOT be used to generate HTTP method strings; use 'methodToByteString' instead. --  -- The constructor 'OtherMethod' is not exported for forwards compatibility reasons.-data MethodADT+data StdMethod     = GET     | POST     | HEAD  @@ -109,46 +125,24 @@     | TRACE     | CONNECT     | OPTIONS-    | OtherMethod B.ByteString-    deriving (Show, Eq, Ord)-+    deriving (Read, Show, Eq, Ord, Enum, Bounded, Ix) -- These are ordered by suspected frequency. More popular methods should go first.--- The reason is that methodListA and methodListB are used with lookup.+-- The reason is that methodList is used with lookup. -- lookup is probably faster for these few cases than setting up an elaborate data structure.-methodListA :: [(Method, MethodADT)]-methodListA -    = [ (methodGet, GET)-      , (methodPost, POST)-      , (methodHead, HEAD)-      , (methodPut, PUT)-      , (methodDelete, DELETE)-      , (methodTrace, TRACE)-      , (methodConnect, CONNECT)-      , (methodOptions, OPTIONS)-      ] -methodListB :: [(MethodADT, Method)]-methodListB = map (\(a, b) -> (b, a)) methodListA---- | Convert a method 'ByteString' to a 'MethodADT'.-methodToADT :: Method -> MethodADT-methodToADT bs = fromMaybe (OtherMethod bs) $ lookup bs methodListA+methodArray :: Array StdMethod Method+methodArray = listArray (minBound, maxBound) $ map (Ascii.pack . show) [minBound :: StdMethod .. maxBound] --- | Convert a 'MethodADT' to a 'ByteString'.-methodFromADT :: MethodADT -> Method-methodFromADT m-    = case m of-        OtherMethod bs -> bs-        _ -> fromMaybe (localError "methodToByteString" "This should not happen (methodListB is incomplete)") $-             lookup m methodListB+methodList :: [(Method, StdMethod)]+methodList = map (\(a, b) -> (b, a)) (assocs methodArray) --- | Convert a method 'String' to a 'MethodADT'.-stringToMethodADT :: String -> MethodADT-stringToMethodADT = methodToADT . Ascii.pack+-- | Convert a method 'ByteString' to a 'StdMethod' if possible.+parseMethod :: Method -> Either B.ByteString StdMethod+parseMethod bs = maybe (Left bs) Right $ lookup bs methodList --- | Convert a 'MethodADT' to a 'String'.-methodADTToString :: MethodADT -> String-methodADTToString = Ascii.unpack . methodFromADT+-- | Convert a 'StdMethod' to a 'ByteString'.+renderMethod :: StdMethod -> Method+renderMethod m = methodArray ! m  -- | HTTP Version. -- @@ -248,17 +242,114 @@ status500 = Status 500 $ Ascii.pack "Internal Server Error" statusServerError = status500 --- | Request Header-type RequestHeaders = [(HttpCIByteString, B.ByteString)]+-- | Header+type Header = (CIByteString, B.ByteString) +-- | Request Headers+type RequestHeaders = [Header]+ -- | Response Headers-type ResponseHeaders = [(HttpCIByteString, B.ByteString)]+type ResponseHeaders = [Header] +makeHeader :: String -> B.ByteString -> Header+makeHeader a = \b -> (a', b)+    where a' = mkCIByteString $ Ascii.pack a++-- | HTTP Headers+headerAccept, headerCacheControl, headerConnection, headerContentLength, headerContentType, headerContentMD5, headerDate :: B.ByteString -> Header+headerAccept        = makeHeader "Accept"+headerCacheControl  = makeHeader "Cache-Control"+headerConnection    = makeHeader "Connection"+headerContentLength = makeHeader "Content-Length"+headerContentType   = makeHeader "Content-Type"+headerContentMD5    = makeHeader "Content-MD5"+headerDate          = makeHeader "Date"++-- | Query item+type QueryItem = (B.ByteString, Maybe B.ByteString)+ -- | Query. --  -- General form: a=b&c=d, but if the value is Nothing, it becomes -- a&c=d.-type Query = [(B.ByteString, Maybe B.ByteString)]+type Query = [QueryItem] +-- | Simplified Query item type without support for parameter-less items.+type SimpleQueryItem = (B.ByteString, B.ByteString)+ -- | Simplified Query type without support for parameter-less items.-type QuerySimple = [(B.ByteString, B.ByteString)]+type SimpleQuery = [SimpleQueryItem]++-- | Convert 'Query' to 'ByteString'.+renderQuery :: Bool -> Query -> B.ByteString+renderQuery useQuestionMark = B.concat +                              . addQuestionMark+                              . intercalate [Ascii.pack "&"] +                              . map showQueryItem +    where+      addQuestionMark :: [B.ByteString] -> [B.ByteString]+      addQuestionMark [] = []+      addQuestionMark xs | useQuestionMark = Ascii.pack "?" : xs+                         | otherwise       = xs+      +      showQueryItem :: (B.ByteString, Maybe B.ByteString) -> [B.ByteString]+      showQueryItem (n, Nothing) = [urlEncode n]+      showQueryItem (n, Just v) = [urlEncode n, Ascii.pack "=", urlEncode v]++-- | Convert 'SimpleQuery' to 'ByteString'.+renderSimpleQuery :: Bool -> SimpleQuery -> B.ByteString+renderSimpleQuery useQuestionMark = renderQuery useQuestionMark . map (\(k, v) -> (k, Just v))++-- | Parse 'Query' from a 'ByteString'.+parseQuery :: B.ByteString -> Query+parseQuery bs = case Ascii.uncons bs of+                  Nothing         -> []+                  Just ('?', bs') -> parseQuery' bs'+                  _               -> parseQuery' bs+    where+      parseQuery' = map parseQueryItem . Ascii.split '&'+      parseQueryItem q = (k, v)+        where (k', v') = Ascii.break (== '=') q+              k = urlDecode k'+              v = if B.null v'+                  then Nothing+                  else Just $ urlDecode $ B.tail v'++-- | Parse 'SimpleQuery' from a 'ByteString'.+parseSimpleQuery :: B.ByteString -> SimpleQuery+parseSimpleQuery = map (second $ fromMaybe B.empty) . parseQuery++-- | Percent-encoding for URLs.+urlEncode :: B.ByteString -> B.ByteString+urlEncode = Ascii.concatMap (Ascii.pack . encodeChar)+    where+      encodeChar :: Char -> [Char]+      encodeChar ch | unreserved ch = [ch]+                    | otherwise     = h2 $ ord ch+      +      unreserved :: Char -> Bool+      unreserved ch | ch >= 'A' && ch <= 'Z' = True +                    | ch >= 'a' && ch <= 'z' = True+                    | ch >= '0' && ch <= '9' = True +      unreserved '-' = True+      unreserved '_' = True+      unreserved '.' = True+      unreserved '~' = True+      unreserved _   = False+      +      h2 :: Int -> [Char]+      h2 v = let (a, b) = v `divMod` 16 in ['%', h a, h b]+      +      h :: Int -> Char+      h i | i < 10    = chr $ ord '0' + i+          | otherwise = chr $ ord 'A' + i - 10++-- | Percent-decoding.+urlDecode :: B.ByteString -> B.ByteString+urlDecode bs = case Ascii.uncons bs of+                 Nothing -> B.empty+                 Just ('%', x) -> case readHex $ Ascii.unpack pc of+                                    [(v, "")] -> chr v `Ascii.cons` urlDecode bs'+                                    _ -> Ascii.cons '%' $ urlDecode x+                     where (pc, bs') = Ascii.splitAt 2 x+                 Just (c, bs') -> Ascii.cons c $ urlDecode bs'

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.1+Version:             0.2.0  -- A short (one-line) description of the package. Synopsis:            Generic HTTP types for Haskell (for both client and server code).@@ -54,7 +54,9 @@   GHC-Options:         -Wall      -- Packages needed in order to build this package.-  Build-depends:       base >= 4 && < 5, bytestring >=0.9.1.5 && <0.10+  Build-depends:       base >= 4 && < 5,+                       bytestring >=0.9.1.5 && <0.10,+                       array >=0.3 && <0.4      -- Modules not exported by this package.   -- Other-modules: