{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
module Network.Simple.WSS
(
WS.Connection
, WS.recv
, WS.send
, WS.close
, connect
, connectOverSOCKS5
, WS.clientConnectionFromStream
, streamFromContext
) where
import qualified Control.Concurrent.Async as Async
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Control.Exception.Safe as Ex
import qualified Data.ByteString as B
import Data.Foldable (traverse_)
import qualified Network.Simple.TCP.TLS as T
import qualified Network.Simple.WS as WS
import qualified Network.WebSockets as W
import qualified Network.WebSockets.Connection as W (pingThread)
import qualified Network.WebSockets.Stream as W (Stream, makeStream, close)
connect
:: (MonadIO m, Ex.MonadMask m)
=> T.ClientParams
-> T.HostName
-> T.ServiceName
-> B.ByteString
-> [(B.ByteString, B.ByteString)]
-> ((W.Connection, T.SockAddr) -> m r)
-> m r
connect :: forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
ClientParams
-> HostName
-> HostName
-> ByteString
-> [(ByteString, ByteString)]
-> ((Connection, SockAddr) -> m r)
-> m r
connect ClientParams
cs HostName
hn HostName
sn ByteString
res [(ByteString, ByteString)]
hds (Connection, SockAddr) -> m r
act = do
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
ClientParams
-> HostName -> HostName -> ((Context, SockAddr) -> m r) -> m r
T.connect ClientParams
cs HostName
hn HostName
sn forall a b. (a -> b) -> a -> b
$ \(Context
ctx, SockAddr
saddr) -> do
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
Ex.bracket (forall (m :: * -> *). MonadIO m => Context -> m Stream
streamFromContext Context
ctx) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream -> IO ()
W.close) forall a b. (a -> b) -> a -> b
$ \Stream
stream -> do
Connection
conn <- forall (m :: * -> *).
MonadIO m =>
Stream
-> HostName
-> HostName
-> ByteString
-> [(ByteString, ByteString)]
-> m Connection
WS.clientConnectionFromStream Stream
stream HostName
hn HostName
sn ByteString
res [(ByteString, ByteString)]
hds
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m) =>
IO a -> (Async a -> m b) -> m b
withAsync (Connection -> Int -> IO () -> IO ()
W.pingThread Connection
conn Int
30 (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) forall a b. (a -> b) -> a -> b
$ \Async ()
_ ->
(Connection, SockAddr) -> m r
act (Connection
conn, SockAddr
saddr)
connectOverSOCKS5
:: (MonadIO m, Ex.MonadMask m)
=> T.HostName
-> T.ServiceName
-> T.ClientParams
-> T.HostName
-> T.ServiceName
-> B.ByteString
-> [(B.ByteString, B.ByteString)]
-> ((W.Connection, T.SockAddr, T.SockAddr) -> m r)
-> m r
connectOverSOCKS5 :: forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
HostName
-> HostName
-> ClientParams
-> HostName
-> HostName
-> ByteString
-> [(ByteString, ByteString)]
-> ((Connection, SockAddr, SockAddr) -> m r)
-> m r
connectOverSOCKS5 HostName
phn HostName
psn ClientParams
tcs HostName
dhn HostName
dsn ByteString
res [(ByteString, ByteString)]
hds (Connection, SockAddr, SockAddr) -> m r
act = do
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
HostName
-> HostName
-> ClientParams
-> HostName
-> HostName
-> ((Context, SockAddr, SockAddr) -> m r)
-> m r
T.connectOverSOCKS5 HostName
phn HostName
psn ClientParams
tcs HostName
dhn HostName
dsn forall a b. (a -> b) -> a -> b
$ \(Context
ctx, SockAddr
pa, SockAddr
da) -> do
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
Ex.bracket (forall (m :: * -> *). MonadIO m => Context -> m Stream
streamFromContext Context
ctx) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream -> IO ()
W.close) forall a b. (a -> b) -> a -> b
$ \Stream
stream -> do
Connection
conn <- forall (m :: * -> *).
MonadIO m =>
Stream
-> HostName
-> HostName
-> ByteString
-> [(ByteString, ByteString)]
-> m Connection
WS.clientConnectionFromStream Stream
stream HostName
dhn HostName
dsn ByteString
res [(ByteString, ByteString)]
hds
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m) =>
IO a -> (Async a -> m b) -> m b
withAsync (Connection -> Int -> IO () -> IO ()
W.pingThread Connection
conn Int
30 (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) forall a b. (a -> b) -> a -> b
$ \Async ()
_ ->
(Connection, SockAddr, SockAddr) -> m r
act (Connection
conn, SockAddr
pa, SockAddr
da)
streamFromContext :: MonadIO m => T.Context -> m W.Stream
streamFromContext :: forall (m :: * -> *). MonadIO m => Context -> m Stream
streamFromContext Context
ctx = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
IO (Maybe ByteString) -> (Maybe ByteString -> IO ()) -> IO Stream
W.makeStream (forall (m :: * -> *). MonadIO m => Context -> m (Maybe ByteString)
T.recv Context
ctx) (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
T.sendLazy Context
ctx))
withAsync
:: (Ex.MonadMask m, MonadIO m)
=> IO a
-> (Async.Async a -> m b)
-> m b
withAsync :: forall (m :: * -> *) a b.
(MonadMask m, MonadIO m) =>
IO a -> (Async a -> m b) -> m b
withAsync IO a
io = forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
Ex.bracket
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ((forall b. IO b -> IO b) -> IO a) -> IO (Async a)
Async.asyncWithUnmask (\forall b. IO b -> IO b
u -> forall b. IO b -> IO b
u IO a
io))
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO ()
Async.uninterruptibleCancel)