module Acme.Serve where
import Acme.Request
import Acme.Response
import Acme.Types
import Control.Concurrent (killThread, forkIO)
import Control.Exception.Extensible as E
import Control.Monad (forever)
import Control.Monad.Trans
import Data.ByteString (ByteString, empty)
import Data.ByteString.Char8 (pack)
import Network.BSD (getProtocolNumber)
import Network.Socket (Socket, SockAddr(..), SocketOption(..), SocketType(Stream), Family(AF_INET), accept, bindSocket, iNADDR_ANY, sClose, listen, maxListenQueue, setSocketOption, socket)
import Network.Socket.ByteString (recv, sendAll)
import System.IO
listenOn :: Int
-> IO Socket
listenOn portm = do
proto <- getProtocolNumber "tcp"
E.bracketOnError
(socket AF_INET Stream proto)
(sClose)
(\sock -> do
setSocketOption sock ReuseAddr 1
setSocketOption sock NoDelay 1
bindSocket sock (SockAddrInet (fromIntegral portm) iNADDR_ANY)
listen sock (max 1024 maxListenQueue)
return sock
)
serve :: Int
-> (Request -> IO Response)
-> IO ()
serve port app =
bracket (listenOn port) sClose $ \listenSocket ->
serveSocket listenSocket app
serveSocket :: Socket
-> (Request -> IO Response)
-> IO ()
serveSocket listenSocket app =
forever $
do (sock, addr) <- accept listenSocket
let reader = recv sock 4096
writer = sendAll sock
forkIO $ do requestLoop False addr reader writer app `E.catch` (\ConnectionClosed -> return ())
sClose sock
requestLoop :: Bool
-> SockAddr
-> IO ByteString
-> (ByteString -> IO ())
-> (Request -> IO Response)
-> IO ()
requestLoop secure addr reader writer app =
go empty
where
go bs =
do (request, bs') <- parseRequest reader bs secure
sendResponse writer =<< app request
go bs'