diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown new file mode 100644 --- /dev/null +++ b/CHANGELOG.markdown @@ -0,0 +1,4 @@ +# Change log + +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.markdown b/LICENSE.markdown --- a/LICENSE.markdown +++ b/LICENSE.markdown @@ -1,6 +1,6 @@ MIT License -Copyright (c) 2021 Taylor Fausak +Copyright (c) 2022 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/source/library/Wuss.hs b/source/library/Wuss.hs new file mode 100644 --- /dev/null +++ b/source/library/Wuss.hs @@ -0,0 +1,212 @@ +{-# 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!") +-} +module Wuss + ( runSecureClient + , runSecureClientWith + , Config(..) + , defaultConfig + , runSecureClientWithConfig + ) where + +import qualified Control.Applicative as Applicative +import qualified Control.Exception as Exception +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 + + +{- | + A secure replacement for 'Network.WebSockets.runClient'. + + >>> let app _connection = return () + >>> runSecureClient "echo.websocket.org" 443 "/" app +-} +runSecureClient + :: Socket.HostName -- ^ Host + -> Socket.PortNumber -- ^ Port + -> String.String -- ^ Path + -> WebSockets.ClientApp a -- ^ Application + -> IO.IO 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 + :: Socket.HostName -- ^ Host + -> Socket.PortNumber -- ^ Port + -> String.String -- ^ Path + -> WebSockets.ConnectionOptions -- ^ Options + -> WebSockets.Headers -- ^ Headers + -> WebSockets.ClientApp a -- ^ Application + -> IO.IO 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 + -- 'Connection.connectionGetChunk', but could be something else like + -- 'Connection.connectionGetLine'. + } + + +-- | 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 + :: Socket.HostName -- ^ Host + -> Socket.PortNumber -- ^ Port + -> String.String -- ^ Path + -> Config -- ^ Config + -> WebSockets.ConnectionOptions -- ^ Options + -> WebSockets.Headers -- ^ Headers + -> WebSockets.ClientApp a -- ^ Application + -> IO.IO a +runSecureClientWithConfig host port path config options headers app = do + context <- Connection.initConnectionContext + Exception.bracket + (Connection.connectTo context (connectionParams host port)) + Connection.connectionClose + (\connection -> 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 host port = do + Connection.ConnectionParams + { 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 + } + + +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/src/lib/Wuss.hs b/src/lib/Wuss.hs deleted file mode 100644 --- a/src/lib/Wuss.hs +++ /dev/null @@ -1,217 +0,0 @@ -{-# 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!") --} -module Wuss - ( runSecureClient - , runSecureClientWith - , Config(..) - , defaultConfig - , runSecureClientWithConfig - ) where - -import qualified Control.Applicative as Applicative -import qualified Control.Exception as Exception -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 - - -{- | - A secure replacement for 'Network.WebSockets.runClient'. - - >>> let app _connection = return () - >>> runSecureClient "echo.websocket.org" 443 "/" app --} -runSecureClient - :: Socket.HostName -- ^ Host - -> Socket.PortNumber -- ^ Port - -> String.String -- ^ Path - -> WebSockets.ClientApp a -- ^ Application - -> IO.IO 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 - :: Socket.HostName -- ^ Host - -> Socket.PortNumber -- ^ Port - -> String.String -- ^ Path - -> WebSockets.ConnectionOptions -- ^ Options - -> WebSockets.Headers -- ^ Headers - -> WebSockets.ClientApp a -- ^ Application - -> IO.IO 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. -data Config = Config - { connectionGet :: Connection.Connection -> IO.IO StrictBytes.ByteString - -- ^ How to get bytes from the connection. Typically - -- 'Connection.connectionGetChunk', but could be something else like - -- 'Connection.connectionGetLine'. - } - - --- | 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 - :: Socket.HostName -- ^ Host - -> Socket.PortNumber -- ^ Port - -> String.String -- ^ Path - -> Config -- ^ Config - -> WebSockets.ConnectionOptions -- ^ Options - -> WebSockets.Headers -- ^ Headers - -> WebSockets.ClientApp a -- ^ Application - -> IO.IO a -runSecureClientWithConfig host port path config options headers app = do - context <- Connection.initConnectionContext - Exception.bracket - (Connection.connectTo context (connectionParams host port)) - Connection.connectionClose - (\connection -> 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 host port = do - Connection.ConnectionParams - { 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 - } - - -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/wuss.cabal b/wuss.cabal --- a/wuss.cabal +++ b/wuss.cabal @@ -1,7 +1,7 @@ -cabal-version: >= 1.10 +cabal-version: 2.2 name: wuss -version: 1.1.19 +version: 2.0.0.0 synopsis: Secure WebSocket (WSS) clients description: @@ -15,7 +15,7 @@ build-type: Simple category: Network -extra-source-files: README.markdown +extra-source-files: CHANGELOG.markdown README.markdown license-file: LICENSE.markdown license: MIT maintainer: Taylor Fausak @@ -24,22 +24,38 @@ location: https://github.com/tfausak/wuss type: git -library +flag pedantic + default: False + description: Enables @-Werror@, which turns warnings into errors. + manual: True + +common library build-depends: - base >= 4.13.0 && < 4.17 + , base >= 4.13.0 && < 4.17 , bytestring >= 0.10.10 && < 0.12 , connection >= 0.3.1 && < 0.4 , network >= 3.1.1 && < 3.2 , websockets >= 0.12.7 && < 0.13 default-language: Haskell2010 - exposed-modules: Wuss ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-unsafe - hs-source-dirs: src/lib + 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 + +library + import: library + + exposed-modules: Wuss + hs-source-dirs: source/library