Merge pull request #114 from kazu-yamamoto/semantics

Using http-semantics

Imports.hs

@@ -14,6 +14,9 @@ module Imports (
     module Data.String,
     module Data.Word,
     module Numeric,
+    module Network.HTTP.Semantics,
+    module Network.HTTP.Types,
+    module Data.CaseInsensitive,
     GCBuffer,
     withForeignPtr,
     mallocPlainForeignPtrBytes,
@@ -24,6 +27,7 @@ import Control.Monad
 import Data.Bits hiding (Bits)
 import Data.ByteString.Internal (ByteString (..))
 import Data.ByteString.Short (ShortByteString)
+import Data.CaseInsensitive (foldedCase, mk, original)
 import Data.Either
 import Data.Foldable
 import Data.Int
@@ -35,6 +39,8 @@ import Data.String
 import Data.Word
 import Foreign.ForeignPtr
 import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
+import Network.HTTP.Semantics
+import Network.HTTP.Types
 import Numeric
 
 type GCBuffer = ForeignPtr Word8

Network/HPACK.hs

@@ -5,6 +5,10 @@ module Network.HPACK (
     -- * Encoding and decoding
     encodeHeader,
     decodeHeader,
+    Header,
+    original,
+    foldedCase,
+    mk,
 
     -- * Encoding and decoding with token
     encodeTokenHeader,
@@ -28,37 +32,30 @@ module Network.HPACK (
     DecodeError (..),
     BufferOverrun (..),
 
-    -- * Headers
-    HeaderList,
-    Header,
-    HeaderName,
-    HeaderValue,
-    TokenHeaderList,
+    -- * Token header
+    FieldValue,
     TokenHeader,
+    TokenHeaderList,
+    toTokenHeaderTable,
 
     -- * Value table
     ValueTable,
-    HeaderTable,
+    TokenHeaderTable,
+    getFieldValue,
     getHeaderValue,
-    toHeaderTable,
 
     -- * Basic types
     Size,
     Index,
     Buffer,
     BufferSize,
-
-    -- * Re-exports
-    original,
-    foldedCase,
-    mk,
 ) where
 
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative ((<$>))
 #endif
-import Data.CaseInsensitive
 
+import Imports
 import Network.HPACK.HeaderBlock
 import Network.HPACK.Table
 import Network.HPACK.Types

Network/HPACK/HeaderBlock.hs

@@ -2,9 +2,9 @@ module Network.HPACK.HeaderBlock (
     decodeHeader,
     decodeTokenHeader,
     ValueTable,
-    HeaderTable,
-    toHeaderTable,
-    getHeaderValue,
+    TokenHeaderTable,
+    toTokenHeaderTable,
+    getFieldValue,
     encodeHeader,
     encodeTokenHeader,
 ) where

Network/HPACK/HeaderBlock/Decode.hs

@@ -5,47 +5,35 @@ module Network.HPACK.HeaderBlock.Decode (
     decodeHeader,
     decodeTokenHeader,
     ValueTable,
-    HeaderTable,
-    toHeaderTable,
-    getHeaderValue,
+    TokenHeaderTable,
+    toTokenHeaderTable,
+    getFieldValue,
     decodeString,
     decodeS,
     decodeSophisticated,
     decodeSimple, -- testing
 ) where
 
-import Control.Exception (catch, throwIO)
-import Data.Array (Array)
-import Data.Array.Base (unsafeAt, unsafeRead, unsafeWrite)
+import Data.Array.Base (unsafeRead, unsafeWrite)
 import qualified Data.Array.IO as IOA
 import qualified Data.Array.Unsafe as Unsafe
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B8
-import Data.CaseInsensitive (CI (..))
 import Data.Char (isUpper)
 import Network.ByteOrder
+import Network.HTTP.Semantics
+import UnliftIO.Exception (catch, throwIO)
 
 import Imports hiding (empty)
 import Network.HPACK.Builder
 import Network.HPACK.HeaderBlock.Integer
 import Network.HPACK.Huffman
 import Network.HPACK.Table
-import Network.HPACK.Token
 import Network.HPACK.Types
 
--- | An array to get 'HeaderValue' quickly.
---   'getHeaderValue' should be used.
---   Internally, the key is 'tokenIx'.
-type ValueTable = Array Int (Maybe HeaderValue)
-
--- | Accessing 'HeaderValue' with 'Token'.
-{-# INLINE getHeaderValue #-}
-getHeaderValue :: Token -> ValueTable -> Maybe HeaderValue
-getHeaderValue t tbl = tbl `unsafeAt` tokenIx t
-
 ----------------------------------------------------------------
 
--- | Converting the HPACK format to 'HeaderList'.
+-- | Converting the HPACK format to '[Header]'.
 --
 --   * Headers are decoded as is.
 --   * 'DecodeError' would be thrown if the HPACK format is broken.
@@ -54,7 +42,7 @@ decodeHeader
     :: DynamicTable
     -> ByteString
     -- ^ An HPACK format
-    -> IO HeaderList
+    -> IO [Header]
 decodeHeader dyntbl inp = decodeHPACK dyntbl inp (decodeSimple (toTokenHeader dyntbl))
 
 -- | Converting the HPACK format to 'TokenHeaderList'
@@ -75,7 +63,7 @@ decodeTokenHeader
     :: DynamicTable
     -> ByteString
     -- ^ An HPACK format
-    -> IO HeaderTable
+    -> IO TokenHeaderTable
 decodeTokenHeader dyntbl inp =
     decodeHPACK dyntbl inp (decodeSophisticated (toTokenHeader dyntbl)) `catch` \BufferOverrun -> throwIO HeaderBlockTruncated
 
@@ -96,15 +84,15 @@ decodeHPACK dyntbl inp dec = withReadBuffer inp chkChange
                 ff rbuf (-1)
                 dec rbuf
 
--- | Converting to 'HeaderList'.
+-- | Converting to '[Header]'.
 --
 --   * Headers are decoded as is.
 --   * 'DecodeError' would be thrown if the HPACK format is broken.
 --   * 'BufferOverrun' will be thrown if the temporary buffer for Huffman decoding is too small.
 decodeSimple
     :: (Word8 -> ReadBuffer -> IO TokenHeader)
     -> ReadBuffer
-    -> IO HeaderList
+    -> IO [Header]
 decodeSimple decTokenHeader rbuf = go empty
   where
     go builder = do
@@ -117,7 +105,7 @@ decodeSimple decTokenHeader rbuf = go empty
                 go builder'
             else do
                 let tvs = run builder
-                    kvs = map (\(t, v) -> let k = tokenFoldedKey t in (k, v)) tvs
+                    kvs = map (\(t, v) -> let k = tokenKey t in (k, v)) tvs
                 return kvs
 
 headerLimit :: Int
@@ -141,15 +129,15 @@ headerLimit = 200
 decodeSophisticated
     :: (Word8 -> ReadBuffer -> IO TokenHeader)
     -> ReadBuffer
-    -> IO HeaderTable
+    -> IO TokenHeaderTable
 decodeSophisticated decTokenHeader rbuf = do
     -- using maxTokenIx to reduce condition
     arr <- IOA.newArray (minTokenIx, maxTokenIx) Nothing
     tvs <- pseudoNormal arr
     tbl <- Unsafe.unsafeFreeze arr
     return (tvs, tbl)
   where
-    pseudoNormal :: IOA.IOArray Int (Maybe HeaderValue) -> IO TokenHeaderList
+    pseudoNormal :: IOA.IOArray Int (Maybe FieldValue) -> IO TokenHeaderList
     pseudoNormal arr = pseudo
       where
         pseudo = do
@@ -334,23 +322,19 @@ isTableSizeUpdate w = w .&. 0xe0 == 0x20
 
 ----------------------------------------------------------------
 
--- | A pair of token list and value table.
-type HeaderTable = (TokenHeaderList, ValueTable)
-
 -- | Converting a header list of the http-types style to
 --   'TokenHeaderList' and 'ValueTable'.
-toHeaderTable :: [(CI HeaderName, HeaderValue)] -> IO HeaderTable
-toHeaderTable kvs = do
+toTokenHeaderTable :: [Header] -> IO TokenHeaderTable
+toTokenHeaderTable kvs = do
     arr <- IOA.newArray (minTokenIx, maxTokenIx) Nothing
     tvs <- conv arr
     tbl <- Unsafe.unsafeFreeze arr
     return (tvs, tbl)
   where
-    conv :: IOA.IOArray Int (Maybe HeaderValue) -> IO TokenHeaderList
+    conv :: IOA.IOArray Int (Maybe FieldValue) -> IO TokenHeaderList
     conv arr = go kvs empty
       where
-        go
-            :: [(CI HeaderName, HeaderValue)] -> Builder TokenHeader -> IO TokenHeaderList
+        go :: [Header] -> Builder TokenHeader -> IO TokenHeaderList
         go [] builder = return $ run builder
         go ((k, v) : xs) builder = do
             let t = toToken (foldedCase k)

Network/HPACK/HeaderBlock/Encode.hs

@@ -8,21 +8,21 @@ module Network.HPACK.HeaderBlock.Encode (
     encodeS,
 ) where
 
-import Control.Exception (bracket, throwIO)
-import qualified Control.Exception as E
 import qualified Data.ByteString as BS
 import Data.ByteString.Internal (create)
 import Data.IORef
 import Foreign.Marshal.Alloc (free, mallocBytes)
 import Foreign.Marshal.Utils (copyBytes)
 import Foreign.Ptr (minusPtr)
 import Network.ByteOrder
+import Network.HTTP.Semantics
+import UnliftIO.Exception (bracket, throwIO)
+import qualified UnliftIO.Exception as E
 
 import Imports
 import Network.HPACK.HeaderBlock.Integer
 import Network.HPACK.Huffman
 import Network.HPACK.Table
-import Network.HPACK.Token
 import Network.HPACK.Types
 
 ----------------------------------------------------------------
@@ -41,22 +41,25 @@ changeTableSize dyntbl wbuf = do
 
 ----------------------------------------------------------------
 
--- | Converting 'HeaderList' to the HPACK format.
+-- | Converting '[Header]' to the HPACK format.
 --   This function has overhead of allocating/freeing a temporary buffer.
 --   'BufferOverrun' will be thrown if the temporary buffer is too small.
 encodeHeader
     :: EncodeStrategy
     -> Size
     -- ^ The size of a temporary buffer.
     -> DynamicTable
-    -> HeaderList
+    -> [Header]
     -> IO ByteString
     -- ^ An HPACK format
 encodeHeader stgy siz dyntbl hs = encodeHeader' stgy siz dyntbl hs'
   where
-    hs' = map (\(k, v) -> let t = toToken k in (t, v)) hs
+    mk' (k, v) = (t, v)
+      where
+        t = toToken $ foldedCase k
+    hs' = map mk' hs
 
--- | Converting 'HeaderList' to the HPACK format.
+-- | Converting 'TokenHeaderList' to the HPACK format.
 --   'BufferOverrun' will be thrown if the temporary buffer is too small.
 encodeHeader'
     :: EncodeStrategy
@@ -135,26 +138,26 @@ encodeTokenHeader buf siz EncodeStrategy{..} first dyntbl hs0 = do
 ----------------------------------------------------------------
 
 naiveStep
-    :: (HeaderName -> HeaderValue -> IO ()) -> Token -> HeaderValue -> IO ()
+    :: (FieldName -> FieldValue -> IO ()) -> Token -> FieldValue -> IO ()
 naiveStep fe t v = fe (tokenFoldedKey t) v
 
 ----------------------------------------------------------------
 
-staticStep :: FA -> FD -> FE -> Token -> HeaderValue -> IO ()
+staticStep :: FA -> FD -> FE -> Token -> FieldValue -> IO ()
 staticStep fa fd fe t v = lookupRevIndex' t v fa fd fe
 
 ----------------------------------------------------------------
 
-linearStep :: RevIndex -> FA -> FB -> FC -> FD -> Token -> HeaderValue -> IO ()
+linearStep :: RevIndex -> FA -> FB -> FC -> FD -> Token -> FieldValue -> IO ()
 linearStep rev fa fb fc fd t v = lookupRevIndex t v fa fb fc fd rev
 
 ----------------------------------------------------------------
 
 type FA = HIndex -> IO ()
-type FB = HeaderValue -> Entry -> HIndex -> IO ()
-type FC = HeaderName -> HeaderValue -> Entry -> IO ()
-type FD = HeaderValue -> HIndex -> IO ()
-type FE = HeaderName -> HeaderValue -> IO ()
+type FB = FieldValue -> Entry -> HIndex -> IO ()
+type FC = FieldName -> FieldValue -> Entry -> IO ()
+type FD = FieldValue -> HIndex -> IO ()
+type FE = FieldName -> FieldValue -> IO ()
 
 -- 6.1.  Indexed Header Field Representation
 -- Indexed Header Field
@@ -194,7 +197,7 @@ literalHeaderFieldWithoutIndexingNewName _ wbuf huff k v =
     newName wbuf huff set0000 k v
 
 literalHeaderFieldWithoutIndexingNewName'
-    :: DynamicTable -> WriteBuffer -> Bool -> HeaderName -> HeaderValue -> IO ()
+    :: DynamicTable -> WriteBuffer -> Bool -> FieldName -> FieldValue -> IO ()
 literalHeaderFieldWithoutIndexingNewName' _ wbuf huff k v =
     newName wbuf huff set0000 k v
 
@@ -211,14 +214,14 @@ index wbuf i = encodeI wbuf set1 7 i
 -- Using Huffman encoding
 {-# INLINE indexedName #-}
 indexedName
-    :: WriteBuffer -> Bool -> Int -> Setter -> HeaderValue -> Index -> IO ()
+    :: WriteBuffer -> Bool -> Int -> Setter -> FieldValue -> Index -> IO ()
 indexedName wbuf huff n set v idx = do
     encodeI wbuf set n idx
     encStr wbuf huff v
 
 -- Using Huffman encoding
 {-# INLINE newName #-}
-newName :: WriteBuffer -> Bool -> Setter -> HeaderName -> HeaderValue -> IO ()
+newName :: WriteBuffer -> Bool -> Setter -> FieldName -> FieldValue -> IO ()
 newName wbuf huff set k v = do
     write8 wbuf $ set 0
     encStr wbuf huff k

Network/HPACK/Huffman/Decode.hs

@@ -9,11 +9,11 @@ module Network.HPACK.Huffman.Decode (
     GCBuffer,
 ) where
 
-import Control.Exception (throwIO)
 import Data.Array (Array, listArray)
 import Data.Array.Base (unsafeAt)
 import qualified Data.ByteString as BS
 import Network.ByteOrder
+import UnliftIO.Exception (throwIO)
 
 import Imports
 import Network.HPACK.Huffman.Bit

Network/HPACK/Huffman/Encode.hs

@@ -6,14 +6,14 @@ module Network.HPACK.Huffman.Encode (
     encodeHuffman,
 ) where
 
-import Control.Exception (throwIO)
 import Data.Array.Base (unsafeAt)
 import Data.Array.IArray (listArray)
 import Data.Array.Unboxed (UArray)
 import Data.IORef
 import Foreign.Ptr (minusPtr, plusPtr)
 import Foreign.Storable (poke)
 import Network.ByteOrder hiding (copy)
+import UnliftIO.Exception (throwIO)
 
 import Imports
 import Network.HPACK.Huffman.Params (idxEos)