-- | Serve

{-# LANGUAGE OverloadedStrings #-}

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 (Effect, Producer, Consumer, runEffect, (>->))
import           Pipes.Network.TCP.Safe (HostPreference())
import           Pipes.Network.TCP.Safe (fromSocket, toSocket, connect, connectSock
                                        , closeSock)
import qualified Pipes.Network.TCP.Safe as PipesNetwork
import           Pipes.Safe (MonadSafe(), runSafeT, SafeT)

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

serve :: (MonadSafe m)  => HostPreference
                        -> NS.ServiceName
                        -> (Producer ByteString (SafeT IO) ()
                            -> (SafeT IO) (Producer ByteString (SafeT IO) ()))
                        -> m ()

serve host service app =
  PipesNetwork.serve host service - \socket -> runSafeT (serveWithSocket socket app)

run :: (MonadSafe m) => HostPreference
                     -> NS.ServiceName
                     -> (Producer ByteString (SafeT IO) ()
                         -> (SafeT IO) (Producer ByteString (SafeT IO) ()))
                     -> m ()
run = serve