module SocketsAndPipes.Serve
    ( {- * Serve -} serve,
      {- * Example -} {- $example -}
      {- * Options -} ServeOptions, port
      {- * Alternatives -} {- $alternatives -}
    ) 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)

-- | The first argument to 'serve'.
data ServeOptions =
    ServeOnPort PortNumber
{- This type is abstract so that we might add more options in
   the future without disturbing the users of this library. -}

port :: PortNumber -- ^ The port number that your server will listen on
     -> ServeOptions
port :: PortNumber -> ServeOptions
port = PortNumber -> ServeOptions
ServeOnPort

serve ::
    ServeOptions
    -> (Socket -> IO ())
            {- ^ What to do each time a new client connects to your server.
                 These actions run concurrently in separate threads. -}
    -> IO ()
            {- ^ Perpetually listens for incoming connections and runs
                 the @(Socket -> IO ())@ function each time a new client
                 opens a connection. -}
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)

{- $example

Suppose you have a function that reads an HTTP request from a
socket and then writes an HTTP response back to the socket.

@handleHttpRequest :: 'Socket' -> IO ()@

Then you might start a server by running the following in GHCi:

@
λ> import "SocketsAndPipes.Serve"
λ> 'serve' ('port' 8000) handleHttpRequest
@

And while the server is still running, test it on the command line
like so:

> $ curl http://localhost:8000

-}

{- $alternatives

The 'serve' function here is somewhat narrowly tailored
to fit our purposes in /Sockets and Pipes/.
Some other packages have more expansive offerings:

  * <https://hackage.haskell.org/package/network-simple network-simple>
  * <https://hackage.haskell.org/package/network-run network-run>

-}