{-# LANGUAGE OverloadedStrings #-}

-- | It's a box. It's a websocket. It's an example.
module Box.Websocket.Example where

import Box
import Box.Socket.Types
import Box.Websocket
import Control.Concurrent.Async
import Data.Functor.Contravariant
import Data.Text (Text)

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

-- | A server that only sends and a client that only receives.
--
-- >>> senderExample ["a","b"]
-- ["a","b"]
senderExample :: [Text] -> IO [Text]
senderExample :: [Text] -> IO [Text]
senderExample [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 (SocketConfig -> PostSend -> Box IO Text Text -> IO ()
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
serverBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0.2) (Box IO Text Text -> IO ())
-> (Emitter IO Text -> Box IO Text Text)
-> Emitter IO Text
-> IO ()
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.1
  SocketConfig -> PostSend -> Box IO Text Text -> IO ()
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
clientBox SocketConfig
defaultSocketConfig PostSend
StayOpen (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.1
  Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
a
  IO [Text]
r

-- | echo server example
--
-- >>> echoExample ["a","b","c"]
-- ["echo: a","echo: b","echo: c"]
echoExample :: [Text] -> IO [Text]
echoExample :: [Text] -> IO [Text]
echoExample [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
      (SocketConfig -> (Text -> Maybe Text) -> IO ()
forall a.
WebSocketsData a =>
SocketConfig -> (a -> Maybe a) -> IO ()
responseServer SocketConfig
defaultSocketConfig (Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text
"echo: " :: Text) <>)))
  Double -> IO ()
sleep Double
0.1
  SocketConfig -> PostSend -> Box IO Text Text -> IO ()
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
clientBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0.2) (Box IO Text Text -> IO ())
-> (Emitter IO Text -> Box IO Text Text)
-> Emitter IO Text
-> IO ()
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
c (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.1
  Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
a
  IO [Text]
r

-- | echo server example, with event logging.
--
-- The order of events is non-deterministic, so this is a rough guide:
--
-- > echoLogExample ["a","b","c"]
-- (["echo: a","echo: b","echo: c"],["client:sender_:emit:Just \"a\"","client:sender_:sendTextData:Right ()","client:sender_:emit:Just \"b\"","client:sender_:sendTextData:Right ()","client:sender_:emit:Just \"c\"","client:sender_:sendTextData:Right ()","client:sender_:emit:Nothing","client:sender_ closed with SocketOpen","server:receiver_:receiveData:Right \"a\"","server:receiver_:receiveData:Right \"b\"","server:receiver_:receiveData:Right \"c\"","server:sender_:emit:Just \"echo: a\"","server:sender_:sendTextData:Right ()","server:sender_:emit:Just \"echo: b\"","server:sender_:sendTextData:Right ()","server:sender_:emit:Just \"echo: c\"","server:sender_:sendTextData:Right ()","client:receiver_:receiveData:Right \"echo: a\"","client:receiver_:receiveData:Right \"echo: b\"","client:receiver_:receiveData:Right \"echo: c\"","server:receiver_:receiveData:Left (CloseRequest 1000 \"close after sending\")","server:receiver_ closed","client:receiver_:receiveData:Left (CloseRequest 1000 \"close after sending\")","client:receiver_ closed","client:duplex_ closed","server:duplex_ closed"])
echoLogExample :: [Text] -> IO ([Text], [Text])
echoLogExample :: [Text] -> IO ([Text], [Text])
echoLogExample [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
  (Committer IO Text
cLog, IO [Text]
resLog) <- 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
      ((Text -> IO (Maybe Text)) -> Box IO Text Text -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Box m b a -> m ()
fuse (Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text))
-> (Text -> Maybe Text) -> Text -> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text
"echo: " :: Text) <>)) (Box IO Text Text -> IO ())
-> Codensity IO (Box IO Text Text) -> IO ()
forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> (Box IO Text Text -> IO ()) -> Codensity IO (Box IO Text Text)
forall a b r. (Box IO a b -> IO r) -> CoBox IO b a
fromAction (\Box IO Text Text
b -> PostSend
-> Committer IO Text -> Box IO Text Text -> Connection -> IO ()
forall a.
(WebSocketsData a, Show a) =>
PostSend -> Committer IO Text -> Box IO a a -> Connection -> IO ()
duplex_ (Double -> PostSend
CloseAfter Double
0.5) ((Text -> Text) -> Committer IO Text -> Committer IO Text
forall a' a. (a' -> a) -> Committer IO a -> Committer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Text
"server:" <>) Committer IO Text
cLog) Box IO Text Text
b (Connection -> IO ()) -> Codensity IO Connection -> IO ()
forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> SocketConfig -> Codensity IO Connection
serve SocketConfig
defaultSocketConfig))
  Double -> IO ()
sleep Double
0.1
  PostSend
-> Committer IO Text -> Box IO Text Text -> Connection -> IO ()
forall a.
(WebSocketsData a, Show a) =>
PostSend -> Committer IO Text -> Box IO a a -> Connection -> IO ()
duplex_ (Double -> PostSend
CloseAfter Double
0.2) ((Text -> Text) -> Committer IO Text -> Committer IO Text
forall a' a. (a' -> a) -> Committer IO a -> Committer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Text
"client:" <>) Committer IO Text
cLog) (Box IO Text Text -> Connection -> IO ())
-> (Emitter IO Text -> Box IO Text Text)
-> Emitter IO Text
-> Connection
-> IO ()
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
c (Emitter IO Text -> Connection -> IO ())
-> Codensity IO (Emitter IO Text)
-> Codensity IO (Connection -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Codensity IO (Emitter IO Text)
forall a. [a] -> CoEmitter IO a
qList [Text]
ts Codensity IO (Connection -> IO ())
-> Codensity IO Connection -> IO ()
forall {k} (m :: k -> *) a (r :: k).
Codensity m (a -> m r) -> Codensity m a -> m r
<*|> SocketConfig -> Codensity IO Connection
connect SocketConfig
defaultSocketConfig
  Double -> IO ()
sleep Double
0.1
  Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
a
  (,) ([Text] -> [Text] -> ([Text], [Text]))
-> IO [Text] -> IO ([Text] -> ([Text], [Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Text]
r IO ([Text] -> ([Text], [Text])) -> IO [Text] -> IO ([Text], [Text])
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [Text]
resLog

-- | "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 =
  SocketConfig -> PostSend -> Box IO Text Text -> IO ()
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
clientBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0) (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 = SocketConfig -> PostSend -> Box IO Text Text -> IO ()
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
serverBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0) (Text -> Box IO Text Text
stdBox Text
"q")