<commit_before>module Network.HPACK.HeaderBlock.Decode (
    fromByteStream
  ) where

import Data.Bits (testBit, clearBit, (.&.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Word (Word8)
import Network.HPACK.Builder
import Network.HPACK.HeaderBlock.HeaderField
import qualified Network.HPACK.HeaderBlock.Integer as I
import qualified Network.HPACK.HeaderBlock.String as S
import Network.HPACK.Types

----------------------------------------------------------------

-- | Converting the low level format to 'HeaderBlock'.
fromByteStream :: ByteStream -> Either DecodeError HeaderBlock
fromByteStream inp = go inp empty
  where
    go bs builder
      | BS.null bs = Right $ run builder
      | otherwise  = do
        (hf, bs') <- toHeaderField bs
        go bs' (builder << hf)

toHeaderField :: ByteString
              -> Either DecodeError (HeaderField, ByteString)
toHeaderField bs
  | BS.null bs    = Left EmptyBlock
  | w `testBit` 7 = indexed w bs'
  | w `testBit` 6 = incrementalIndexing w bs'
  | w `testBit` 5 = clear w bs'
  | w `testBit` 4 = neverIndexing w bs'
  | otherwise     = withoutIndexing w bs'
  where
    w = BS.head bs
    bs' = BS.tail bs

----------------------------------------------------------------

indexed :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString)
indexed w ws = Right (Indexed idx , ws')
  where
    w' = clearBit w 7
    (idx, ws') = I.parseInteger 7 w' ws

incrementalIndexing :: Word8 -> ByteString
                    -> Either DecodeError (HeaderField, ByteString)
incrementalIndexing w ws
  | isIndexedName w = indexedName Add w ws 6 mask6
  | otherwise       = newName Add ws

clear :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString)
clear _ ws = Right (Clear, ws) -- fixme: Maximum Header Table Size Change

withoutIndexing :: Word8 -> ByteString
                -> Either DecodeError (HeaderField, ByteString)
withoutIndexing w ws
  | isIndexedName w = indexedName NotAdd w ws 4 mask4
  | otherwise       = newName NotAdd ws

neverIndexing :: Word8 -> ByteString
                -> Either DecodeError (HeaderField, ByteString)
neverIndexing w ws
  | isIndexedName w = indexedName Never w ws 4 mask4
  | otherwise       = newName Never ws

----------------------------------------------------------------

indexedName :: Indexing -> Word8 -> ByteString -> Int -> (Word8 -> Word8)
            -> Either DecodeError (HeaderField, ByteString)
indexedName indexing w ws n mask = do
    (val,ws'') <- headerStuff ws'
    let hf = Literal indexing (Idx idx) val
    return (hf, ws'')
  where
    p = mask w
    (idx,ws') = I.parseInteger n p ws

newName :: Indexing -> ByteString
        -> Either DecodeError (HeaderField, ByteString)
newName indexing ws = do
    (key,ws')  <- headerStuff ws
    (val,ws'') <- headerStuff ws'
    let hf = Literal indexing (Lit key) val
    return (hf, ws'')

----------------------------------------------------------------

headerStuff :: ByteString
            -> Either DecodeError (HeaderStuff, ByteString)
headerStuff bs
  | BS.null bs  = Left EmptyEncodedString
  | otherwise   = S.parseString huff len bs''
  where
    w = BS.head bs
    bs' = BS.tail bs
    p = dropHuffman w
    huff = isHuffman w
    (len, bs'') = I.parseInteger 7 p bs'

----------------------------------------------------------------

mask6 :: Word8 -> Word8
mask6 w = w .&. 63

mask4 :: Word8 -> Word8
mask4 w = w .&. 15

isIndexedName :: Word8 -> Bool
isIndexedName w = mask6 w /= 0 -- fixme mask4<commit_msg>catching up HPACK 07.<commit_after>module Network.HPACK.HeaderBlock.Decode (
    fromByteStream
  ) where

import Data.Bits (testBit, clearBit, (.&.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Word (Word8)
import Network.HPACK.Builder
import Network.HPACK.HeaderBlock.HeaderField
import qualified Network.HPACK.HeaderBlock.Integer as I
import qualified Network.HPACK.HeaderBlock.String as S
import Network.HPACK.Types

----------------------------------------------------------------

-- | Converting the low level format to 'HeaderBlock'.
fromByteStream :: ByteStream -> Either DecodeError HeaderBlock
fromByteStream inp = go inp empty
  where
    go bs builder
      | BS.null bs = Right $ run builder
      | otherwise  = do
        (hf, bs') <- toHeaderField bs
        go bs' (builder << hf)

toHeaderField :: ByteString
              -> Either DecodeError (HeaderField, ByteString)
toHeaderField bs
  | BS.null bs    = Left EmptyBlock
  | w `testBit` 7 = indexed w bs'
  | w `testBit` 6 = incrementalIndexing w bs'
  | w `testBit` 5 = if w `testBit` 4 then clear w bs' else maxSize w bs'
  | w `testBit` 4 = neverIndexing w bs'
  | otherwise     = withoutIndexing w bs'
  where
    w = BS.head bs
    bs' = BS.tail bs

----------------------------------------------------------------

indexed :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString)
indexed w ws = Right (Indexed idx , ws')
  where
    w' = clearBit w 7
    (idx, ws') = I.parseInteger 7 w' ws

incrementalIndexing :: Word8 -> ByteString
                    -> Either DecodeError (HeaderField, ByteString)
incrementalIndexing w ws
  | isIndexedName1 w = indexedName Add w ws 6 mask6
  | otherwise        = newName Add ws

clear :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString)
clear _ ws = Right (Clear, ws)

maxSize :: Word8 -> ByteString -> Either DecodeError (HeaderField, ByteString)
maxSize w ws = Right (ChangeTableSize siz, ws')
  where
    w' = mask4 w
    (siz, ws') = I.parseInteger 4 w' ws

withoutIndexing :: Word8 -> ByteString
                -> Either DecodeError (HeaderField, ByteString)
withoutIndexing w ws
  | isIndexedName2 w = indexedName NotAdd w ws 4 mask4
  | otherwise        = newName NotAdd ws

neverIndexing :: Word8 -> ByteString
                -> Either DecodeError (HeaderField, ByteString)
neverIndexing w ws
  | isIndexedName2 w = indexedName Never w ws 4 mask4
  | otherwise        = newName Never ws

----------------------------------------------------------------

indexedName :: Indexing -> Word8 -> ByteString -> Int -> (Word8 -> Word8)
            -> Either DecodeError (HeaderField, ByteString)
indexedName indexing w ws n mask = do
    (val,ws'') <- headerStuff ws'
    let hf = Literal indexing (Idx idx) val
    return (hf, ws'')
  where
    p = mask w
    (idx,ws') = I.parseInteger n p ws

newName :: Indexing -> ByteString
        -> Either DecodeError (HeaderField, ByteString)
newName indexing ws = do
    (key,ws')  <- headerStuff ws
    (val,ws'') <- headerStuff ws'
    let hf = Literal indexing (Lit key) val
    return (hf, ws'')

----------------------------------------------------------------

headerStuff :: ByteString
            -> Either DecodeError (HeaderStuff, ByteString)
headerStuff bs
  | BS.null bs  = Left EmptyEncodedString
  | otherwise   = S.parseString huff len bs''
  where
    w = BS.head bs
    bs' = BS.tail bs
    p = dropHuffman w
    huff = isHuffman w
    (len, bs'') = I.parseInteger 7 p bs'

----------------------------------------------------------------

mask6 :: Word8 -> Word8
mask6 w = w .&. 63

mask4 :: Word8 -> Word8
mask4 w = w .&. 15

isIndexedName1 :: Word8 -> Bool
isIndexedName1 w = mask6 w /= 0

isIndexedName2 :: Word8 -> Bool
isIndexedName2 w = mask4 w /= 0
{'fraction_non_alphanumeric': 0.1754647849097571, 'fraction_numerical': 0.0123490297190935, 'mean_word_length': 2.109704641350211, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 54, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3499805', 'n_tokens_mistral': 2321, 'n_tokens_neox': 2144, 'n_words': 743}