1{-# LANGUAGE OverloadedStrings, BangPatterns #-}
2
3module Network.HPACK.Token (
4  -- * Data type
5    Token(..)
6  , tokenIx
7  , tokenCIKey
8  , tokenFoldedKey
9  , toToken
10  -- * Ix
11  , minTokenIx
12  , maxStaticTokenIx
13  , maxTokenIx
14  , cookieTokenIx
15  -- * Utilities
16  , isMaxTokenIx
17  , isCookieTokenIx
18  , isStaticTokenIx
19  , isStaticToken
20  -- * Defined tokens
21  , tokenAuthority
22  , tokenMethod
23  , tokenPath
24  , tokenScheme
25  , tokenStatus
26  , tokenAcceptCharset
27  , tokenAcceptEncoding
28  , tokenAcceptLanguage
29  , tokenAcceptRanges
30  , tokenAccept
31  , tokenAccessControlAllowOrigin
32  , tokenAge
33  , tokenAllow
34  , tokenAuthorization
35  , tokenCacheControl
36  , tokenContentDisposition
37  , tokenContentEncoding
38  , tokenContentLanguage
39  , tokenContentLength
40  , tokenContentLocation
41  , tokenContentRange
42  , tokenContentType
43  , tokenCookie
44  , tokenDate
45  , tokenEtag
46  , tokenExpect
47  , tokenExpires
48  , tokenFrom
49  , tokenHost
50  , tokenIfMatch
51  , tokenIfModifiedSince
52  , tokenIfNoneMatch
53  , tokenIfRange
54  , tokenIfUnmodifiedSince
55  , tokenLastModified
56  , tokenLink
57  , tokenLocation
58  , tokenMaxForwards
59  , tokenProxyAuthenticate
60  , tokenProxyAuthorization
61  , tokenRange
62  , tokenReferer
63  , tokenRefresh
64  , tokenRetryAfter
65  , tokenServer
66  , tokenSetCookie
67  , tokenStrictTransportSecurity
68  , tokenTransferEncoding
69  , tokenUserAgent
70  , tokenVary
71  , tokenVia
72  , tokenWwwAuthenticate
73  , tokenConnection
74  , tokenTE
75  , tokenMax
76  ) where
77
78import qualified Data.ByteString as B
79import Data.ByteString.Internal (ByteString(..), memcmp)
80import Foreign.ForeignPtr (withForeignPtr)
81import Foreign.Ptr (plusPtr)
82import System.IO.Unsafe (unsafeDupablePerformIO)
83import Data.CaseInsensitive (original, mk, CI(..))
84
85-- $setup
86-- >>> :set -XOverloadedStrings
87
88-- | Internal representation for header keys.
89data Token = Token {
90    ix :: !Int               -- ^ Index for value table
91  , shouldBeIndexed :: !Bool -- ^ should be indexed in HPACK
92  , isPseudo :: !Bool        -- ^ is this a pseudo header key?
93  , tokenKey :: !(CI ByteString) -- ^ Case insensitive header key
94  } deriving (Eq, Show)
95
96-- | Extracting an index from a token.
97{-# INLINE tokenIx #-}
98tokenIx :: Token -> Int
99tokenIx (Token n _ _ _) = n
100
101-- | Extracting a case insensitive header key from a token.
102{-# INLINE tokenCIKey #-}
103tokenCIKey :: Token -> ByteString
104tokenCIKey (Token _ _ _ ci) = original ci
105
106-- | Extracting a folded header key from a token.
107{-# INLINE tokenFoldedKey #-}
108tokenFoldedKey :: Token -> ByteString
109tokenFoldedKey (Token _ _ _ ci) = foldedCase ci
110
111tokenAuthority                :: Token
112tokenMethod                   :: Token
113tokenPath                     :: Token
114tokenScheme                   :: Token
115tokenStatus                   :: Token
116tokenAcceptCharset            :: Token
117tokenAcceptEncoding           :: Token
118tokenAcceptLanguage           :: Token
119tokenAcceptRanges             :: Token
120tokenAccept                   :: Token
121tokenAccessControlAllowOrigin :: Token
122tokenAge                      :: Token
123tokenAllow                    :: Token
124tokenAuthorization            :: Token
125tokenCacheControl             :: Token
126tokenContentDisposition       :: Token
127tokenContentEncoding          :: Token
128tokenContentLanguage          :: Token
129tokenContentLength            :: Token
130tokenContentLocation          :: Token
131tokenContentRange             :: Token
132tokenContentType              :: Token
133tokenCookie                   :: Token
134tokenDate                     :: Token
135tokenEtag                     :: Token
136tokenExpect                   :: Token
137tokenExpires                  :: Token
138tokenFrom                     :: Token
139tokenHost                     :: Token
140tokenIfMatch                  :: Token
141tokenIfModifiedSince          :: Token
142tokenIfNoneMatch              :: Token
143tokenIfRange                  :: Token
144tokenIfUnmodifiedSince        :: Token
145tokenLastModified             :: Token
146tokenLink                     :: Token
147tokenLocation                 :: Token
148tokenMaxForwards              :: Token
149tokenProxyAuthenticate        :: Token
150tokenProxyAuthorization       :: Token
151tokenRange                    :: Token
152tokenReferer                  :: Token
153tokenRefresh                  :: Token
154tokenRetryAfter               :: Token
155tokenServer                   :: Token
156tokenSetCookie                :: Token
157tokenStrictTransportSecurity  :: Token
158tokenTransferEncoding         :: Token
159tokenUserAgent                :: Token
160tokenVary                     :: Token
161tokenVia                      :: Token
162tokenWwwAuthenticate          :: Token
163tokenConnection               :: Token -- Original
164tokenTE                       :: Token -- Original
165tokenMax                      :: Token -- Other tokens
166
167tokenAuthority                = Token  0  True  True ":authority"
168tokenMethod                   = Token  1  True  True ":method"
169tokenPath                     = Token  2 False  True ":path"
170tokenScheme                   = Token  3  True  True ":scheme"
171tokenStatus                   = Token  4  True  True ":status"
172tokenAcceptCharset            = Token  5  True False "Accept-Charset"
173tokenAcceptEncoding           = Token  6  True False "Accept-Encoding"
174tokenAcceptLanguage           = Token  7  True False "Accept-Language"
175tokenAcceptRanges             = Token  8  True False "Accept-Ranges"
176tokenAccept                   = Token  9  True False "Accept"
177tokenAccessControlAllowOrigin = Token 10  True False "Access-Control-Allow-Origin"
178tokenAge                      = Token 11  True False "Age"
179tokenAllow                    = Token 12  True False "Allow"
180tokenAuthorization            = Token 13  True False "Authorization"
181tokenCacheControl             = Token 14  True False "Cache-Control"
182tokenContentDisposition       = Token 15  True False "Content-Disposition"
183tokenContentEncoding          = Token 16  True False "Content-Encoding"
184tokenContentLanguage          = Token 17  True False "Content-Language"
185tokenContentLength            = Token 18 False False "Content-Length"
186tokenContentLocation          = Token 19 False False "Content-Location"
187tokenContentRange             = Token 20  True False "Content-Range"
188tokenContentType              = Token 21  True False "Content-Type"
189tokenCookie                   = Token 22  True False "Cookie"
190tokenDate                     = Token 23  True False "Date"
191tokenEtag                     = Token 24 False False "Etag"
192tokenExpect                   = Token 25  True False "Expect"
193tokenExpires                  = Token 26  True False "Expires"
194tokenFrom                     = Token 27  True False "From"
195tokenHost                     = Token 28  True False "Host"
196tokenIfMatch                  = Token 29  True False "If-Match"
197tokenIfModifiedSince          = Token 30  True False "If-Modified-Since"
198tokenIfNoneMatch              = Token 31  True False "If-None-Match"
199tokenIfRange                  = Token 32  True False "If-Range"
200tokenIfUnmodifiedSince        = Token 33  True False "If-Unmodified-Since"
201tokenLastModified             = Token 34  True False "Last-Modified"
202tokenLink                     = Token 35  True False "Link"
203tokenLocation                 = Token 36  True False "Location"
204tokenMaxForwards              = Token 37  True False "Max-Forwards"
205tokenProxyAuthenticate        = Token 38  True False "Proxy-Authenticate"
206tokenProxyAuthorization       = Token 39  True False "Proxy-Authorization"
207tokenRange                    = Token 40  True False "Range"
208tokenReferer                  = Token 41  True False "Referer"
209tokenRefresh                  = Token 42  True False "Refresh"
210tokenRetryAfter               = Token 43  True False "Retry-After"
211tokenServer                   = Token 44  True False "Server"
212tokenSetCookie                = Token 45 False False "Set-Cookie"
213tokenStrictTransportSecurity  = Token 46  True False "Strict-Transport-Security"
214tokenTransferEncoding         = Token 47  True False "Transfer-Encoding"
215tokenUserAgent                = Token 48  True False "User-Agent"
216tokenVary                     = Token 49  True False "Vary"
217tokenVia                      = Token 50  True False "Via"
218tokenWwwAuthenticate          = Token 51  True False "Www-Authenticate"
219-- | Not defined in the static table.
220tokenConnection               = Token 52 False False "Connection"
221-- | Not defined in the static table.
222tokenTE                       = Token 53 False False "TE"
223-- | A place holder to hold header keys not defined in the static table.
224tokenMax                      = Token 54  True False "for other tokens"
225
226-- | Minimum token index.
227minTokenIx :: Int
228minTokenIx = 0
229
230-- | Maximun token index defined in the static table.
231maxStaticTokenIx :: Int
232maxStaticTokenIx = 51
233
234-- | Maximum token index.
235maxTokenIx :: Int
236maxTokenIx = 54
237
238-- | Token index for 'tokenCookie'.
239cookieTokenIx :: Int
240cookieTokenIx = 22
241
242-- | Is this token ix for Cookie?
243{-# INLINE isCookieTokenIx #-}
244isCookieTokenIx :: Int -> Bool
245isCookieTokenIx n = n == cookieTokenIx
246
247-- | Is this token ix to be held in the place holder?
248{-# INLINE isMaxTokenIx #-}
249isMaxTokenIx :: Int -> Bool
250isMaxTokenIx n = n == maxTokenIx
251
252-- | Is this token ix for a header not defined in the static table?
253{-# INLINE isStaticTokenIx #-}
254isStaticTokenIx :: Int -> Bool
255isStaticTokenIx n = n <= maxStaticTokenIx
256
257-- | Is this token for a header not defined in the static table?
258{-# INLINE isStaticToken #-}
259isStaticToken :: Token -> Bool
260isStaticToken n = tokenIx n <= maxStaticTokenIx
261
262-- | Making a token from a header key.
263--
264-- >>> toToken ":authority" == tokenAuthority
265-- True
266-- >>> toToken "foo"
267-- Token {ix = 54, shouldBeIndexed = True, isPseudo = False, tokenKey = "foo"}
268-- >>> toToken ":bar"
269-- Token {ix = 54, shouldBeIndexed = True, isPseudo = True, tokenKey = ":bar"}
270toToken :: ByteString -> Token
271toToken bs = case len of
272    2 -> if bs === "te" then tokenTE else mkTokenMax bs
273    3 -> case lst of
274        97  | bs === "via" -> tokenVia
275        101 | bs === "age" -> tokenAge
276        _                  -> mkTokenMax bs
277    4 -> case lst of
278        101 | bs === "date" -> tokenDate
279        103 | bs === "etag" -> tokenEtag
280        107 | bs === "link" -> tokenLink
281        109 | bs === "from" -> tokenFrom
282        116 | bs === "host" -> tokenHost
283        121 | bs === "vary" -> tokenVary
284        _                   -> mkTokenMax bs
285    5 -> case lst of
286        101 | bs === "range" -> tokenRange
287        104 | bs === ":path" -> tokenPath
288        119 | bs === "allow" -> tokenAllow
289        _                    -> mkTokenMax bs
290    6 -> case lst of
291        101 | bs === "cookie" -> tokenCookie
292        114 | bs === "server" -> tokenServer
293        116 | bs === "expect" -> tokenExpect
294            | bs === "accept" -> tokenAccept
295        _                     -> mkTokenMax bs
296    7 -> case lst of
297        100 | bs === ":method" -> tokenMethod
298        101 | bs === ":scheme" -> tokenScheme
299        104 | bs === "refresh" -> tokenRefresh
300        114 | bs === "referer" -> tokenReferer
301        115 | bs === "expires" -> tokenExpires
302            | bs === ":status" -> tokenStatus
303        _                      -> mkTokenMax bs
304    8 -> case lst of
305        101 | bs === "if-range" -> tokenIfRange
306        104 | bs === "if-match" -> tokenIfMatch
307        110 | bs === "location" -> tokenLocation
308        _                       -> mkTokenMax bs
309    10 -> case lst of
310        101 | bs === "set-cookie" -> tokenSetCookie
311        110 | bs === "connection" -> tokenConnection
312        116 | bs === "user-agent" -> tokenUserAgent
313        121 | bs === ":authority" -> tokenAuthority
314        _                         -> mkTokenMax bs
315    11 -> case lst of
316        114 | bs === "retry-after" -> tokenRetryAfter
317        _                          -> mkTokenMax bs
318    12 -> case lst of
319        101 | bs === "content-type" -> tokenContentType
320        115 | bs === "max-forwards" -> tokenMaxForwards
321        _                           -> mkTokenMax bs
322    13 -> case lst of
323        100 | bs === "last-modified" -> tokenLastModified
324        101 | bs === "content-range" -> tokenContentRange
325        104 | bs === "if-none-match" -> tokenIfNoneMatch
326        108 | bs === "cache-control" -> tokenCacheControl
327        110 | bs === "authorization" -> tokenAuthorization
328        115 | bs === "accept-ranges" -> tokenAcceptRanges
329        _                            -> mkTokenMax bs
330    14 -> case lst of
331        104 | bs === "content-length" -> tokenContentLength
332        116 | bs === "accept-charset" -> tokenAcceptCharset
333        _                             -> mkTokenMax bs
334    15 -> case lst of
335        101 | bs === "accept-language" -> tokenAcceptLanguage
336        103 | bs === "accept-encoding" -> tokenAcceptEncoding
337        _                              -> mkTokenMax bs
338    16 -> case lst of
339        101 | bs === "content-language" -> tokenContentLanguage
340            | bs === "www-authenticate" -> tokenWwwAuthenticate
341        103 | bs === "content-encoding" -> tokenContentEncoding
342        110 | bs === "content-location" -> tokenContentLocation
343        _                               -> mkTokenMax bs
344    17 -> case lst of
345        101 | bs === "if-modified-since" -> tokenIfModifiedSince
346        103 | bs === "transfer-encoding" -> tokenTransferEncoding
347        _                                -> mkTokenMax bs
348    18 -> case lst of
349        101 | bs === "proxy-authenticate" -> tokenProxyAuthenticate
350        _                                 -> mkTokenMax bs
351    19 -> case lst of
352        101 | bs === "if-unmodified-since" -> tokenIfUnmodifiedSince
353        110 | bs === "proxy-authorization" -> tokenProxyAuthorization
354            | bs === "content-disposition" -> tokenContentDisposition
355        _                                  -> mkTokenMax bs
356    25 -> case lst of
357        121 | bs === "strict-transport-security" -> tokenStrictTransportSecurity
358        _                                        -> mkTokenMax bs
359    27 -> case lst of
360        110 | bs === "access-control-allow-origin" -> tokenAccessControlAllowOrigin
361        _                                          -> mkTokenMax bs
362    _  -> mkTokenMax bs
363  where
364    len = B.length bs
365    lst = B.last bs
366    PS fp1 off1 siz === PS fp2 off2 _ = unsafeDupablePerformIO $
367      withForeignPtr fp1 $ \p1 ->
368      withForeignPtr fp2 $ \p2 -> do
369        i <- memcmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) siz
370        return $! i == 0
371
372mkTokenMax :: ByteString -> Token
373mkTokenMax bs = Token maxTokenIx True p (mk bs)
374  where
375    !p | B.length bs == 0 = False
376       | B.head bs == 58  = True
377       | otherwise        = False
378