{-# LANGUAGE OverloadedStrings #-}

-- | TCP Boxes.
module Box.TCP
  ( TCPConfig (..),
    defaultTCPConfig,
    TCPEnv (..),
    Socket,
    connect,
    serve,
    receiver,
    sender,
    duplex,
    clientBox,
    clientCoBox,
    serverBox,
    serverCoBox,
    responseServer,
  )
where

import Box
import Box.Socket.Types
import Control.Concurrent.Async
import Control.Monad
import Data.ByteString (ByteString)
import Data.Text (Text, unpack)
import GHC.Generics (Generic)
import Network.Simple.TCP (Socket)
import Network.Simple.TCP qualified as NS

-- | TCP configuration
--
-- >>> defaultTCPConfig
-- TCPConfig {hostPreference = HostAny, host = "127.0.0.1", port = "3566", chunk = 2048, endLine = "\n"}
data TCPConfig = TCPConfig
  { TCPConfig -> HostPreference
hostPreference :: NS.HostPreference,
    TCPConfig -> Text
host :: Text,
    TCPConfig -> Text
port :: Text,
    TCPConfig -> Int
chunk :: Int,
    TCPConfig -> Text
endLine :: Text
  }
  deriving (Int -> TCPConfig -> ShowS
[TCPConfig] -> ShowS
TCPConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TCPConfig] -> ShowS
$cshowList :: [TCPConfig] -> ShowS
show :: TCPConfig -> String
$cshow :: TCPConfig -> String
showsPrec :: Int -> TCPConfig -> ShowS
$cshowsPrec :: Int -> TCPConfig -> ShowS
Show, TCPConfig -> TCPConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TCPConfig -> TCPConfig -> Bool
$c/= :: TCPConfig -> TCPConfig -> Bool
== :: TCPConfig -> TCPConfig -> Bool
$c== :: TCPConfig -> TCPConfig -> Bool
Eq, forall x. Rep TCPConfig x -> TCPConfig
forall x. TCPConfig -> Rep TCPConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TCPConfig x -> TCPConfig
$cfrom :: forall x. TCPConfig -> Rep TCPConfig x
Generic)

-- | default
defaultTCPConfig :: TCPConfig
defaultTCPConfig :: TCPConfig
defaultTCPConfig = HostPreference -> Text -> Text -> Int -> Text -> TCPConfig
TCPConfig HostPreference
NS.HostAny Text
"127.0.0.1" Text
"3566" Int
2048 Text
"\n"

-- | An active TCP environment
data TCPEnv = TCPEnv
  { TCPEnv -> Socket
socket :: NS.Socket,
    TCPEnv -> SockAddr
sockaddr :: NS.SockAddr
  }

-- | connect an action (ie a client)
connect :: TCPConfig -> Codensity IO TCPEnv
connect :: TCPConfig -> Codensity IO TCPEnv
connect TCPConfig
cfg =
  forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
String -> String -> ((Socket, SockAddr) -> m r) -> m r
NS.connect (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ TCPConfig -> Text
host TCPConfig
cfg) (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ TCPConfig -> Text
port TCPConfig
cfg)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\TCPEnv -> IO b
action (Socket
s, SockAddr
a) -> TCPEnv -> IO b
action (Socket -> SockAddr -> TCPEnv
TCPEnv Socket
s SockAddr
a))

-- | serve an action (ie a server)
serve :: TCPConfig -> Codensity IO TCPEnv
serve :: TCPConfig -> Codensity IO TCPEnv
serve TCPConfig
cfg =
  forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
MonadIO m =>
HostPreference -> String -> ((Socket, SockAddr) -> IO ()) -> m a
NS.serve (TCPConfig -> HostPreference
hostPreference TCPConfig
cfg) (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ TCPConfig -> Text
port TCPConfig
cfg)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\TCPEnv -> IO b
action (Socket
s, SockAddr
a) -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ TCPEnv -> IO b
action (Socket -> SockAddr -> TCPEnv
TCPEnv Socket
s SockAddr
a))

-- | Commit received ByteStrings.
receiver ::
  TCPConfig ->
  Committer IO ByteString ->
  Socket ->
  IO ()
receiver :: TCPConfig -> Committer IO ByteString -> Socket -> IO ()
receiver TCPConfig
cfg Committer IO ByteString
c Socket
conn = IO ()
go
  where
    go :: IO ()
go = do
      Maybe ByteString
msg <- forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
NS.recv Socket
conn (TCPConfig -> Int
chunk TCPConfig
cfg)
      case Maybe ByteString
msg of
        Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just ByteString
bs -> forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO ByteString
c ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
go

-- | Send emitted ByteStrings.
sender ::
  Emitter IO ByteString ->
  Socket ->
  IO SocketStatus
sender :: Emitter IO ByteString -> Socket -> IO SocketStatus
sender Emitter IO ByteString
e Socket
conn = IO SocketStatus
go
  where
    go :: IO SocketStatus
go = do
      Maybe ByteString
bs <- forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO ByteString
e
      case Maybe ByteString
bs of
        Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SocketStatus
SocketOpen
        Just ByteString
bs' -> forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
NS.send Socket
conn ByteString
bs' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO SocketStatus
go

-- | A two-way connection.
duplex ::
  TCPConfig ->
  PostSend ->
  Box IO ByteString ByteString ->
  Socket ->
  IO ()
duplex :: TCPConfig
-> PostSend -> Box IO ByteString ByteString -> Socket -> IO ()
duplex TCPConfig
cfg PostSend
ps (Box Committer IO ByteString
c Emitter IO ByteString
e) Socket
conn = do
  Either () ()
_ <-
    forall a b. IO a -> IO b -> IO (Either a b)
race
      ( do
          SocketStatus
status <- Emitter IO ByteString -> Socket -> IO SocketStatus
sender Emitter IO ByteString
e Socket
conn
          case (PostSend
ps, SocketStatus
status) of
            (CloseAfter Double
s, SocketStatus
SocketOpen) -> Double -> IO ()
sleep Double
s
            (PostSend, SocketStatus)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      )
      (TCPConfig -> Committer IO ByteString -> Socket -> IO ()
receiver TCPConfig
cfg Committer IO ByteString
c Socket
conn)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | A 'Box' action for a client.
clientBox ::
  TCPConfig ->
  PostSend ->
  Box IO ByteString ByteString ->
  IO ()
clientBox :: TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
clientBox TCPConfig
cfg PostSend
ps Box IO ByteString ByteString
b = TCPConfig
-> PostSend -> Box IO ByteString ByteString -> Socket -> IO ()
duplex TCPConfig
cfg PostSend
ps Box IO ByteString ByteString
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. TCPEnv -> Socket
socket forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> TCPConfig -> Codensity IO TCPEnv
connect TCPConfig
cfg

-- | A client 'CoBox'.
clientCoBox ::
  TCPConfig ->
  PostSend ->
  CoBox IO ByteString ByteString
clientCoBox :: TCPConfig -> PostSend -> CoBox IO ByteString ByteString
clientCoBox TCPConfig
cfg PostSend
ps = forall a b r. (Box IO a b -> IO r) -> CoBox IO b a
fromAction (TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
clientBox TCPConfig
cfg PostSend
ps)

-- | A 'Box' action for a server.
serverBox ::
  TCPConfig ->
  PostSend ->
  Box IO ByteString ByteString ->
  IO ()
serverBox :: TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
serverBox TCPConfig
cfg PostSend
ps Box IO ByteString ByteString
b = TCPConfig
-> PostSend -> Box IO ByteString ByteString -> Socket -> IO ()
duplex TCPConfig
cfg PostSend
ps Box IO ByteString ByteString
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. TCPEnv -> Socket
socket forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> TCPConfig -> Codensity IO TCPEnv
serve TCPConfig
cfg

-- | A server 'CoBox'.
serverCoBox ::
  TCPConfig ->
  PostSend ->
  CoBox IO ByteString ByteString
serverCoBox :: TCPConfig -> PostSend -> CoBox IO ByteString ByteString
serverCoBox TCPConfig
cfg PostSend
ps = forall a b r. (Box IO a b -> IO r) -> CoBox IO b a
fromAction (TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
serverBox TCPConfig
cfg PostSend
ps)

-- | A receiver that applies a response function to received ByteStrings.
responseServer :: TCPConfig -> (ByteString -> Maybe ByteString) -> IO ()
responseServer :: TCPConfig -> (ByteString -> Maybe ByteString) -> IO ()
responseServer TCPConfig
cfg ByteString -> Maybe ByteString
f = forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Box m b a -> m ()
fuse (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
f) forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> TCPConfig -> PostSend -> CoBox IO ByteString ByteString
serverCoBox TCPConfig
cfg (Double -> PostSend
CloseAfter Double
0.5)