Log component!

src/App/AuthenticationForm.purs

@@ -35,7 +35,6 @@ data Query a = MessageReceived ArrayBuffer a
 
 type Slot = H.Slot Query Output
 
--- No input.
 type Input = Unit
 
 data AuthenticationInput

src/App/Container.purs

@@ -7,6 +7,7 @@ import Bulma as Bulma
 import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
 import App.AuthenticationForm as AF
+import App.Log as Log
 import App.WS as WS
 import App.AuthenticationDaemonAdminInterface as AAI
 import App.DNSManagerDomainsInterface         as NewDomainInterface
@@ -27,16 +28,18 @@ type State = { token :: Maybe String
              }
 
 type ChildSlots =
-  ( af  :: AF.Slot Unit
+  ( log     :: Log.Slot Unit
   , ws_auth :: WS.Slot Unit
   , ws_dns  :: WS.Slot Unit
+  , af      :: AF.Slot Unit
   , aai     :: AAI.Slot Unit
   , ndi     :: NewDomainInterface.Slot Unit
   )
 
-_af      = Proxy :: Proxy "af"
+_log     = Proxy :: Proxy "log"
 _ws_auth = Proxy :: Proxy "ws_auth"
 _ws_dns  = Proxy :: Proxy "ws_dns"
+_af      = Proxy :: Proxy "af"
 _aai     = Proxy :: Proxy "aai"
 _ndi     = Proxy :: Proxy "ndi"
 
@@ -58,8 +61,7 @@ initialState _ = { token: Nothing
 render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
 render state
   = HH.div_ $
-    [ render_auth_WS
+    [ Bulma.columns_ [ Bulma.column_ [ render_logs ], Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
-    , render_dnsmanager_WS
     , render_auth_form
     , render_authd_admin_interface
     , render_newdomain_interface
@@ -69,6 +71,9 @@ render state
     div_token :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     div_token = Bulma.box [ Bulma.p ("User [" <> show state.uid <> "] has token: " <> show state.token) ]
 
+    render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
+    render_logs = Bulma.box [ HH.slot_ _log unit Log.component unit ]
+
     render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_auth_WS = Bulma.box [ HH.slot _ws_auth unit WS.component "ws://127.0.0.1:8080" AuthDEvent ]
 
@@ -105,14 +110,23 @@ handleAction = case _ of
    AF.MessageToSend message -> do
      H.tell _ws_auth unit (WS.ToSend message)
 
+  -- TODO: depending on the current page, we should provide the received message to
+  --       different components.
   AuthDEvent ev -> case ev of
     WS.MessageReceived (Tuple _ message) ->
      H.tell _af unit (AF.MessageReceived message)
     WS.WSJustConnected          -> H.modify_ _ { auth_ws_connected = true }
     WS.WSJustClosed             -> H.modify_ _ { auth_ws_connected = false }
+    WS.AppendMessage msg        -> H.tell _log unit (Log.SimpleLog msg)
+    WS.AppendSystemMessage msg  -> H.tell _log unit (Log.SystemLog msg)
+    WS.UnableToSend        msg  -> H.tell _log unit (Log.UnableToSend msg)
 
   DNSManagerDEvent ev -> case ev of
-    WS.MessageReceived (Tuple _ _) -> pure unit -- TODO
+    WS.MessageReceived (Tuple _ _) -> pure unit
+     -- TODO: H.tell _ndi unit (NewDomainInterface.MessageReceived message)
     WS.WSJustConnected          -> H.modify_ _ { dns_ws_connected = true }
     WS.WSJustClosed             -> H.modify_ _ { dns_ws_connected = false }
+    WS.AppendMessage msg        -> H.tell _log unit (Log.SimpleLog msg)
+    WS.AppendSystemMessage msg  -> H.tell _log unit (Log.SystemLog msg)
+    WS.UnableToSend        msg  -> H.tell _log unit (Log.UnableToSend msg)
 

src/App/Log.purs

@@ -0,0 +1,65 @@
+module App.Log where
+
+{- Simple log component, showing the current events. -}
+
+import Prelude (Unit, discard, map, pure, ($))
+
+import Data.Maybe (Maybe(..))
+import Effect.Aff.Class (class MonadAff)
+import Halogen as H
+import Halogen.HTML as HH
+
+import App.Utils
+
+data Output = Void
+type Slot = H.Slot Query Output
+
+-- type Query :: forall k. k -> Type
+data Query a
+  = SimpleLog String a
+  | SystemLog String a
+  | UnableToSend String a
+
+type Input = Unit
+
+type Action = Unit
+
+type State =
+  { messages               :: Array String
+  , messageHistoryLength   :: Int
+  }
+
+component :: forall m. MonadAff m => H.Component Query Input Output m
+component =
+  H.mkComponent
+    { initialState
+    , render
+    , eval: H.mkEval $ H.defaultEval { handleQuery  = handleQuery }
+    }
+
+initialState :: Input -> State
+initialState _ =
+  { messages: []
+  , messageHistoryLength: 10
+  }
+
+render :: forall m. State -> H.ComponentHTML Action () m
+render { messages }
+    = HH.div_ [ render_messages ]
+    where
+      render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
+
+handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
+handleQuery = case _ of
+
+  SimpleLog str a -> do
+    appendMessage str
+    pure (Just a)
+
+  SystemLog str a -> do
+    systemMessage str
+    pure (Just a)
+
+  UnableToSend str a -> do
+    unableToSend str
+    pure (Just a)

src/App/WS.purs

@@ -2,7 +2,7 @@ module App.WS where
 
 {- This component handles all WS operations. -}
 
-import Prelude (Unit, bind, discard, map, pure, show, void, when, ($), (&&), (<$>), (<>), (>>=))
+import Prelude (Unit, bind, discard, map, pure, show, void, when, ($), (&&), (<$>), (<>), (>>=), unit)
 
 import Bulma as Bulma
 
@@ -30,8 +30,9 @@ 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.
+  | AppendSystemMessage String                  -- System message to print.
-  --| AppendMessage String                        -- Basic message to print.
+  | AppendMessage String                        -- Basic message to print.
+  | UnableToSend String                         -- Message to print: cannot send a packet.
 
 type Slot = H.Slot Query Output
 
@@ -54,11 +55,7 @@ type WSInfo
     , reconnect  :: Boolean
     }
 
-type State =
+type State = { wsInfo :: WSInfo }
-  { messages               :: Array String
-  , messageHistoryLength   :: Int
-  , wsInfo                 :: WSInfo
-  }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
 component =
@@ -75,25 +72,19 @@ component =
 
 initialState :: Input -> State
 initialState url =
-  { messages: []
+  { wsInfo: { url: url
-  , messageHistoryLength: 10
-  , wsInfo: { url: url
             , connection: Nothing
             , reconnect: false
             }
   }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { messages, wsInfo }
+render { wsInfo }
     = HH.div_
-       [ Bulma.h1 "WS BOX"
+       [ renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect)
-       , 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 ] ]
@@ -122,16 +113,16 @@ handleAction action = do
       handleAction ConnectWebSocket
 
     Finalize -> do
-      systemMessage "Finalize"
+      H.raise $ AppendSystemMessage "Finalize"
       case wsInfo.connection of
-        Nothing -> systemMessage "No socket? How is that even possible?"
+        Nothing -> H.raise $ AppendSystemMessage "No socket? How is that even possible?"
         Just socket -> H.liftEffect $ WS.close socket
 
     WebSocketParseError error ->
-      systemMessage $ renderError (UnknownError error)
+      H.raise $ AppendSystemMessage $ renderError (UnknownError error)
 
     ConnectWebSocket -> do
-      systemMessage ("Connecting to \"" <> wsInfo.url <>  "\"...")
+      H.raise $ AppendSystemMessage ("Connecting to \"" <> wsInfo.url <>  "\"...")
       webSocket <- H.liftEffect $ WS.create wsInfo.url []
       H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer
       H.modify_ _ { wsInfo { connection = Just webSocket } }
@@ -139,29 +130,29 @@ handleAction action = do
 
     SendMessage array_buffer_to_send -> do
       case wsInfo.connection of
-        Nothing -> appendMessage $ "[🤖] Can't send a message, websocket is down!"
+        Nothing -> H.raise $ 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
+          H.raise $ AppendMessage $ "[😈] Received a message"
 
         WebSocketOpen -> do
-          systemMessage ("Successfully connected to WebSocket at \"" <> wsInfo.url <>  "\"!🎉")
+          H.raise $ AppendSystemMessage ("Successfully connected to WebSocket at \"" <> wsInfo.url <>  "\"!🎉")
           H.raise $ WSJustConnected
 
         WebSocketClose { code, reason, wasClean } -> do
-          systemMessage $ renderCloseMessage code wasClean reason
+          H.raise $ AppendSystemMessage $ 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
+          H.raise $ AppendSystemMessage $ renderError errorType
           -- TODO: MAYBE inform the parent the connection is closed (if it's the case).
 
   where
@@ -191,21 +182,21 @@ handleQuery = case _ of
     { wsInfo } <- H.get
     case wsInfo.connection of
       Nothing -> do
-        unableToSend "Not connected to server."
+        H.raise $ UnableToSend "Not connected to server."
         pure Nothing
 
       Just webSocket -> do
         H.liftEffect (WS.readyState webSocket) >>= case _ of
           Connecting -> do
-            unableToSend "Still connecting to server."
+            H.raise $ UnableToSend "Still connecting to server."
             pure Nothing
 
           Closing -> do
-            unableToSend "Connection to server is closing."
+            H.raise $ UnableToSend "Connection to server is closing."
             pure Nothing
 
           Closed -> do
-            unableToSend "Connection to server has been closed."
+            H.raise $ UnableToSend "Connection to server has been closed."
             maybeCurrentConnection <- H.gets _.wsInfo.connection
             when (isJust maybeCurrentConnection) do
               H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } }