Dynamic.hs

{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Network.QPACK.Table.Dynamic (
    -- * Dynamic table
    DynamicTable,
    newDynamicTableForEncoding,
    newDynamicTableForDecoding,

    -- * Capacity
    isTableReady,
    getTableCapacity,
    getMaxTableCapacity,
    setTableCapacity,
    setDecoderTableCapacity,
    getMaxNumOfEntries,
    getMaxEntries,
    setMaxEntries,

    -- * Entry
    insertEntryToDecoder,
    insertEntryToEncoder,
    toDynamicEntry,

    -- * Section
    Section (..),
    insertSection,
    getAndDelSection,
    getAndDelSections,
    increaseReference,
    decreaseReference,

    -- * Streams
    getMaxBlockedStreams,
    setMaxBlockedStreams,
    tryIncreaseStreams,
    decreaseStreams,

    -- * Blocked streams
    insertBlockedStreamE,
    deleteBlockedStreamE,
    unblockStreamsE,
    checkBlockedStreams,

    -- * Required insert count
    getRequiredInsertCount,
    clearRequiredInsertCount,
    checkRequiredInsertCount,
    checkRequiredInsertCountNB,
    updateRequiredInsertCount,

    -- * Known received count
    incrementKnownReceivedCount,
    updateKnownReceivedCount,
    wouldSectionBeBlocked,
    wouldInstructionBeBlocked,
    setInsersionPointToKnownReceivedCount,

    -- * Points
    getBasePoint,
    setBasePointToInsersionPoint,
    getInsertionPoint,
    getInsertionPointSTM,

    -- * Draining
    isDraining,
    adjustDrainingPoint,
    checkTailDuplication,
    tailDuplication,
    duplicate,
    tryDrop,

    -- * Dropping
    canInsertEntry,

    -- * Accessing
    getLruCache,
    getRevIndex,
    getHuffmanDecoder,
    sendIns,

    -- * Max header size
    getMaxHeaderSize,
    setMaxHeaderSize,

    -- * Debug
    qpackDebug,
    getDebugQPACK,
    setDebugQPACK,
    printReferences,
    checkHIndex,
    checkAbsoluteIndex,

    -- * QIF
    getImmediateAck,
    setImmediateAck,
) where

import Control.Concurrent
import Control.Concurrent.STM
import Data.Array.Base (unsafeRead, unsafeWrite)
import Data.Array.IO (IOArray, newArray)
import Data.IORef
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Sequence (Seq, ViewL (..), viewl, (|>))
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set -- Set.size is O(1), IntSet.size is O(n)
import Imports
import Network.Control
import Network.HPACK.Internal (
    Entry,
    HuffmanDecoder,
    Index,
    Size,
    decodeH,
    dummyEntry,
    entryFieldValue,
    entryHeaderName,
    entrySize,
    maxNumbers,
 )
import System.IO.Unsafe (unsafePerformIO)

import Network.QPACK.Error
import Network.QPACK.Table.RevIndex
import Network.QPACK.Types
import Network.QUIC (StreamId)

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

type Table = TArray Index Entry
data Section = Section RequiredInsertCount [AbsoluteIndex]
data Reference = Reference Int Int deriving (Show)

{- FOURMOLU_DISABLE -}
data CodeInfo
    = EncodeInfo
        { revIndex            :: RevIndex -- Reverse index
        , requiredInsertCount :: IORef RequiredInsertCount
        , droppingPoint       :: IORef AbsoluteIndex
        , drainingPoint       :: IORef AbsoluteIndex
        , knownReceivedCount  :: TVar Int
        , referenceCounters   :: IORef (IOArray Index Reference)
        , sections            :: IORef (IntMap (Seq Section)) -- oldest first
        , lruCache            :: LRUCacheRef (FieldName, FieldValue) ()
        , immediateAck        :: IORef Bool -- for QIF
        , blockedStreamsE     :: IORef (Set Int)
        }
    | DecodeInfo
        { huffmanDecoder  :: HuffmanDecoder  -- only for encoder instruction handler
        , blockedStreamsD :: IORef Int
        }
{- FOURMOLU_ENABLE -}

-- | Dynamic table for QPACK.
{- FOURMOLU_DISABLE -}
data DynamicTable = DynamicTable
    { codeInfo          :: CodeInfo
    , insertionPoint    :: TVar InsertionPoint
    , maxNumOfEntries   :: TVar Int
    , maxEntries        :: IORef Int -- MaxEntries of RFC 9204 section 4.5.1.1
    , circularTable     :: TVar Table
    , basePoint         :: IORef BasePoint
    , debugQPACK        :: IORef Bool
    , capaReady         :: IORef Bool
    , tableSize         :: TVar Size
    , maxTableSize      :: IORef Size
    , sendIns           :: ByteString -> IO ()
    , maxHeaderSize     :: IORef Int
    , maxBlockedStreams :: IORef Int
    }
{- FOURMOLU_ENABLE -}

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

{- FOURMOLU_DISABLE -}
-- | Creating 'DynamicTable' for encoding.
newDynamicTableForEncoding
    :: (ByteString -> IO ())
    -> IO DynamicTable
newDynamicTableForEncoding sendEI = do
    arr <- newArray (0, 0) $ Reference 0 0
    info <- do
        revIndex            <- newRevIndex
        requiredInsertCount <- newIORef 0
        droppingPoint       <- newIORef 0
        drainingPoint       <- newIORef 0
        knownReceivedCount  <- newTVarIO 0
        referenceCounters   <- newIORef arr
        sections            <- newIORef IntMap.empty
        lruCache            <- newLRUCacheRef 0
        immediateAck        <- newIORef False
        blockedStreamsE     <- newIORef Set.empty
        return EncodeInfo{..}
    newDynamicTable info sendEI
{- FOURMOLU_ENABLE -}

-- | Creating 'DynamicTable' for decoding.
newDynamicTableForDecoding
    :: Size
    -- ^ The size of temporary buffer for Huffman decoding
    -> (ByteString -> IO ())
    -> IO DynamicTable
newDynamicTableForDecoding huftmpsiz sendDI = do
    gcbuf <- mallocPlainForeignPtrBytes huftmpsiz
    let huffmanDecoder = decodeH gcbuf huftmpsiz
    blockedStreamsD <- newIORef 0
    newDynamicTable DecodeInfo{..} sendDI

newDynamicTable :: CodeInfo -> (ByteString -> IO ()) -> IO DynamicTable
newDynamicTable info send = do
    tbl <- atomically $ newArray (0, 0) dummyEntry
    let codeInfo = info
    insertionPoint <- newTVarIO 0
    maxNumOfEntries <- newTVarIO 0
    maxEntries <- newIORef 0
    circularTable <- newTVarIO tbl
    basePoint <- newIORef 0
    debugQPACK <- newIORef False
    capaReady <- newIORef False
    tableSize <- newTVarIO 0
    maxTableSize <- newIORef 0
    let sendIns = send
    maxHeaderSize <- newIORef maxBound
    maxBlockedStreams <- newIORef 0
    return DynamicTable{..}

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

isTableReady :: DynamicTable -> IO Bool
isTableReady DynamicTable{..} = readIORef capaReady

getTableCapacity :: DynamicTable -> IO Int
getTableCapacity DynamicTable{..} = readTVarIO tableSize

-- | The capacity, as last set.  'getTableCapacity' is how much of it the
--   entries take, whatever its name says.
getMaxTableCapacity :: DynamicTable -> IO Int
getMaxTableCapacity DynamicTable{..} = readIORef maxTableSize

setTableCapacity :: DynamicTable -> Int -> IO ()
setTableCapacity dyntbl@DynamicTable{..} maxsiz = do
    qpackDebug dyntbl $ putStrLn $ "setTableCapacity " ++ show maxsiz
    when (maxN >= 1) $ do
        writeIORef maxTableSize maxsiz
        tbl <- atomically $ newArray (0, end) dummyEntry
        atomically $ do
            writeTVar maxNumOfEntries maxN
            writeTVar circularTable tbl
        case codeInfo of
            EncodeInfo{..} -> do
                arr <- newArray (0, end) $ Reference 0 0
                writeIORef referenceCounters arr
                setLRUCapacity lruCache (maxN * 4)
            _ -> return ()
        writeIORef capaReady True
  where
    maxN = maxNumbers maxsiz
    end = maxN - 1

-- | Setting the capacity of the decoder's table, as the encoder instructs.
--
-- The encoder may change the capacity whenever it likes, within the maximum
-- the decoder announced (RFC 9204, section 3.2.3), and the entries in the
-- table stay where they are.  So the ring is allocated once, for as many
-- entries as the maximum allows ('setMaxEntries'), and a later change only
-- moves the capacity.  Reallocating it, as 'setTableCapacity' does, emptied
-- the table and changed what the absolute indices map onto: references to
-- entries inserted before the change came back as a dummy entry.
setDecoderTableCapacity :: DynamicTable -> Int -> IO ()
setDecoderTableCapacity dyntbl@DynamicTable{..} cap = do
    qpackDebug dyntbl $ putStrLn $ "setDecoderTableCapacity " ++ show cap
    maxN <- readIORef maxEntries
    allocated <- (>= 1) <$> readTVarIO maxNumOfEntries
    when (not allocated && maxN >= 1) $ do
        tbl <- atomically $ newArray (0, maxN - 1) dummyEntry
        atomically $ do
            writeTVar maxNumOfEntries maxN
            writeTVar circularTable tbl
    writeIORef maxTableSize cap
    -- No entry is smaller than 32, so below that nothing can be inserted.
    writeIORef capaReady (maxN >= 1 && maxNumbers cap >= 1)

getMaxNumOfEntries :: DynamicTable -> IO Int
getMaxNumOfEntries DynamicTable{..} = readTVarIO maxNumOfEntries

-- | MaxEntries, which the Required Insert Count of a field section is
-- encoded and decoded against (RFC 9204, section 4.5.1.1).
--
-- It comes from the decoder's SETTINGS_QPACK_MAX_TABLE_CAPACITY, not from the
-- capacity the encoder actually set.  The two ends agree on the former; the
-- latter is only the encoder's choice within it, and using it here made the
-- two ends disagree once more than 2*MaxEntries entries had been inserted.
getMaxEntries :: DynamicTable -> IO Int
getMaxEntries DynamicTable{..} = readIORef maxEntries

-- | Setting MaxEntries from the decoder's maximum table capacity.
setMaxEntries :: DynamicTable -> Int -> IO ()
setMaxEntries DynamicTable{..} maxCapacity =
    writeIORef maxEntries $ maxNumbers maxCapacity

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

insertEntryToEncoder :: Entry -> DynamicTable -> IO AbsoluteIndex
insertEntryToEncoder ent dyntbl@DynamicTable{..} = do
    InsertionPoint insp <- atomically $ do
        x <- readTVar insertionPoint
        writeTVar insertionPoint (x + 1)
        return x
    maxN <- readTVarIO maxNumOfEntries
    let i = insp `mod` maxN
    table <- readTVarIO circularTable
    atomically $ unsafeWrite table i ent
    let revtbl = getRevIndex dyntbl
    let ai = AbsoluteIndex insp
    insertRevIndex ent ai revtbl
    atomically $ modifyTVar' tableSize (+ entrySize ent)
    dropIfNecessary dyntbl
    resetReference dyntbl ai
    return ai

insertEntryToDecoder :: Entry -> DynamicTable -> STM AbsoluteIndex
insertEntryToDecoder ent DynamicTable{..} = do
    x@(InsertionPoint insp) <- readTVar insertionPoint
    writeTVar insertionPoint (x + 1)
    maxN <- readTVar maxNumOfEntries
    let i = insp `mod` maxN
    table <- readTVar circularTable
    unsafeWrite table i ent
    modifyTVar' tableSize (+ entrySize ent)
    return $ AbsoluteIndex insp

-- | Look up an entry of the dynamic table by absolute index.
--
-- The live window is the most recent 'maxNumOfEntries' insertions. An index
-- outside it names nothing, and the @mod@ below would fold it back into the
-- table and hand over whichever slot it landed on -- a header nobody sent.
-- RFC 9204 section 2.1.2 asks for an error instead, and this one reaches the
-- peer as QPACK_DECOMPRESSION_FAILED from a field section, or as
-- QPACK_ENCODER_STREAM_ERROR from an encoder instruction.
--
-- The window is empty until a capacity has been set, which is also what keeps
-- the @mod@ from dividing by zero: 'maxNumOfEntries' starts at 0 and a field
-- section can reach here before the peer has sent us a capacity at all.
toDynamicEntry :: DynamicTable -> AbsoluteIndex -> STM Entry
toDynamicEntry DynamicTable{..} (AbsoluteIndex idx) = do
    maxN <- readTVar maxNumOfEntries
    InsertionPoint ip <- readTVar insertionPoint
    -- @max 0@ because early on the table holds fewer than maxN entries and
    -- @ip - maxN@ is negative, which would let a negative index through; the
    -- index conversions produce those readily, since a pre-base index larger
    -- than the base gives one.
    let lo = max 0 (ip - maxN)
    when (maxN == 0 || idx < lo || idx >= ip) $
        throwSTM $
            IllegalDynamicIndex idx
    table <- readTVar circularTable
    unsafeRead table (idx `mod` maxN)

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

-- | Registering a field section which awaits acknowledgement.
--
-- A stream can have more than one outstanding -- headers and trailers, say --
-- and a Section Acknowledgement is for the oldest of them (RFC 9204, section
-- 4.4.1), so they are queued rather than keyed by the stream alone.  Keyed
-- alone, the second replaced the first, whose references were then never
-- released, and the second acknowledgement found nothing and was taken for a
-- decoder stream error.
insertSection :: DynamicTable -> StreamId -> Section -> IO ()
insertSection DynamicTable{..} sid section = atomicModifyIORef' sections ins
  where
    ins m =
        let m' = IntMap.insertWith (\_ old -> old |> section) sid (Seq.singleton section) m
         in (m', ())
    EncodeInfo{..} = codeInfo

-- | Taking out the oldest outstanding field section of a stream.
getAndDelSection :: DynamicTable -> StreamId -> IO (Maybe Section)
getAndDelSection DynamicTable{..} sid = atomicModifyIORef' sections getAndDel
  where
    getAndDel m = case IntMap.lookup sid m of
        Nothing -> (m, Nothing)
        Just q -> case viewl q of
            EmptyL -> (IntMap.delete sid m, Nothing)
            sec :< rest
                | Seq.null rest -> (IntMap.delete sid m, Just sec)
                | otherwise -> (IntMap.insert sid rest m, Just sec)
    EncodeInfo{..} = codeInfo

-- | Taking out every outstanding field section of a stream.
getAndDelSections :: DynamicTable -> StreamId -> IO [Section]
getAndDelSections DynamicTable{..} sid = atomicModifyIORef' sections getAndDel
  where
    getAndDel m = case IntMap.lookup sid m of
        Nothing -> (m, [])
        Just q -> (IntMap.delete sid m, toList q)
    EncodeInfo{..} = codeInfo

increaseReference :: DynamicTable -> AbsoluteIndex -> IO ()
increaseReference = modifyReference $ \(Reference c t) -> Reference (c + 1) (t + 1)

decreaseReference :: DynamicTable -> AbsoluteIndex -> IO ()
decreaseReference = modifyReference $ \(Reference c t) -> Reference (c - 1) t

modifyReference
    :: (Reference -> Reference) -> DynamicTable -> AbsoluteIndex -> IO ()
modifyReference func DynamicTable{..} (AbsoluteIndex idx) = do
    maxN <- readTVarIO maxNumOfEntries
    let i = idx `mod` maxN
    arr <- readIORef referenceCounters
    -- modifyArray' is not provided by GHC 9.4 or earlier, sigh.
    x <- unsafeRead arr i
    let x' = func x
    unsafeWrite arr i x'
  where
    EncodeInfo{..} = codeInfo

resetReference :: DynamicTable -> AbsoluteIndex -> IO ()
resetReference DynamicTable{..} (AbsoluteIndex idx) = do
    maxN <- readTVarIO maxNumOfEntries
    let i = idx `mod` maxN
    arr <- readIORef referenceCounters
    unsafeWrite arr i $ Reference 0 0
  where
    EncodeInfo{..} = codeInfo

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

getMaxBlockedStreams :: DynamicTable -> IO Int
getMaxBlockedStreams DynamicTable{..} = readIORef maxBlockedStreams

setMaxBlockedStreams :: DynamicTable -> Int -> IO ()
setMaxBlockedStreams DynamicTable{..} n = writeIORef maxBlockedStreams n

-- Decoder

tryIncreaseStreams :: DynamicTable -> IO Bool
tryIncreaseStreams DynamicTable{..} = do
    lim <- readIORef maxBlockedStreams
    -- Counted only if it is let in, since nothing takes a refused one off.
    atomicModifyIORef' blockedStreamsD $ \n ->
        if n < lim then (n + 1, True) else (n, False)
  where
    DecodeInfo{..} = codeInfo

decreaseStreams :: DynamicTable -> IO ()
decreaseStreams DynamicTable{..} = atomicModifyIORef' blockedStreamsD (\n -> (n - 1, ()))
  where
    DecodeInfo{..} = codeInfo

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

getBlockedStreamsE :: DynamicTable -> IO Int
getBlockedStreamsE DynamicTable{..} =
    Set.size <$> readIORef blockedStreamsE
  where
    EncodeInfo{..} = codeInfo

insertBlockedStreamE :: DynamicTable -> StreamId -> IO ()
insertBlockedStreamE DynamicTable{..} sid =
    atomicModifyIORef' blockedStreamsE (\set -> (Set.insert sid set, ()))
  where
    EncodeInfo{..} = codeInfo

deleteBlockedStreamE :: DynamicTable -> StreamId -> IO ()
deleteBlockedStreamE DynamicTable{..} sid =
    atomicModifyIORef' blockedStreamsE (\set -> (Set.delete sid set, ()))
  where
    EncodeInfo{..} = codeInfo

-- | Forgetting the blocked streams that the known received count has caught
-- up with.
--
-- A stream stops being blocked once the decoder holds every entry its
-- section refers to (RFC 9204, section 2.1.2), which an Insert Count
-- Increment can say as well as a Section Acknowledgement.  Waiting for the
-- acknowledgement alone would be safe but would keep a stream counted for as
-- long as it is never acknowledged -- forever, for one that was reset.
unblockStreamsE :: DynamicTable -> IO ()
unblockStreamsE DynamicTable{..} = do
    krc <- readTVarIO knownReceivedCount
    secs <- readIORef sections
    let blocking (Section (RequiredInsertCount ric) _) = ric > krc
        stillBlocked sid = maybe False (any blocking) $ IntMap.lookup sid secs
    atomicModifyIORef' blockedStreamsE (\set -> (Set.filter stillBlocked set, ()))
  where
    EncodeInfo{..} = codeInfo

checkBlockedStreams :: DynamicTable -> IO Bool
checkBlockedStreams dyntbl = do
    maxBlocked <- getMaxBlockedStreams dyntbl
    blocked <- getBlockedStreamsE dyntbl
    -- The next one would be blocked, so <, not <=
    return $ blocked < maxBlocked

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

getRequiredInsertCount :: DynamicTable -> IO RequiredInsertCount
getRequiredInsertCount DynamicTable{..} = readIORef requiredInsertCount
  where
    EncodeInfo{..} = codeInfo

clearRequiredInsertCount :: DynamicTable -> IO ()
clearRequiredInsertCount DynamicTable{..} = writeIORef requiredInsertCount 0
  where
    EncodeInfo{..} = codeInfo

checkRequiredInsertCount :: DynamicTable -> RequiredInsertCount -> IO ()
checkRequiredInsertCount DynamicTable{..} (RequiredInsertCount reqip) = atomically $ do
    InsertionPoint ip <- readTVar insertionPoint
    -- RequiredInsertCount is index + 1
    -- InsertionPoin is index + 1
    -- So, equal is necessary.
    check (reqip <= ip)

checkRequiredInsertCountNB :: DynamicTable -> RequiredInsertCount -> IO Bool
checkRequiredInsertCountNB DynamicTable{..} (RequiredInsertCount reqip) = atomically $ do
    InsertionPoint ip <- readTVar insertionPoint
    return (reqip <= ip)

absoluteIndexToRequiredInsertCount :: AbsoluteIndex -> RequiredInsertCount
absoluteIndexToRequiredInsertCount (AbsoluteIndex idx) =
    RequiredInsertCount (idx + 1)

updateRequiredInsertCount :: DynamicTable -> AbsoluteIndex -> IO ()
updateRequiredInsertCount DynamicTable{..} aidx = do
    let newric = absoluteIndexToRequiredInsertCount aidx
    oldric <- readIORef requiredInsertCount
    when (newric > oldric) $ writeIORef requiredInsertCount newric
  where
    EncodeInfo{..} = codeInfo

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

incrementKnownReceivedCount :: DynamicTable -> Int -> IO ()
incrementKnownReceivedCount DynamicTable{..} n =
    atomically $ modifyTVar' knownReceivedCount (+ n)
  where
    EncodeInfo{..} = codeInfo

updateKnownReceivedCount :: DynamicTable -> RequiredInsertCount -> IO ()
updateKnownReceivedCount DynamicTable{..} (RequiredInsertCount reqInsCnt) =
    atomically $ modifyTVar' knownReceivedCount $ \krc -> max reqInsCnt krc
  where
    EncodeInfo{..} = codeInfo

wouldSectionBeBlocked :: DynamicTable -> RequiredInsertCount -> IO Bool
wouldSectionBeBlocked DynamicTable{..} (RequiredInsertCount reqip) = atomically $ do
    krc <- readTVar knownReceivedCount
    return (reqip > krc)
  where
    EncodeInfo{..} = codeInfo

wouldInstructionBeBlocked :: DynamicTable -> AbsoluteIndex -> IO Bool
wouldInstructionBeBlocked DynamicTable{..} (AbsoluteIndex ai) = atomically $ do
    krc <- readTVar knownReceivedCount
    -- The decoder is known to hold entries 0 .. krc-1, so a reference to
    -- krc itself is still one it may not have.  This is the same test as
    -- 'wouldSectionBeBlocked', whose Required Insert Count is ai + 1.
    return (ai >= krc)
  where
    EncodeInfo{..} = codeInfo

setInsersionPointToKnownReceivedCount :: DynamicTable -> IO ()
setInsersionPointToKnownReceivedCount dyntbl@DynamicTable{..} = do
    InsertionPoint ai <- getInsertionPoint dyntbl
    atomically $ writeTVar knownReceivedCount ai
  where
    EncodeInfo{..} = codeInfo

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

getBasePoint :: DynamicTable -> IO BasePoint
getBasePoint DynamicTable{..} = readIORef basePoint

setBasePointToInsersionPoint :: DynamicTable -> IO ()
setBasePointToInsersionPoint DynamicTable{..} = do
    InsertionPoint ip <- readTVarIO insertionPoint
    writeIORef basePoint $ BasePoint ip

getInsertionPoint :: DynamicTable -> IO InsertionPoint
getInsertionPoint DynamicTable{..} = readTVarIO insertionPoint

getInsertionPointSTM :: DynamicTable -> STM InsertionPoint
getInsertionPointSTM DynamicTable{..} = readTVar insertionPoint

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

isDraining :: DynamicTable -> AbsoluteIndex -> IO Bool
isDraining DynamicTable{..} ai = do
    di <- readIORef drainingPoint
    return (ai <= di)
  where
    EncodeInfo{..} = codeInfo

adjustDrainingPoint :: DynamicTable -> IO ()
adjustDrainingPoint DynamicTable{..} = do
    InsertionPoint beg <- readTVarIO insertionPoint
    AbsoluteIndex end <- readIORef droppingPoint
    let num = beg - end
        space = max 1 (num !>>. 4)
        end' = beg - num + space
    writeIORef drainingPoint $ AbsoluteIndex end'
    table <- readTVarIO circularTable
    maxN <- readTVarIO maxNumOfEntries
    loop end end' table maxN
  where
    EncodeInfo{..} = codeInfo
    loop :: Int -> Int -> Table -> Int -> IO ()
    loop ai lim table maxN
        | ai == lim = return ()
        | otherwise = do
            let i = ai `mod` maxN
            ent <- atomically $ unsafeRead table i
            deleteRevIndex revIndex ent $ AbsoluteIndex ai
            loop (ai + 1) lim table maxN

tailDuplicationThreshold :: Int
tailDuplicationThreshold = 10

checkTailDuplication :: DynamicTable -> IO (Maybe AbsoluteIndex)
checkTailDuplication DynamicTable{..} = do
    dai@(AbsoluteIndex ai) <- readIORef droppingPoint
    arr <- readIORef referenceCounters
    maxN <- readTVarIO maxNumOfEntries
    let i = ai `mod` maxN
    -- modifyArray' is not provided by GHC 9.4 or earlier, sigh.
    ref@(Reference _ total) <- unsafeRead arr i
    krc <- readTVarIO knownReceivedCount
    -- Duplicating it evicts it, so it has to be evictable.
    if evictable krc ai ref && total >= tailDuplicationThreshold
        then return $ Just dai
        else return Nothing
  where
    EncodeInfo{..} = codeInfo

tailDuplication :: DynamicTable -> IO AbsoluteIndex
tailDuplication dyntbl@DynamicTable{..} = do
    dai <- readIORef droppingPoint
    ndai <- duplicate dyntbl dai
    dropIfNecessary dyntbl
    return ndai
  where
    EncodeInfo{..} = codeInfo

duplicate :: DynamicTable -> AbsoluteIndex -> IO AbsoluteIndex
duplicate dyntbl@DynamicTable{..} (AbsoluteIndex ai) = do
    maxN <- readTVarIO maxNumOfEntries
    let i = ai `mod` maxN
    table <- readTVarIO circularTable
    ent <- atomically $ unsafeRead table i
    insertEntryToEncoder ent dyntbl

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

-- | Whether the entry at an absolute index may be evicted, given the Known
--   Received Count (RFC 9204, section 2.1.1): once its insertion has been
--   acknowledged and no unacknowledged field section refers to it.
--
-- Whether it was ever referred to has nothing to do with it.  This used to
-- ask for that instead of the acknowledgement, which kept an entry nothing
-- referred to for good -- and, since entries go oldest first, every entry
-- after it too, so that the table filled up and took nothing new for the
-- rest of the connection.  An encoder inserts such an entry whenever it may
-- not block another stream and so writes the field out literally.
evictable :: Int -> Int -> Reference -> Bool
evictable krc ai (Reference current _) = current == 0 && ai < krc

canInsertEntry :: DynamicTable -> Entry -> Maybe AbsoluteIndex -> IO Bool
canInsertEntry DynamicTable{..} ent mai = do
    let siz = entrySize ent
    tblsiz <- readTVarIO tableSize
    maxtblsiz <- readIORef maxTableSize
    if tblsiz + siz <= maxtblsiz
        then
            return True
        else do
            AbsoluteIndex ai <- readIORef droppingPoint
            InsertionPoint lim <- readTVarIO insertionPoint
            loop ai lim (tblsiz + siz - maxtblsiz)
  where
    myself = case mai of
        Nothing -> -1 -- trick: this index does not exist
        Just (AbsoluteIndex i) -> i
    EncodeInfo{..} = codeInfo
    loop ai lim requiredSize
        | requiredSize <= 0 = return True
        | otherwise = do
            if ai < lim && ai /= myself -- don't drop the referred entry
                then do
                    maxN <- readTVarIO maxNumOfEntries
                    let i = ai `mod` maxN
                    refs <- readIORef referenceCounters
                    ref <- unsafeRead refs i
                    krc <- readTVarIO knownReceivedCount
                    if evictable krc ai ref
                        then do
                            table <- readTVarIO circularTable
                            dent <- atomically $ unsafeRead table i
                            let siz = entrySize dent

                            loop (ai + 1) lim (requiredSize - siz)
                        else return False
                else return False

dropIfNecessary :: DynamicTable -> IO ()
dropIfNecessary dyntbl@DynamicTable{..} = loop
  where
    loop = do
        tblsize <- readTVarIO tableSize
        maxtblsize <- readIORef maxTableSize
        unless (tblsize <= maxtblsize) $ do
            dropped <- tryDrop dyntbl
            if dropped then loop else error "dropIfNecessary"

tryDrop :: DynamicTable -> IO Bool
tryDrop dyntbl@DynamicTable{..} = do
    maxN <- readTVarIO maxNumOfEntries
    dai@(AbsoluteIndex ai) <- readIORef droppingPoint
    InsertionPoint lim <- readTVarIO insertionPoint
    if ai < lim
        then do
            let i = ai `mod` maxN
            refs <- readIORef referenceCounters
            ref <- unsafeRead refs i
            krc <- readTVarIO knownReceivedCount
            if evictable krc ai ref
                then do
                    table <- readTVarIO circularTable
                    ent <- atomically $ do
                        e <- unsafeRead table i
                        unsafeWrite table i dummyEntry
                        return e
                    let siz = entrySize ent
                    atomically $ modifyTVar' tableSize $ subtract siz
                    modifyIORef' droppingPoint (+ 1)
                    qpackDebug dyntbl $ do
                        putStrLn $
                            "DROPPED (AbsoluteIndex "
                                ++ show ai
                                ++ ") "
                                ++ show (entryHeaderName ent)
                                ++ " "
                                ++ show (entryFieldValue ent)
                        tblsiz <- readTVarIO tableSize
                        putStrLn $ "    tblsiz: " ++ show tblsiz
                    deleteRevIndex revIndex ent dai
                    return True
                else return False
        else return False
  where
    EncodeInfo{..} = codeInfo

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

getLruCache :: DynamicTable -> LRUCacheRef (FieldName, FieldValue) ()
getLruCache DynamicTable{..} = lruCache
  where
    EncodeInfo{..} = codeInfo

{-# INLINE getRevIndex #-}
getRevIndex :: DynamicTable -> RevIndex
getRevIndex DynamicTable{..} = revIndex
  where
    EncodeInfo{..} = codeInfo

-- only for encoder instruction handler
getHuffmanDecoder :: DynamicTable -> HuffmanDecoder
getHuffmanDecoder DynamicTable{..} = huffmanDecoder
  where
    DecodeInfo{..} = codeInfo

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

getMaxHeaderSize :: DynamicTable -> IO Int
getMaxHeaderSize DynamicTable{..} = readIORef maxHeaderSize

setMaxHeaderSize :: DynamicTable -> Int -> IO ()
setMaxHeaderSize DynamicTable{..} n = writeIORef maxHeaderSize n

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

qpackDebug :: DynamicTable -> IO () -> IO ()
qpackDebug DynamicTable{..} action = do
    debug <- readIORef debugQPACK
    when debug $ withMVar stdoutLock $ \_ -> action

getDebugQPACK :: DynamicTable -> IO Bool
getDebugQPACK DynamicTable{..} = readIORef debugQPACK

setDebugQPACK :: DynamicTable -> Bool -> IO ()
setDebugQPACK DynamicTable{..} b = writeIORef debugQPACK b

{-# NOINLINE stdoutLock #-}
stdoutLock :: MVar ()
stdoutLock = unsafePerformIO $ newMVar ()

printReferences :: DynamicTable -> IO ()
printReferences DynamicTable{..} = do
    AbsoluteIndex start <- readIORef droppingPoint
    InsertionPoint end <- readTVarIO insertionPoint
    maxN <- readTVarIO maxNumOfEntries
    arr <- readIORef referenceCounters
    putStr "Refs: "
    loop start end arr maxN
    putStr "\n"
  where
    loop :: Int -> Int -> IOArray Index Reference -> Int -> IO ()
    loop start end arr maxN
        | start < end = do
            r <- unsafeRead arr (start `mod` maxN)
            putStr $ show start ++ ": " ++ showReference r ++ ", "
            loop (start + 1) end arr maxN
        | otherwise = return ()
    EncodeInfo{..} = codeInfo
    showReference (Reference c t) = show c ++ "(" ++ show t ++ ")"

-- For decoder
checkHIndex :: DynamicTable -> HIndex -> IO ()
checkHIndex _ (SIndex _) = return ()
checkHIndex DynamicTable{..} (DIndex (AbsoluteIndex ai)) = do
    InsertionPoint ip <- readTVarIO insertionPoint
    maxN <- readTVarIO maxNumOfEntries
    if ip - maxN <= ai && ai < ip
        then return ()
        else error "checkHIndex"

-- For encoder
checkAbsoluteIndex :: DynamicTable -> AbsoluteIndex -> String -> IO ()
checkAbsoluteIndex DynamicTable{..} (AbsoluteIndex ai) tag = do
    InsertionPoint beg <- readTVarIO insertionPoint
    AbsoluteIndex end <- readIORef droppingPoint
    maxN <- readTVarIO maxNumOfEntries
    table <- readTVarIO circularTable
    let calcSize i acc
            | i == beg = return acc
            | otherwise = do
                siz <- entrySize <$> atomically (unsafeRead table (i `mod` maxN))
                calcSize (i + 1) (acc + siz)
    if end <= ai && ai < beg
        then do
            size <- calcSize end 0
            size0 <- readTVarIO tableSize
            when (size /= size0) $ error $ "checkAbsoluteIndex: size /= size0) " ++ tag
            lim <- readIORef maxTableSize
            when (size > lim) $ error $ "checkAbsoluteIndex: size > lim " ++ tag
            putStrLn $ "    check: tblsiz: " ++ show size ++ " " ++ show ai ++ " " ++ tag
        else
            error $
                "checkAbsoluteIndex (3) "
                    ++ tag
                    ++ " <= "
                    ++ show end
                    ++ " "
                    ++ show ai
                    ++ " < "
                    ++ show beg
  where
    EncodeInfo{..} = codeInfo

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

getImmediateAck :: DynamicTable -> IO Bool
getImmediateAck DynamicTable{..} = readIORef immediateAck
  where
    EncodeInfo{..} = codeInfo

setImmediateAck :: DynamicTable -> Bool -> IO ()
setImmediateAck DynamicTable{..} b = writeIORef immediateAck b
  where
    EncodeInfo{..} = codeInfo