{-# LANGUAGE OverloadedStrings #-}

-- | Websocket components built with 'Box'es.
module Box.Websocket
  ( SocketConfig (..),
    defaultSocketConfig,
    connect,
    serve,
    pending,
    serverApp,
    receiver,
    receiver_,
    sender,
    sender_,
    duplex,
    duplex_,
    clientBox,
    clientCoBox,
    serverBox,
    serverCoBox,
    responseServer,
  )
where

import Box
import Box.Socket.Types
import Control.Concurrent.Async
import Control.Exception
import Control.Monad
import Data.ByteString qualified as BS
import Data.Functor.Contravariant
import Data.Text (Text, pack, unpack)
import GHC.Generics (Generic)
import Network.WebSockets

-- | Socket configuration
--
-- >>> defaultSocketConfig
-- SocketConfig {host = "127.0.0.1", port = 9160, path = "/"}
data SocketConfig = SocketConfig
  { SocketConfig -> Text
host :: Text,
    SocketConfig -> Int
port :: Int,
    SocketConfig -> Text
path :: Text
  }
  deriving (Int -> SocketConfig -> ShowS
[SocketConfig] -> ShowS
SocketConfig -> String
(Int -> SocketConfig -> ShowS)
-> (SocketConfig -> String)
-> ([SocketConfig] -> ShowS)
-> Show SocketConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocketConfig -> ShowS
showsPrec :: Int -> SocketConfig -> ShowS
$cshow :: SocketConfig -> String
show :: SocketConfig -> String
$cshowList :: [SocketConfig] -> ShowS
showList :: [SocketConfig] -> ShowS
Show, SocketConfig -> SocketConfig -> Bool
(SocketConfig -> SocketConfig -> Bool)
-> (SocketConfig -> SocketConfig -> Bool) -> Eq SocketConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocketConfig -> SocketConfig -> Bool
== :: SocketConfig -> SocketConfig -> Bool
$c/= :: SocketConfig -> SocketConfig -> Bool
/= :: SocketConfig -> SocketConfig -> Bool
Eq, (forall x. SocketConfig -> Rep SocketConfig x)
-> (forall x. Rep SocketConfig x -> SocketConfig)
-> Generic SocketConfig
forall x. Rep SocketConfig x -> SocketConfig
forall x. SocketConfig -> Rep SocketConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SocketConfig -> Rep SocketConfig x
from :: forall x. SocketConfig -> Rep SocketConfig x
$cto :: forall x. Rep SocketConfig x -> SocketConfig
to :: forall x. Rep SocketConfig x -> SocketConfig
Generic)

-- | official default
defaultSocketConfig :: SocketConfig
defaultSocketConfig :: SocketConfig
defaultSocketConfig = Text -> Int -> Text -> SocketConfig
SocketConfig Text
"127.0.0.1" Int
9160 Text
"/"

-- | connect an action (ie a client)
connect :: SocketConfig -> Codensity IO Connection
connect :: SocketConfig -> Codensity IO Connection
connect SocketConfig
c = (forall b. (Connection -> IO b) -> IO b) -> Codensity IO Connection
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (Connection -> IO b) -> IO b)
 -> Codensity IO Connection)
-> (forall b. (Connection -> IO b) -> IO b)
-> Codensity IO Connection
forall a b. (a -> b) -> a -> b
$ \Connection -> IO b
action ->
  String -> Int -> String -> (Connection -> IO b) -> IO b
forall a. String -> Int -> String -> ClientApp a -> IO a
runClient (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SocketConfig -> Text
host SocketConfig
c) (SocketConfig -> Int
port SocketConfig
c) (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SocketConfig -> Text
path SocketConfig
c) Connection -> IO b
action

-- | serve an action (ie a server)
serve :: SocketConfig -> Codensity IO Connection
serve :: SocketConfig -> Codensity IO Connection
serve SocketConfig
c =
  (forall b. (Connection -> IO b) -> IO b) -> Codensity IO Connection
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (Connection -> IO b) -> IO b)
 -> Codensity IO Connection)
-> (forall b. (Connection -> IO b) -> IO b)
-> Codensity IO Connection
forall a b. (a -> b) -> a -> b
$
    ServerOptions -> ServerApp -> IO b
forall a. ServerOptions -> ServerApp -> IO a
runServerWithOptions (ServerOptions
defaultServerOptions {serverHost = unpack (host c), serverPort = port c}) (ServerApp -> IO b)
-> ((Connection -> IO b) -> ServerApp)
-> (Connection -> IO b)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> IO b) -> ServerApp
forall {a}. (Connection -> IO a) -> ServerApp
upgrade
  where
    upgrade :: (Connection -> IO a) -> ServerApp
upgrade Connection -> IO a
action PendingConnection
p = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO a
action (Connection -> IO a) -> Codensity IO Connection -> IO a
forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> PendingConnection -> Codensity IO Connection
pending PendingConnection
p

-- | Attach a box to a 'PendingConnection' in wai-style.
serverApp ::
  Box IO Text Text ->
  PendingConnection ->
  IO ()
serverApp :: Box IO Text Text -> ServerApp
serverApp Box IO Text Text
b PendingConnection
p = (Connection -> IO ()) -> ServerApp
forall {a}. (Connection -> IO a) -> ServerApp
upgrade (PostSend -> Box IO Text Text -> Connection -> IO ()
forall a.
WebSocketsData a =>
PostSend -> Box IO a a -> Connection -> IO ()
duplex (Double -> PostSend
CloseAfter Double
0.2) Box IO Text Text
b) PendingConnection
p
  where
    upgrade :: (Connection -> IO a) -> ServerApp
upgrade Connection -> IO a
action PendingConnection
p' = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO a
action (Connection -> IO a) -> Codensity IO Connection -> IO a
forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> PendingConnection -> Codensity IO Connection
pending PendingConnection
p'

-- | Given a 'PendingConnection', provide a 'Connection' continuation.
pending :: PendingConnection -> Codensity IO Connection
pending :: PendingConnection -> Codensity IO Connection
pending PendingConnection
p = (forall b. (Connection -> IO b) -> IO b) -> Codensity IO Connection
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (Connection -> IO b) -> IO b)
 -> Codensity IO Connection)
-> (forall b. (Connection -> IO b) -> IO b)
-> Codensity IO Connection
forall a b. (a -> b) -> a -> b
$ \Connection -> IO b
action ->
  IO Connection
-> (Connection -> IO ()) -> (Connection -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (PendingConnection -> IO Connection
acceptRequest PendingConnection
p)
    (\Connection
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    ( \Connection
conn ->
        IO Any -> (Async Any -> IO b) -> IO b
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync
          (IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendPing Connection
conn (ByteString
"connect ping" :: BS.ByteString) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> IO ()
sleep Double
30)
          (\Async Any
_ -> Connection -> IO b
action Connection
conn)
    )

-- | Commit received messages, finalising on receiving a 'CloseRequest'
receiver ::
  (WebSocketsData a) =>
  Committer IO a ->
  Connection ->
  IO ()
receiver :: forall a. WebSocketsData a => Committer IO a -> Connection -> IO ()
receiver Committer IO a
c Connection
conn = IO ()
go
  where
    go :: IO ()
go = do
      Either ConnectionException a
msg <- IO a -> IO (Either ConnectionException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (Connection -> IO a
forall a. WebSocketsData a => Connection -> IO a
receiveData Connection
conn)
      case Either ConnectionException a
msg of
        Left (CloseRequest Word16
_ ByteString
_) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Left ConnectionException
err -> ConnectionException -> IO ()
forall e a. Exception e => e -> IO a
throwIO ConnectionException
err
        Right a
msg' -> Committer IO a -> a -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO a
c a
msg' IO Bool -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
go

-- | Commit received messages, finalising on receiving a 'CloseRequest', with event logging.
receiver_ ::
  (WebSocketsData a, Show a) =>
  Committer IO a ->
  Committer IO Text ->
  Connection ->
  IO ()
receiver_ :: forall a.
(WebSocketsData a, Show a) =>
Committer IO a -> Committer IO Text -> Connection -> IO ()
receiver_ Committer IO a
c Committer IO Text
cLog Connection
conn = IO ()
go
  where
    go :: IO ()
go = do
      Either ConnectionException a
msg <- IO a -> IO (Either ConnectionException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (Connection -> IO a
forall a. WebSocketsData a => Connection -> IO a
receiveData Connection
conn)
      Bool
_ <- Committer IO Text -> Text -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO Text
cLog (Text
"receiveData:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Either ConnectionException a -> String
forall a. Show a => a -> String
show Either ConnectionException a
msg))
      case Either ConnectionException a
msg of
        Left (CloseRequest Word16
_ ByteString
_) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Left ConnectionException
err -> ConnectionException -> IO ()
forall e a. Exception e => e -> IO a
throwIO ConnectionException
err
        Right a
msg' -> Committer IO a -> a -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO a
c a
msg' IO Bool -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
go

-- | Send emitted messages, returning whether the socket remained open (the 'Emitter' ran out of emits) or closed (a 'CloseRequest' was received).
sender ::
  (WebSocketsData a) =>
  Emitter IO a ->
  Connection ->
  IO SocketStatus
sender :: forall a.
WebSocketsData a =>
Emitter IO a -> Connection -> IO SocketStatus
sender Emitter IO a
e Connection
conn = IO SocketStatus
go
  where
    go :: IO SocketStatus
go = do
      Maybe a
msg <- Emitter IO a -> IO (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO a
e
      case Maybe a
msg of
        Maybe a
Nothing -> SocketStatus -> IO SocketStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SocketStatus
SocketOpen
        Just a
msg' -> do
          Either ConnectionException ()
ok <- IO () -> IO (Either ConnectionException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (Connection -> a -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendTextData Connection
conn a
msg')
          case Either ConnectionException ()
ok of
            Left (CloseRequest Word16
_ ByteString
_) -> SocketStatus -> IO SocketStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SocketStatus
SocketClosed
            Left ConnectionException
err -> ConnectionException -> IO SocketStatus
forall e a. Exception e => e -> IO a
throwIO ConnectionException
err
            Right () -> IO SocketStatus
go

-- | Send emitted messages, returning whether the socket remained open (the 'Emitter' ran out of emits) or closed (a 'CloseRequest' was received). With event logging.
sender_ ::
  (WebSocketsData a, Show a) =>
  Emitter IO a ->
  Committer IO Text ->
  Connection ->
  IO SocketStatus
sender_ :: forall a.
(WebSocketsData a, Show a) =>
Emitter IO a -> Committer IO Text -> Connection -> IO SocketStatus
sender_ Emitter IO a
e Committer IO Text
cLog Connection
conn = IO SocketStatus
go
  where
    go :: IO SocketStatus
go = do
      Maybe a
msg <- Emitter IO a -> IO (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO a
e
      Bool
_ <- Committer IO Text -> Text -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO Text
cLog (Text
"emit:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Maybe a -> String
forall a. Show a => a -> String
show Maybe a
msg))
      case Maybe a
msg of
        Maybe a
Nothing -> SocketStatus -> IO SocketStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SocketStatus
SocketOpen
        Just a
msg' -> do
          Either ConnectionException ()
ok <- IO () -> IO (Either ConnectionException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (Connection -> a -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendTextData Connection
conn a
msg')
          Bool
_ <- Committer IO Text -> Text -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO Text
cLog (Text
"sendTextData:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Either ConnectionException () -> String
forall a. Show a => a -> String
show Either ConnectionException ()
ok))
          case Either ConnectionException ()
ok of
            Left (CloseRequest Word16
_ ByteString
_) -> SocketStatus -> IO SocketStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SocketStatus
SocketClosed
            Left ConnectionException
err -> ConnectionException -> IO SocketStatus
forall e a. Exception e => e -> IO a
throwIO ConnectionException
err
            Right () -> IO SocketStatus
go

-- | A two-way connection. Closes if it receives a 'CloseRequest' exception, or if 'PostSend' is 'CloseAfter'.
duplex ::
  (WebSocketsData a) =>
  PostSend ->
  Box IO a a ->
  Connection ->
  IO ()
duplex :: forall a.
WebSocketsData a =>
PostSend -> Box IO a a -> Connection -> IO ()
duplex PostSend
ps (Box Committer IO a
c Emitter IO a
e) Connection
conn = do
  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
concurrentlyRight
    ( do
        SocketStatus
status <- Emitter IO a -> Connection -> IO SocketStatus
forall a.
WebSocketsData a =>
Emitter IO a -> Connection -> IO SocketStatus
sender Emitter IO a
e Connection
conn
        case (PostSend
ps, SocketStatus
status) of
          (CloseAfter Double
s, SocketStatus
SocketOpen) -> do
            Double -> IO ()
sleep Double
s
            Connection -> Text -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendClose Connection
conn (Text
"close after sending" :: Text)
          (PostSend, SocketStatus)
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    )
    (Committer IO a -> Connection -> IO ()
forall a. WebSocketsData a => Committer IO a -> Connection -> IO ()
receiver Committer IO a
c Connection
conn)

-- | A two-way connection. Closes if it receives a 'CloseRequest' exception, or if 'PostSend' is 'CloseAfter'. With event logging.
duplex_ ::
  (WebSocketsData a, Show a) =>
  PostSend ->
  Committer IO Text ->
  Box IO a a ->
  Connection ->
  IO ()
duplex_ :: forall a.
(WebSocketsData a, Show a) =>
PostSend -> Committer IO Text -> Box IO a a -> Connection -> IO ()
duplex_ PostSend
ps Committer IO Text
cLog (Box Committer IO a
c Emitter IO a
e) Connection
conn = do
  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
concurrentlyRight
    ( do
        SocketStatus
status <- Emitter IO a -> Committer IO Text -> Connection -> IO SocketStatus
forall a.
(WebSocketsData a, Show a) =>
Emitter IO a -> Committer IO Text -> Connection -> IO SocketStatus
sender_ Emitter IO a
e ((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
"sender_:" <>) Committer IO Text
cLog) Connection
conn
        Bool
_ <- Committer IO Text -> Text -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO Text
cLog (Text
"sender_ closed with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (SocketStatus -> String
forall a. Show a => a -> String
show SocketStatus
status))
        case (PostSend
ps, SocketStatus
status) of
          (CloseAfter Double
s, SocketStatus
SocketOpen) -> do
            Double -> IO ()
sleep Double
s
            Connection -> Text -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendClose Connection
conn (Text
"close after sending" :: Text)
          (PostSend, SocketStatus)
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    )
    ( do
        Committer IO a -> Committer IO Text -> Connection -> IO ()
forall a.
(WebSocketsData a, Show a) =>
Committer IO a -> Committer IO Text -> Connection -> IO ()
receiver_ Committer IO a
c ((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
"receiver_:" <>) Committer IO Text
cLog) Connection
conn
        IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Committer IO Text -> Text -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO Text
cLog Text
"receiver_ closed"
    )
  IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Committer IO Text -> Text -> IO Bool
forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO Text
cLog Text
"duplex_ closed"

-- | A 'Box' action for a client.
clientBox ::
  (WebSocketsData a) =>
  SocketConfig ->
  PostSend ->
  Box IO a a ->
  IO ()
clientBox :: forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
clientBox SocketConfig
cfg PostSend
ps Box IO a a
b = PostSend -> Box IO a a -> Connection -> IO ()
forall a.
WebSocketsData a =>
PostSend -> Box IO a a -> Connection -> IO ()
duplex PostSend
ps Box IO a a
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
connect SocketConfig
cfg

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

-- | A 'Box' action for a server.
serverBox ::
  (WebSocketsData a) =>
  SocketConfig ->
  PostSend ->
  Box IO a a ->
  IO ()
serverBox :: forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
serverBox SocketConfig
cfg PostSend
ps Box IO a a
b = PostSend -> Box IO a a -> Connection -> IO ()
forall a.
WebSocketsData a =>
PostSend -> Box IO a a -> Connection -> IO ()
duplex PostSend
ps Box IO a a
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
cfg

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

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