{-# LANGUAGE OverloadedStrings #-}

module Network.QPACK.Table.Static (
    toStaticEntry,
    staticTableSize,
    staticTableList,
) where

import qualified Control.Exception as E
import Data.Array (Array, listArray)
import Data.Array.Base (unsafeAt)
import Network.HPACK.Internal (Entry, Index, Size, toEntry)
import Network.HTTP.Types (Header)

import Network.QPACK.Error
import Network.QPACK.Types

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

-- | The size of static table.
staticTableSize :: Size
staticTableSize :: Index
staticTableSize = [Header] -> Index
forall a. [a] -> Index
forall (t :: * -> *) a. Foldable t => t a -> Index
length [Header]
staticTableList

{-# INLINE toStaticEntry #-}

-- | Get 'Entry' from the static table.
--
-- >>> toStaticEntry 1
-- Entry 38 (Token {tokenIx = 2, shouldBeIndexed = False, isPseudo = True, tokenKey = ":path"}) "/"
-- >>> toStaticEntry 8
-- Entry 49 (Token {tokenIx = 30, shouldBeIndexed = True, isPseudo = False, tokenKey = "If-Modified-Since"}) ""
-- >>> toStaticEntry 50
-- Entry 53 (Token {tokenIx = 21, shouldBeIndexed = True, isPseudo = False, tokenKey = "Content-Type"}) "image/png"
toStaticEntry :: AbsoluteIndex -> Entry
toStaticEntry :: AbsoluteIndex -> Entry
toStaticEntry (AbsoluteIndex Index
sidx)
    | Index
sidx Index -> Index -> Bool
forall a. Ord a => a -> a -> Bool
< Index
staticTableSize = Array Index Entry
staticTable Array Index Entry -> Index -> Entry
forall i. Ix i => Array i Entry -> Index -> Entry
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Index -> e
`unsafeAt` Index
sidx
    | Bool
otherwise = DecodeError -> Entry
forall a e. Exception e => e -> a
E.throw DecodeError
IllegalStaticIndex

-- | Pre-defined static table.
staticTable :: Array Index Entry
staticTable :: Array Index Entry
staticTable = (Index, Index) -> [Entry] -> Array Index Entry
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Index
1, Index
staticTableSize) ([Entry] -> Array Index Entry) -> [Entry] -> Array Index Entry
forall a b. (a -> b) -> a -> b
$ (Header -> Entry) -> [Header] -> [Entry]
forall a b. (a -> b) -> [a] -> [b]
map Header -> Entry
toEntry [Header]
staticTableList

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

staticTableList :: [Header]
staticTableList :: [Header]
staticTableList =
    [ (HeaderName
":authority", ByteString
"")
    , (HeaderName
":path", ByteString
"/")
    , (HeaderName
"age", ByteString
"0")
    , (HeaderName
"content-disposition", ByteString
"")
    , (HeaderName
"content-length", ByteString
"0")
    , (HeaderName
"cookie", ByteString
"")
    , (HeaderName
"date", ByteString
"")
    , (HeaderName
"etag", ByteString
"")
    , (HeaderName
"if-modified-since", ByteString
"")
    , (HeaderName
"if-none-match", ByteString
"")
    , (HeaderName
"last-modified", ByteString
"")
    , (HeaderName
"link", ByteString
"")
    , (HeaderName
"location", ByteString
"")
    , (HeaderName
"referer", ByteString
"")
    , (HeaderName
"set-cookie", ByteString
"")
    , (HeaderName
":method", ByteString
"CONNECT")
    , (HeaderName
":method", ByteString
"DELETE")
    , (HeaderName
":method", ByteString
"GET")
    , (HeaderName
":method", ByteString
"HEAD")
    , (HeaderName
":method", ByteString
"OPTIONS")
    , (HeaderName
":method", ByteString
"POST")
    , (HeaderName
":method", ByteString
"PUT")
    , (HeaderName
":scheme", ByteString
"http")
    , (HeaderName
":scheme", ByteString
"https")
    , (HeaderName
":status", ByteString
"103")
    , (HeaderName
":status", ByteString
"200")
    , (HeaderName
":status", ByteString
"304")
    , (HeaderName
":status", ByteString
"404")
    , (HeaderName
":status", ByteString
"503")
    , (HeaderName
"accept", ByteString
"*/*")
    , (HeaderName
"accept", ByteString
"application/dns-message")
    , (HeaderName
"accept-encoding", ByteString
"gzip, deflate, br")
    , (HeaderName
"accept-ranges", ByteString
"bytes")
    , (HeaderName
"access-control-allow-headers", ByteString
"cache-control")
    , (HeaderName
"access-control-allow-headers", ByteString
"content-type")
    , (HeaderName
"access-control-allow-origin", ByteString
"*")
    , (HeaderName
"cache-control", ByteString
"max-age=0")
    , (HeaderName
"cache-control", ByteString
"max-age=2592000")
    , (HeaderName
"cache-control", ByteString
"max-age=604800")
    , (HeaderName
"cache-control", ByteString
"no-cache")
    , (HeaderName
"cache-control", ByteString
"no-store")
    , (HeaderName
"cache-control", ByteString
"public, age=31536000")
    , (HeaderName
"content-encoding", ByteString
"br")
    , (HeaderName
"content-encoding", ByteString
"gzip")
    , (HeaderName
"content-type", ByteString
"application/dns-message")
    , (HeaderName
"content-type", ByteString
"application/javascript")
    , (HeaderName
"content-type", ByteString
"application/json")
    , (HeaderName
"content-type", ByteString
"application/x-www-form-urlencoded")
    , (HeaderName
"content-type", ByteString
"image/gif")
    , (HeaderName
"content-type", ByteString
"image/jpeg")
    , (HeaderName
"content-type", ByteString
"image/png")
    , (HeaderName
"content-type", ByteString
"text/css")
    , (HeaderName
"content-type", ByteString
"text/html; charset=utf-8")
    , (HeaderName
"content-type", ByteString
"text/plain")
    , (HeaderName
"content-type", ByteString
"text/plain;charset=utf-8")
    , (HeaderName
"range", ByteString
"bytes=0-")
    , (HeaderName
"strict-transport-security", ByteString
"max-age=31536000")
    , (HeaderName
"strict-transport-security", ByteString
"max-age=31536000; includesubdomains")
    , (HeaderName
"strict-transport-security", ByteString
"max-age=31536000; includesubdomains; preload")
    , (HeaderName
"vary", ByteString
"accept-encoding")
    , (HeaderName
"vary", ByteString
"origin")
    , (HeaderName
"x-content-type-options", ByteString
"nosniff")
    , (HeaderName
"x-xss-protection", ByteString
"1; mode=block")
    , (HeaderName
":status", ByteString
"100")
    , (HeaderName
":status", ByteString
"204")
    , (HeaderName
":status", ByteString
"206")
    , (HeaderName
":status", ByteString
"302")
    , (HeaderName
":status", ByteString
"400")
    , (HeaderName
":status", ByteString
"403")
    , (HeaderName
":status", ByteString
"421")
    , (HeaderName
":status", ByteString
"425")
    , (HeaderName
":status", ByteString
"500")
    , (HeaderName
"accept-language", ByteString
"")
    , (HeaderName
"access-control-allow-credentials", ByteString
"FALSE")
    , (HeaderName
"access-control-allow-credentials", ByteString
"TRUE")
    , (HeaderName
"access-control-allow-headers", ByteString
"*")
    , (HeaderName
"access-control-allow-methods", ByteString
"get")
    , (HeaderName
"access-control-allow-methods", ByteString
"get, post, options")
    , (HeaderName
"access-control-allow-methods", ByteString
"options")
    , (HeaderName
"access-control-expose-headers", ByteString
"content-length")
    , (HeaderName
"access-control-request-headers", ByteString
"content-type")
    , (HeaderName
"access-control-request-method", ByteString
"get")
    , (HeaderName
"access-control-request-method", ByteString
"post")
    , (HeaderName
"alt-svc", ByteString
"clear")
    , (HeaderName
"authorization", ByteString
"")
    ,
        ( HeaderName
"content-security-policy"
        , ByteString
"script-src 'none'; object-src 'none'; base-uri 'none'"
        )
    , (HeaderName
"early-data", ByteString
"1")
    , (HeaderName
"expect-ct", ByteString
"")
    , (HeaderName
"forwarded", ByteString
"")
    , (HeaderName
"if-range", ByteString
"")
    , (HeaderName
"origin", ByteString
"")
    , (HeaderName
"purpose", ByteString
"prefetch")
    , (HeaderName
"server", ByteString
"")
    , (HeaderName
"timing-allow-origin", ByteString
"*")
    , (HeaderName
"upgrade-insecure-requests", ByteString
"1")
    , (HeaderName
"user-agent", ByteString
"")
    , (HeaderName
"x-forwarded-for", ByteString
"")
    , (HeaderName
"x-frame-options", ByteString
"deny")
    , (HeaderName
"x-frame-options", ByteString
"sameorigin")
    ]