module App.WS where {- This component handles all WS operations. -} import Prelude (Unit, bind, discard, map, pure, show, void, when, ($), (&&), (<$>), (<>), (>>=)) import Bulma as Bulma import Data.Maybe (Maybe(..), isJust, isNothing) import Data.String as String import Data.Tuple (Tuple(..)) import Effect.Aff.Class (class MonadAff) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP import Web.Socket.WebSocket as WS import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed)) import App.Utils import Data.ArrayBuffer.Types (ArrayBuffer) import Web.Socket.BinaryType (BinaryType(ArrayBuffer)) -- Input is the WS url. type Input = String -- MessageReceived (Tuple URL message) data Output = MessageReceived (Tuple String ArrayBuffer) -- Provide a received message to the parent. | WSJustConnected -- Inform the parent the connection is up. | WSJustClosed -- Inform the parent the connection is down. --| AppendSystemMessage String -- System message to print. --| AppendMessage String -- Basic message to print. type Slot = H.Slot Query Output data Query a = ToSend ArrayBuffer a data Action = Initialize | WebSocketParseError String | ConnectWebSocket | SendMessage ArrayBuffer | Finalize | HandleWebSocket (WebSocketEvent WebSocketMessageType) type WSInfo = { url :: String , connection :: Maybe WS.WebSocket , reconnect :: Boolean } type State = { messages :: Array String , messageHistoryLength :: Int , wsInfo :: WSInfo } component :: forall m. MonadAff m => H.Component Query Input Output m component = H.mkComponent { initialState , render , eval: H.mkEval $ H.defaultEval { initialize = Just Initialize , handleAction = handleAction , handleQuery = handleQuery , finalize = Just Finalize } } initialState :: Input -> State initialState url = { messages: [] , messageHistoryLength: 10 , wsInfo: { url: url , connection: Nothing , reconnect: false } } render :: forall m. State -> H.ComponentHTML Action () m render { messages, wsInfo } = HH.div_ [ Bulma.h1 "WS BOX" , render_messages , renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect) ] where render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages renderFootnote :: String -> H.ComponentHTML Action () m renderFootnote txt = HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ] renderReconnectButton :: Boolean -> H.ComponentHTML Action () m renderReconnectButton cond = if cond then HH.p_ [ HH.button [ HP.type_ HP.ButtonButton , HE.onClick \_ -> ConnectWebSocket ] [ HH.text "Reconnect?" ] ] else HH.p_ [ renderFootnote "NOTE: A 'Reconnect?' button will appear if the connection drops" ] handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction action = do { wsInfo } <- H.get case action of Initialize -> handleAction ConnectWebSocket Finalize -> do systemMessage "Finalize" case wsInfo.connection of Nothing -> systemMessage "No socket? How is that even possible?" Just socket -> H.liftEffect $ WS.close socket WebSocketParseError error -> systemMessage $ renderError (UnknownError error) ConnectWebSocket -> do systemMessage ("Connecting to \"" <> wsInfo.url <> "\"...") webSocket <- H.liftEffect $ WS.create wsInfo.url [] H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer H.modify_ _ { wsInfo { connection = Just webSocket } } void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket) SendMessage array_buffer_to_send -> do case wsInfo.connection of Nothing -> appendMessage $ "[🤖] Can't send a message, websocket is down!" Just webSocket -> H.liftEffect $ do sendArrayBuffer webSocket array_buffer_to_send HandleWebSocket wsEvent -> do case wsEvent of WebSocketMessage received_message -> do appendMessage $ "[😈] Received a message" H.raise $ MessageReceived $ Tuple wsInfo.url received_message.message WebSocketOpen -> do systemMessage ("Successfully connected to WebSocket at \"" <> wsInfo.url <> "\"!🎉") H.raise $ WSJustConnected WebSocketClose { code, reason, wasClean } -> do systemMessage $ renderCloseMessage code wasClean reason maybeCurrentConnection <- H.gets _.wsInfo.connection when (isJust maybeCurrentConnection) do H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } } H.raise $ WSJustClosed WebSocketError errorType -> systemMessage $ renderError errorType -- TODO: MAYBE inform the parent the connection is closed (if it's the case). where renderCloseMessage :: Int -> Boolean -> String -> String renderCloseMessage code wasClean = case _ of "" -> baseCloseMessage reason -> baseCloseMessage <> "Reason: " <> reason where baseCloseMessage :: String baseCloseMessage = String.joinWith " " [ "Connection to WebSocket closed" , "[ CODE:" , show code , "|" , if wasClean then "CLEAN" else "DIRTY" , "]" ] handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of ToSend message a -> do { wsInfo } <- H.get case wsInfo.connection of Nothing -> do unableToSend "Not connected to server." pure Nothing Just webSocket -> do H.liftEffect (WS.readyState webSocket) >>= case _ of Connecting -> do unableToSend "Still connecting to server." pure Nothing Closing -> do unableToSend "Connection to server is closing." pure Nothing Closed -> do unableToSend "Connection to server has been closed." maybeCurrentConnection <- H.gets _.wsInfo.connection when (isJust maybeCurrentConnection) do H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } } pure Nothing Open -> do H.liftEffect $ do sendArrayBuffer webSocket message pure (Just a)