-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE CPP               #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Subscription.WebSocket
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Subscription.WebSocket
  ( -- *** Subscription
    websocketSub
  , send
  , close
  , connect
  , getSocketState
  -- *** Types
  , WebSocket   (..)
  , URL         (..)
  , Protocols   (..)
  , SocketState (..)
  , CloseCode   (..)
  , WasClean    (..)
  , Reason      (..)
  ) where
-----------------------------------------------------------------------------
import           Control.Concurrent (threadDelay)
import           Control.Monad (when, void, unless)
import           Control.Monad.IO.Class (liftIO)
import           Data.Aeson (FromJSON, ToJSON)
import           Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef)
import           GHC.Generics (Generic)
import           Language.Javascript.JSaddle hiding (create)
import           System.IO.Unsafe (unsafePerformIO)
-----------------------------------------------------------------------------
import           Miso.Effect (Sub)
import qualified Miso.FFI.Internal as FFI
import           Miso.String (MisoString)
-----------------------------------------------------------------------------
websocket :: IORef (Maybe Socket)
{-# NOINLINE websocket #-}
websocket :: IORef (Maybe Socket)
websocket = IO (IORef (Maybe Socket)) -> IORef (Maybe Socket)
forall a. IO a -> a
unsafePerformIO (Maybe Socket -> IO (IORef (Maybe Socket))
forall a. a -> IO (IORef a)
newIORef Maybe Socket
forall a. Maybe a
Nothing)
-----------------------------------------------------------------------------
closedCode :: IORef (Maybe CloseCode)
{-# NOINLINE closedCode #-}
closedCode :: IORef (Maybe CloseCode)
closedCode = IO (IORef (Maybe CloseCode)) -> IORef (Maybe CloseCode)
forall a. IO a -> a
unsafePerformIO (Maybe CloseCode -> IO (IORef (Maybe CloseCode))
forall a. a -> IO (IORef a)
newIORef Maybe CloseCode
forall a. Maybe a
Nothing)
-----------------------------------------------------------------------------
secs :: Int -> Int
secs :: Int -> Int
secs = (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1000000)
-----------------------------------------------------------------------------
-- | WebSocket subscription
websocketSub
  :: FromJSON m
  => URL
  -> Protocols
  -> (WebSocket m -> action)
  -> Sub action
websocketSub :: forall m action.
FromJSON m =>
URL -> Protocols -> (WebSocket m -> action) -> Sub action
websocketSub (URL MisoString
u) (Protocols [MisoString]
ps) WebSocket m -> action
f Sink action
sink = do
  Socket socket <- MisoString -> [MisoString] -> JSM Socket
createWebSocket MisoString
u [MisoString]
ps
  liftIO (writeIORef websocket (Just (Socket socket)))
  void . FFI.forkJSM $ handleReconnect
  FFI.addEventListener socket "open" $ \JSVal
_ -> do
    IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe CloseCode) -> Maybe CloseCode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe CloseCode)
closedCode Maybe CloseCode
forall a. Maybe a
Nothing)
    Sink action
sink (WebSocket m -> action
f WebSocket m
forall action. WebSocket action
WebSocketOpen)
  FFI.addEventListener socket "message" $ \JSVal
v -> do
    d <- JSVal -> JSM m
forall json. FromJSON json => JSVal -> JSM json
FFI.jsonParse (JSVal -> JSM m) -> JSM JSVal -> JSM m
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"data" :: MisoString)
    sink $ f (WebSocketMessage d)
  FFI.addEventListener socket "close" $ \JSVal
e -> do
    code <- Int -> CloseCode
codeToCloseCode (Int -> CloseCode) -> JSM Int -> JSM CloseCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> JSM Int
getCode JSVal
e
    liftIO (writeIORef closedCode (Just code))
    reason <- getReason e
    clean <- wasClean e
    sink $ f (WebSocketClose code clean reason)
  FFI.addEventListener socket "error" $ \JSVal
v -> do
    IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe CloseCode) -> Maybe CloseCode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe CloseCode)
closedCode Maybe CloseCode
forall a. Maybe a
Nothing)
    d' <- JSVal
v JSVal -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"data" :: MisoString)
#ifndef ghcjs_HOST_OS
    undef <- FFI.ghcjsPure (isUndefined d')
#else
    let undef = isUndefined d'
#endif
    if undef
      then do
         sink $ f (WebSocketError mempty)
      else do
         Just d <- fromJSVal d'
         sink $ f (WebSocketError d)
  where
    handleReconnect :: JSM ()
handleReconnect = do
      IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay (Int -> Int
secs Int
3))
      Just s <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
      status <- socketState s
      code <- liftIO (readIORef closedCode)
      if status == 3
        then do
          unless (code == Just CLOSE_NORMAL) $
            websocketSub (URL u) (Protocols ps) f sink
        else handleReconnect
-----------------------------------------------------------------------------
-- | Sends message to a websocket server
send :: ToJSON a => a -> JSM ()
{-# INLINE send #-}
send :: forall a. ToJSON a => a -> JSM ()
send a
x = do
  Just socket <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
  sendJson' socket x
-----------------------------------------------------------------------------
-- | Sends message to a websocket server
close :: JSM ()
{-# INLINE close #-}
close :: JSM ()
close = (Socket -> JSM ()) -> Maybe Socket -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Socket -> JSM ()
closeSocket (Maybe Socket -> JSM ()) -> JSM (Maybe Socket) -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
-----------------------------------------------------------------------------
-- | Connects to a websocket server
connect :: URL -> Protocols -> JSM ()
{-# INLINE connect #-}
connect :: URL -> Protocols -> JSM ()
connect (URL MisoString
url') (Protocols [MisoString]
ps) = do
  Just ws <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
  s <- socketState ws
  when (s == 3) $ do
    socket <- createWebSocket url' ps
    liftIO (atomicWriteIORef websocket (Just socket))
-----------------------------------------------------------------------------
-- | Retrieves current status of `WebSocket`
getSocketState :: JSM SocketState
getSocketState :: JSM SocketState
getSocketState = do
  Just ws <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
  toEnum <$> socketState ws
-----------------------------------------------------------------------------
sendJson' :: ToJSON json => Socket -> json -> JSM ()
sendJson' :: forall json. ToJSON json => Socket -> json -> JSM ()
sendJson' Socket
socket json
m = Socket -> MisoString -> JSM ()
sendSocket Socket
socket (MisoString -> JSM ()) -> JSM MisoString -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< json -> JSM MisoString
forall json. ToJSON json => json -> JSM MisoString
FFI.jsonStringify json
m
-----------------------------------------------------------------------------
createWebSocket :: MisoString -> [MisoString] -> JSM Socket
{-# INLINE createWebSocket #-}
createWebSocket :: MisoString -> [MisoString] -> JSM Socket
createWebSocket MisoString
url' [MisoString]
protocols = MisoString -> JSVal -> JSM Socket
createSocket MisoString
url' (JSVal -> JSM Socket) -> JSM JSVal -> JSM Socket
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [MisoString] -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal [MisoString]
protocols
-----------------------------------------------------------------------------
codeToCloseCode :: Int -> CloseCode
codeToCloseCode :: Int -> CloseCode
codeToCloseCode = Int -> CloseCode
go
  where
    go :: Int -> CloseCode
go Int
1000 = CloseCode
CLOSE_NORMAL
    go Int
1001 = CloseCode
CLOSE_GOING_AWAY
    go Int
1002 = CloseCode
CLOSE_PROTOCOL_ERROR
    go Int
1003 = CloseCode
CLOSE_UNSUPPORTED
    go Int
1005 = CloseCode
CLOSE_NO_STATUS
    go Int
1006 = CloseCode
CLOSE_ABNORMAL
    go Int
1007 = CloseCode
Unsupported_Data
    go Int
1008 = CloseCode
Policy_Violation
    go Int
1009 = CloseCode
CLOSE_TOO_LARGE
    go Int
1010 = CloseCode
Missing_Extension
    go Int
1011 = CloseCode
Internal_Error
    go Int
1012 = CloseCode
Service_Restart
    go Int
1013 = CloseCode
Try_Again_Later
    go Int
1015 = CloseCode
TLS_Handshake
    go Int
n    = Int -> CloseCode
OtherCode Int
n
-----------------------------------------------------------------------------
-- | WebSocket connection messages
data WebSocket action
  = WebSocketMessage action
  | WebSocketClose CloseCode WasClean Reason
  | WebSocketOpen
  | WebSocketError MisoString
  deriving (Int -> WebSocket action -> ShowS
[WebSocket action] -> ShowS
WebSocket action -> String
(Int -> WebSocket action -> ShowS)
-> (WebSocket action -> String)
-> ([WebSocket action] -> ShowS)
-> Show (WebSocket action)
forall action. Show action => Int -> WebSocket action -> ShowS
forall action. Show action => [WebSocket action] -> ShowS
forall action. Show action => WebSocket action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall action. Show action => Int -> WebSocket action -> ShowS
showsPrec :: Int -> WebSocket action -> ShowS
$cshow :: forall action. Show action => WebSocket action -> String
show :: WebSocket action -> String
$cshowList :: forall action. Show action => [WebSocket action] -> ShowS
showList :: [WebSocket action] -> ShowS
Show, WebSocket action -> WebSocket action -> Bool
(WebSocket action -> WebSocket action -> Bool)
-> (WebSocket action -> WebSocket action -> Bool)
-> Eq (WebSocket action)
forall action.
Eq action =>
WebSocket action -> WebSocket action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall action.
Eq action =>
WebSocket action -> WebSocket action -> Bool
== :: WebSocket action -> WebSocket action -> Bool
$c/= :: forall action.
Eq action =>
WebSocket action -> WebSocket action -> Bool
/= :: WebSocket action -> WebSocket action -> Bool
Eq)
-----------------------------------------------------------------------------
-- | URL of Websocket server
newtype URL = URL MisoString
  deriving (Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
(Int -> URL -> ShowS)
-> (URL -> String) -> ([URL] -> ShowS) -> Show URL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URL -> ShowS
showsPrec :: Int -> URL -> ShowS
$cshow :: URL -> String
show :: URL -> String
$cshowList :: [URL] -> ShowS
showList :: [URL] -> ShowS
Show, URL -> URL -> Bool
(URL -> URL -> Bool) -> (URL -> URL -> Bool) -> Eq URL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
/= :: URL -> URL -> Bool
Eq)
-----------------------------------------------------------------------------
-- | Protocols for Websocket connection
newtype Protocols = Protocols [MisoString]
  deriving (Int -> Protocols -> ShowS
[Protocols] -> ShowS
Protocols -> String
(Int -> Protocols -> ShowS)
-> (Protocols -> String)
-> ([Protocols] -> ShowS)
-> Show Protocols
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Protocols -> ShowS
showsPrec :: Int -> Protocols -> ShowS
$cshow :: Protocols -> String
show :: Protocols -> String
$cshowList :: [Protocols] -> ShowS
showList :: [Protocols] -> ShowS
Show, Protocols -> Protocols -> Bool
(Protocols -> Protocols -> Bool)
-> (Protocols -> Protocols -> Bool) -> Eq Protocols
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Protocols -> Protocols -> Bool
== :: Protocols -> Protocols -> Bool
$c/= :: Protocols -> Protocols -> Bool
/= :: Protocols -> Protocols -> Bool
Eq)
-----------------------------------------------------------------------------
-- | Wether or not the connection closed was done so cleanly
newtype WasClean = WasClean Bool deriving (Int -> WasClean -> ShowS
[WasClean] -> ShowS
WasClean -> String
(Int -> WasClean -> ShowS)
-> (WasClean -> String) -> ([WasClean] -> ShowS) -> Show WasClean
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WasClean -> ShowS
showsPrec :: Int -> WasClean -> ShowS
$cshow :: WasClean -> String
show :: WasClean -> String
$cshowList :: [WasClean] -> ShowS
showList :: [WasClean] -> ShowS
Show, WasClean -> WasClean -> Bool
(WasClean -> WasClean -> Bool)
-> (WasClean -> WasClean -> Bool) -> Eq WasClean
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WasClean -> WasClean -> Bool
== :: WasClean -> WasClean -> Bool
$c/= :: WasClean -> WasClean -> Bool
/= :: WasClean -> WasClean -> Bool
Eq)
-----------------------------------------------------------------------------
-- | Reason for closed connection
newtype Reason = Reason MisoString deriving (Int -> Reason -> ShowS
[Reason] -> ShowS
Reason -> String
(Int -> Reason -> ShowS)
-> (Reason -> String) -> ([Reason] -> ShowS) -> Show Reason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reason -> ShowS
showsPrec :: Int -> Reason -> ShowS
$cshow :: Reason -> String
show :: Reason -> String
$cshowList :: [Reason] -> ShowS
showList :: [Reason] -> ShowS
Show, Reason -> Reason -> Bool
(Reason -> Reason -> Bool)
-> (Reason -> Reason -> Bool) -> Eq Reason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reason -> Reason -> Bool
== :: Reason -> Reason -> Bool
$c/= :: Reason -> Reason -> Bool
/= :: Reason -> Reason -> Bool
Eq)
-----------------------------------------------------------------------------
-- | `SocketState` corresponding to current WebSocket connection
data SocketState
  = CONNECTING -- ^ 0
  | OPEN       -- ^ 1
  | CLOSING    -- ^ 2
  | CLOSED     -- ^ 3
  deriving (Int -> SocketState -> ShowS
[SocketState] -> ShowS
SocketState -> String
(Int -> SocketState -> ShowS)
-> (SocketState -> String)
-> ([SocketState] -> ShowS)
-> Show SocketState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocketState -> ShowS
showsPrec :: Int -> SocketState -> ShowS
$cshow :: SocketState -> String
show :: SocketState -> String
$cshowList :: [SocketState] -> ShowS
showList :: [SocketState] -> ShowS
Show, SocketState -> SocketState -> Bool
(SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool) -> Eq SocketState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocketState -> SocketState -> Bool
== :: SocketState -> SocketState -> Bool
$c/= :: SocketState -> SocketState -> Bool
/= :: SocketState -> SocketState -> Bool
Eq, Eq SocketState
Eq SocketState =>
(SocketState -> SocketState -> Ordering)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> SocketState)
-> (SocketState -> SocketState -> SocketState)
-> Ord SocketState
SocketState -> SocketState -> Bool
SocketState -> SocketState -> Ordering
SocketState -> SocketState -> SocketState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SocketState -> SocketState -> Ordering
compare :: SocketState -> SocketState -> Ordering
$c< :: SocketState -> SocketState -> Bool
< :: SocketState -> SocketState -> Bool
$c<= :: SocketState -> SocketState -> Bool
<= :: SocketState -> SocketState -> Bool
$c> :: SocketState -> SocketState -> Bool
> :: SocketState -> SocketState -> Bool
$c>= :: SocketState -> SocketState -> Bool
>= :: SocketState -> SocketState -> Bool
$cmax :: SocketState -> SocketState -> SocketState
max :: SocketState -> SocketState -> SocketState
$cmin :: SocketState -> SocketState -> SocketState
min :: SocketState -> SocketState -> SocketState
Ord, Int -> SocketState
SocketState -> Int
SocketState -> [SocketState]
SocketState -> SocketState
SocketState -> SocketState -> [SocketState]
SocketState -> SocketState -> SocketState -> [SocketState]
(SocketState -> SocketState)
-> (SocketState -> SocketState)
-> (Int -> SocketState)
-> (SocketState -> Int)
-> (SocketState -> [SocketState])
-> (SocketState -> SocketState -> [SocketState])
-> (SocketState -> SocketState -> [SocketState])
-> (SocketState -> SocketState -> SocketState -> [SocketState])
-> Enum SocketState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SocketState -> SocketState
succ :: SocketState -> SocketState
$cpred :: SocketState -> SocketState
pred :: SocketState -> SocketState
$ctoEnum :: Int -> SocketState
toEnum :: Int -> SocketState
$cfromEnum :: SocketState -> Int
fromEnum :: SocketState -> Int
$cenumFrom :: SocketState -> [SocketState]
enumFrom :: SocketState -> [SocketState]
$cenumFromThen :: SocketState -> SocketState -> [SocketState]
enumFromThen :: SocketState -> SocketState -> [SocketState]
$cenumFromTo :: SocketState -> SocketState -> [SocketState]
enumFromTo :: SocketState -> SocketState -> [SocketState]
$cenumFromThenTo :: SocketState -> SocketState -> SocketState -> [SocketState]
enumFromThenTo :: SocketState -> SocketState -> SocketState -> [SocketState]
Enum)
-----------------------------------------------------------------------------
-- | Code corresponding to a closed connection
-- https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent
data CloseCode
  = CLOSE_NORMAL
   -- ^ 1000, Normal closure; the connection successfully completed whatever purpose for which it was created.
  | CLOSE_GOING_AWAY
   -- ^ 1001, The endpoint is going away, either because of a server failure or because the browser is navigating away from the page that opened the connection.
  | CLOSE_PROTOCOL_ERROR
   -- ^ 1002, The endpoint is terminating the connection due to a protocol error.
  | CLOSE_UNSUPPORTED
   -- ^ 1003, The connection is being terminated because the endpoint received data of a type it cannot accept (for example, a textonly endpoint received binary data).
  | CLOSE_NO_STATUS
   -- ^ 1005, Reserved.  Indicates that no status code was provided even though one was expected.
  | CLOSE_ABNORMAL
   -- ^ 1006, Reserved. Used to indicate that a connection was closed abnormally (that is, with no close frame being sent) when a status code is expected.
  | Unsupported_Data
   -- ^ 1007, The endpoint is terminating the connection because a message was received that contained inconsistent data (e.g., nonUTF8 data within a text message).
  | Policy_Violation
   -- ^ 1008, The endpoint is terminating the connection because it received a message that violates its policy. This is a generic status code, used when codes 1003 and 1009 are not suitable.
  | CLOSE_TOO_LARGE
   -- ^ 1009, The endpoint is terminating the connection because a data frame was received that is too large.
  | Missing_Extension
   -- ^ 1010, The client is terminating the connection because it expected the server to negotiate one or more extension, but the server didn't.
  | Internal_Error
   -- ^ 1011, The server is terminating the connection because it encountered an unexpected condition that prevented it from fulfilling the request.
  | Service_Restart
   -- ^ 1012, The server is terminating the connection because it is restarting.
  | Try_Again_Later
   -- ^ 1013, The server is terminating the connection due to a temporary condition, e.g. it is overloaded and is casting off some of its clients.
  | TLS_Handshake
   -- ^ 1015, Reserved. Indicates that the connection was closed due to a failure to perform a TLS handshake (e.g., the server certificate can't be verified).
  | OtherCode Int
   -- ^ OtherCode that is reserved and not in the range 0999
  deriving (Int -> CloseCode -> ShowS
[CloseCode] -> ShowS
CloseCode -> String
(Int -> CloseCode -> ShowS)
-> (CloseCode -> String)
-> ([CloseCode] -> ShowS)
-> Show CloseCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloseCode -> ShowS
showsPrec :: Int -> CloseCode -> ShowS
$cshow :: CloseCode -> String
show :: CloseCode -> String
$cshowList :: [CloseCode] -> ShowS
showList :: [CloseCode] -> ShowS
Show, CloseCode -> CloseCode -> Bool
(CloseCode -> CloseCode -> Bool)
-> (CloseCode -> CloseCode -> Bool) -> Eq CloseCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloseCode -> CloseCode -> Bool
== :: CloseCode -> CloseCode -> Bool
$c/= :: CloseCode -> CloseCode -> Bool
/= :: CloseCode -> CloseCode -> Bool
Eq, (forall x. CloseCode -> Rep CloseCode x)
-> (forall x. Rep CloseCode x -> CloseCode) -> Generic CloseCode
forall x. Rep CloseCode x -> CloseCode
forall x. CloseCode -> Rep CloseCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloseCode -> Rep CloseCode x
from :: forall x. CloseCode -> Rep CloseCode x
$cto :: forall x. Rep CloseCode x -> CloseCode
to :: forall x. Rep CloseCode x -> CloseCode
Generic)
-----------------------------------------------------------------------------
instance ToJSVal CloseCode
-----------------------------------------------------------------------------
instance FromJSVal CloseCode
-----------------------------------------------------------------------------
newtype Socket = Socket JSVal
-----------------------------------------------------------------------------
createSocket :: MisoString -> JSVal -> JSM Socket
createSocket :: MisoString -> JSVal -> JSM Socket
createSocket MisoString
url JSVal
protocols = JSVal -> Socket
Socket (JSVal -> Socket) -> JSM JSVal -> JSM Socket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> (MisoString, JSVal) -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new (JSString -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (JSString
"WebSocket" :: JSString)) (MisoString
url, JSVal
protocols)
-----------------------------------------------------------------------------
socketState :: Socket -> JSM Int
socketState :: Socket -> JSM Int
socketState (Socket JSVal
s) = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
s JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"readyState" :: JSString)
-----------------------------------------------------------------------------
wasClean :: JSVal -> JSM WasClean
wasClean :: JSVal -> JSM WasClean
wasClean JSVal
v = Bool -> WasClean
WasClean (Bool -> WasClean) -> JSM Bool -> JSM WasClean
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> JSM Bool
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Bool) -> JSM JSVal -> JSM Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"wasClean" :: JSString))
-----------------------------------------------------------------------------
getCode :: JSVal -> JSM Int
getCode :: JSVal -> JSM Int
getCode JSVal
v = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"code" :: JSString)
-----------------------------------------------------------------------------
getReason :: JSVal -> JSM Reason
getReason :: JSVal -> JSM Reason
getReason JSVal
v = MisoString -> Reason
Reason (MisoString -> Reason) -> JSM MisoString -> JSM Reason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> JSM MisoString
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM MisoString) -> JSM JSVal -> JSM MisoString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"reason" :: JSString))
-----------------------------------------------------------------------------
closeSocket :: Socket -> JSM ()
closeSocket :: Socket -> JSM ()
closeSocket (Socket JSVal
s) = do
  _ <- JSVal
s JSVal -> JSString -> [JSString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (JSString
"close" :: JSString) ([JSString] -> JSM JSVal) -> [JSString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [JSString])
  pure ()
-----------------------------------------------------------------------------
sendSocket :: Socket -> MisoString -> JSM ()
sendSocket :: Socket -> MisoString -> JSM ()
sendSocket (Socket JSVal
s) MisoString
msg = do
  _ <- JSVal
s JSVal -> JSString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (JSString
"send" :: JSString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
msg]
  pure ()
-----------------------------------------------------------------------------