module Network.HTTP.Pony.Serve where
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString.Char8 (ByteString)
import qualified Network.Socket as NS
import Pipes (Producer, Consumer, runEffect, (>->))
import Pipes.Network.TCP.Safe (HostPreference())
import Pipes.Network.TCP.Safe (fromSocket, toSocket)
import qualified Pipes.Network.TCP.Safe as PipesNetwork
import Pipes.Safe (MonadSafe(), runSafeT)
import Network.HTTP.Pony.Helper ((), shutdownSend, shutdownReceive)
import Prelude hiding ((), log)
serveWithPipe :: (Monad m) => Producer ByteString m a
-> Consumer ByteString m b
-> (Producer ByteString m a -> m (Producer ByteString m b))
-> m ()
serveWithPipe pull push pipe = do
r <- pipe pull
runEffect r >-> push
pure ()
serveWithSocket :: (MonadIO m) => (NS.Socket, NS.SockAddr)
-> (Producer ByteString m () -> m (Producer ByteString m ()))
-> m ()
serveWithSocket (s,_) =
let
pull = fromSocket s 4096 >> shutdownReceive s
push = toSocket s >> shutdownSend s
in
serveWithPipe pull push
run :: (MonadSafe m) => HostPreference
-> NS.ServiceName
-> (Producer ByteString IO () -> IO (Producer ByteString IO ()))
-> m ()
run host service app =
PipesNetwork.serve host service \socket -> do
serveWithSocket socket app