WIP: CAN'T BE COMPILED. WILL BE SOON FIXED.

src/App/AuthenticationDaemonAdminInterface.purs

@@ -34,7 +34,11 @@ data Output
   | SystemMessage String
   | UnableToSend String
 
-data Query a = MessageReceived ArrayBuffer a
+data Query a
+  = MessageReceived ArrayBuffer a
+  | ConnectionIsDown a
+  | ConnectionIsUp a
+
 type Slot = H.Slot Query Output
 
 type Input = Unit
@@ -193,6 +197,15 @@ handleQuery = case _ of
               H.raise $ AppendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
               pure (Just a)
 
+  ConnectionIsDown a -> do
+    H.modify_ _ { wsUp = false }
+    pure (Just a)
+
+  ConnectionIsUp a -> do
+    H.modify_ _ { wsUp = true }
+    pure (Just a)
+
+
 ----print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
 --print_json_string arraybuffer = do
 --  -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))

src/App/AuthenticationForm.purs

@@ -34,7 +34,10 @@ data Output
   | SystemMessage String
   | UnableToSend String
 
-data Query a = MessageReceived ArrayBuffer a
+data Query a
+  = MessageReceived ArrayBuffer a
+  | ConnectionIsDown a
+  | ConnectionIsUp a
 
 type Slot = H.Slot Query Output
 
@@ -50,17 +53,11 @@ data RegisterInput
   | REG_INP_pass String
 
 data Action
-  = Initialize
+  = HandleAuthenticationInput AuthenticationInput
-  -- | WebSocketParseError String
-  -- | ConnectWebSocket
-
-  | HandleAuthenticationInput AuthenticationInput
   | HandleRegisterInput       RegisterInput
-
+  --
   | AuthenticationAttempt Event
   | RegisterAttempt Event
-  | Finalize
-  --| HandleWebSocket (WebSocketEvent WebSocketMessageType)
 
 type StateAuthenticationForm = { login :: String, pass :: String }
 type StateRegistrationForm = { login :: String, email :: String, pass :: String }
@@ -68,7 +65,6 @@ type StateRegistrationForm = { login :: String, email :: String, pass :: String
 type State =
   { authenticationForm     :: StateAuthenticationForm
   , registrationForm       :: StateRegistrationForm
-
   , wsUp                   :: Boolean
   }
 
@@ -78,10 +74,8 @@ component =
     { initialState
     , render
     , eval: H.mkEval $ H.defaultEval
-        { initialize = Just Initialize
+        { handleAction = handleAction
-        , handleAction = handleAction
         , handleQuery  = handleQuery
-        , finalize = Just Finalize
         }
     }
 
@@ -163,12 +157,6 @@ render { wsUp,
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
-  Initialize ->
-    H.raise $ SystemMessage "Authentication form initialized."
-
-  Finalize ->
-    H.raise $ SystemMessage "Removing the authentication form."
-
   HandleAuthenticationInput authinp -> do
     case authinp of
       AUTH_INP_login v -> H.modify_ _ { authenticationForm { login = v } }
@@ -204,7 +192,7 @@ handleAction = case _ of
                            , email: Just (Email.Email email)
                            , password: pass }
         H.raise $ MessageToSend message
-        H.raise $ AppendMessage "[😇] Trying to register"
+        H.raise $ AppendMessage $ "[😇] Trying to register (login: " <> login <> ")"
 
   AuthenticationAttempt ev -> do
     H.liftEffect $ Event.preventDefault ev
@@ -221,8 +209,7 @@ handleAction = case _ of
       login, pass -> do
         message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass }
         H.raise $ MessageToSend message
-        H.raise $ AppendMessage $ "[😇] Trying to connect with login: " <> login
+        H.raise $ AppendMessage $ "[😇] Trying to authenticate (login: " <> login <> ")"
-
 
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
@@ -247,7 +234,7 @@ handleQuery = case _ of
               pure (Just a)
             -- The authentication was a success!
             (AuthD.GotToken msg) -> do
-              H.raise $ AppendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token
+              H.raise $ AppendMessage $ "[🎉] Authenticated!"
               H.raise $ AuthToken (Tuple msg.uid msg.token)
               pure (Just a)
             -- WTH?!
@@ -255,10 +242,18 @@ handleQuery = case _ of
               H.raise $ AppendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
               pure Nothing
 
+  ConnectionIsDown a -> do
+    H.modify_ _ { wsUp = false }
+    pure (Just a)
+
+  ConnectionIsUp a -> do
+    H.modify_ _ { wsUp = true }
+    pure (Just a)
+
 --print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
-print_json_string arraybuffer = do
+--print_json_string arraybuffer = do
-  -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
+--  -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
-  value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
+--  value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
-  H.raise $ AppendMessage $ case (value) of
+--  H.raise $ AppendMessage $ case (value) of
-    Left _ -> "Cannot even fromTypedIPC the message."
+--    Left _ -> "Cannot even fromTypedIPC the message."
-    Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
+--    Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string

src/App/Container.purs

@@ -24,8 +24,6 @@ data Action
 
 type State = { token :: Maybe String
              , uid :: Maybe Int
-             , auth_ws_connected :: Boolean
-             , dns_ws_connected  :: Boolean
              }
 
 type ChildSlots =
@@ -55,8 +53,6 @@ component =
 initialState :: forall i. i -> State
 initialState _ = { token: Nothing
                  , uid: Nothing
-                 , auth_ws_connected: false
-                 , dns_ws_connected:  false
                  }
 
 render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
@@ -119,23 +115,28 @@ handleAction = case _ of
    AAI.SystemMessage message        -> H.tell _log unit (Log.SystemLog message)
    AAI.UnableToSend  message        -> H.tell _log unit (Log.UnableToSend message)
 
-  -- TODO: depending on the current page, we should provide the received message to
+  -- TODO: depending on the current page, we should provide the received message to different components.
-  --       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.WSJustConnected -> do
-    WS.WSJustClosed             -> H.modify_ _ { auth_ws_connected = false }
+      H.tell _af unit AF.ConnectionIsUp
+      H.tell _aai unit AAI.ConnectionIsUp
+    WS.WSJustClosed -> do
+      H.tell _af unit AF.ConnectionIsDown
+      H.tell _aai unit AAI.ConnectionIsDown
     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)
+    WS.UnableToSend msg         -> H.tell _log unit (Log.UnableToSend msg)
 
   DNSManagerDEvent ev -> case ev of
     WS.MessageReceived (Tuple _ _) -> pure unit
      -- TODO: H.tell _ndi unit (NewDomainInterface.MessageReceived message)
-    WS.WSJustConnected          -> H.modify_ _ { dns_ws_connected = true }
+    WS.WSJustConnected          -> do
-    WS.WSJustClosed             -> H.modify_ _ { dns_ws_connected = false }
+      H.tell _ndi unit NewDomainInterface.ConnectionIsUp
+    WS.WSJustClosed             -> do
+      H.tell _ndi unit NewDomainInterface.ConnectionIsDown
     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)
+    WS.UnableToSend msg         -> H.tell _log unit (Log.UnableToSend msg)
 

src/App/DNSManagerDomainsInterface.purs

@@ -32,7 +32,6 @@ import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Web.Event.Event (Event)
 import Web.Event.Event as Event
-import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed))
 import Web.Socket.WebSocket as WS
 
 import Effect.Class (class MonadEffect)
@@ -49,11 +48,19 @@ import Web.Socket.BinaryType (BinaryType(ArrayBuffer))
 -- Root component module
 --------------------------------------------------------------------------------
 
-data Output = Void
+data Output
+  = MessageToSend ArrayBuffer
+  | AppendMessage String
+  | SystemMessage String
+  | UnableToSend String
+
+data Query a
+  = MessageReceived ArrayBuffer a
+  | ConnectionIsDown a
+  | ConnectionIsUp a
+
 type Slot = H.Slot Query Output
 
-type Query :: forall k. k -> Type
-type Query = Const Void
 -- Input = url token
 type Input = Tuple String String
 
@@ -62,11 +69,7 @@ data NewDomainFormAction
   | UpdateSelectedDomain String
 
 data Action
-  = Initialize
+  = UpdateAcceptedDomains (Array String)
-  | WebSocketParseError String
-  | ConnectWebSocket
-
-  | UpdateAcceptedDomains (Array String)
   | UpdateMyDomains (Array String)
 
   | AuthenticateToDNSManager
@@ -76,7 +79,6 @@ data Action
   | NewDomainAttempt Event
   | RemoveDomain String
   | EnterDomain String
-  | Finalize
   | HandleWebSocket (WebSocketEvent WebSocketMessageType)
 
 type NewDomainFormState
@@ -84,22 +86,12 @@ type NewDomainFormState
     , selected_domain :: String
     }
 
-type WSInfo
-  = { url        :: String
-    , connection :: Maybe WS.WebSocket
-    , reconnect  :: Boolean
-    , token      :: String
-    }
-
 type State =
-  { messages               :: Array String
+  { newDomainForm          :: NewDomainFormState
-  , messageHistoryLength   :: Int
-
-  , newDomainForm          :: NewDomainFormState
   , accepted_domains       :: Array String
   , my_domains             :: Array String
 
-  , wsInfo                 :: WSInfo
+  , wsUp :: Boolean
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -110,7 +102,7 @@ component =
     , eval: H.mkEval $ H.defaultEval
         { initialize = Just Initialize
         , handleAction = handleAction
-        , finalize = Just Finalize
+        , handleQuery  = handleQuery
         }
     }
 
@@ -228,27 +220,6 @@ render {
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
-  Initialize ->
-    handleAction ConnectWebSocket
-
-  Finalize -> do
-    { wsInfo } <- H.get
-    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
-    { wsInfo } <- H.get
-    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)
-
   UpdateAcceptedDomains domains -> do
     H.modify_ _ { accepted_domains = domains }
 
@@ -256,13 +227,9 @@ handleAction = case _ of
     H.modify_ _ { my_domains = domains }
 
   AuthenticateToDNSManager -> do
-    { wsInfo } <- H.get
     appendMessage $ "[🤖] Trying to authenticate..."
-    case wsInfo.connection of
+    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: wsInfo.token }
-      Nothing -> appendMessage $ "[🤖] Can't authenticate, websocket is down!"
+    H.raise $ MessageToSend message
-      Just webSocket -> H.liftEffect $ do
-        ab <- DNSManager.serialize $ DNSManager.MkLogin { token: wsInfo.token }
-        sendArrayBuffer webSocket ab
 
   HandleNewDomainInput adduserinp -> do
     case adduserinp of
@@ -304,126 +271,85 @@ handleAction = case _ of
     { wsInfo, newDomainForm } <- H.get
     let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain
 
-    case wsInfo.connection, new_domain of
+    case new_domain of
-      Nothing, _ ->
+      "" ->
-        unableToSend "Not connected to server."
-
-      Just _, "" ->
         unableToSend "You didn't enter the new domain!"
+      _ -> do
+        message <- H.liftEffect
+          $ DNSManager.serialize
+          $ DNSManager.MkNewDomain { domain: new_domain }
+        H.raise $ MessageToSend message
+        appendMessage "[😇] Trying to add a new domain"
+        handleAction $ HandleNewDomainInput $ INP_newdomain ""
 
-      Just webSocket, _ -> do
+handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
-        H.liftEffect (WS.readyState webSocket) >>= case _ of
+handleQuery = case _ of
-          Connecting ->
-            unableToSend "Still connecting to server."
 
-          Closing ->
+  MessageReceived message a -> do
-            unableToSend "Connection to server is closing."
+    receivedMessage <- H.liftEffect $ DNSManager.deserialize messageEvent.message
+    case receivedMessage of
+        -- Cases where we didn't understand the message.
+        Left err -> do
+          case err of
+            (DNSManager.JSONERROR jerr) -> do
+              print_json_string messageEvent.message
+              handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr)
+            (DNSManager.UnknownError   unerr) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownError" <> (show unerr))
+            (DNSManager.UnknownNumber       ) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownNumber")
+          pure Nothing
 
-          Closed -> do
+        -- Cases where we understood the message.
-            unableToSend "Connection to server has been closed."
+        Right received_msg -> do
-            maybeCurrentConnection <- H.gets _.wsInfo.connection
+          case received_msg of
-            when (isJust maybeCurrentConnection) do
+            -- The authentication failed.
-              H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } }
+            (DNSManager.MkError errmsg) -> do
+              appendMessage $ "[😈] Failed, reason is: " <> errmsg.reason
+            (DNSManager.MkErrorUserNotLogged _) -> do
+              appendMessage $ "[😈] Failed! The user isn't connected!"
+              handleAction AuthenticateToDNSManager
+            (DNSManager.MkErrorInvalidToken _) -> do
+              appendMessage $ "[😈] Failed connection! Invalid token!"
+            (DNSManager.MkDomainAlreadyExists _) -> do
+              appendMessage $ "[😈] Failed! The domain already exists."
+            (DNSManager.MkUnacceptableDomain _) -> do
+              appendMessage $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)."
 
-          Open -> do
+            (DNSManager.MkAcceptedDomains response) -> do
-            H.liftEffect $ do
+              appendMessage $ "[😈] Received the list of accepted domains!"
-              ab <- DNSManager.serialize $ DNSManager.MkNewDomain { domain: new_domain }
+              handleAction $ UpdateAcceptedDomains response.domains
-              sendArrayBuffer webSocket ab
-            appendMessage "[😇] Trying to add a new domain"
-            handleAction $ HandleNewDomainInput $ INP_newdomain ""
 
-  HandleWebSocket wsEvent ->
+            (DNSManager.MkLogged response) -> do
-    case wsEvent of
+              appendMessage $ "[😈] Logged!"
-      WebSocketMessage messageEvent -> do
+              handleAction $ UpdateAcceptedDomains response.accepted_domains
-        receivedMessage <- H.liftEffect $ DNSManager.deserialize messageEvent.message
+              handleAction $ UpdateMyDomains response.my_domains
-        case receivedMessage of
-            -- Cases where we didn't understand the message.
-            Left err -> do
-              case err of
-                (DNSManager.JSONERROR jerr) -> do
-                  print_json_string messageEvent.message
-                  handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr)
-                (DNSManager.UnknownError   unerr) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownError" <> (show unerr))
-                (DNSManager.UnknownNumber       ) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownNumber")
 
-            -- Cases where we understood the message.
+            (DNSManager.MkDomainAdded response) -> do
-            Right received_msg -> do
+              { my_domains } <- H.get
-              case received_msg of
+              appendMessage $ "[😈] Domain added: " <> response.domain
-                -- The authentication failed.
+              handleAction $ UpdateMyDomains (my_domains <> [response.domain])
-                (DNSManager.MkError errmsg) -> do
-                  appendMessage $ "[😈] Failed, reason is: " <> errmsg.reason
-                (DNSManager.MkErrorUserNotLogged _) -> do
-                  appendMessage $ "[😈] Failed! The user isn't connected!"
-                  handleAction AuthenticateToDNSManager
-                (DNSManager.MkErrorInvalidToken _) -> do
-                  appendMessage $ "[😈] Failed connection! Invalid token!"
-                (DNSManager.MkDomainAlreadyExists _) -> do
-                  appendMessage $ "[😈] Failed! The domain already exists."
-                (DNSManager.MkUnacceptableDomain _) -> do
-                  appendMessage $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)."
 
-                (DNSManager.MkAcceptedDomains response) -> do
+            (DNSManager.MkInvalidDomainName _) -> do
-                  appendMessage $ "[😈] Received the list of accepted domains!"
+              appendMessage $ "[😈] Failed! The domain is not valid!"
-                  handleAction $ UpdateAcceptedDomains response.domains
 
-                (DNSManager.MkLogged response) -> do
+            (DNSManager.MkDomainDeleted response) -> do
-                  appendMessage $ "[😈] Logged!"
+              { my_domains } <- H.get
-                  handleAction $ UpdateAcceptedDomains response.accepted_domains
+              appendMessage $ "[😈] The domain '" <> response.domain <> "' has been deleted!"
-                  handleAction $ UpdateMyDomains response.my_domains
+              handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
 
-                (DNSManager.MkDomainAdded response) -> do
+            (DNSManager.MkSuccess _) -> do
-                  { my_domains } <- H.get
+              appendMessage $ "[😈] Success!"
-                  appendMessage $ "[😈] Domain added: " <> response.domain
+            -- WTH?!
-                  handleAction $ UpdateMyDomains (my_domains <> [response.domain])
+            _ -> do
+              appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
+          pure (Just a)
 
-                (DNSManager.MkInvalidDomainName _) -> do
+  ConnectionIsDown a -> do
-                  appendMessage $ "[😈] Failed! The domain is not valid!"
+    H.modify_ _ { wsUp = false }
+    pure (Just a)
 
-                (DNSManager.MkDomainDeleted response) -> do
+  ConnectionIsUp a -> do
-                  { my_domains } <- H.get
+    H.modify_ _ { wsUp = true }
-                  appendMessage $ "[😈] The domain '" <> response.domain <> "' has been deleted!"
+    pure (Just a)
-                  handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
-
-                (DNSManager.MkSuccess _) -> do
-                  appendMessage $ "[😈] Success!"
-                -- WTH?!
-                _ -> do
-                  appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
-
-      WebSocketOpen -> do
-        { wsInfo } <- H.get
-        systemMessage ("Successfully connected to WebSocket at \"" <> wsInfo.url <>  "\"!🎉")
-        handleAction AuthenticateToDNSManager
-
-      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 } }
-
-      WebSocketError errorType ->
-        systemMessage $ renderError errorType
-
-  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"
-        , "]"
-        ]
 
 build_new_domain :: String -> String -> String
 build_new_domain sub tld