module SocketsAndPipes.Serve
( serve,
ServeOptions, port
) where
import SocketsAndPipes.Serve.Exceptions ( displayBindFailed )
import SocketsAndPipes.Serve.Sockets ( Socket, PortNumber, PassiveSocket,
passiveSocketAddress, peerSocket )
import SocketsAndPipes.Serve.Setup ( withSocketOnPort )
import SocketsAndPipes.Serve.Loop ( run )
import SocketsAndPipes.Serve.Log ( Write, withLogging )
import Control.Exception.Safe ( catch )
import Data.Functor ( void, (<&>) )
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified System.IO as IO
data ServeOptions =
ServeOnPort PortNumber
port :: PortNumber
-> ServeOptions
port :: PortNumber -> ServeOptions
port = PortNumber -> ServeOptions
ServeOnPort
serve ::
ServeOptions
-> (Socket -> IO ())
-> IO ()
serve :: ServeOptions -> (Socket -> IO ()) -> IO ()
serve (ServeOnPort PortNumber
p) Socket -> IO ()
f =
Handle -> (Write -> IO ()) -> IO ()
withLogging Handle
IO.stderr ((Write -> IO ()) -> IO ()) -> (Write -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Write
w -> (Write -> IO ()
forall a. Write -> IO a
go Write
w IO () -> (BindFailed -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` Write -> BindFailed -> IO ()
forall (f :: * -> *) a.
Functor f =>
(String -> f a) -> BindFailed -> f ()
ifBindFailed Write
w)
where
go :: Write -> IO a
go Write
w =
PortNumber -> (PassiveSocket -> IO a) -> IO a
forall a. PortNumber -> (PassiveSocket -> IO a) -> IO a
withSocketOnPort PortNumber
p ((PassiveSocket -> IO a) -> IO a)
-> (PassiveSocket -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \PassiveSocket
s ->
do
Write -> PassiveSocket -> IO ()
logBindSuccess Write
w PassiveSocket
s
Write -> (PeerSocket -> IO ()) -> PassiveSocket -> IO a
forall a b. Write -> (PeerSocket -> IO a) -> PassiveSocket -> IO b
run Write
w (Socket -> IO ()
f (Socket -> IO ()) -> (PeerSocket -> Socket) -> PeerSocket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSocket -> Socket
peerSocket) PassiveSocket
s
ifBindFailed :: (String -> f a) -> BindFailed -> f ()
ifBindFailed String -> f a
w =
f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f a -> f ()) -> (BindFailed -> f a) -> BindFailed -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> f a
w (String -> f a) -> (BindFailed -> String) -> BindFailed -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack (Text -> String) -> (BindFailed -> Text) -> BindFailed -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (BindFailed -> Builder) -> BindFailed -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindFailed -> Builder
displayBindFailed
logBindSuccess :: Write -> PassiveSocket -> IO ()
logBindSuccess :: Write -> PassiveSocket -> IO ()
logBindSuccess Write
w PassiveSocket
s =
IO MessageWritten -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO MessageWritten -> IO ())
-> (Builder -> IO MessageWritten) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Write
w Write -> (Builder -> String) -> Builder -> IO MessageWritten
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> IO ()) -> IO Builder -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PassiveSocket -> IO Builder
displayBindSuccess PassiveSocket
s
displayBindSuccess :: PassiveSocket -> IO TB.Builder
displayBindSuccess :: PassiveSocket -> IO Builder
displayBindSuccess PassiveSocket
s =
PassiveSocket -> IO SockAddr
passiveSocketAddress PassiveSocket
s IO SockAddr -> (SockAddr -> Builder) -> IO Builder
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \SockAddr
a ->
String -> Builder
TB.fromString String
"The server is listening on address "
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString (SockAddr -> String
forall a. Show a => a -> String
show SockAddr
a)