{-# LANGUAGE OverloadedStrings #-}
module Network.HPACK.Table.Static (
toStaticEntry,
staticTableSize,
staticTableList,
) where
import Data.Array (Array, listArray)
import Data.Array.Base (unsafeAt)
import Network.HPACK.Table.Entry
import Network.HTTP.Types (Header)
staticTableSize :: Size
staticTableSize :: Index
staticTableSize = [Header] -> Index
forall a. [a] -> Index
forall (t :: * -> *) a. Foldable t => t a -> Index
length [Header]
staticTableList
{-# INLINE toStaticEntry #-}
toStaticEntry :: Index -> Entry
toStaticEntry :: Index -> Entry
toStaticEntry Index
sidx = 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 Index -> Index -> Index
forall a. Num a => a -> a -> a
- Index
1)
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
":method", ByteString
"GET")
, (HeaderName
":method", ByteString
"POST")
, (HeaderName
":path", ByteString
"/")
, (HeaderName
":path", ByteString
"/index.html")
, (HeaderName
":scheme", ByteString
"http")
, (HeaderName
":scheme", ByteString
"https")
, (HeaderName
":status", ByteString
"200")
, (HeaderName
":status", ByteString
"204")
, (HeaderName
":status", ByteString
"206")
, (HeaderName
":status", ByteString
"304")
, (HeaderName
":status", ByteString
"400")
, (HeaderName
":status", ByteString
"404")
, (HeaderName
":status", ByteString
"500")
, (HeaderName
"accept-charset", ByteString
"")
, (HeaderName
"accept-encoding", ByteString
"gzip, deflate")
, (HeaderName
"accept-language", ByteString
"")
, (HeaderName
"accept-ranges", ByteString
"")
, (HeaderName
"accept", ByteString
"")
, (HeaderName
"access-control-allow-origin", ByteString
"")
, (HeaderName
"age", ByteString
"")
, (HeaderName
"allow", ByteString
"")
, (HeaderName
"authorization", ByteString
"")
, (HeaderName
"cache-control", ByteString
"")
, (HeaderName
"content-disposition", ByteString
"")
, (HeaderName
"content-encoding", ByteString
"")
, (HeaderName
"content-language", ByteString
"")
, (HeaderName
"content-length", ByteString
"")
, (HeaderName
"content-location", ByteString
"")
, (HeaderName
"content-range", ByteString
"")
, (HeaderName
"content-type", ByteString
"")
, (HeaderName
"cookie", ByteString
"")
, (HeaderName
"date", ByteString
"")
, (HeaderName
"etag", ByteString
"")
, (HeaderName
"expect", ByteString
"")
, (HeaderName
"expires", ByteString
"")
, (HeaderName
"from", ByteString
"")
, (HeaderName
"host", ByteString
"")
, (HeaderName
"if-match", ByteString
"")
, (HeaderName
"if-modified-since", ByteString
"")
, (HeaderName
"if-none-match", ByteString
"")
, (HeaderName
"if-range", ByteString
"")
, (HeaderName
"if-unmodified-since", ByteString
"")
, (HeaderName
"last-modified", ByteString
"")
, (HeaderName
"link", ByteString
"")
, (HeaderName
"location", ByteString
"")
, (HeaderName
"max-forwards", ByteString
"")
, (HeaderName
"proxy-authenticate", ByteString
"")
, (HeaderName
"proxy-authorization", ByteString
"")
, (HeaderName
"range", ByteString
"")
, (HeaderName
"referer", ByteString
"")
, (HeaderName
"refresh", ByteString
"")
, (HeaderName
"retry-after", ByteString
"")
, (HeaderName
"server", ByteString
"")
, (HeaderName
"set-cookie", ByteString
"")
, (HeaderName
"strict-transport-security", ByteString
"")
, (HeaderName
"transfer-encoding", ByteString
"")
, (HeaderName
"user-agent", ByteString
"")
, (HeaderName
"vary", ByteString
"")
, (HeaderName
"via", ByteString
"")
, (HeaderName
"www-authenticate", ByteString
"")
]