websockets-simple-0.1.0: Composable websockets clients

Safe HaskellNone
LanguageHaskell2010

Network.WebSockets.Simple

Contents

Synopsis

Types

data WebSocketsApp m receive send Source #

Constructors

WebSocketsApp 

Fields

Instances

Profunctor (WebSocketsApp m) Source # 

Methods

dimap :: (a -> b) -> (c -> d) -> WebSocketsApp m b c -> WebSocketsApp m a d #

lmap :: (a -> b) -> WebSocketsApp m b c -> WebSocketsApp m a c #

rmap :: (b -> c) -> WebSocketsApp m a b -> WebSocketsApp m a c #

(#.) :: Coercible * c b => (b -> c) -> WebSocketsApp m a b -> WebSocketsApp m a c #

(.#) :: Coercible * b a => WebSocketsApp m b c -> (a -> b) -> WebSocketsApp m a c #

Generic (WebSocketsApp m receive send) Source # 

Associated Types

type Rep (WebSocketsApp m receive send) :: * -> * #

Methods

from :: WebSocketsApp m receive send -> Rep (WebSocketsApp m receive send) x #

to :: Rep (WebSocketsApp m receive send) x -> WebSocketsApp m receive send #

Applicative m => Monoid (WebSocketsApp m receive send) Source # 

Methods

mempty :: WebSocketsApp m receive send #

mappend :: WebSocketsApp m receive send -> WebSocketsApp m receive send -> WebSocketsApp m receive send #

mconcat :: [WebSocketsApp m receive send] -> WebSocketsApp m receive send #

type Rep (WebSocketsApp m receive send) Source # 
type Rep (WebSocketsApp m receive send) = D1 * (MetaData "WebSocketsApp" "Network.WebSockets.Simple" "websockets-simple-0.1.0-BkJTtgCNSBg7c104qxX2iS" False) (C1 * (MetaCons "WebSocketsApp" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "onOpen") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (WebSocketsAppParams m send -> m ()))) ((:*:) * (S1 * (MetaSel (Just Symbol "onReceive") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (WebSocketsAppParams m send -> receive -> m ()))) (S1 * (MetaSel (Just Symbol "onClose") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (CloseOrigin -> ConnectionException -> m ()))))))

data WebSocketsAppParams m send Source #

Constructors

WebSocketsAppParams 

Fields

Instances

Generic (WebSocketsAppParams m send) Source # 

Associated Types

type Rep (WebSocketsAppParams m send) :: * -> * #

Methods

from :: WebSocketsAppParams m send -> Rep (WebSocketsAppParams m send) x #

to :: Rep (WebSocketsAppParams m send) x -> WebSocketsAppParams m send #

type Rep (WebSocketsAppParams m send) Source # 
type Rep (WebSocketsAppParams m send) = D1 * (MetaData "WebSocketsAppParams" "Network.WebSockets.Simple" "websockets-simple-0.1.0-BkJTtgCNSBg7c104qxX2iS" False) (C1 * (MetaCons "WebSocketsAppParams" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "send") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (send -> m ()))) (S1 * (MetaSel (Just Symbol "close") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (m ())))))

data ConnectionException :: * #

Various exceptions that can occur while receiving or transmitting messages

Constructors

CloseRequest Word16 ByteString

The peer has requested that the connection be closed, and included a close code and a reason for closing. When receiving this exception, no more messages can be sent. Also, the server is responsible for closing the TCP connection once this exception is received.

See http://tools.ietf.org/html/rfc6455#section-7.4 for a list of close codes.

ConnectionClosed

The peer unexpectedly closed the connection while we were trying to receive some data. This is a violation of the websocket RFC since the TCP connection should only be closed after sending and receiving close control messages.

ParseException String

The client sent garbage, i.e. we could not parse the WebSockets stream.

UnicodeException String

The client sent invalid UTF-8. Note that this exception will only be thrown if strict decoding is set in the connection options.

Running

toClientAppT :: forall send receive m. (ToJSON send, FromJSON receive, MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadCatch m) => WebSocketsApp m receive send -> ClientAppT m () Source #

This can throw a WebSocketSimpleError to the main thread via link when json parsing fails.

Utilities

expBackoffStrategy Source #

Arguments

:: MonadIO m 
=> m a

Action to call, like pinging a scoped channel to trigger the reconnect

-> m (ConnectionException -> m a) 

A simple backoff strategy, which (per second), will increasingly delay at 2^soFar, until soFar >= 5minutes, where it will then routinely poll every 5 minutes.

hoistWebSocketsApp :: (forall a. m a -> n a) -> (forall a. n a -> m a) -> WebSocketsApp m receive send -> WebSocketsApp n receive send Source #