second-transfer 0.5.4.0 → 0.5.5.0
raw patch · 9 files changed
+580/−500 lines, 9 filesdep ~transformers
Dependency ranges changed: transformers
Files
- README.md +7/−0
- changelog.md +6/−2
- hs-src/SecondTransfer.hs +4/−1
- hs-src/SecondTransfer/Http2/Framer.hs +186/−177
- hs-src/SecondTransfer/Http2/Session.hs +283/−285
- hs-src/SecondTransfer/MainLoop.hs +15/−1
- hs-src/SecondTransfer/Utils/HTTPHeaders.hs +6/−0
- second-transfer.cabal +71/−33
- tests/tests-hs-src/hunit_tests.hs +2/−1
README.md view
@@ -62,3 +62,10 @@ - Epoll I/O management - Benchmarking.++Internal+--------++Uploading documentation (provided you have access to the package):++ $ ./hackage-upload-docs.sh second-transfer 0.5.4.0 <hackage-user> <hackage-password>
changelog.md view
@@ -1,10 +1,14 @@+- 0.5.5.0 :+ * Made HeaderEditor a Monoid instance+ * Trying to WINDOW_UPDATE an unexistent stream aborts the session, as it should+ - 0.5.4.0 : * Added the type HTTP500PrecursorException and corresponding test * Improved test suite so that requests can be simulated a little bit more easily * Re-export type Headers from module HTTPHeaders -- 0.5.3.2 : - * Added this changelog. +- 0.5.3.2 :+ * Added this changelog. * Fixed the lower limit for the time package. * Enforce first frame being a settings frame when receiving. * Added a couple of tests.
hs-src/SecondTransfer.hs view
@@ -152,17 +152,20 @@ ,Attendant ,http11Attendant ,http2Attendant++#ifndef DISABLE_OPENSSL_TLS -- * High level OpenSSL functions. -- -- | Use these functions to create your TLS-compliant -- HTTP/2 server in a snap. ,tlsServeWithALPN ,tlsServeWithALPNAndFinishOnRequest- ,dropIncomingData ,TLSLayerGenericProblem(..) ,FinishRequest(..)+#endif -- DISABLE_OPENSSL_TLS + ,dropIncomingData -- * Logging -- -- | The library uses hslogger for its logging. Since logging is
hs-src/SecondTransfer/Http2/Framer.hs view
@@ -1,6 +1,6 @@ -- The framer has two functions: to convert bytes to Frames and the other way around,--- and two keep track of flow-control quotas. -{-# LANGUAGE OverloadedStrings, StandaloneDeriving, FlexibleInstances, +-- and two keep track of flow-control quotas.+{-# LANGUAGE OverloadedStrings, StandaloneDeriving, FlexibleInstances, DeriveDataTypeable, TemplateHaskell #-} {-# OPTIONS_HADDOCK hide #-} module SecondTransfer.Http2.Framer (@@ -11,7 +11,7 @@ -- Not needed anywhere, but supress the warning about unneeded symbol closeAction- ) where + ) where @@ -20,6 +20,7 @@ import qualified Control.Exception as E import Control.Lens (view) import qualified Control.Lens as L+import Control.Monad (unless, when) import Control.Monad.IO.Class (liftIO) import qualified Control.Monad.Catch as C import Control.Monad.Trans.Class (lift)@@ -37,7 +38,7 @@ import qualified Data.HashTable.IO as H import SecondTransfer.Sessions.Internal (sessionExceptionHandler, nextSessionId, SessionsContext)-import SecondTransfer.Http2.Session +import SecondTransfer.Http2.Session import SecondTransfer.MainLoop.CoherentWorker (CoherentWorker) import qualified SecondTransfer.MainLoop.Framer as F import SecondTransfer.MainLoop.PushPullType (Attendant, CloseAction,@@ -52,7 +53,7 @@ http2PrefixLength :: Int http2PrefixLength = B.length NH2.connectionPreface --- Let's do flow control here here .... +-- Let's do flow control here here .... type HashTable k v = H.CuckooHashTable k v @@ -60,8 +61,8 @@ type GlobalStreamId = Int -data FlowControlCommand = - AddBytes_FCM Int +data FlowControlCommand =+ AddBytes_FCM Int -- A hashtable from stream id to channel of availabiliy increases type Stream2AvailSpace = HashTable GlobalStreamId (Chan FlowControlCommand)@@ -80,21 +81,21 @@ -- Wait variable to output bytes to the channel , _canOutput :: MVar CanOutput- -- Flag that says if the session has been unwound... if such, + -- Flag that says if the session has been unwound... if such, -- threads are adviced to exit as early as possible- , _outputIsForbidden :: MVar Bool + , _outputIsForbidden :: MVar Bool , _noHeadersInChannel :: MVar NoHeadersInChannel , _pushAction :: PushAction , _closeAction :: CloseAction -- Global id of the session, used for e.g. error reporting.- , _sessionId :: Int + , _sessionId :: Int -- Sessions context, used for thing like e.g. error reporting , _sessionsContext :: SessionsContext -- For GoAway frames- , _lastStream :: MVar Int + , _lastStream :: MVar Int } @@ -107,19 +108,21 @@ wrapSession :: CoherentWorker -> SessionsContext -> Attendant wrapSession coherent_worker sessions_context push_action pull_action close_action = do - let + let session_id_mvar = view nextSessionId sessions_context new_session_id <- modifyMVarMasked- session_id_mvar- (\ session_id -> return (session_id+1, session_id))+ session_id_mvar $+ \ session_id -> return (session_id+1, session_id) - (session_input, session_output) <- (http2Session - coherent_worker new_session_id sessions_context)+ (session_input, session_output) <- http2Session+ coherent_worker+ new_session_id+ sessions_context -- TODO : Add type annotations....- s2f <- H.new - s2o <- H.new + s2f <- H.new+ s2o <- H.new default_stream_size_mvar <- newMVar 65536 can_output <- newMVar CanOutput no_headers_in_channel <- newMVar NoHeadersInChannel@@ -127,12 +130,12 @@ output_is_forbidden <- newMVar False - -- We need some shared state + -- We need some shared state let framer_session_data = FramerSessionData { _stream2flow = s2f- ,_stream2outputBytes = s2o + ,_stream2outputBytes = s2o ,_defaultStreamWindow = default_stream_size_mvar- ,_canOutput = can_output + ,_canOutput = can_output ,_noHeadersInChannel = no_headers_in_channel ,_pushAction = push_action ,_closeAction = close_action@@ -143,16 +146,15 @@ } - let + let -- TODO: Dodgy exception handling here...- close_on_error session_id session_context comp = + close_on_error session_id session_context comp = E.finally (- E.catch(+ E.catch ( E.catch comp (exc_handler session_id session_context)- ) ) (io_exc_handler session_id session_context) )@@ -160,172 +162,168 @@ exc_handler :: Int -> SessionsContext -> FramerException -> IO () exc_handler x y e = do- modifyMVar_ output_is_forbidden (\ _ -> return True) + modifyMVar_ output_is_forbidden (\ _ -> return True) INSTRUMENTATION( errorM "HTTP2.Framer" "Exception went up" ) sessionExceptionHandler Framer_HTTP2SessionComponent x y e io_exc_handler :: Int -> SessionsContext -> IOProblem -> IO ()- io_exc_handler _x _y _e = do- modifyMVar_ output_is_forbidden (\ _ -> return True) + io_exc_handler _x _y _e =+ modifyMVar_ output_is_forbidden (\ _ -> return True) -- !!! These exceptions are way too common for we to care.... -- errorM "HTTP2.Framer" "Exception went up" -- sessionExceptionHandler Framer_HTTP2SessionComponent x y e - forkIO - $ close_on_error new_session_id sessions_context - $ runReaderT (inputGatherer pull_action session_input ) framer_session_data - forkIO - $ close_on_error new_session_id sessions_context - $ runReaderT (outputGatherer session_output ) framer_session_data + forkIO+ $ close_on_error new_session_id sessions_context+ $ runReaderT (inputGatherer pull_action session_input ) framer_session_data+ forkIO+ $ close_on_error new_session_id sessions_context+ $ runReaderT (outputGatherer session_output ) framer_session_data return () http2FrameLength :: F.LengthCallback-http2FrameLength bs - | (B.length bs) >= 3 = let+http2FrameLength bs+ | B.length bs >= 3 = let word24 = decode input_as_lbs :: Word24 input_as_lbs = LB.fromStrict bs- in - Just $ (word24ToInt word24) + 9 -- Nine bytes that the frame header always uses+ in+ Just $ word24ToInt word24 + 9 -- Nine bytes that the frame header always uses | otherwise = Nothing -addCapacity :: +addCapacity :: GlobalStreamId ->- Int -> - FramerSession ()-addCapacity stream_id delta_cap = do -- if stream_id == 0 - then - -- TODO: Add session flow control- return ()- else do- table <- view stream2flow + Int ->+ FramerSession Bool+addCapacity 0 delta_cap =+ -- TODO: Implement session flow control+ return True+addCapacity stream_id delta_cap =+ do+ table <- view stream2flow val <- liftIO $ H.lookup table stream_id- case val of - Nothing -> do- -- TODO: There is a very important compliance note here. Fix this, otherwise- -- a peer can create a memory overflow by sending WindowUpdate on unexistent- -- streams.- liftIO $ putStrLn $ "Tried to update window of unexistent stream (creating): " ++ (show stream_id)- (_, command_chan) <- startStreamOutputQueue stream_id - -- And try again- liftIO $ writeChan command_chan $ AddBytes_FCM delta_cap-+ case val of+ Nothing -> return False Just command_chan -> do liftIO $ writeChan command_chan $ AddBytes_FCM delta_cap- + return True + -- This works by pulling bytes from the input side of the pipeline and converting them to frames.--- The frames are then put in the SessionInput. In the other end of the SessionInput they can be --- interpreted according to their HTTP/2 meaning. --- +-- The frames are then put in the SessionInput. In the other end of the SessionInput they can be+-- interpreted according to their HTTP/2 meaning.+-- -- This function also does part of the flow control: it registers WindowUpdate frames and triggers--- quota updates on the streams. +-- quota updates on the streams. inputGatherer :: PullAction -> SessionInput -> FramerSession ()-inputGatherer pull_action session_input = do +inputGatherer pull_action session_input = do -- We can start by reading off the prefix.... (prefix, remaining) <- liftIO $ F.readLength http2PrefixLength pull_action-- if prefix /= NH2.connectionPreface - then do + if prefix /= NH2.connectionPreface+ then do sendGoAwayFrame NH2.ProtocolError- liftIO $ do + liftIO $ -- We just the the GoAway frame, although this is awfully early -- and probably wrong throwIO BadPrefaceException- else + else INSTRUMENTATION( debugM "HTTP2.Framer" "Prologue validated" )- let + let source::Source FramerSession B.ByteString source = transPipe liftIO $ F.readNextChunk http2FrameLength remaining pull_action- ( source $$ consume True)- where + source $$ consume True+ where sendToSession :: Bool -> InputFrame -> IO ()- sendToSession starting frame = if starting - then do- sendFirstFrameToSession session_input frame - else do- sendMiddleFrameToSession session_input frame+ sendToSession starting frame =+ -- print(NH2.streamId $ NH2.frameHeader frame)+ if starting+ then+ sendFirstFrameToSession session_input frame+ else+ sendMiddleFrameToSession session_input frame + abortSession :: Sink B.ByteString FramerSession ()+ abortSession =+ lift $ do+ sendGoAwayFrame NH2.ProtocolError+ -- Inform the session that it can tear down itself+ liftIO $ sendCommandToSession session_input CancelSession_SIC+ -- Any resources remaining here can be disposed+ releaseFramer+ consume_continue = consume False consume :: Bool -> Sink B.ByteString FramerSession ()- consume starting = do - maybe_bytes <- await + consume starting = do+ maybe_bytes <- await - case maybe_bytes of + case maybe_bytes of Just bytes -> do- let + let error_or_frame = NH2.decodeFrame some_settings bytes -- TODO: See how we can change these.... some_settings = NH2.defaultSettings - case error_or_frame of + case error_or_frame of - Left _ -> do - -- Got an error from the decoder... meaning that a frame could - -- not be decoded.... in this case we send a cancel session command - -- to the session. + Left _ -> do+ -- Got an error from the decoder... meaning that a frame could+ -- not be decoded.... in this case we send a cancel session command+ -- to the session. INSTRUMENTATION( errorM "HTTP2.Framer" "CouldNotDecodeFrame" ) -- Send frames like GoAway and such...- lift $ sendGoAwayFrame NH2.ProtocolError- -- Inform the session that it can tear down itself- liftIO $ sendCommandToSession session_input CancelSession_SIC- -- Any resources remaining here can be disposed- lift $ releaseFramer- -- And end this thread+ abortSession Right right_frame -> do- case right_frame of + case right_frame of - (NH2.Frame (NH2.FrameHeader _ _ stream_id) (NH2.WindowUpdateFrame credit) ) -> do + (NH2.Frame (NH2.FrameHeader _ _ stream_id) (NH2.WindowUpdateFrame credit) ) -> do -- Bookkeep the increase on bytes on that stream -- liftIO $ putStrLn $ "Extra capacity for stream " ++ (show stream_id)- lift $ addCapacity (NH2.fromStreamIdentifier stream_id) (fromIntegral credit)- return ()+ succeeded <- lift $ addCapacity (NH2.fromStreamIdentifier stream_id) (fromIntegral credit)+ unless succeeded abortSession - frame@(NH2.Frame _ (NH2.SettingsFrame settings_list) ) -> do + frame@(NH2.Frame _ (NH2.SettingsFrame settings_list) ) -> do -- Increase all the stuff....- case find (\(i,_) -> i == NH2.SettingsInitialWindowSize) settings_list of + case find (\(i,_) -> i == NH2.SettingsInitialWindowSize) settings_list of - Just (_, new_default_stream_size) -> do + Just (_, new_default_stream_size) -> do old_default_stream_size_mvar <- view defaultStreamWindow old_default_stream_size <- liftIO $ takeMVar old_default_stream_size_mvar let general_delta = new_default_stream_size - old_default_stream_size stream_to_flow <- view stream2flow -- Add capacity to everybody's windows- liftIO $ - H.mapM_ (- \ (k,v) -> if k /=0 - then writeChan v (AddBytes_FCM general_delta) - else return () )+ liftIO $+ H.mapM_ (\ (k,v) ->+ when (k /=0 ) $ writeChan v (AddBytes_FCM general_delta)+ ) stream_to_flow - -- And set a new value + -- And set a new value liftIO $ putMVar old_default_stream_size_mvar new_default_stream_size - Nothing -> + Nothing -> -- This is a silenced internal error return () -- And send the frame down to the session, so that session specific settings- -- can be applied. + -- can be applied. liftIO $ sendToSession starting frame - a_frame@(NH2.Frame (NH2.FrameHeader _ _ stream_id) _ ) -> do - -- Update the keep of last stream - lift $ updateLastStream $ NH2.fromStreamIdentifier stream_id+ a_frame@(NH2.Frame (NH2.FrameHeader _ _ stream_id) _ ) -> do+ -- Update the keep of last stream+ lift . startStreamOutputQueueIfNotExists $ NH2.fromStreamIdentifier stream_id+ lift . updateLastStream $ NH2.fromStreamIdentifier stream_id -- Send frame to the session liftIO $ sendToSession starting a_frame@@ -333,51 +331,51 @@ -- tail recursion: go again... consume_continue - Nothing -> + Nothing -> -- We may as well exit this thread return () -- All the output frames come this way first outputGatherer :: SessionOutput -> FramerSession ()-outputGatherer session_output = do +outputGatherer session_output = do - -- We start by sending a settings frame - pushFrame + -- We start by sending a settings frame+ pushFrame (NH2.EncodeInfo NH2.defaultFlags (NH2.toStreamIdentifier 0) Nothing) (NH2.SettingsFrame []) loopPart - where + where - dataForFrame p1 p2 = + dataForFrame p1 p2 = LB.fromStrict $ NH2.encodeFrame p1 p2 loopPart :: FramerSession ()- loopPart = do + loopPart = do command_or_frame <- liftIO $ getFrameFromSession session_output- case command_or_frame of + case command_or_frame of - Left CancelSession_SOC -> do + Left CancelSession_SOC -> do -- The session wants to cancel things INSTRUMENTATION( debugM "HTTP2.Framer" "CancelSession_SOC processed") releaseFramer Right ( p1@(NH2.EncodeInfo _ stream_idii _), p2@(NH2.DataFrame _) ) -> do -- This frame is flow-controlled... I may be unable to send this frame in- -- some circumstances... + -- some circumstances... let stream_id = NH2.fromStreamIdentifier stream_idii s2o <- view stream2outputBytes- lookup_result <- liftIO $ H.lookup s2o stream_id - stream_bytes_chan <- case lookup_result of + lookup_result <- liftIO $ H.lookup s2o stream_id+ stream_bytes_chan <- case lookup_result of - Nothing -> do + Nothing -> do (bc, _) <- startStreamOutputQueue stream_id return bc - Just bytes_chan -> return bytes_chan + Just bytes_chan -> return bytes_chan liftIO $ writeChan stream_bytes_chan $ dataForFrame p1 p2 loopPart@@ -390,53 +388,65 @@ handleHeadersOfStream p1 p2 loopPart - Right (p1, p2) -> do + Right (p1, p2) -> do -- Most other frames go right away... as long as no headers are in process... no_headers <- view noHeadersInChannel liftIO $ takeMVar no_headers- pushFrame p1 p2 + pushFrame p1 p2 liftIO $ putMVar no_headers NoHeadersInChannel loopPart updateLastStream :: GlobalStreamId -> FramerSession ()-updateLastStream stream_id = do +updateLastStream stream_id = do last_stream_id_mvar <- view lastStream liftIO $ modifyMVar_ last_stream_id_mvar (\ x -> return $ max x stream_id) +startStreamOutputQueueIfNotExists :: GlobalStreamId -> FramerSession ()+startStreamOutputQueueIfNotExists stream_id = do+ table <- view stream2flow+ val <- liftIO $ H.lookup table stream_id+ case val of+ Nothing | stream_id /= 0 -> do+ startStreamOutputQueue stream_id+ return () + _ ->+ return ()++ startStreamOutputQueue :: Int -> FramerSession (Chan LB.ByteString, Chan FlowControlCommand) startStreamOutputQueue stream_id = do -- New thread for handling outputs of this stream is needed- bytes_chan <- liftIO newChan - command_chan <- liftIO newChan + bytes_chan <- liftIO newChan+ command_chan <- liftIO newChan s2o <- view stream2outputBytes - liftIO $ H.insert s2o stream_id bytes_chan + liftIO $ H.insert s2o stream_id bytes_chan s2c <- view stream2flow liftIO $ H.insert s2c stream_id command_chan - -- + -- initial_cap_mvar <- view defaultStreamWindow initial_cap <- liftIO $ readMVar initial_cap_mvar close_action <- view closeAction- sessions_context <- view sessionsContext + sessions_context <- view sessionsContext session_id' <- view SecondTransfer.Http2.Framer.sessionId- output_is_forbidden_mvar <- view outputIsForbidden + output_is_forbidden_mvar <- view outputIsForbidden -- And don't forget the thread itself- let - close_on_error session_id session_context comp = - E.finally - (E.catch + let+ close_on_error session_id session_context comp =+ E.finally+ (E.catch comp (exc_handler session_id session_context)- ) + ) close_action exc_handler :: Int -> SessionsContext -> IOProblem -> IO ()@@ -446,7 +456,7 @@ sessionExceptionHandler Framer_HTTP2SessionComponent x y e - read_state <- ask + read_state <- ask liftIO $ forkIO $ close_on_error session_id' sessions_context $ runReaderT (flowControlOutput stream_id initial_cap "" command_chan bytes_chan) read_state@@ -454,34 +464,34 @@ return (bytes_chan , command_chan) --- This works in the output side of the HTTP/2 framing session, and it acts as a --- semaphore ensuring that headers are output without any interleaved frames. --- +-- This works in the output side of the HTTP/2 framing session, and it acts as a+-- semaphore ensuring that headers are output without any interleaved frames.+-- -- There are more synchronization mechanisms in the session... handleHeadersOfStream :: NH2.EncodeInfo -> NH2.FramePayload -> FramerSession ()-handleHeadersOfStream p1@(NH2.EncodeInfo _ _ _) frame_payload- | (frameIsHeadersAndOpensStream frame_payload) && (not $ frameEndsHeaders p1 frame_payload) = do- -- Take it +handleHeadersOfStream p1@(NH2.EncodeInfo {}) frame_payload+ | frameIsHeadersAndOpensStream frame_payload && not (frameEndsHeaders p1 frame_payload) = do+ -- Take it no_headers <- view noHeadersInChannel liftIO $ takeMVar no_headers- pushFrame p1 frame_payload - -- DONT PUT THE MvAR HERE + pushFrame p1 frame_payload+ -- DONT PUT THE MvAR HERE - | (frameIsHeadersAndOpensStream frame_payload) && (frameEndsHeaders p1 frame_payload) = do+ | frameIsHeadersAndOpensStream frame_payload && frameEndsHeaders p1 frame_payload = do no_headers <- view noHeadersInChannel liftIO $ takeMVar no_headers- pushFrame p1 frame_payload - -- Since we finish.... + pushFrame p1 frame_payload+ -- Since we finish.... liftIO $ putMVar no_headers NoHeadersInChannel - | frameEndsHeaders p1 frame_payload = do + | frameEndsHeaders p1 frame_payload = do -- I can only get here for a continuation frame after something else that is a headers no_headers <- view noHeadersInChannel pushFrame p1 frame_payload liftIO $ putMVar no_headers NoHeadersInChannel return () - | otherwise = do + | otherwise = -- Nothing to do with the mvar, the no_headers should be empty pushFrame p1 frame_payload @@ -489,22 +499,22 @@ frameIsHeadersAndOpensStream :: NH2.FramePayload -> Bool frameIsHeadersAndOpensStream (NH2.HeadersFrame _ _ ) = True-frameIsHeadersAndOpensStream _ - = False +frameIsHeadersAndOpensStream _+ = False -frameEndsHeaders :: NH2.EncodeInfo -> NH2.FramePayload -> Bool +frameEndsHeaders :: NH2.EncodeInfo -> NH2.FramePayload -> Bool frameEndsHeaders (NH2.EncodeInfo flags _ _) (NH2.HeadersFrame _ _) = NH2.testEndHeader flags frameEndsHeaders (NH2.EncodeInfo flags _ _) (NH2.ContinuationFrame _) = NH2.testEndHeader flags frameEndsHeaders _ _ = False --- Push a frame into the output channel... this waits for the --- channel to be free to send. +-- Push a frame into the output channel... this waits for the+-- channel to be free to send. pushFrame :: NH2.EncodeInfo -> NH2.FramePayload -> FramerSession () pushFrame p1 p2 = do- let bs = LB.fromStrict $ NH2.encodeFrame p1 p2 + let bs = LB.fromStrict $ NH2.encodeFrame p1 p2 sendBytes bs @@ -519,32 +529,31 @@ sendBytes :: LB.ByteString -> FramerSession () sendBytes bs = do push_action <- view pushAction- can_output <- view canOutput - liftIO $ do - bs `seq` - (C.bracket + can_output <- view canOutput+ liftIO $+ bs `seq`+ C.bracket (takeMVar can_output)- (\ _ -> push_action bs)- (\ c -> putMVar can_output c)- )+ (const $ push_action bs)+ (putMVar can_output) -- A thread in charge of doing flow control transmission....This sends already--- formatted frames (ByteStrings), not the frames themselves. And it doesn't +-- formatted frames (ByteStrings), not the frames themselves. And it doesn't -- mess with the structure of the packets.-flowControlOutput :: Int -> Int -> LB.ByteString -> (Chan FlowControlCommand) -> (Chan LB.ByteString) -> FramerSession ()-flowControlOutput stream_id capacity leftovers commands_chan bytes_chan = do - if leftovers == "" +flowControlOutput :: Int -> Int -> LB.ByteString -> Chan FlowControlCommand -> Chan LB.ByteString -> FramerSession ()+flowControlOutput stream_id capacity leftovers commands_chan bytes_chan =+ if leftovers == "" then do -- Get more data (possibly block waiting for it) bytes_to_send <- liftIO $ readChan bytes_chan flowControlOutput stream_id capacity bytes_to_send commands_chan bytes_chan else do -- Length?- let amount = fromIntegral $ ((LB.length leftovers) - 9)- if amount <= capacity + let amount = fromIntegral (LB.length leftovers - 9)+ if amount <= capacity then do- -- Is + -- Is -- I can send ... if no headers are in process.... no_headers <- view noHeadersInChannel C.bracket@@ -553,17 +562,17 @@ (\ _ -> sendBytes leftovers ) flowControlOutput stream_id (capacity - amount) "" commands_chan bytes_chan else do- -- I can not send because flow-control is full, wait for a command instead + -- I can not send because flow-control is full, wait for a command instead -- liftIO $ putStrLn $ "Warning: channel flow-saturated " ++ (show stream_id) command <- liftIO $ readChan commands_chan- case command of - AddBytes_FCM delta_cap -> do + case command of+ AddBytes_FCM delta_cap -> -- liftIO $ putStrLn $ "Flow control delta_cap stream " ++ (show stream_id) flowControlOutput stream_id (capacity + delta_cap) leftovers commands_chan bytes_chan releaseFramer :: FramerSession ()-releaseFramer = do +releaseFramer = -- Release any resources pending... return ()
hs-src/SecondTransfer/Http2/Session.hs view
@@ -1,5 +1,5 @@ -- Session: links frames to streams, and helps in ordering the header frames--- so that they don't get mixed with header frames from other streams when +-- so that they don't get mixed with header frames from other streams when -- resources are being served concurrently. {-# LANGUAGE FlexibleContexts, Rank2Types, TemplateHaskell, OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-}@@ -51,7 +51,7 @@ #endif import Control.Lens- + -- No framing layer here... let's use Kazu's Yamamoto library import qualified Network.HPACK as HP import qualified Network.HTTP2 as NH2@@ -69,26 +69,26 @@ import qualified SecondTransfer.Utils.HTTPHeaders as He import SecondTransfer.MainLoop.Logging (logWithExclusivity) --- Unfortunately the frame encoding API of Network.HTTP2 is a bit difficult to --- use :-( +-- Unfortunately the frame encoding API of Network.HTTP2 is a bit difficult to+-- use :-( type OutputFrame = (NH2.EncodeInfo, NH2.FramePayload) type InputFrame = NH2.Frame -useChunkLength :: Int +useChunkLength :: Int useChunkLength = 16384 -- Singleton instance used for concurrency-data HeadersSent = HeadersSent +data HeadersSent = HeadersSent -- All streams put their data bits here. A "Nothing" value signals--- end of data. +-- end of data. type DataOutputToConveyor = (GlobalStreamId, Maybe B.ByteString) --- Whatever a worker thread is going to need comes here.... --- this is to make refactoring easier, but not strictly needed. +-- Whatever a worker thread is going to need comes here....+-- this is to make refactoring easier, but not strictly needed. data WorkerThreadEnvironment = WorkerThreadEnvironment { -- What's the header stream id? _streamId :: GlobalStreamId@@ -99,7 +99,7 @@ , _headersOutput :: Chan (GlobalStreamId, MVar HeadersSent, Headers) -- And regular contents can come this way and thus be properly mixed- -- with everything else.... for now... + -- with everything else.... for now... ,_dataOutput :: Chan DataOutputToConveyor ,_streamsCancelled_WTE :: MVar NS.IntSet@@ -109,11 +109,11 @@ makeLenses ''WorkerThreadEnvironment --- An HTTP/2 session. Basically a couple of channels ... +-- An HTTP/2 session. Basically a couple of channels ... type Session = (SessionInput, SessionOutput) --- From outside, one can only write to this one ... the newtype is to enforce +-- From outside, one can only write to this one ... the newtype is to enforce -- this. newtype SessionInput = SessionInput ( Chan SessionInputCommand ) sendMiddleFrameToSession :: SessionInput -> InputFrame -> IO ()@@ -125,9 +125,9 @@ sendCommandToSession :: SessionInput -> SessionInputCommand -> IO () sendCommandToSession (SessionInput chan) command = writeChan chan command --- From outside, one can only read from this one +-- From outside, one can only read from this one newtype SessionOutput = SessionOutput ( Chan (Either SessionOutputCommand OutputFrame) )-getFrameFromSession :: SessionOutput -> IO (Either SessionOutputCommand OutputFrame) +getFrameFromSession :: SessionOutput -> IO (Either SessionOutputCommand OutputFrame) getFrameFromSession (SessionOutput chan) = readChan chan @@ -137,38 +137,38 @@ type Stream2HeaderBlockFragment = HashTable GlobalStreamId Bu.Builder -type WorkerMonad = ReaderT WorkerThreadEnvironment IO +type WorkerMonad = ReaderT WorkerThreadEnvironment IO -- Have to figure out which are these...but I would expect to have things -- like unexpected aborts here in this type.-data SessionInputCommand = +data SessionInputCommand = FirstFrame_SIC InputFrame -- This frame is special |MiddleFrame_SIC InputFrame -- Ordinary frame |InternalAbort_SIC -- Internal abort from the session itself |CancelSession_SIC -- Cancel request from the framer- deriving Show + deriving Show -- temporary-data SessionOutputCommand = +data SessionOutputCommand = CancelSession_SOC deriving Show --- Here is how we make a session +-- Here is how we make a session type SessionMaker = SessionsContext -> IO Session -- Here is how we make a session wrapping a CoherentWorker-type CoherentSession = CoherentWorker -> SessionMaker +type CoherentSession = CoherentWorker -> SessionMaker data PostInputMechanism = PostInputMechanism (Chan (Maybe B.ByteString), InputDataStream) -- Settings imposed by the peer data SessionSettings = SessionSettings {- _pushEnabled :: Bool + _pushEnabled :: Bool } makeLenses ''SessionSettings@@ -177,26 +177,26 @@ -- NH2.Frame != Frame data SessionData = SessionData { -- ATTENTION: Ignore the warning coming from here for now- _sessionsContext :: SessionsContext + _sessionsContext :: SessionsContext ,_sessionInput :: Chan SessionInputCommand - -- We need to lock this channel occassionally so that we can order multiple - -- header frames properly.... + -- We need to lock this channel occassionally so that we can order multiple+ -- header frames properly.... ,_sessionOutput :: MVar (Chan (Either SessionOutputCommand OutputFrame)) - -- Use to encode + -- Use to encode ,_toEncodeHeaders :: MVar HP.DynamicTable -- And used to decode ,_toDecodeHeaders :: MVar HP.DynamicTable- -- While I'm receiving headers, anything which - -- is not a header should end in the connection being - -- closed + -- While I'm receiving headers, anything which+ -- is not a header should end in the connection being+ -- closed ,_receivingHeaders :: MVar (Maybe Int)- -- _lastGoodStream is used both to report the last good stream in the - -- GoAwayFrame and to keep track of streams oppened by the client. In - -- other words, it contains the stream_id of the last valid client - -- stream and is updated as soon as the first frame of that stream is + -- _lastGoodStream is used both to report the last good stream in the+ -- GoAwayFrame and to keep track of streams oppened by the client. In+ -- other words, it contains the stream_id of the last valid client+ -- stream and is updated as soon as the first frame of that stream is -- received. ,_lastGoodStream :: MVar Int @@ -204,21 +204,21 @@ ,_stream2HeaderBlockFragment :: Stream2HeaderBlockFragment -- Used for worker threads... this is actually a pre-filled template- -- I make copies of it in different contexts, and as needed. + -- I make copies of it in different contexts, and as needed. ,_forWorkerThread :: WorkerThreadEnvironment ,_coherentWorker :: CoherentWorker - -- Some streams may be cancelled + -- Some streams may be cancelled ,_streamsCancelled :: MVar NS.IntSet -- Data input mechanism corresponding to some threads- ,_stream2PostInputMechanism :: HashTable Int PostInputMechanism + ,_stream2PostInputMechanism :: HashTable Int PostInputMechanism - -- Worker thread register. This is a dictionary from stream id to - -- the ThreadId of the thread with the worker thread. I use this to - -- raise asynchronous exceptions in the worker thread if the stream - -- is cancelled by the client. This way we get early finalization. + -- Worker thread register. This is a dictionary from stream id to+ -- the ThreadId of the thread with the worker thread. I use this to+ -- raise asynchronous exceptions in the worker thread if the stream+ -- is cancelled by the client. This way we get early finalization. ,_stream2WorkerThread :: HashTable Int ThreadId -- Use to retrieve/set the session id@@ -234,7 +234,7 @@ -- v- {headers table size comes here!!} http2Session :: CoherentWorker -> Int -> SessionsContext -> IO Session-http2Session coherent_worker session_id sessions_context = do +http2Session coherent_worker session_id sessions_context = do session_input <- newChan session_output <- newChan session_output_mvar <- newMVar session_output@@ -251,11 +251,11 @@ encode_headers_table_mvar <- newMVar encode_headers_table -- These ones need independent threads taking care of sending stuff- -- their way... + -- their way... headers_output <- newChan :: IO (Chan (GlobalStreamId, MVar HeadersSent, Headers)) data_output <- newChan :: IO (Chan DataOutputToConveyor) - stream2postinputmechanism <- H.new + stream2postinputmechanism <- H.new stream2workerthread <- H.new last_good_stream_mvar <- newMVar (-1) @@ -266,7 +266,7 @@ cancelled_streams_mvar <- newMVar $ NS.empty :: IO (MVar NS.IntSet) let for_worker_thread = WorkerThreadEnvironment {- _streamId = error "NotInitialized" + _streamId = error "NotInitialized" ,_headersOutput = headers_output ,_dataOutput = data_output ,_streamsCancelled_WTE = cancelled_streams_mvar@@ -274,7 +274,7 @@ let session_data = SessionData { _sessionsContext = sessions_context- ,_sessionInput = session_input + ,_sessionInput = session_input ,_sessionOutput = session_output_mvar ,_toDecodeHeaders = decode_headers_table_mvar ,_toEncodeHeaders = encode_headers_table_mvar@@ -290,31 +290,31 @@ ,_lastGoodStream = last_good_stream_mvar } - let - exc_handler :: SessionComponent -> HTTP2SessionException -> IO () + let+ exc_handler :: SessionComponent -> HTTP2SessionException -> IO () exc_handler component e = sessionExceptionHandler component session_id sessions_context e exc_guard :: SessionComponent -> IO () -> IO ()- exc_guard component action = E.catch - action - (\e -> do + exc_guard component action = E.catch+ action+ (\e -> do INSTRUMENTATION( errorM "HTTP2.Session" "Exception processed" )- exc_handler component e + exc_handler component e ) -- Create an input thread that decodes frames...- forkIO $ exc_guard SessionInputThread_HTTP2SessionComponent + forkIO $ exc_guard SessionInputThread_HTTP2SessionComponent $ runReaderT sessionInputThread session_data- - -- Create a thread that captures headers and sends them down the tube - forkIO $ exc_guard SessionHeadersOutputThread_HTTP2SessionComponent ++ -- Create a thread that captures headers and sends them down the tube+ forkIO $ exc_guard SessionHeadersOutputThread_HTTP2SessionComponent $ runReaderT (headersOutputThread headers_output session_output_mvar) session_data -- Create a thread that captures data and sends it down the tube- forkIO $ exc_guard SessionDataOutputThread_HTTP2SessionComponent + forkIO $ exc_guard SessionDataOutputThread_HTTP2SessionComponent $ dataOutputThread data_output session_output_mvar -- The two previous threads fill the session_output argument below (they write to it)- -- the session machinery in the other end is in charge of sending that data through the + -- the session machinery in the other end is in charge of sending that data through the -- socket. return ( (SessionInput session_input),@@ -324,15 +324,15 @@ -- TODO: Some ill clients can break this thread with exceptions. Make these paths a bit --- more robust. sessionInputThread :: ReaderT SessionData IO ()-sessionInputThread = do +sessionInputThread = do INSTRUMENTATION( debugM "HTTP2.Session" "Entering sessionInputThread" ) -- This is an introductory and declarative block... all of this is tail-executed -- every time that a packet needs to be processed. It may be a good idea to abstract- -- these values in a closure... - session_input <- view sessionInput - - decode_headers_table_mvar <- view toDecodeHeaders + -- these values in a closure...+ session_input <- view sessionInput++ decode_headers_table_mvar <- view toDecodeHeaders stream_request_headers <- view stream2HeaderBlockFragment cancelled_streams_mvar <- view streamsCancelled coherent_worker <- view coherentWorker@@ -344,34 +344,34 @@ input <- liftIO $ readChan session_input - case input of + case input of - FirstFrame_SIC (NH2.Frame - (NH2.FrameHeader _ 1 null_stream_id ) _ )| NH2.toStreamIdentifier 0 == null_stream_id -> do + FirstFrame_SIC (NH2.Frame+ (NH2.FrameHeader _ 1 null_stream_id ) _ )| NH2.toStreamIdentifier 0 == null_stream_id -> do -- This is a SETTINGS ACK frame, which is okej to have, -- do nothing here- continue + continue - FirstFrame_SIC - (NH2.Frame - (NH2.FrameHeader _ 0 null_stream_id ) - (NH2.SettingsFrame settings_list) - ) | NH2.toStreamIdentifier 0 == null_stream_id -> do - -- Good, handle + FirstFrame_SIC+ (NH2.Frame+ (NH2.FrameHeader _ 0 null_stream_id )+ (NH2.SettingsFrame settings_list)+ ) | NH2.toStreamIdentifier 0 == null_stream_id -> do+ -- Good, handle handleSettingsFrame settings_list- continue + continue - FirstFrame_SIC _ -> do - -- Bad, incorrect id or god knows only what .... + FirstFrame_SIC _ -> do+ -- Bad, incorrect id or god knows only what .... closeConnectionBecauseIsInvalid NH2.ProtocolError return () - CancelSession_SIC -> do + CancelSession_SIC -> do -- Good place to tear down worker threads... Let the rest of the finalization -- to the framer. -- -- This message is normally got from the Framer- liftIO $ do + liftIO $ do H.mapM_ (\ (_, thread_id) -> do throwTo thread_id StreamCancelledException@@ -382,151 +382,151 @@ -- We do not continue here, but instead let it finish return () - InternalAbort_SIC -> do - -- Message triggered because the worker failed to behave. - -- When this is sent, the connection is closed - closeConnectionBecauseIsInvalid NH2.InternalError + InternalAbort_SIC -> do+ -- Message triggered because the worker failed to behave.+ -- When this is sent, the connection is closed+ closeConnectionBecauseIsInvalid NH2.InternalError return () - -- The block below will process both HEADERS and CONTINUATION frames. - -- TODO: As it stands now, the server will happily start a new stream with - -- a CONTINUATION frame instead of a HEADERS frame. That's against the + -- The block below will process both HEADERS and CONTINUATION frames.+ -- TODO: As it stands now, the server will happily start a new stream with+ -- a CONTINUATION frame instead of a HEADERS frame. That's against the -- protocol.- MiddleFrame_SIC frame | Just (stream_id, bytes) <- isAboutHeaders frame -> do + MiddleFrame_SIC frame | Just (stream_id, bytes) <- isAboutHeaders frame -> do -- Just append the frames to streamRequestHeaders opens_stream <- appendHeaderFragmentBlock stream_id bytes - if opens_stream - then do + if opens_stream+ then do maybe_rcv_headers_of <- liftIO $ takeMVar receiving_headers_mvar- case maybe_rcv_headers_of of - Just _ -> do - -- Bad client, it is already sending headers + case maybe_rcv_headers_of of+ Just _ -> do+ -- Bad client, it is already sending headers -- and trying to open another one closeConnectionBecauseIsInvalid NH2.ProtocolError -- An exception will be thrown above, so to not complicate -- control flow here too much.- Nothing -> do + Nothing -> do -- Signal that we are receiving headers now, for this stream liftIO $ putMVar receiving_headers_mvar (Just stream_id) -- And go to check if the stream id is valid last_good_stream <- liftIO $ takeMVar last_good_stream_mvar- if (odd stream_id ) && (stream_id > last_good_stream) - then do + if (odd stream_id ) && (stream_id > last_good_stream)+ then do -- We are golden, set the new good stream liftIO $ putMVar last_good_stream_mvar (stream_id)- else do + else do -- We are not golden INSTRUMENTATION( errorM "HTTP2.Session" "Protocol error: bad stream id") closeConnectionBecauseIsInvalid NH2.ProtocolError- else do + else do maybe_rcv_headers_of <- liftIO $ takeMVar receiving_headers_mvar- case maybe_rcv_headers_of of - Just a_stream_id | a_stream_id == stream_id -> do - -- Nothing to complain about + case maybe_rcv_headers_of of+ Just a_stream_id | a_stream_id == stream_id -> do+ -- Nothing to complain about liftIO $ putMVar receiving_headers_mvar maybe_rcv_headers_of Nothing -> error "InternalError, this should be set" - if frameEndsHeaders frame then + if frameEndsHeaders frame then do- -- Ok, let it be known that we are not receiving more headers - liftIO $ modifyMVar_ + -- Ok, let it be known that we are not receiving more headers+ liftIO $ modifyMVar_ receiving_headers_mvar- (\ _ -> return Nothing ) + (\ _ -> return Nothing ) -- Let's decode the headers- let for_worker_thread = set streamId stream_id for_worker_thread_uns + let for_worker_thread = set streamId stream_id for_worker_thread_uns headers_bytes <- getHeaderBytes stream_id dyn_table <- liftIO $ takeMVar decode_headers_table_mvar (new_table, header_list ) <- liftIO $ HP.decodeHeader dyn_table headers_bytes -- Good moment to remove the headers from the table.... we don't want a space- -- leak here - liftIO $ do + -- leak here+ liftIO $ do H.delete stream_request_headers stream_id putMVar decode_headers_table_mvar new_table -- TODO: Validate headers, abort session if the headers are invalid. -- Otherwise other invariants will break!! -- THIS IS PROBABLY THE BEST PLACE FOR DOING IT.- let - headers_editor = He.fromList header_list + let+ headers_editor = He.fromList header_list maybe_good_headers_editor <- validateIncomingHeaders headers_editor - good_headers <- case maybe_good_headers_editor of + good_headers <- case maybe_good_headers_editor of Just yes_they_are_good -> return yes_they_are_good Nothing -> closeConnectionBecauseIsInvalid NH2.ProtocolError -- Add any extra headers, on demand headers_extra_good <- addExtraHeaders good_headers- let + let header_list_after = He.toList headers_extra_good -- liftIO $ putStrLn $ "header list after " ++ (show header_list_after) - -- If the headers end the request.... + -- If the headers end the request.... post_data_source <- if not (frameEndsStream frame)- then do - mechanism <- createMechanismForStream stream_id + then do+ mechanism <- createMechanismForStream stream_id let source = postDataSourceFromMechanism mechanism return $ Just source- else do + else do return Nothing - -- TODO: Handle the cases where a request tries to send data + -- TODO: Handle the cases where a request tries to send data -- even if the method doesn't allow for data. -- I'm clear to start the worker, in its own thread- -- - -- NOTE: Some late internal errors from the worker thread are + --+ -- NOTE: Some late internal errors from the worker thread are -- handled here by clossing the session. -- -- TODO: Log exceptions handled here.- liftIO $ do - thread_id <- forkIO $ E.catch - (runReaderT + liftIO $ do+ thread_id <- forkIO $ E.catch+ (runReaderT (workerThread (header_list_after, post_data_source) coherent_worker)- for_worker_thread + for_worker_thread )- ( - ( \ _ -> do + (+ ( \ _ -> do -- Actions to take when the thread breaks.... writeChan session_input InternalAbort_SIC- ) - :: HTTP500PrecursorException -> IO () + )+ :: HTTP500PrecursorException -> IO () ) H.insert stream2workerthread stream_id thread_id return ()- else + else -- Frame doesn't end the headers... it was added before... so- -- probably do nothing + -- probably do nothing return ()- - continue + continue+ MiddleFrame_SIC frame@(NH2.Frame _ (NH2.RSTStreamFrame _error_code_id)) -> do let stream_id = streamIdFromFrame frame- liftIO $ do + liftIO $ do INSTRUMENTATION( infoM "HTTP2.Session" $ "Stream reset: " ++ (show _error_code_id) ) cancelled_streams <- takeMVar cancelled_streams_mvar INSTRUMENTATION( infoM "HTTP2.Session" $ "Cancelled stream was: " ++ (show stream_id) ) putMVar cancelled_streams_mvar $ NS.insert stream_id cancelled_streams maybe_thread_id <- H.lookup stream2workerthread stream_id- case maybe_thread_id of - Nothing -> - -- This is actually more like an internal error, when this - -- happend, cancel the session+ case maybe_thread_id of+ Nothing ->+ -- This is actually more like an internal error, when this+ -- happens, cancel the session error "InterruptingUnexistentStream" Just thread_id -> do INSTRUMENTATION( infoM "HTTP2.Session" $ "Stream successfully interrupted" ) throwTo thread_id StreamCancelledException - continue + continue - MiddleFrame_SIC frame@(NH2.Frame (NH2.FrameHeader _ _ nh2_stream_id) (NH2.DataFrame somebytes)) - -> unlessReceivingHeaders $ do + MiddleFrame_SIC frame@(NH2.Frame (NH2.FrameHeader _ _ nh2_stream_id) (NH2.DataFrame somebytes))+ -> unlessReceivingHeaders $ do -- So I got data to process -- TODO: Handle end of stream let stream_id = NH2.fromStreamIdentifier nh2_stream_id@@ -560,59 +560,59 @@ ) (NH2.WindowUpdateFrame (fromIntegral (B.length somebytes))- ) + ) - if frameEndsStream frame - then do - -- Good place to close the source ... - closePostDataSource stream_id - else + if frameEndsStream frame+ then do+ -- Good place to close the source ...+ closePostDataSource stream_id+ else return () - continue + continue - MiddleFrame_SIC (NH2.Frame (NH2.FrameHeader _ flags _) (NH2.PingFrame _)) | NH2.testAck flags-> do + MiddleFrame_SIC (NH2.Frame (NH2.FrameHeader _ flags _) (NH2.PingFrame _)) | NH2.testAck flags-> do -- Deal with pings: this is an Ack, so do nothing- continue + continue - MiddleFrame_SIC (NH2.Frame (NH2.FrameHeader _ _ _) (NH2.PingFrame somebytes)) -> do + MiddleFrame_SIC (NH2.Frame (NH2.FrameHeader _ _ _) (NH2.PingFrame somebytes)) -> do -- Deal with pings: NOT an Ack, so answer INSTRUMENTATION( debugM "HTTP2.Session" "Ping processed" ) sendOutFrame (NH2.EncodeInfo (NH2.setAck NH2.defaultFlags) (NH2.toStreamIdentifier 0)- Nothing + Nothing ) (NH2.PingFrame somebytes) - continue + continue - MiddleFrame_SIC (NH2.Frame frame_header (NH2.SettingsFrame _)) | isSettingsAck frame_header -> do + MiddleFrame_SIC (NH2.Frame frame_header (NH2.SettingsFrame _)) | isSettingsAck frame_header -> do -- Frame was received by the peer, do nothing here...- continue + continue -- TODO: Do something with these settings!!- MiddleFrame_SIC (NH2.Frame _ (NH2.SettingsFrame settings_list)) -> do + MiddleFrame_SIC (NH2.Frame _ (NH2.SettingsFrame settings_list)) -> do INSTRUMENTATION( debugM "HTTP2.Session" $ "Received settings: " ++ (show settings_list) )- -- Just acknowledge the frame.... for now + -- Just acknowledge the frame.... for now handleSettingsFrame settings_list- continue + continue - MiddleFrame_SIC somethingelse -> unlessReceivingHeaders $ do + MiddleFrame_SIC somethingelse -> unlessReceivingHeaders $ do -- An undhandled case here.... INSTRUMENTATION( errorM "HTTP2.Session" $ "Received problematic frame: " ) INSTRUMENTATION( errorM "HTTP2.Session" $ ".. " ++ (show somethingelse) ) - continue + continue - where + where continue = sessionInputThread -- TODO: Do use the settings!!! handleSettingsFrame :: NH2.SettingsList -> ReaderT SessionData IO ()- handleSettingsFrame _settings_list = - sendOutFrame + handleSettingsFrame _settings_list =+ sendOutFrame (NH2.EncodeInfo (NH2.setAck NH2.defaultFlags) (NH2.toStreamIdentifier 0)@@ -623,22 +623,22 @@ sendOutFrame :: NH2.EncodeInfo -> NH2.FramePayload -> ReaderT SessionData IO ()-sendOutFrame encode_info payload = do - session_output_mvar <- view sessionOutput +sendOutFrame encode_info payload = do+ session_output_mvar <- view sessionOutput session_output <- liftIO $ takeMVar session_output_mvar liftIO $ writeChan session_output $ Right (encode_info, payload) liftIO $ putMVar session_output_mvar session_output --- TODO: This function, but using the headers editor, triggers --- some renormalization of the header order. A good thing, if +-- TODO: This function, but using the headers editor, triggers+-- some renormalization of the header order. A good thing, if -- I get that order well enough.... addExtraHeaders :: He.HeaderEditor -> ReaderT SessionData IO He.HeaderEditor addExtraHeaders headers_editor = do- let + let enriched_lens = (sessionsContext . sessionsConfig .sessionsEnrichedHeaders )- -- TODO: Figure out which is the best way to put this contact in the + -- TODO: Figure out which is the best way to put this contact in the -- source code protocol_lens = He.headerLens "second-transfer-eh--used-protocol" @@ -646,53 +646,53 @@ -- liftIO $ putStrLn $ "AAA" ++ (show add_used_protocol) - let - he1 = if add_used_protocol + let+ he1 = if add_used_protocol then set protocol_lens (Just "HTTP/2") headers_editor else headers_editor - if add_used_protocol + if add_used_protocol -- Nothing will be computed here if the headers are not modified. then return he1 else return headers_editor validateIncomingHeaders :: He.HeaderEditor -> ReaderT SessionData IO (Maybe He.HeaderEditor)-validateIncomingHeaders headers_editor = do - -- Check that the headers block comes with all mandatory headers. +validateIncomingHeaders headers_editor = do+ -- Check that the headers block comes with all mandatory headers. -- Right now I'm not checking that they come in the mandatory order though...- -- + -- -- Notice that this function will transform a "host" header to an ":authority" -- one.- let + let h1 = He.replaceHostByAuthority headers_editor -- Check that headers are lowercase headers_are_lowercase = He.headersAreLowercaseAtHeaderEditor headers_editor- -- Check that we have mandatory headers + -- Check that we have mandatory headers maybe_authority = h1 ^. (He.headerLens ":authority") maybe_method = h1 ^. (He.headerLens ":method") maybe_scheme = h1 ^. (He.headerLens ":scheme") maybe_path = h1 ^. (He.headerLens ":path") - if - (isJust maybe_authority) && - (isJust maybe_method) && - (isJust maybe_scheme) && - (isJust maybe_path ) - then + if+ (isJust maybe_authority) &&+ (isJust maybe_method) &&+ (isJust maybe_scheme) &&+ (isJust maybe_path )+ then return (Just h1)- else - return Nothing + else+ return Nothing --- Sends a GO_AWAY frame and raises an exception, effectively terminating the input --- thread of the session. +-- Sends a GO_AWAY frame and raises an exception, effectively terminating the input+-- thread of the session. closeConnectionBecauseIsInvalid :: NH2.ErrorCodeId -> ReaderT SessionData IO a-closeConnectionBecauseIsInvalid error_code = do +closeConnectionBecauseIsInvalid error_code = do -- liftIO $ errorM "HTTP2.Session" "closeConnectionBecauseIsInvalid called!" last_good_stream_mvar <- view lastGoodStream last_good_stream <- liftIO $ takeMVar last_good_stream_mvar- session_output_mvar <- view sessionOutput + session_output_mvar <- view sessionOutput stream2workerthread <- view stream2WorkerThread sendOutFrame (NH2.EncodeInfo@@ -704,53 +704,53 @@ (NH2.toStreamIdentifier last_good_stream) error_code ""- ) - - liftIO $ do + )++ liftIO $ do -- Close all active threads for this session H.mapM_- ( \(_stream_id, thread_id) -> + ( \(_stream_id, thread_id) -> throwTo thread_id StreamCancelledException ) stream2workerthread - -- Notify the framer that the session is closing, so - -- that it stops accepting frames from connected sources + -- Notify the framer that the session is closing, so+ -- that it stops accepting frames from connected sources -- (Streams?) session_output <- takeMVar session_output_mvar writeChan session_output $ Left CancelSession_SOC putMVar session_output_mvar session_output - -- And unwind the input thread in the session, so that the - -- exception handler runs.... + -- And unwind the input thread in the session, so that the+ -- exception handler runs.... E.throw HTTP2ProtocolException -frameEndsStream :: InputFrame -> Bool +frameEndsStream :: InputFrame -> Bool frameEndsStream (NH2.Frame (NH2.FrameHeader _ flags _) _) = NH2.testEndStream flags --- Executes its argument, unless receiving +-- Executes its argument, unless receiving -- headers, in which case the connection is closed. unlessReceivingHeaders :: ReaderT SessionData IO a -> ReaderT SessionData IO a-unlessReceivingHeaders comp = do +unlessReceivingHeaders comp = do receiving_headers_mvar <- view receivingHeaders -- First check if we are receiving headers maybe_recv_headers <- liftIO $ readMVar receiving_headers_mvar- if isJust maybe_recv_headers - then + if isJust maybe_recv_headers+ then -- So, this frame is highly illegal closeConnectionBecauseIsInvalid NH2.ProtocolError- else + else comp createMechanismForStream :: GlobalStreamId -> ReaderT SessionData IO PostInputMechanism-createMechanismForStream stream_id = do +createMechanismForStream stream_id = do (chan, source) <- liftIO $ unfoldChannelAndSource stream2postinputmechanism <- view stream2PostInputMechanism let pim = PostInputMechanism (chan, source)- liftIO $ H.insert stream2postinputmechanism stream_id pim + liftIO $ H.insert stream2postinputmechanism stream_id pim return pim @@ -758,40 +758,40 @@ -- TODO IMPORTANT: This is a good place to drop the postinputmechanism -- for a stream, so that unprocessed data can be garbage-collected. closePostDataSource :: GlobalStreamId -> ReaderT SessionData IO ()-closePostDataSource stream_id = do +closePostDataSource stream_id = do stream2postinputmechanism <- view stream2PostInputMechanism - pim_maybe <- liftIO $ H.lookup stream2postinputmechanism stream_id + pim_maybe <- liftIO $ H.lookup stream2postinputmechanism stream_id - case pim_maybe of + case pim_maybe of - Just (PostInputMechanism (chan, _)) -> + Just (PostInputMechanism (chan, _)) -> liftIO $ writeChan chan Nothing - Nothing -> + Nothing -> -- TODO: This is a protocol error, handle it properly error "Internal error/closePostDataSource" streamWorkerSendData :: Int -> B.ByteString -> ReaderT SessionData IO ()-streamWorkerSendData stream_id bytes = do +streamWorkerSendData stream_id bytes = do s2pim <- view stream2PostInputMechanism- pim_maybe <- liftIO $ H.lookup s2pim stream_id + pim_maybe <- liftIO $ H.lookup s2pim stream_id - case pim_maybe of + case pim_maybe of - Just pim -> + Just pim -> sendBytesToPim pim bytes - Nothing -> - -- This is an internal error, the mechanism should be - -- created when the headers end (and if the headers + Nothing ->+ -- This is an internal error, the mechanism should be+ -- created when the headers end (and if the headers -- do not finish the stream) error "Internal error" sendBytesToPim :: PostInputMechanism -> B.ByteString -> ReaderT SessionData IO ()-sendBytesToPim (PostInputMechanism (chan, _)) bytes = +sendBytesToPim (PostInputMechanism (chan, _)) bytes = liftIO $ writeChan chan (Just bytes) @@ -799,26 +799,26 @@ postDataSourceFromMechanism (PostInputMechanism (_, source)) = source -isSettingsAck :: NH2.FrameHeader -> Bool -isSettingsAck (NH2.FrameHeader _ flags _) = +isSettingsAck :: NH2.FrameHeader -> Bool+isSettingsAck (NH2.FrameHeader _ flags _) = NH2.testAck flags -isStreamCancelled :: GlobalStreamId -> WorkerMonad Bool -isStreamCancelled stream_id = do +isStreamCancelled :: GlobalStreamId -> WorkerMonad Bool+isStreamCancelled stream_id = do cancelled_streams_mvar <- view streamsCancelled_WTE cancelled_streams <- liftIO $ readMVar cancelled_streams_mvar return $ NS.member stream_id cancelled_streams sendPrimitive500Error :: IO PrincipalStream-sendPrimitive500Error = +sendPrimitive500Error = return ( [ (":status", "500") ], [],- do + do yield "Internal server error\n" -- No footers return []@@ -836,15 +836,15 @@ -- throws an exception signaling that the request is ill-formed -- and should be dropped? That could happen in a couple of occassions, -- but really most cases should be handled here in this file...- (headers, _, data_and_conclussion) <- - liftIO $ E.catch - ( do - (h, x, d) <- coherent_worker req + (headers, _, data_and_conclussion) <-+ liftIO $ E.catch+ ( do+ (h, x, d) <- coherent_worker req return $! (h,x,d) )- ( - (\ _ -> sendPrimitive500Error ) - :: HTTP500PrecursorException -> IO (Headers, PushedStreams, DataAndConclusion) + (+ (\ _ -> sendPrimitive500Error )+ :: HTTP500PrecursorException -> IO (Headers, PushedStreams, DataAndConclusion) ) -- Now I send the headers, if that's possible at all@@ -852,7 +852,7 @@ liftIO $ writeChan headers_output (stream_id, headers_sent, headers) -- At this moment I should ask if the stream hasn't been cancelled by the browser before- -- commiting to the work of sending addtitional data... this is important for pushed + -- commiting to the work of sending addtitional data... this is important for pushed -- streams is_stream_cancelled <- isStreamCancelled stream_id if not is_stream_cancelled@@ -861,18 +861,18 @@ -- I have a beautiful source that I can de-construct... -- TODO: Optionally pulling data out from a Conduit .... -- liftIO ( data_and_conclussion $$ (_sendDataOfStream stream_id) )- -- + -- -- This threadlet should block here waiting for the headers to finish going- -- NOTE: Exceptions generated here inheriting from HTTP500PrecursorException + -- NOTE: Exceptions generated here inheriting from HTTP500PrecursorException -- are let to bubble and managed in this thread fork point... (_maybe_footers, _) <- runConduit $- (transPipe liftIO data_and_conclussion) - `fuseBothMaybe` + (transPipe liftIO data_and_conclussion)+ `fuseBothMaybe` (sendDataOfStream stream_id headers_sent)- -- BIG TODO: Send the footers ... likely stream conclusion semantics - -- will need to be changed. + -- BIG TODO: Send the footers ... likely stream conclusion semantics+ -- will need to be changed. return ()- else + else return () @@ -883,11 +883,11 @@ -- Wait for all headers sent liftIO $ takeMVar headers_sent consumer data_output- where - consumer data_output = do - maybe_bytes <- await - case maybe_bytes of - Nothing -> + where+ consumer data_output = do+ maybe_bytes <- await+ case maybe_bytes of+ Nothing -> liftIO $ writeChan data_output (stream_id, Nothing) Just bytes -> do liftIO $ writeChan data_output (stream_id, Just bytes)@@ -896,24 +896,24 @@ -- Returns if the frame is the first in the stream appendHeaderFragmentBlock :: GlobalStreamId -> B.ByteString -> ReaderT SessionData IO Bool-appendHeaderFragmentBlock global_stream_id bytes = do - ht <- view stream2HeaderBlockFragment +appendHeaderFragmentBlock global_stream_id bytes = do+ ht <- view stream2HeaderBlockFragment maybe_old_block <- liftIO $ H.lookup ht global_stream_id- (new_block, new_stream) <- case maybe_old_block of + (new_block, new_stream) <- case maybe_old_block of Nothing -> do -- TODO: Make the commented message below more informative return $ (Bu.byteString bytes, True) - Just something -> + Just something -> return $ (something `mappend` (Bu.byteString bytes), False) liftIO $ H.insert ht global_stream_id new_block return new_stream getHeaderBytes :: GlobalStreamId -> ReaderT SessionData IO B.ByteString-getHeaderBytes global_stream_id = do - ht <- view stream2HeaderBlockFragment +getHeaderBytes global_stream_id = do+ ht <- view stream2HeaderBlockFragment Just bytes <- liftIO $ H.lookup ht global_stream_id return $ Bl.toStrict $ Bu.toLazyByteString bytes @@ -923,11 +923,11 @@ = Just (NH2.fromStreamIdentifier stream_id, block_fragment) isAboutHeaders (NH2.Frame (NH2.FrameHeader _ _ stream_id) ( NH2.ContinuationFrame block_fragment) ) = Just (NH2.fromStreamIdentifier stream_id, block_fragment)-isAboutHeaders _ - = Nothing +isAboutHeaders _+ = Nothing -frameEndsHeaders :: InputFrame -> Bool +frameEndsHeaders :: InputFrame -> Bool frameEndsHeaders (NH2.Frame (NH2.FrameHeader _ flags _) _) = NH2.testEndHeader flags @@ -938,9 +938,9 @@ -- TODO: Have different size for the headers..... just now going with a default size of 16 k... -- TODO: Find a way to kill this thread.... headersOutputThread :: Chan (GlobalStreamId, MVar HeadersSent, Headers)- -> MVar (Chan (Either SessionOutputCommand OutputFrame)) + -> MVar (Chan (Either SessionOutputCommand OutputFrame)) -> ReaderT SessionData IO ()-headersOutputThread input_chan session_output_mvar = forever $ do +headersOutputThread input_chan session_output_mvar = forever $ do (stream_id, headers_ready_mvar, headers) <- liftIO $ readChan input_chan -- First encode the headers using the table@@ -950,7 +950,7 @@ (new_dyn_table, data_to_send ) <- liftIO $ HP.encodeHeader HP.defaultEncodeStrategy encode_dyn_table headers liftIO $ putMVar encode_dyn_table_mvar new_dyn_table - -- Now split the bytestring in chunks of the needed size.... + -- Now split the bytestring in chunks of the needed size.... bs_chunks <- return $! bytestringChunk useChunkLength data_to_send -- And send the chunks through while locking the output place....@@ -959,29 +959,29 @@ (putMVar session_output_mvar ) (\ session_output -> do writeIndividualHeaderFrames session_output stream_id bs_chunks True- -- And say that the headers for this thread are out + -- And say that the headers for this thread are out -- INSTRUMENTATION( debugM "HTTP2.Session" $ "Headers were output for stream " ++ (show stream_id) ) putMVar headers_ready_mvar HeadersSent- ) - where - writeIndividualHeaderFrames :: + )+ where+ writeIndividualHeaderFrames :: Chan (Either SessionOutputCommand OutputFrame)- -> GlobalStreamId - -> [B.ByteString] - -> Bool + -> GlobalStreamId+ -> [B.ByteString]+ -> Bool -> IO ()- writeIndividualHeaderFrames session_output stream_id (last_fragment:[]) is_first = + writeIndividualHeaderFrames session_output stream_id (last_fragment:[]) is_first = writeChan session_output $ Right ( NH2.EncodeInfo {- NH2.encodeFlags = NH2.setEndHeader NH2.defaultFlags - ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id - ,NH2.encodePadding = Nothing }, + NH2.encodeFlags = NH2.setEndHeader NH2.defaultFlags+ ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id+ ,NH2.encodePadding = Nothing }, (if is_first then NH2.HeadersFrame Nothing last_fragment else NH2.ContinuationFrame last_fragment) )- writeIndividualHeaderFrames session_output stream_id (fragment:xs) is_first = do + writeIndividualHeaderFrames session_output stream_id (fragment:xs) is_first = do writeChan session_output $ Right ( NH2.EncodeInfo {- NH2.encodeFlags = NH2.defaultFlags - ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id - ,NH2.encodePadding = Nothing }, + NH2.encodeFlags = NH2.defaultFlags+ ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id+ ,NH2.encodePadding = Nothing }, (if is_first then NH2.HeadersFrame Nothing fragment else NH2.ContinuationFrame fragment) ) writeIndividualHeaderFrames session_output stream_id xs False@@ -990,55 +990,53 @@ bytestringChunk :: Int -> B.ByteString -> [B.ByteString] bytestringChunk len s | (B.length s) < len = [ s ] bytestringChunk len s = h:(bytestringChunk len xs)- where - (h, xs) = B.splitAt len s + where+ (h, xs) = B.splitAt len s -- TODO: find a clean way to finish this thread (maybe with negative stream ids?) -- TODO: This function does non-optimal chunking for the case where responses are--- actually streamed.... in those cases we need to keep state for frames in --- some other format.... +-- actually streamed.... in those cases we need to keep state for frames in+-- some other format.... -- TODO: Right now, we are transmitting an empty last frame with the end-of-stream -- flag set. I'm afraid that the only -- way to avoid that is by holding a frame or by augmenting the end-user interface -- so that the user can signal which one is the last frame. The first approach -- restricts responsiviness, the second one clutters things. dataOutputThread :: Chan DataOutputToConveyor- -> MVar (Chan (Either SessionOutputCommand OutputFrame)) + -> MVar (Chan (Either SessionOutputCommand OutputFrame)) -> IO ()-dataOutputThread input_chan session_output_mvar = forever $ do +dataOutputThread input_chan session_output_mvar = forever $ do (stream_id, maybe_contents) <- readChan input_chan- case maybe_contents of + case maybe_contents of Nothing -> do liftIO $ do withLockedSessionOutput (\ session_output -> writeChan session_output $ Right ( NH2.EncodeInfo { NH2.encodeFlags = NH2.setEndStream NH2.defaultFlags- ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id - ,NH2.encodePadding = Nothing }, + ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id+ ,NH2.encodePadding = Nothing }, NH2.DataFrame "" ) ) - Just contents -> do + Just contents -> do -- And now just simply output it... let bs_chunks = bytestringChunk useChunkLength $! contents -- And send the chunks through while locking the output place.... writeContinuations bs_chunks stream_id- - where - withLockedSessionOutput = E.bracket - (takeMVar session_output_mvar) + where++ withLockedSessionOutput = E.bracket+ (takeMVar session_output_mvar) (putMVar session_output_mvar) -- <-- There is an implicit argument there!! writeContinuations :: [B.ByteString] -> GlobalStreamId -> IO ()- writeContinuations fragments stream_id = mapM_ (\ fragment -> + writeContinuations fragments stream_id = mapM_ (\ fragment -> withLockedSessionOutput (\ session_output -> writeChan session_output $ Right ( NH2.EncodeInfo {- NH2.encodeFlags = NH2.defaultFlags - ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id - ,NH2.encodePadding = Nothing }, + NH2.encodeFlags = NH2.defaultFlags+ ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id+ ,NH2.encodePadding = Nothing }, NH2.DataFrame fragment ) ) ) fragments--
hs-src/SecondTransfer/MainLoop.hs view
@@ -1,17 +1,31 @@ module SecondTransfer.MainLoop (++#ifndef DISABLE_OPENSSL_TLS -- * High level OpenSSL functions. -- -- | Use these functions to create your TLS-compliant -- HTTP/2 server in a snap. tlsServeWithALPN ,tlsServeWithALPNAndFinishOnRequest+#endif - ,enableConsoleLogging+#ifndef DISABLE_OPENSSL_TLS+ ,+#endif + enableConsoleLogging++#ifndef DISABLE_OPENSSL_TLS ,TLSLayerGenericProblem(..) ,FinishRequest(..)+#endif+ ) where +-- We don't need this module in the test suite, and stackage doesn't have a good +-- enough OpenSSL library yet+#ifndef DISABLE_OPENSSL_TLS import SecondTransfer.MainLoop.OpenSSL_TLS+#endif import SecondTransfer.MainLoop.Logging (enableConsoleLogging)
hs-src/SecondTransfer/Utils/HTTPHeaders.hs view
@@ -45,11 +45,13 @@ import qualified Data.Map.Strict as Ms import Data.Word (Word8) + import Data.Time.Format (formatTime, defaultTimeLocale) import Data.Time.Clock (getCurrentTime) #ifndef IMPLICIT_MONOID import Control.Applicative ((<$>))+import Data.Monoid #endif import SecondTransfer.MainLoop.CoherentWorker (Headers)@@ -111,6 +113,10 @@ -- The underlying representation admits better asymptotics. newtype HeaderEditor = HeaderEditor { innerMap :: Ms.Map Autosorted B.ByteString } +-- This is a pretty uninteresting instance+instance Monoid HeaderEditor where + mempty = HeaderEditor mempty+ mappend (HeaderEditor x) (HeaderEditor y) = HeaderEditor (x `mappend` y) -- | /O(n*log n)/ Builds the editor from a list. fromList :: Headers -> HeaderEditor
second-transfer.cabal view
@@ -1,13 +1,13 @@ name : second-transfer --- The package version. See the Haskell package versioning policy (PVP) +-- The package version. See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version : 0.5.4.0+version : 0.5.5.0 synopsis : Second Transfer HTTP/2 web server @@ -23,7 +23,7 @@ maintainer : alcidesv@zunzun.se -copyright : Copyright 2015, Alcides Viamontes Esquivel +copyright : Copyright 2015, Alcides Viamontes Esquivel category : Network @@ -33,7 +33,7 @@ build-type : Simple --- Extra files to be distributed with the package-- such as examples or a +-- Extra files to be distributed with the package-- such as examples or a -- README. extra-source-files: README.md changelog.md @@ -42,8 +42,8 @@ extra-source-files: macros/Logging.cpphs -Flag debug - Description: Enable debug support +Flag debug+ Description: Enable debug support Default: False source-repository head@@ -53,7 +53,7 @@ source-repository this type: git location: git@github.com:alcidesv/second-transfer.git- tag: 0.5.4.0+ tag: 0.5.5.0 library @@ -65,8 +65,8 @@ , SecondTransfer.Types , SecondTransfer.Utils.HTTPHeaders , SecondTransfer.Utils.DevNull- -- These are really internal modules, but are exposed - -- here for the sake of the test suite. They are hidden + -- These are really internal modules, but are exposed+ -- here for the sake of the test suite. They are hidden -- from the documentation. , SecondTransfer.MainLoop.Internal , SecondTransfer.Sessions@@ -77,8 +77,8 @@ , SecondTransfer.MainLoop.PushPullType , SecondTransfer.MainLoop.Tokens , SecondTransfer.MainLoop.Framer- , SecondTransfer.MainLoop.Logging - , SecondTransfer.Sessions.Internal + , SecondTransfer.MainLoop.Logging+ , SecondTransfer.Sessions.Internal , SecondTransfer.MainLoop.OpenSSL_TLS , SecondTransfer.Utils@@ -105,8 +105,8 @@ CPP-Options: -DIMPLICIT_MONOID -DIMPLICIT_APPLICATIVE_FOLDABLE -- LANGUAGE extensions used by modules in this package.- -- other-extensions: - + -- other-extensions:+ -- Other library packages from which modules are imported. build-depends: base >= 4.7 && <= 4.9, exceptions >= 0.8 && < 0.9,@@ -126,16 +126,16 @@ hashable >= 1.2, attoparsec >= 0.12, time >= 1.5.0 && < 1.8- + -- Directories containing source files. hs-source-dirs: hs-src- + -- Base language which the package is written in. default-language: Haskell2010 - -- Very specific directory with the version of openssl - -- that I'm using. As of February 2015-- this one is not - -- commonly installed + -- Very specific directory with the version of openssl+ -- that I'm using. As of February 2015-- this one is not+ -- commonly installed include-dirs: /opt/openssl-1.0.2/include c-sources: cbits/tlsinc.c@@ -149,7 +149,7 @@ -- ghc-options: -O2 -cpp -pgmPcpphs -optP--cpp ghc-options: -pgmPcpphs -optP--cpp- + extra-libraries: ssl crypto -- NOTICE: Please fill-in with an-up-to date library path here@@ -172,17 +172,55 @@ Test-Suite hunit-tests- type : exitcode-stdio-1.0- main-is : hunit_tests.hs- hs-source-dirs : tests/tests-hs-src- default-language: Haskell2010- build-depends : base >=4.7 && <= 4.9 - ,second-transfer- ,conduit >= 1.2.4- ,lens >= 4.7- ,HUnit >= 1.2 && < 1.5- ,bytestring >= 0.10.4.0- ,http2 == 0.9.1- ,transformers >= 0.3- ghc-options : -threaded- other-modules : SecondTransfer.Test.DecoySession+ type : exitcode-stdio-1.0+ main-is : hunit_tests.hs+ hs-source-dirs : tests/tests-hs-src, hs-src/+ default-language : Haskell2010+ build-depends : base >=4.7 && <= 4.9+ ,conduit >= 1.2.4+ ,lens >= 4.7+ ,HUnit >= 1.2 && < 1.5+ ,bytestring >= 0.10.4.0+ ,http2 == 0.9.1+ ,exceptions >= 0.8 && < 0.9+ ,base16-bytestring >= 0.1.1+ ,network >= 2.6 && < 2.7+ ,text >= 1.2 && < 1.3+ ,binary >= 0.7.1.0+ ,containers >= 0.5.5+ ,transformers >=0.3 && <= 0.5+ ,network-uri >= 2.6 && < 2.7+ ,hashtables >= 1.2 && < 1.3+ ,hslogger >= 1.2.6+ ,hashable >= 1.2+ ,attoparsec >= 0.12+ ,time >= 1.5.0 && < 1.8+ build-tools : cpphs+ default-extensions : CPP+ include-dirs : macros/+ CPP-Options : -DDISABLE_OPENSSL_TLS+ ghc-options : -threaded -pgmPcpphs -optP--cpp+ other-modules : SecondTransfer.Test.DecoySession+ , SecondTransfer+ , SecondTransfer.MainLoop+ , SecondTransfer.Http2+ , SecondTransfer.Http1+ , SecondTransfer.Exception+ , SecondTransfer.Types+ , SecondTransfer.Utils.HTTPHeaders+ , SecondTransfer.Utils.DevNull+ , SecondTransfer.MainLoop.Internal+ , SecondTransfer.Sessions+ , SecondTransfer.Sessions.Config+ , SecondTransfer.Http1.Parse+ , SecondTransfer.MainLoop.CoherentWorker+ , SecondTransfer.MainLoop.PushPullType+ , SecondTransfer.MainLoop.Tokens+ , SecondTransfer.MainLoop.Framer+ , SecondTransfer.MainLoop.Logging+ , SecondTransfer.Sessions.Internal+ , SecondTransfer.Utils+ , SecondTransfer.Http2.Framer+ , SecondTransfer.Http2.MakeAttendant+ , SecondTransfer.Http2.Session+ , SecondTransfer.Http1.Session
tests/tests-hs-src/hunit_tests.hs view
@@ -25,7 +25,8 @@ TestLabel "testFirstFrameIsSettings2" testFirstFrameMustBeSettings2, TestLabel "testFirstFrameIsSettings3" testFirstFrameMustBeSettings3, TestLabel "testIGet500Status" testIGet500Status,- TestLabel "testSessionBreaksOnLateError" testSessionBreaksOnLateError+ TestLabel "testSessionBreaksOnLateError" testSessionBreaksOnLateError,+ TestLabel "WindowUpdate to unexistent stream" testUpdateWindowFrameAborts ]