{-# LANGUAGE NoImplicitPrelude #-}
module Wuss
( runSecureClient,
runSecureClientWith,
Config (..),
defaultConfig,
runSecureClientWithConfig,
)
where
import qualified Control.Applicative as Applicative
import qualified Control.Exception as Exception
import qualified Control.Monad.Catch as Catch
import qualified Control.Monad.IO.Class as MonadIO
import qualified Data.Bool as Bool
import qualified Data.ByteString as StrictBytes
import qualified Data.ByteString.Lazy as LazyBytes
import qualified Data.Maybe as Maybe
import qualified Data.String as String
import qualified Network.Connection as Connection
import qualified Network.Socket as Socket
import qualified Network.WebSockets as WebSockets
import qualified Network.WebSockets.Stream as Stream
import qualified System.IO as IO
import qualified System.IO.Error as IO.Error
import Prelude (($), (.))
runSecureClient ::
(MonadIO.MonadIO m) =>
(Catch.MonadMask m) =>
Socket.HostName ->
Socket.PortNumber ->
String.String ->
WebSockets.ClientApp a ->
m a
runSecureClient :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
HostName -> PortNumber -> HostName -> ClientApp a -> m a
runSecureClient HostName
host PortNumber
port HostName
path ClientApp a
app = do
let options :: ConnectionOptions
options = ConnectionOptions
WebSockets.defaultConnectionOptions
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
HostName
-> PortNumber
-> HostName
-> ConnectionOptions
-> Headers
-> ClientApp a
-> m a
runSecureClientWith HostName
host PortNumber
port HostName
path ConnectionOptions
options [] ClientApp a
app
runSecureClientWith ::
(MonadIO.MonadIO m) =>
(Catch.MonadMask m) =>
Socket.HostName ->
Socket.PortNumber ->
String.String ->
WebSockets.ConnectionOptions ->
WebSockets.Headers ->
WebSockets.ClientApp a ->
m a
runSecureClientWith :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
HostName
-> PortNumber
-> HostName
-> ConnectionOptions
-> Headers
-> ClientApp a
-> m a
runSecureClientWith HostName
host PortNumber
port HostName
path ConnectionOptions
options Headers
headers ClientApp a
app = do
let config :: Config
config = Config
defaultConfig
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
HostName
-> PortNumber
-> HostName
-> Config
-> ConnectionOptions
-> Headers
-> ClientApp a
-> m a
runSecureClientWithConfig HostName
host PortNumber
port HostName
path Config
config ConnectionOptions
options Headers
headers ClientApp a
app
newtype Config = Config
{
Config -> Connection -> IO ByteString
connectionGet :: Connection.Connection -> IO.IO StrictBytes.ByteString
}
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = do
Config {connectionGet :: Connection -> IO ByteString
connectionGet = Connection -> IO ByteString
Connection.connectionGetChunk}
runSecureClientWithConfig ::
(MonadIO.MonadIO m) =>
(Catch.MonadMask m) =>
Socket.HostName ->
Socket.PortNumber ->
String.String ->
Config ->
WebSockets.ConnectionOptions ->
WebSockets.Headers ->
WebSockets.ClientApp a ->
m a
runSecureClientWithConfig :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
HostName
-> PortNumber
-> HostName
-> Config
-> ConnectionOptions
-> Headers
-> ClientApp a
-> m a
runSecureClientWithConfig HostName
host PortNumber
port HostName
path Config
config ConnectionOptions
options Headers
headers ClientApp a
app = do
ConnectionContext
context <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
MonadIO.liftIO IO ConnectionContext
Connection.initConnectionContext
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
Catch.bracket
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
MonadIO.liftIO forall a b. (a -> b) -> a -> b
$ ConnectionContext -> ConnectionParams -> IO Connection
Connection.connectTo ConnectionContext
context (HostName -> PortNumber -> ConnectionParams
connectionParams HostName
host PortNumber
port))
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
MonadIO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
Connection.connectionClose)
( \Connection
connection -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
MonadIO.liftIO forall a b. (a -> b) -> a -> b
$ do
Stream
stream <-
IO (Maybe ByteString) -> (Maybe ByteString -> IO ()) -> IO Stream
Stream.makeStream
(Config -> Connection -> IO (Maybe ByteString)
reader Config
config Connection
connection)
(Connection -> Maybe ByteString -> IO ()
writer Connection
connection)
forall a.
Stream
-> HostName
-> HostName
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
WebSockets.runClientWithStream Stream
stream HostName
host HostName
path ConnectionOptions
options Headers
headers ClientApp a
app
)
connectionParams ::
Socket.HostName -> Socket.PortNumber -> Connection.ConnectionParams
connectionParams :: HostName -> PortNumber -> ConnectionParams
connectionParams HostName
host PortNumber
port = do
Connection.ConnectionParams
{ connectionHostname :: HostName
Connection.connectionHostname = HostName
host,
connectionPort :: PortNumber
Connection.connectionPort = PortNumber
port,
connectionUseSecure :: Maybe TLSSettings
Connection.connectionUseSecure = forall a. a -> Maybe a
Maybe.Just TLSSettings
tlsSettings,
connectionUseSocks :: Maybe ProxySettings
Connection.connectionUseSocks = forall a. Maybe a
Maybe.Nothing
}
tlsSettings :: Connection.TLSSettings
tlsSettings :: TLSSettings
tlsSettings = do
Connection.TLSSettingsSimple
{ settingDisableCertificateValidation :: Bool
Connection.settingDisableCertificateValidation = Bool
Bool.False,
settingDisableSession :: Bool
Connection.settingDisableSession = Bool
Bool.False,
settingUseServerName :: Bool
Connection.settingUseServerName = Bool
Bool.False
}
reader ::
Config ->
Connection.Connection ->
IO.IO (Maybe.Maybe StrictBytes.ByteString)
reader :: Config -> Connection -> IO (Maybe ByteString)
reader Config
config Connection
connection =
forall a. IO a -> (IOError -> IO a) -> IO a
IO.Error.catchIOError
( do
ByteString
chunk <- Config -> Connection -> IO ByteString
connectionGet Config
config Connection
connection
forall (f :: * -> *) a. Applicative f => a -> f a
Applicative.pure (forall a. a -> Maybe a
Maybe.Just ByteString
chunk)
)
( \IOError
e ->
if IOError -> Bool
IO.Error.isEOFError IOError
e
then forall (f :: * -> *) a. Applicative f => a -> f a
Applicative.pure forall a. Maybe a
Maybe.Nothing
else forall e a. Exception e => e -> IO a
Exception.throwIO IOError
e
)
writer ::
Connection.Connection -> Maybe.Maybe LazyBytes.ByteString -> IO.IO ()
writer :: Connection -> Maybe ByteString -> IO ()
writer Connection
connection Maybe ByteString
maybeBytes = do
case Maybe ByteString
maybeBytes of
Maybe ByteString
Maybe.Nothing -> do
forall (f :: * -> *) a. Applicative f => a -> f a
Applicative.pure ()
Maybe.Just ByteString
bytes -> do
Connection -> ByteString -> IO ()
Connection.connectionPut Connection
connection (ByteString -> ByteString
LazyBytes.toStrict ByteString
bytes)