diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,4 @@ # Change log -Wuss uses [Semantic Versioning][]. -The change log is available through the [releases on GitHub][]. - -[Semantic Versioning]: http://semver.org/spec/v2.0.0.html -[releases on GitHub]: https://github.com/tfausak/wuss/releases +Wuss follows the [Package Versioning Policy](https://pvp.haskell.org). +You can find release notes [on GitHub](https://github.com/tfausak/wuss/releases). diff --git a/LICENSE.md b/LICENSE.md deleted file mode 100644 --- a/LICENSE.md +++ /dev/null @@ -1,23 +0,0 @@ -[The MIT License (MIT)][] - -Copyright (c) 2016 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 in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. - -[The MIT License (MIT)]: https://opensource.org/licenses/MIT diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2026 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 +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,71 @@ +# Wuss + +[![CI](https://github.com/tfausak/wuss/actions/workflows/ci.yml/badge.svg)](https://github.com/tfausak/wuss/actions/workflows/ci.yml) +[![Hackage](https://badgen.net/hackage/v/wuss)](https://hackage.haskell.org/package/wuss) + +Secure WebSocket (WSS) clients in Haskell. + +--- + +Wuss is a library that lets you easily create secure WebSocket clients over the +WSS protocol. It is a small addition to [the `websockets` package][] and is +adapted from existing solutions by [@jaspervdj][], [@mpickering][], and +[@elfenlaid][]. + +- [Installation](#installation) +- [Usage](#usage) + +## Installation + +To add Wuss as a dependency to your package, add it to your Cabal file. + +``` +build-depends: wuss +``` + +For other use cases, install it with Cabal. + +``` sh +$ cabal install wuss +``` + +## Usage + +``` hs +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!") +``` + +For more information about Wuss, please read [the Haddock documentation][]. + +[the `websockets` package]: https://hackage.haskell.org/package/websockets +[@jaspervdj]: https://gist.github.com/jaspervdj/7198388 +[@mpickering]: https://gist.github.com/mpickering/f1b7ba3190a4bb5884f3 +[@elfenlaid]: https://gist.github.com/elfenlaid/7b5c28065e67e4cf0767 +[semantic versioning]: http://semver.org/spec/v2.0.0.html +[the change log]: CHANGELOG.md +[the haddock documentation]: https://hackage.haskell.org/package/wuss diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,4 +0,0 @@ -import qualified Distribution.Simple - -main :: IO () -main = Distribution.Simple.defaultMain diff --git a/Wuss.hs b/Wuss.hs deleted file mode 100644 --- a/Wuss.hs +++ /dev/null @@ -1,142 +0,0 @@ -{- | - 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!") --} -module Wuss - ( runSecureClient - , runSecureClientWith - ) where - -import qualified Data.ByteString as BS -import Data.ByteString.Lazy (toStrict) -import qualified Data.ByteString.Lazy as BL -import Network.Connection (Connection, ConnectionParams (..), TLSSettings (..), - connectTo, connectionGetChunk, connectionPut, initConnectionContext) -import Network.Socket (HostName, PortNumber) -import Network.WebSockets (ClientApp, ConnectionOptions, Headers, - defaultConnectionOptions, runClientWithStream) -import Network.WebSockets.Stream (makeStream) - -{- | - A secure replacement for 'Network.WebSockets.runClient'. - - >>> let app _connection = return () - >>> runSecureClient "echo.websocket.org" 443 "/" app --} -runSecureClient - :: HostName -- ^ Host - -> PortNumber -- ^ Port - -> String -- ^ Path - -> ClientApp a -- ^ Application - -> IO a -runSecureClient host port path app = - let options = defaultConnectionOptions - headers = [] - in runSecureClientWith host port path options headers 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 - :: HostName -- ^ Host - -> PortNumber -- ^ Port - -> String -- ^ Path - -> ConnectionOptions -- ^ Options - -> Headers -- ^ Headers - -> ClientApp a -- ^ Application - -> IO a -runSecureClientWith host port path options headers app = do - context <- initConnectionContext - connection <- connectTo context (connectionParams host port) - stream <- makeStream (reader connection) (writer connection) - runClientWithStream stream host path options headers app - -connectionParams :: HostName -> PortNumber -> ConnectionParams -connectionParams host port = ConnectionParams - { connectionHostname = host - , connectionPort = port - , connectionUseSecure = Just tlsSettings - , connectionUseSocks = Nothing - } - -tlsSettings :: TLSSettings -tlsSettings = TLSSettingsSimple - { settingDisableCertificateValidation = False - , settingDisableSession = False - , settingUseServerName = False - } - -reader :: Connection -> IO (Maybe BS.ByteString) -reader connection = fmap Just (connectionGetChunk connection) - -writer :: Connection -> Maybe BL.ByteString -> IO () -writer connection = maybe (return ()) (connectionPut connection . toStrict) diff --git a/package.yaml b/package.yaml deleted file mode 100644 --- a/package.yaml +++ /dev/null @@ -1,28 +0,0 @@ -category: Network -description: 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 - . -extra-source-files: -- CHANGELOG.md -- LICENSE.md -- package.yaml -- stack.yaml -ghc-options: -Wall -github: tfausak/wuss -library: - dependencies: - - base ==4.* - - bytestring - - connection ==0.2.* - - network - - websockets ==0.9.* - exposed-modules: Wuss -license: MIT -maintainer: Taylor Fausak -name: wuss -synopsis: Secure WebSocket (WSS) clients -version: '1.0.4' diff --git a/source/library/Wuss.hs b/source/library/Wuss.hs new file mode 100644 --- /dev/null +++ b/source/library/Wuss.hs @@ -0,0 +1,305 @@ +{-# 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. +module Wuss + ( runSecureClient, + newSecureClientConnection, + runSecureClientWith, + newSecureClientConnectionWith, + Config (..), + defaultConfig, + runSecureClientWithConfig, + newSecureClientConnectionWithConfig, + ) +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.ByteString as StrictBytes +import qualified Data.ByteString.Lazy as LazyBytes +import qualified Data.Default as Default +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 (($), (.)) + +-- | +-- 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 + +-- | Build a new `Connection` from the client's point of view. +-- +-- /WARNING/: Be sure to run the returned `IO ()` action after you are done +-- using the `Connection` in order to properly close the communication channel. +-- `runSecureClient` handles this for you, prefer to use it when possible. +newSecureClientConnection :: + (MonadIO.MonadIO m) => + (Catch.MonadMask m) => + -- | Host + Socket.HostName -> + -- | PortNumber + Socket.PortNumber -> + -- | Path + String.String -> + m (WebSockets.Connection, IO.IO ()) +newSecureClientConnection host port path = do + let options = WebSockets.defaultConnectionOptions + newSecureClientConnectionWith host port path options [] + +-- | +-- 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 + +-- | Build a new `Connection` from the client's point of view. +-- +-- /WARNING/: Be sure to run the returned `IO ()` action after you are done +-- using the `Connection` in order to properly close the communication channel. +-- `runSecureClientWith` handles this for you, prefer to use it when possible. +newSecureClientConnectionWith :: + (MonadIO.MonadIO m) => + (Catch.MonadMask m) => + -- | Host + Socket.HostName -> + -- | PortNumber + Socket.PortNumber -> + -- | Path + String.String -> + -- | Options + WebSockets.ConnectionOptions -> + -- | Headers + WebSockets.Headers -> + m (WebSockets.Connection, IO.IO ()) +newSecureClientConnectionWith host port path options headers = do + let config = defaultConfig + newSecureClientConnectionWithConfig host port path config options headers + +-- | Configures a secure WebSocket connection. +newtype Config = Config + { -- | 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} + +-- | Runs a secure WebSockets client with the given 'Config'. +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 = + Catch.bracket + (newSecureClientConnectionWithConfig host port path config options headers) + (\(_, close) -> MonadIO.liftIO close) + (\(conn, _) -> MonadIO.liftIO (app conn)) + +-- | Build a new `Connection` from the client's point of view. +-- +-- /WARNING/: Be sure to run the returned `IO ()` action after you are done +-- using the `Connection` in order to properly close the communication channel. +-- `runSecureClientWithConfig` handles this for you, prefer to use it when +-- possible. +newSecureClientConnectionWithConfig :: + (MonadIO.MonadIO m) => + (Catch.MonadMask m) => + -- | Host + Socket.HostName -> + -- | PortNumber + Socket.PortNumber -> + -- | Path + String.String -> + -- | Config + Config -> + -- | Options + WebSockets.ConnectionOptions -> + -- | Headers + WebSockets.Headers -> + m (WebSockets.Connection, IO.IO ()) +newSecureClientConnectionWithConfig host port path config options headers = do + context <- MonadIO.liftIO Connection.initConnectionContext + Catch.bracketOnError + (MonadIO.liftIO $ Connection.connectTo context (connectionParams host port)) + (MonadIO.liftIO . Connection.connectionClose) + ( \connection -> MonadIO.liftIO $ do + stream <- + Stream.makeStream + (reader config connection) + (writer connection) + conn <- WebSockets.newClientConnection stream host path options headers + Applicative.pure (conn, Connection.connectionClose connection) + ) + +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 + } + +tlsSettings :: Connection.TLSSettings +tlsSettings = Default.def + +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 maybeBytes = do + case maybeBytes of + Maybe.Nothing -> do + Applicative.pure () + Maybe.Just bytes -> do + Connection.connectionPut connection (LazyBytes.toStrict bytes) diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 --- a/stack.yaml +++ /dev/null @@ -1,3 +0,0 @@ -install-ghc: true -require-stack-version: ! '>=1.0.4' -resolver: lts-5.12 diff --git a/wuss.cabal b/wuss.cabal --- a/wuss.cabal +++ b/wuss.cabal @@ -1,39 +1,59 @@ --- This file has been generated from package.yaml by hpack version 0.9.0. --- --- see: https://github.com/sol/hpack +cabal-version: 2.2 +name: wuss +version: 2.0.2.7 +synopsis: Secure WebSocket (WSS) clients +description: + 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 + . -name: wuss -version: 1.0.4 -synopsis: Secure WebSocket (WSS) clients -description: 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 . -category: Network -homepage: https://github.com/tfausak/wuss#readme -bug-reports: https://github.com/tfausak/wuss/issues -maintainer: Taylor Fausak -license: MIT -build-type: Simple -cabal-version: >= 1.10 +build-type: Simple +category: Network +extra-doc-files: + CHANGELOG.md + README.md -extra-source-files: - CHANGELOG.md - LICENSE.md - package.yaml - stack.yaml +license-file: LICENSE.txt +license: MIT +maintainer: Taylor Fausak source-repository head - type: git location: https://github.com/tfausak/wuss + type: git -library - ghc-options: -Wall +flag pedantic + default: False + manual: True + +common library + build-depends: base ^>=4.20.0.0 || ^>=4.21.0.0 || ^>=4.22.0.0 build-depends: - base ==4.* - , bytestring - , connection ==0.2.* - , network - , websockets ==0.9.* - exposed-modules: - Wuss - other-modules: - Paths_wuss + bytestring ^>=0.12.0.2, + crypton-connection ^>=0.3.2 || ^>=0.4.0, + data-default ^>=0.7.0 || ^>=0.8.0.0, + exceptions ^>=0.10.7, + network ^>=3.1.4.0 || ^>=3.2.0.0, + websockets ^>=0.12.7.3 || ^>=0.13.0.0, + default-language: Haskell2010 + ghc-options: + -Weverything + -Wno-all-missed-specialisations + -Wno-missing-exported-signatures + -Wno-missing-kind-signatures + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module + -Wno-unsafe + + if flag(pedantic) + ghc-options: -Werror + +library + import: library + -- cabal-gild: discover source/library + exposed-modules: Wuss + hs-source-dirs: source/library