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 Control.Exception.Safe ( catch )
import qualified Data.Text.Lazy.IO as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified System.IO as IO
import Prelude hiding (print)
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 =
IO ()
go IO () -> (BindFailed -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` BindFailed -> IO ()
ifBindFailed
where
go :: IO ()
go = PortNumber -> (PassiveSocket -> IO ()) -> IO ()
forall a. PortNumber -> (PassiveSocket -> IO a) -> IO a
withSocketOnPort PortNumber
p ((PassiveSocket -> IO ()) -> IO ())
-> (PassiveSocket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PassiveSocket
s ->
do
Builder -> IO ()
print (Builder -> IO ()) -> IO Builder -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PassiveSocket -> IO Builder
displayBindSuccess PassiveSocket
s
(PeerSocket -> IO ()) -> PassiveSocket -> IO ()
forall a b. (PeerSocket -> IO a) -> PassiveSocket -> IO b
run (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 :: BindFailed -> IO ()
ifBindFailed = Builder -> IO ()
print (Builder -> IO ())
-> (BindFailed -> Builder) -> BindFailed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindFailed -> Builder
displayBindFailed
print :: TB.Builder -> IO ()
print :: Builder -> IO ()
print = Handle -> Text -> IO ()
LT.hPutStrLn Handle
IO.stderr (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
displayBindSuccess :: PassiveSocket -> IO TB.Builder
displayBindSuccess :: PassiveSocket -> IO Builder
displayBindSuccess PassiveSocket
s =
PassiveSocket -> IO SockAddr
passiveSocketAddress PassiveSocket
s IO SockAddr -> (SockAddr -> IO Builder) -> IO Builder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SockAddr
a ->
Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$
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)