# 1 "hs-src/SecondTransfer/Http1/Session.cpphs"
# 1 "<command-line>"
# 14 "<command-line>"
# 1 "/usr/include/stdc-predef.h" 1 3 4
# 17 "/usr/include/stdc-predef.h" 3 4
# 14 "<command-line>" 2
# 1 "./dist/build/autogen/cabal_macros.h" 1
# 14 "<command-line>" 2
# 1 "hs-src/SecondTransfer/Http1/Session.cpphs"
module SecondTransfer.Http1.Session(
http11Attendant
) where
import Control.Exception (catch)
import Control.Concurrent (forkIO)
import qualified Data.ByteString as B
import Data.Conduit
import Data.Conduit.List (consume)
import SecondTransfer.MainLoop.CoherentWorker (CoherentWorker,)
import SecondTransfer.MainLoop.PushPullType (Attendant)
import SecondTransfer.Sessions.Internal (SessionsContext, acquireNewSessionTag)
import System.Log.Logger
import SecondTransfer.Http1.Parse
import SecondTransfer.Exception (IOProblem)
http11Attendant :: SessionsContext -> CoherentWorker -> Attendant
http11Attendant sessions_context coherent_worker
push_action pull_action close_action
= do
new_session_tag <- acquireNewSessionTag sessions_context
infoM "Session.Session_HTTP11" $ "Starting new session with tag: " ++(show new_session_tag)
forkIO $ go new_session_tag (Just "")
return ()
where
go :: Int -> Maybe B.ByteString -> IO ()
go session_tag (Just leftovers) = do
infoM "Session.Session_HTTP11" $ "(Re)Using session with tag: " ++(show session_tag)
maybe_leftovers <- add_data newIncrementalHttp1Parser leftovers session_tag
go session_tag maybe_leftovers
go _ Nothing =
return ()
add_data :: IncrementalHttp1Parser -> B.ByteString -> Int -> IO (Maybe B.ByteString)
add_data parser bytes session_tag = do
let
completion = addBytes parser bytes
case completion of
MustContinue_H1PC new_parser -> do
catch
(do
new_bytes <- pull_action
r <- add_data new_parser new_bytes session_tag
return r
)
( (\ _e -> do
debugM "Session.HTTP1" "Could not receive data"
close_action
return Nothing
) :: IOProblem -> IO (Maybe B.ByteString) )
OnlyHeaders_H1PC headers leftovers -> do
(response_headers, _, data_and_conclusion) <- coherent_worker (headers, Nothing)
(_, fragments) <- runConduit $ fuseBoth data_and_conclusion consume
let
response_text =
serializeHTTPResponse response_headers fragments
catch
(do
push_action response_text
return $ Just leftovers
)
((\ _e -> do
debugM "Session.HTTP1" "Session abandoned"
close_action
return Nothing
) :: IOProblem -> IO (Maybe B.ByteString) )
HeadersAndBody_H1PC _headers _stopcondition _recv_leftovers -> do
close_action
error "NotImplemented requests with bodies"