{-# LANGUAGE OverloadedStrings #-}

-- | It's a box. It's a TCP socket. It's an example.
module Box.TCP.Example where

import Box
import Box.Socket.Types
import Box.TCP
import Control.Concurrent.Async
import Data.ByteString
import Data.Profunctor
import Data.Text
import Data.Text.Encoding

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Box
-- >>> import Box.TCP.Example
-- >>> import Control.Concurrent.Async

-- | A server that only sends and a client that only receives.
--
-- The result here is indeterminate: it can return ["ab"] or ["a","b"] depending on when the client and servers fire.
--
-- > senderExample ["a","b"]
-- ["ab"]
senderExample :: [ByteString] -> IO [ByteString]
senderExample :: [ByteString] -> IO [ByteString]
senderExample [ByteString]
ts = do
  (Committer IO ByteString
c, IO [ByteString]
r) <- IO (Committer IO ByteString, IO [ByteString])
forall a. IO (Committer IO a, IO [a])
refCommitter
  Async ()
a <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
serverBox TCPConfig
defaultTCPConfig (Double -> PostSend
CloseAfter Double
0.2) (Box IO ByteString ByteString -> IO ())
-> (Emitter IO ByteString -> Box IO ByteString ByteString)
-> Emitter IO ByteString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Committer IO ByteString
-> Emitter IO ByteString -> Box IO ByteString ByteString
forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO ByteString
forall a. Monoid a => a
mempty (Emitter IO ByteString -> IO ())
-> Codensity IO (Emitter IO ByteString) -> IO ()
forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> [ByteString] -> Codensity IO (Emitter IO ByteString)
forall a. [a] -> CoEmitter IO a
qList [ByteString]
ts)
  Double -> IO ()
sleep Double
0.2
  TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
clientBox TCPConfig
defaultTCPConfig (Double -> PostSend
CloseAfter Double
0.5) (Committer IO ByteString
-> Emitter IO ByteString -> Box IO ByteString ByteString
forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO ByteString
c Emitter IO ByteString
forall a. Monoid a => a
mempty)
  Double -> IO ()
sleep Double
0.6
  Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
a
  IO [ByteString]
r

-- | A server that only sends and a client that only receives.
--
-- >>> senderLinesExample ["a","b"]
-- ["a","b"]
senderLinesExample :: [Text] -> IO [Text]
senderLinesExample :: [Text] -> IO [Text]
senderLinesExample [Text]
ts = do
  (Committer IO Text
c, IO [Text]
r) <- IO (Committer IO Text, IO [Text])
forall a. IO (Committer IO a, IO [a])
refCommitter
  Async ()
a <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
serverBox TCPConfig
defaultTCPConfig (Double -> PostSend
CloseAfter Double
0.2) (Box IO ByteString ByteString -> IO ())
-> (Emitter IO Text -> Box IO ByteString ByteString)
-> Emitter IO Text
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Box IO Text Text -> Box IO ByteString ByteString
fromLineBox Text
"\n" (Box IO Text Text -> Box IO ByteString ByteString)
-> (Emitter IO Text -> Box IO Text Text)
-> Emitter IO Text
-> Box IO ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Committer IO Text -> Emitter IO Text -> Box IO Text Text
forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO Text
forall a. Monoid a => a
mempty (Emitter IO Text -> IO ())
-> Codensity IO (Emitter IO Text) -> IO ()
forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> [Text] -> Codensity IO (Emitter IO Text)
forall a. [a] -> CoEmitter IO a
qList [Text]
ts)
  Double -> IO ()
sleep Double
0.2
  TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
clientBox TCPConfig
defaultTCPConfig (Double -> PostSend
CloseAfter Double
0.5) (Text -> Box IO Text Text -> Box IO ByteString ByteString
fromLineBox Text
"\n" (Box IO Text Text -> Box IO ByteString ByteString)
-> Box IO Text Text -> Box IO ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Committer IO Text -> Emitter IO Text -> Box IO Text Text
forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO Text
c Emitter IO Text
forall a. Monoid a => a
mempty)
  Double -> IO ()
sleep Double
0.6
  Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
a
  IO [Text]
r

-- | echo server example
--
-- >>> echoExample ["a","b","c"]
-- ["echo: abc"]
echoExample :: [ByteString] -> IO [ByteString]
echoExample :: [ByteString] -> IO [ByteString]
echoExample [ByteString]
ts = do
  (Committer IO ByteString
c, IO [ByteString]
r) <- IO (Committer IO ByteString, IO [ByteString])
forall a. IO (Committer IO a, IO [a])
refCommitter
  Async ()
a <-
    IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async
      (TCPConfig -> (ByteString -> Maybe ByteString) -> IO ()
responseServer TCPConfig
defaultTCPConfig (ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"echo: " <>)))
  Double -> IO ()
sleep Double
0.1
  TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
clientBox TCPConfig
defaultTCPConfig (Double -> PostSend
CloseAfter Double
0.2) (Box IO ByteString ByteString -> IO ())
-> (Emitter IO ByteString -> Box IO ByteString ByteString)
-> Emitter IO ByteString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Committer IO ByteString
-> Emitter IO ByteString -> Box IO ByteString ByteString
forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO ByteString
c (Emitter IO ByteString -> IO ())
-> Codensity IO (Emitter IO ByteString) -> IO ()
forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> [ByteString] -> Codensity IO (Emitter IO ByteString)
forall a. [a] -> CoEmitter IO a
qList [ByteString]
ts
  Double -> IO ()
sleep Double
0.1
  Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
a
  IO [ByteString]
r

-- | "q" to close the client, reads and writes from std
--
-- >>> clientIO
-- *** Exception: Network.Socket.connect: <socket: ...>: does not exist (Connection refused)
clientIO :: IO ()
clientIO :: IO ()
clientIO =
  TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
clientBox TCPConfig
defaultTCPConfig (Double -> PostSend
CloseAfter Double
0) ((ByteString -> Text)
-> (Text -> ByteString)
-> Box IO Text Text
-> Box IO ByteString ByteString
forall a b c d. (a -> b) -> (c -> d) -> Box IO b c -> Box IO a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ByteString -> Text
decodeUtf8 Text -> ByteString
encodeUtf8 (Text -> Box IO Text Text
stdBox Text
"q"))

-- | "q" to close a client socket down. Ctrl-c to close the server. Reads and writes from std.
--
-- >>> a <- async serverIO
-- >>> serverIO
-- *** Exception: Network.Socket.bind: resource busy (Address already in use)
--
-- >>> cancel a
serverIO :: IO ()
serverIO :: IO ()
serverIO = TCPConfig -> PostSend -> Box IO ByteString ByteString -> IO ()
serverBox TCPConfig
defaultTCPConfig (Double -> PostSend
CloseAfter Double
0) ((ByteString -> Text)
-> (Text -> ByteString)
-> Box IO Text Text
-> Box IO ByteString ByteString
forall a b c d. (a -> b) -> (c -> d) -> Box IO b c -> Box IO a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ByteString -> Text
decodeUtf8 Text -> ByteString
encodeUtf8 (Text -> Box IO Text Text
stdBox Text
"q"))