1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP2.H2.Types where
import qualified Control.Exception as E
import Data.ByteString.Builder (Builder)
import Data.IORef
import Data.Typeable
import Network.Control
import qualified Network.HTTP.Types as H
import Network.Socket hiding (Stream)
import System.IO.Unsafe
import qualified System.TimeManager as T
import UnliftIO.Concurrent
import UnliftIO.Exception (SomeException)
import UnliftIO.STM
import Imports
import Network.HPACK
import Network.HTTP2.Frame
import Network.HTTP2.H2.File
----------------------------------------------------------------
-- | "http" or "https".
type Scheme = ByteString
-- | Authority.
type Authority = ByteString
-- | Path.
type Path = ByteString
----------------------------------------------------------------
type InpBody = IO ByteString
data OutBody
= OutBodyNone
| -- | Streaming body takes a write action and a flush action.
OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ())
| -- | Like 'OutBodyStreaming', but with a callback to unmask expections
--
-- This is used in the client: we spawn the new thread for the request body
-- with exceptions masked, and provide the body of 'OutBodyStreamingUnmask'
-- with a callback to unmask them again (typically after installing an exception
-- handler).
--
-- We do /NOT/ support this in the server, as here the scope of the thread
-- that is spawned for the server is the entire handler, not just the response
-- streaming body.
--
-- TODO: The analogous change for the server-side would be to provide a similar
-- @unmask@ callback as the first argument in the 'Server' type alias.
OutBodyStreamingUnmask
((forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ())
| OutBodyBuilder Builder
| OutBodyFile FileSpec
-- | Input object
data InpObj = InpObj
{ inpObjHeaders :: HeaderTable
-- ^ Accessor for headers.
, inpObjBodySize :: Maybe Int
-- ^ Accessor for body length specified in content-length:.
, inpObjBody :: InpBody
-- ^ Accessor for body.
, inpObjTrailers :: IORef (Maybe HeaderTable)
-- ^ Accessor for trailers.
}
instance Show InpObj where
show (InpObj (thl, _) _ _body _tref) = show thl
-- | Output object
data OutObj = OutObj
{ outObjHeaders :: [H.Header]
-- ^ Accessor for header.
, outObjBody :: OutBody
-- ^ Accessor for outObj body.
, outObjTrailers :: TrailersMaker
-- ^ Accessor for trailers maker.
}
instance Show OutObj where
show (OutObj hdr _ _) = show hdr
-- | Trailers maker. A chunks of the response body is passed
-- with 'Just'. The maker should update internal state
-- with the 'ByteString' and return the next trailers maker.
-- When response body reaches its end,
-- 'Nothing' is passed and the maker should generate
-- trailers. An example:
--
-- > {-# LANGUAGE BangPatterns #-}
-- > import Data.ByteString (ByteString)
-- > import qualified Data.ByteString.Char8 as C8
-- > import Crypto.Hash (Context, SHA1) -- cryptonite
-- > import qualified Crypto.Hash as CH
-- >
-- > -- Strictness is important for Context.
-- > trailersMaker :: Context SHA1 -> Maybe ByteString -> IO NextTrailersMaker
-- > trailersMaker ctx Nothing = return $ Trailers [("X-SHA1", sha1)]
-- > where
-- > !sha1 = C8.pack $ show $ CH.hashFinalize ctx
-- > trailersMaker ctx (Just bs) = return $ NextTrailersMaker $ trailersMaker ctx'
-- > where
-- > !ctx' = CH.hashUpdate ctx bs
--
-- Usage example:
--
-- > let h2rsp = responseFile ...
-- > maker = trailersMaker (CH.hashInit :: Context SHA1)
-- > h2rsp' = setResponseTrailersMaker h2rsp maker
type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker
-- | TrailersMake to create no trailers.
defaultTrailersMaker :: TrailersMaker
defaultTrailersMaker Nothing = return $ Trailers []
defaultTrailersMaker _ = return $ NextTrailersMaker defaultTrailersMaker
-- | Either the next trailers maker or final trailers.
data NextTrailersMaker
= NextTrailersMaker TrailersMaker
| Trailers [H.Header]
----------------------------------------------------------------
-- | File specification.
data FileSpec = FileSpec FilePath FileOffset ByteCount deriving (Eq, Show)
----------------------------------------------------------------
{-
== Stream state
The stream state is stored in the 'streamState' field (an @IORef@) of a
'Stream'. The main place where the stream state is updated is in
'controlOrStream', which does something like this:
> state0 <- readStreamState strm
> state1 <- stream .. state0 ..
> processState .. state1 ..
where 'processState' updates the @IORef@, based on 'state1' (the state computed
by 'stream') and the /current/ state of the stream; for simplicity, we will
assume here that this must equal 'state0' (it might not, if a concurrent thread
changed the stream state).
The diagram below summarizes the stream state transitions on the client side,
omitting error cases (which result in exceptions being thrown). Each transition
is labelled with the relevant case in either the function 'stream' or the
function 'processState'.
> [Open JustOpened]
> |
> |
> HEADERS
> |
> | (stream1)
> |
> END_HEADERS?
> |
> ______/ \______
> / yes no \
> | |
> | [Open Continued] <--\
> | | |
> | CONTINUATION |
> | | |
> | | (stream5) |
> | | |
> | END_HEADERS? |
> | | |
> v yes / \ no |
> END_STREAM? <-------/ \-----------/
> | (process3)
> |
> _________/ \_________
> / yes no \
> | |
> [Open NoBody] [Open HasBody]
> | |
> | (process1) | (process2)
> | |
> [HalfClosedRemote] <--\ [Open Body] <----------------------\
> | | | |
> | | +---------------\ |
> RST_STREAM | | | |
> | | HEADERS DATA |
> | (stream6) | | | |
> | | | (stream2) | (stream4) |
> | (process5) | | | |
> | | END_STREAM? END_STREAM? |
> [Closed] | | | |
> | | yes yes / \ no |
> \--------+-------------/ \-----------/
> (process4) (process6)
Notes:
- The 'HalfClosedLocal' state is not used on the client side.
- Indeed, unless an exception is thrown, even the 'Closed' stream state is not
used in the client; when the @IORef@ is collected, it is typically in
'HalfClosedRemote' state.
-}
data OpenState
= JustOpened
| Continued
[HeaderBlockFragment]
Int -- Total size
Int -- The number of continuation frames
Bool -- End of stream
| NoBody HeaderTable
| HasBody HeaderTable
| Body
(TQueue (Either SomeException ByteString))
(Maybe Int) -- received Content-Length
-- compared the body length for error checking
(IORef Int) -- actual body length
(IORef (Maybe HeaderTable)) -- trailers
data ClosedCode
= Finished
| Killed
| Reset ErrorCode
| ResetByMe SomeException
deriving (Show)
closedCodeToError :: StreamId -> ClosedCode -> HTTP2Error
closedCodeToError sid cc =
case cc of
Finished -> ConnectionIsClosed
Killed -> ConnectionIsTimeout
Reset err -> ConnectionErrorIsReceived err sid "Connection was reset"
ResetByMe err -> BadThingHappen err
----------------------------------------------------------------
data StreamState
= Idle
| Open (Maybe ClosedCode) OpenState -- HalfClosedLocal if Just
| HalfClosedRemote
| Closed ClosedCode
| Reserved
instance Show StreamState where
show Idle = "Idle"
show (Open Nothing _) = "Open"
show (Open (Just e) _) = "HalfClosedLocal: " ++ show e
show HalfClosedRemote = "HalfClosedRemote"
show (Closed e) = "Closed: " ++ show e
show Reserved = "Reserved"
----------------------------------------------------------------
data Stream = Stream
{ streamNumber :: StreamId
, streamState :: IORef StreamState
, streamInput :: MVar (Either SomeException InpObj) -- Client only
, streamTxFlow :: TVar TxFlow
, streamRxFlow :: IORef RxFlow
}
instance Show Stream where
show Stream{..} =
"Stream{id="
++ show streamNumber
++ ",state="
++ show (unsafePerformIO (readIORef streamState))
++ "}"
----------------------------------------------------------------
data Input a = Input a InpObj
data Output a = Output
{ outputStream :: a
, outputObject :: OutObj
, outputType :: OutputType
, outputStrmQ :: Maybe (TBQueue StreamingChunk)
, outputSentinel :: IO ()
}
data OutputType
= OObj
| OWait (IO ())
| OPush TokenHeaderList StreamId -- associated stream id from client
| ONext DynaNext TrailersMaker
----------------------------------------------------------------
type DynaNext = Buffer -> BufferSize -> WindowSize -> IO Next
type BytesFilled = Int
data Next
= Next
BytesFilled -- payload length
Bool -- require flushing
(Maybe DynaNext)
----------------------------------------------------------------
data Control
= CFinish HTTP2Error
| CFrames (Maybe SettingsList) [ByteString]
| CGoaway ByteString (MVar ())
----------------------------------------------------------------
data StreamingChunk
= StreamingFinished (IO ())
| StreamingFlush
| StreamingBuilder Builder
----------------------------------------------------------------
type ReasonPhrase = ShortByteString
-- | The connection error or the stream error.
-- Stream errors are treated as connection errors since
-- there are no good recovery ways.
-- `ErrorCode` in connection errors should be the highest stream identifier
-- but in this implementation it identifies the stream that
-- caused this error.
data HTTP2Error
= ConnectionIsClosed -- NoError
| ConnectionIsTimeout
| ConnectionErrorIsReceived ErrorCode StreamId ReasonPhrase
| ConnectionErrorIsSent ErrorCode StreamId ReasonPhrase
| StreamErrorIsReceived ErrorCode StreamId
| StreamErrorIsSent ErrorCode StreamId ReasonPhrase
| BadThingHappen E.SomeException
| GoAwayIsSent
deriving (Show, Typeable)
instance E.Exception HTTP2Error
----------------------------------------------------------------
-- | Checking 'SettingsList' and reporting an error if any.
--
-- >>> checkSettingsList [(SettingsEnablePush,2)]
-- Just (ConnectionErrorIsSent ProtocolError 0 "enable push must be 0 or 1")
checkSettingsList :: SettingsList -> Maybe HTTP2Error
checkSettingsList settings = case mapMaybe checkSettingsValue settings of
[] -> Nothing
(x : _) -> Just x
checkSettingsValue :: (SettingsKey, SettingsValue) -> Maybe HTTP2Error
checkSettingsValue (SettingsEnablePush, v)
| v /= 0 && v /= 1 =
Just $ ConnectionErrorIsSent ProtocolError 0 "enable push must be 0 or 1"
checkSettingsValue (SettingsInitialWindowSize, v)
| v > maxWindowSize =
Just $
ConnectionErrorIsSent
FlowControlError
0
"Window size must be less than or equal to 65535"
checkSettingsValue (SettingsMaxFrameSize, v)
| v < defaultPayloadLength || v > maxPayloadLength =
Just $
ConnectionErrorIsSent
ProtocolError
0
"Max frame size must be in between 16384 and 16777215"
checkSettingsValue _ = Nothing
----------------------------------------------------------------
-- | HTTP/2 configuration.
data Config = Config
{ confWriteBuffer :: Buffer
-- ^ This is used only by frameSender.
-- This MUST be freed after frameSender is terminated.
, confBufferSize :: BufferSize
-- ^ The size of the write buffer.
-- We assume that the read buffer is the same size.
-- So, this value is announced via SETTINGS_MAX_FRAME_SIZE
-- to the peer.
, confSendAll :: ByteString -> IO ()
, confReadN :: Int -> IO ByteString
, confPositionReadMaker :: PositionReadMaker
, confTimeoutManager :: T.Manager
, confMySockAddr :: SockAddr
-- ^ This is copied into 'Aux', if exist, on server.
, confPeerSockAddr :: SockAddr
-- ^ This is copied into 'Aux', if exist, on server.
}
|