{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP2.Server.Run where
import Control.Concurrent (forkIO, killThread)
import qualified Control.Exception as E
import Imports
import Network.HTTP2
import Network.HTTP2.Server.API
import Network.HTTP2.Server.EncodeFrame
import Network.HTTP2.Server.Manager
import Network.HTTP2.Server.Receiver
import Network.HTTP2.Server.Sender
import Network.HTTP2.Server.Worker
import Network.HTTP2.Server.Context
run :: Config -> Server -> IO ()
run conf@Config{..} server = do
ok <- checkPreface
when ok $ do
ctx <- newContext
mgr <- start
setAction mgr $ worker ctx mgr server
replicateM_ 3 $ spawnAction mgr
tid <- forkIO $ frameReceiver ctx confReadN
frameSender ctx conf mgr `E.finally` do
clearContext ctx
stop mgr
killThread tid
where
checkPreface = do
preface <- confReadN connectionPrefaceLength
if connectionPreface /= preface then do
goaway conf ProtocolError "Preface mismatch"
return False
else
return True
goaway :: Config -> ErrorCodeId -> ByteString -> IO ()
goaway Config{..} etype debugmsg = confSendAll bytestream
where
bytestream = goawayFrame 0 etype debugmsg