1{-# LANGUAGE OverloadedStrings #-}
2
3module Network.HTTP2.Arch.Types where
4
5import Control.Concurrent
6import Control.Concurrent.STM
7import Control.Exception (SomeException)
8import Data.ByteString.Builder (Builder)
9import Data.IORef
10import Data.IntMap.Strict (IntMap)
11import qualified Network.HTTP.Types as H
12
13import Imports
14import Network.HPACK
15import Network.HTTP2.Arch.File
16import Network.HTTP2.Frame
17
18----------------------------------------------------------------
19
20-- | "http" or "https".
21type Scheme = ByteString
22
23-- | For so-called "Host:" header.
24type Authority = ByteString
25
26-- | Path.
27type Path = ByteString
28
29----------------------------------------------------------------
30
31type InpBody = IO ByteString
32
33data OutBody = OutBodyNone
34             -- | Streaming body takes a write action and a flush action.
35             | OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ())
36             | OutBodyBuilder Builder
37             | OutBodyFile FileSpec
38
39-- | Input object
40data InpObj = InpObj {
41    inpObjHeaders  :: HeaderTable   -- ^ Accessor for headers.
42  , inpObjBodySize :: Maybe Int     -- ^ Accessor for body length specified in content-length:.
43  , inpObjBody     :: InpBody       -- ^ Accessor for body.
44  , inpObjTrailers :: IORef (Maybe HeaderTable) -- ^ Accessor for trailers.
45  }
46
47instance Show InpObj where
48    show (InpObj (thl,_) _ _body _tref) = show thl
49
50-- | Output object
51data OutObj = OutObj {
52    outObjHeaders  :: [H.Header]    -- ^ Accessor for header.
53  , outObjBody     :: OutBody       -- ^ Accessor for outObj body.
54  , outObjTrailers :: TrailersMaker -- ^ Accessor for trailers maker.
55  }
56
57instance Show OutObj where
58    show (OutObj hdr _ _) = show hdr
59
60-- | Trailers maker. A chunks of the response body is passed
61--   with 'Just'. The maker should update internal state
62--   with the 'ByteString' and return the next trailers maker.
63--   When response body reaches its end,
64--   'Nothing' is passed and the maker should generate
65--   trailers. An example:
66--
67--   > {-# LANGUAGE BangPatterns #-}
68--   > import Data.ByteString (ByteString)
69--   > import qualified Data.ByteString.Char8 as C8
70--   > import Crypto.Hash (Context, SHA1) -- cryptonite
71--   > import qualified Crypto.Hash as CH
72--   >
73--   > -- Strictness is important for Context.
74--   > trailersMaker :: Context SHA1 -> Maybe ByteString -> IO NextTrailersMaker
75--   > trailersMaker ctx Nothing = return $ Trailers [("X-SHA1", sha1)]
76--   >   where
77--   >     !sha1 = C8.pack $ show $ CH.hashFinalize ctx
78--   > trailersMaker ctx (Just bs) = return $ NextTrailersMaker $ trailersMaker ctx'
79--   >   where
80--   >     !ctx' = CH.hashUpdate ctx bs
81--
82--   Usage example:
83--
84--   > let h2rsp = responseFile ...
85--   >     maker = trailersMaker (CH.hashInit :: Context SHA1)
86--   >     h2rsp' = setResponseTrailersMaker h2rsp maker
87--
88type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker
89
90-- | TrailersMake to create no trailers.
91defaultTrailersMaker :: TrailersMaker
92defaultTrailersMaker Nothing = return $ Trailers []
93defaultTrailersMaker _       = return $ NextTrailersMaker defaultTrailersMaker
94
95-- | Either the next trailers maker or final trailers.
96data NextTrailersMaker = NextTrailersMaker TrailersMaker
97                       | Trailers [H.Header]
98
99----------------------------------------------------------------
100
101-- | File specification.
102data FileSpec = FileSpec FilePath FileOffset ByteCount deriving (Eq, Show)
103
104----------------------------------------------------------------
105
106data OpenState =
107    JustOpened
108  | Continued [HeaderBlockFragment]
109              Int  -- Total size
110              Int  -- The number of continuation frames
111              Bool -- End of stream
112  | NoBody HeaderTable
113  | HasBody HeaderTable
114  | Body (TQueue ByteString)
115         (Maybe Int) -- received Content-Length
116                     -- compared the body length for error checking
117         (IORef Int) -- actual body length
118         (IORef (Maybe HeaderTable)) -- trailers
119
120data ClosedCode = Finished
121                | Killed
122                | Reset ErrorCodeId
123                | ResetByMe SomeException
124                deriving Show
125
126----------------------------------------------------------------
127
128data StreamState =
129    Idle
130  | Open OpenState
131  | HalfClosedRemote
132  | HalfClosedLocal ClosedCode
133  | Closed ClosedCode
134  | Reserved
135
136instance Show StreamState where
137    show Idle                = "Idle"
138    show Open{}              = "Open"
139    show HalfClosedRemote    = "HalfClosedRemote"
140    show (HalfClosedLocal e) = "HalfClosedLocal: " ++ show e
141    show (Closed e)          = "Closed: " ++ show e
142    show Reserved            = "Reserved"
143
144----------------------------------------------------------------
145
146data Stream = Stream {
147    streamNumber     :: StreamId
148  , streamState      :: IORef StreamState
149  , streamWindow     :: TVar WindowSize
150  , streamInput      :: MVar InpObj -- Client only
151  }
152
153instance Show Stream where
154  show s = show (streamNumber s)
155
156----------------------------------------------------------------
157
158newtype StreamTable = StreamTable (IORef (IntMap Stream))
159
160----------------------------------------------------------------
161
162data Input a = Input a InpObj
163
164data Output a = Output {
165    outputStream   :: a
166  , outputObject   :: OutObj
167  , outputType     :: OutputType
168  , outputStrmQ    :: Maybe (TBQueue StreamingChunk)
169  , outputSentinel :: IO ()
170  }
171
172data OutputType = OObj
173                | OWait (IO ())
174                | OPush TokenHeaderList StreamId -- associated stream id from client
175                | ONext DynaNext TrailersMaker
176
177----------------------------------------------------------------
178
179type DynaNext = Buffer -> BufferSize -> WindowSize -> IO Next
180
181type BytesFilled = Int
182
183data Next = Next BytesFilled (Maybe DynaNext)
184
185----------------------------------------------------------------
186
187data Control = CFinish
188             | CGoaway    ByteString
189             | CFrame     ByteString
190             | CSettings  ByteString SettingsList
191             | CSettings0 ByteString ByteString SettingsList
192
193----------------------------------------------------------------
194
195data StreamingChunk = StreamingFinished
196                    | StreamingFlush
197                    | StreamingBuilder Builder
198