diff --git a/LICENSE.markdown b/LICENSE.markdown --- a/LICENSE.markdown +++ b/LICENSE.markdown @@ -1,6 +1,6 @@ MIT License -Copyright (c) 2022 Taylor Fausak +Copyright (c) 2023 Taylor Fausak Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,6 +1,6 @@ # Wuss -[![CI](https://github.com/tfausak/wuss/workflows/CI/badge.svg)](https://github.com/tfausak/wuss/actions/new) +[![Workflow](https://github.com/tfausak/wuss/actions/workflows/workflow.yaml/badge.svg)](https://github.com/tfausak/wuss/actions/workflows/workflow.yaml) [![Hackage](https://img.shields.io/hackage/v/wuss)](https://hackage.haskell.org/package/wuss) [![Stackage](https://www.stackage.org/package/wuss/badge/nightly?label=stackage)](https://www.stackage.org/package/wuss) diff --git a/source/library/Wuss.hs b/source/library/Wuss.hs --- a/source/library/Wuss.hs +++ b/source/library/Wuss.hs @@ -1,63 +1,61 @@ {-# LANGUAGE NoImplicitPrelude #-} -{- | - Wuss is a library that lets you easily create secure WebSocket clients over - the WSS protocol. It is a small addition to - - and is adapted from existing solutions by - , - , and - . - - == Example - - > import Wuss - > - > import Control.Concurrent (forkIO) - > import Control.Monad (forever, unless, void) - > import Data.Text (Text, pack) - > import Network.WebSockets (ClientApp, receiveData, sendClose, sendTextData) - > - > main :: IO () - > main = runSecureClient "echo.websocket.org" 443 "/" ws - > - > ws :: ClientApp () - > ws connection = do - > putStrLn "Connected!" - > - > void . forkIO . forever $ do - > message <- receiveData connection - > print (message :: Text) - > - > let loop = do - > line <- getLine - > unless (null line) $ do - > sendTextData connection (pack line) - > loop - > loop - > - > sendClose connection (pack "Bye!") - - == Retry - - Note that it is possible for the connection itself or any message to fail and need to be retried. - Fortunately this can be handled by something like . - See for an example. --} +-- | +-- Wuss is a library that lets you easily create secure WebSocket clients over +-- the WSS protocol. It is a small addition to +-- +-- and is adapted from existing solutions by +-- , +-- , and +-- . +-- +-- == Example +-- +-- > import Wuss +-- > +-- > import Control.Concurrent (forkIO) +-- > import Control.Monad (forever, unless, void) +-- > import Data.Text (Text, pack) +-- > import Network.WebSockets (ClientApp, receiveData, sendClose, sendTextData) +-- > +-- > main :: IO () +-- > main = runSecureClient "echo.websocket.org" 443 "/" ws +-- > +-- > ws :: ClientApp () +-- > ws connection = do +-- > putStrLn "Connected!" +-- > +-- > void . forkIO . forever $ do +-- > message <- receiveData connection +-- > print (message :: Text) +-- > +-- > let loop = do +-- > line <- getLine +-- > unless (null line) $ do +-- > sendTextData connection (pack line) +-- > loop +-- > loop +-- > +-- > sendClose connection (pack "Bye!") +-- +-- == Retry +-- +-- Note that it is possible for the connection itself or any message to fail and need to be retried. +-- Fortunately this can be handled by something like . +-- See for an example. module Wuss - ( runSecureClient - , runSecureClientWith - , Config(..) - , defaultConfig - , runSecureClientWithConfig - ) where - -import Prelude (($), (.)) + ( runSecureClient, + runSecureClientWith, + Config (..), + defaultConfig, + runSecureClientWithConfig, + ) +where import qualified Control.Applicative as Applicative import qualified Control.Exception as Exception -import qualified Control.Monad.IO.Class as MonadIO 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 @@ -69,157 +67,167 @@ import qualified Network.WebSockets.Stream as Stream import qualified System.IO as IO import qualified System.IO.Error as IO.Error - - -{- | - A secure replacement for 'Network.WebSockets.runClient'. +import Prelude (($), (.)) - >>> let app _connection = return () - >>> runSecureClient "echo.websocket.org" 443 "/" app --} -runSecureClient - :: MonadIO.MonadIO m - => Catch.MonadMask m - => Socket.HostName -- ^ Host - -> Socket.PortNumber -- ^ Port - -> String.String -- ^ Path - -> WebSockets.ClientApp a -- ^ Application - -> m a +-- | +-- A secure replacement for 'Network.WebSockets.runClient'. +-- +-- >>> let app _connection = return () +-- >>> runSecureClient "echo.websocket.org" 443 "/" app +runSecureClient :: + (MonadIO.MonadIO m) => + (Catch.MonadMask m) => + -- | Host + Socket.HostName -> + -- | Port + Socket.PortNumber -> + -- | Path + String.String -> + -- | Application + WebSockets.ClientApp a -> + m a runSecureClient host port path app = do let options = WebSockets.defaultConnectionOptions runSecureClientWith host port path options [] app - -{- | - A secure replacement for 'Network.WebSockets.runClientWith'. - - >>> let options = defaultConnectionOptions - >>> let headers = [] - >>> let app _connection = return () - >>> runSecureClientWith "echo.websocket.org" 443 "/" options headers app - - If you want to run a secure client without certificate validation, use - 'Network.WebSockets.runClientWithStream'. For example: - - > let host = "echo.websocket.org" - > let port = 443 - > let path = "/" - > let options = defaultConnectionOptions - > let headers = [] - > let tlsSettings = TLSSettingsSimple - > -- This is the important setting. - > { settingDisableCertificateValidation = True - > , settingDisableSession = False - > , settingUseServerName = False - > } - > let connectionParams = ConnectionParams - > { connectionHostname = host - > , connectionPort = port - > , connectionUseSecure = Just tlsSettings - > , connectionUseSocks = Nothing - > } - > - > context <- initConnectionContext - > connection <- connectTo context connectionParams - > stream <- makeStream - > (fmap Just (connectionGetChunk connection)) - > (maybe (return ()) (connectionPut connection . toStrict)) - > runClientWithStream stream host path options headers $ \ connection -> do - > -- Do something with the connection. - > return () --} -runSecureClientWith - :: MonadIO.MonadIO m - => Catch.MonadMask m - => Socket.HostName -- ^ Host - -> Socket.PortNumber -- ^ Port - -> String.String -- ^ Path - -> WebSockets.ConnectionOptions -- ^ Options - -> WebSockets.Headers -- ^ Headers - -> WebSockets.ClientApp a -- ^ Application - -> m a +-- | +-- A secure replacement for 'Network.WebSockets.runClientWith'. +-- +-- >>> let options = defaultConnectionOptions +-- >>> let headers = [] +-- >>> let app _connection = return () +-- >>> runSecureClientWith "echo.websocket.org" 443 "/" options headers app +-- +-- If you want to run a secure client without certificate validation, use +-- 'Network.WebSockets.runClientWithStream'. For example: +-- +-- > let host = "echo.websocket.org" +-- > let port = 443 +-- > let path = "/" +-- > let options = defaultConnectionOptions +-- > let headers = [] +-- > let tlsSettings = TLSSettingsSimple +-- > -- This is the important setting. +-- > { settingDisableCertificateValidation = True +-- > , settingDisableSession = False +-- > , settingUseServerName = False +-- > } +-- > let connectionParams = ConnectionParams +-- > { connectionHostname = host +-- > , connectionPort = port +-- > , connectionUseSecure = Just tlsSettings +-- > , connectionUseSocks = Nothing +-- > } +-- > +-- > context <- initConnectionContext +-- > connection <- connectTo context connectionParams +-- > stream <- makeStream +-- > (fmap Just (connectionGetChunk connection)) +-- > (maybe (return ()) (connectionPut connection . toStrict)) +-- > runClientWithStream stream host path options headers $ \ connection -> do +-- > -- Do something with the connection. +-- > return () +runSecureClientWith :: + (MonadIO.MonadIO m) => + (Catch.MonadMask m) => + -- | Host + Socket.HostName -> + -- | Port + Socket.PortNumber -> + -- | Path + String.String -> + -- | Options + WebSockets.ConnectionOptions -> + -- | Headers + WebSockets.Headers -> + -- | Application + WebSockets.ClientApp a -> + m a runSecureClientWith host port path options headers app = do let config = defaultConfig runSecureClientWithConfig host port path config options headers app - -- | Configures a secure WebSocket connection. newtype Config = Config - { connectionGet :: Connection.Connection -> IO.IO StrictBytes.ByteString - -- ^ How to get bytes from the connection. Typically + { -- | How to get bytes from the connection. Typically -- 'Connection.connectionGetChunk', but could be something else like -- 'Connection.connectionGetLine'. - } - + connectionGet :: Connection.Connection -> IO.IO StrictBytes.ByteString + } -- | The default 'Config' value used by 'runSecureClientWith'. defaultConfig :: Config defaultConfig = do - Config { connectionGet = Connection.connectionGetChunk } - + Config {connectionGet = Connection.connectionGetChunk} -- | Runs a secure WebSockets client with the given 'Config'. -runSecureClientWithConfig - :: MonadIO.MonadIO m - => Catch.MonadMask m - => Socket.HostName -- ^ Host - -> Socket.PortNumber -- ^ Port - -> String.String -- ^ Path - -> Config -- ^ Config - -> WebSockets.ConnectionOptions -- ^ Options - -> WebSockets.Headers -- ^ Headers - -> WebSockets.ClientApp a -- ^ Application - -> m a +runSecureClientWithConfig :: + (MonadIO.MonadIO m) => + (Catch.MonadMask m) => + -- | Host + Socket.HostName -> + -- | Port + Socket.PortNumber -> + -- | Path + String.String -> + -- | Config + Config -> + -- | Options + WebSockets.ConnectionOptions -> + -- | Headers + WebSockets.Headers -> + -- | Application + WebSockets.ClientApp a -> + m a runSecureClientWithConfig host port path config options headers app = do context <- MonadIO.liftIO Connection.initConnectionContext Catch.bracket (MonadIO.liftIO $ Connection.connectTo context (connectionParams host port)) (MonadIO.liftIO . Connection.connectionClose) - (\connection -> MonadIO.liftIO $ do - stream <- Stream.makeStream - (reader config connection) - (writer connection) - WebSockets.runClientWithStream stream host path options headers app + ( \connection -> MonadIO.liftIO $ do + stream <- + Stream.makeStream + (reader config connection) + (writer connection) + WebSockets.runClientWithStream stream host path options headers app ) - -connectionParams - :: Socket.HostName -> Socket.PortNumber -> Connection.ConnectionParams +connectionParams :: + Socket.HostName -> Socket.PortNumber -> Connection.ConnectionParams connectionParams host port = do Connection.ConnectionParams - { Connection.connectionHostname = host - , Connection.connectionPort = port - , Connection.connectionUseSecure = Maybe.Just tlsSettings - , Connection.connectionUseSocks = Maybe.Nothing + { Connection.connectionHostname = host, + Connection.connectionPort = port, + Connection.connectionUseSecure = Maybe.Just tlsSettings, + Connection.connectionUseSocks = Maybe.Nothing } - tlsSettings :: Connection.TLSSettings tlsSettings = do Connection.TLSSettingsSimple - { Connection.settingDisableCertificateValidation = Bool.False - , Connection.settingDisableSession = Bool.False - , Connection.settingUseServerName = Bool.False + { Connection.settingDisableCertificateValidation = Bool.False, + Connection.settingDisableSession = Bool.False, + Connection.settingUseServerName = Bool.False } - -reader - :: Config - -> Connection.Connection - -> IO.IO (Maybe.Maybe StrictBytes.ByteString) -reader config connection = IO.Error.catchIOError - (do - chunk <- connectionGet config connection - Applicative.pure (Maybe.Just chunk) - ) - (\e -> if IO.Error.isEOFError e - then Applicative.pure Maybe.Nothing - else Exception.throwIO e - ) - +reader :: + Config -> + Connection.Connection -> + IO.IO (Maybe.Maybe StrictBytes.ByteString) +reader config connection = + IO.Error.catchIOError + ( do + chunk <- connectionGet config connection + Applicative.pure (Maybe.Just chunk) + ) + ( \e -> + if IO.Error.isEOFError e + then Applicative.pure Maybe.Nothing + else Exception.throwIO e + ) -writer - :: Connection.Connection -> Maybe.Maybe LazyBytes.ByteString -> IO.IO () +writer :: + Connection.Connection -> Maybe.Maybe LazyBytes.ByteString -> IO.IO () writer connection maybeBytes = do case maybeBytes of Maybe.Nothing -> do diff --git a/wuss.cabal b/wuss.cabal --- a/wuss.cabal +++ b/wuss.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: wuss -version: 2.0.1.0 +version: 2.0.1.1 synopsis: Secure WebSocket (WSS) clients description: @@ -31,29 +31,26 @@ common library build-depends: - , base >= 4.13.0 && < 4.18 - , bytestring >= 0.10.10 && < 0.12 + , base >= 4.15.0 && < 4.18 + , bytestring >= 0.10.12 && < 0.12 , connection >= 0.3.1 && < 0.4 , network >= 3.1.1 && < 3.2 , websockets >= 0.12.7 && < 0.13 - , exceptions >= 0.10 && < 0.11 + , exceptions >= 0.10.4 && < 0.11 default-language: Haskell2010 ghc-options: -Weverything -Wno-missing-exported-signatures + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module -Wno-unsafe - if flag(pedantic) - ghc-options: -Werror - - if impl(ghc >= 8.10) - ghc-options: - -Wno-missing-safe-haskell-mode - -Wno-prepositive-qualified-module - if impl(ghc >= 9.2) ghc-options: -Wno-missing-kind-signatures + + if flag(pedantic) + ghc-options: -Werror library import: library