Compiles again! :)

src/App/Container.purs

@@ -96,7 +96,7 @@ render state
     render_newdomain_interface = Bulma.box $ case state.token of
       Just token ->
         [ Bulma.h1 "New domain interface!"
-        , HH.slot_ _ndi unit NewDomainInterface.component (Tuple "ws://127.0.0.1:8081" token)
+        , HH.slot_ _ndi unit NewDomainInterface.component token
         ]
       Nothing -> [ Bulma.p "Here will be the new domain box." ]
 

src/App/DNSManagerDomainsInterface.purs

@@ -12,7 +12,7 @@ module App.DNSManagerDomainsInterface where
    Authentication is automatic with the token.
 -}
 
-import Prelude (Unit, Void, bind, discard, map, otherwise, show, void, when, ($), (&&), (<$>), (<<<), (<>), (>>=), (/=))
+import Prelude (Unit, Void, bind, discard, map, otherwise, show, void, when, ($), (&&), (<$>), (<<<), (<>), (>>=), (/=), pure)
 
 import Bulma as Bulma
 
@@ -61,8 +61,7 @@ data Query a
 
 type Slot = H.Slot Query Output
 
--- Input = url token
+type Input = String
-type Input = Tuple String String
 
 data NewDomainFormAction
   = INP_newdomain String
@@ -79,7 +78,6 @@ data Action
   | NewDomainAttempt Event
   | RemoveDomain String
   | EnterDomain String
-  | HandleWebSocket (WebSocketEvent WebSocketMessageType)
 
 type NewDomainFormState
   = { new_domain      :: String
@@ -92,6 +90,7 @@ type State =
   , my_domains             :: Array String
 
   , wsUp :: Boolean
+  , token :: String
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -100,8 +99,7 @@ component =
     { initialState
     , render
     , eval: H.mkEval $ H.defaultEval
-        { initialize = Just Initialize
+        { handleAction = handleAction
-        , handleAction = handleAction
         , handleQuery  = handleQuery
         }
     }
@@ -110,36 +108,21 @@ default_domain :: String
 default_domain = "netlib.re"
 
 initialState :: Input -> State
-initialState (Tuple url token) =
+initialState token =
-  { messages: []
+  { newDomainForm: { new_domain: ""
-  , messageHistoryLength: 10
-
-  , newDomainForm: { new_domain: ""
                    , selected_domain: default_domain
                    }
-
   , accepted_domains: [ default_domain ]
   , my_domains: [ ]
-
+  , wsUp: true
-  , wsInfo: { url: url
-            , connection: Nothing
-            , reconnect: false
   , token: token
   }
-  }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render {
+render { accepted_domains, my_domains, newDomainForm, wsUp }
-  messages,
-  accepted_domains,
-  my_domains,
-  wsInfo,
-  newDomainForm }
     = HH.div_
        [ Bulma.columns_ [ Bulma.column_ newdomain_form
                         , Bulma.column_ list_of_own_domains ]
-       , render_messages
-       , renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect)
        ]
     where
 
@@ -153,25 +136,26 @@ render {
           , HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) my_domains
           ]
 
+      -- should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection)
+      should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
+
       domain_buttons domain
         = [ HH.button
               [ HP.style "padding: 0.5rem 1.25rem;"
               , HP.type_ HP.ButtonSubmit
               , HE.onClick \_ -> EnterDomain domain
-              , maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection
+              , (if wsUp then (HP.enabled true) else (HP.disabled true))
               ]
               [ HH.text domain ]
           , HH.button
               [ HP.style "padding: 0.5rem 1.25rem;"
               , HP.type_ HP.ButtonSubmit
               , HE.onClick \_ -> RemoveDomain domain
-              , maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection
+              , (if wsUp then (HP.enabled true) else (HP.disabled true))
               ]
               [ HH.text "x" ]
           ]
 
-      should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection)
-
       render_adduser_form = HH.form
         [ HE.onSubmit NewDomainAttempt ]
         [ Bulma.box_input "Your new domain" "awesomewebsite"   -- title, placeholder
@@ -184,7 +168,7 @@ render {
             [ HH.button
                 [ HP.style "padding: 0.5rem 1.25rem;"
                 , HP.type_ HP.ButtonSubmit
-                , maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection
+                , (if wsUp then (HP.enabled true) else (HP.disabled true))
                 ]
                 [ HH.text "Send Message to Server" ]
             ]
@@ -195,29 +179,6 @@ render {
       domain_choice i
         = HandleNewDomainInput <<< UpdateSelectedDomain $ maybe "netlib.re" (\x -> x) $ accepted_domains A.!! i
 
-
-      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 = case _ of
   UpdateAcceptedDomains domains -> do
@@ -227,75 +188,54 @@ handleAction = case _ of
     H.modify_ _ { my_domains = domains }
 
   AuthenticateToDNSManager -> do
-    appendMessage $ "[🤖] Trying to authenticate..."
+    { token } <- H.get
-    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: wsInfo.token }
+    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: token }
     H.raise $ MessageToSend message
 
   HandleNewDomainInput adduserinp -> do
     case adduserinp of
       INP_newdomain        v      -> H.modify_ _ { newDomainForm { new_domain = v } }
-      UpdateSelectedDomain domain -> do
+      UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
-        H.modify_ _ { newDomainForm { selected_domain = domain } }
 
   EnterDomain domain -> do
-    appendMessage $ "[???] trying to enter domain: " <> domain
+    H.raise $ AppendMessage $ "[???] trying to enter domain: " <> domain
 
   RemoveDomain domain -> do
-    { wsInfo } <- H.get
+    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
-    case wsInfo.connection of
+    H.raise $ MessageToSend message
-      Nothing ->
+    H.raise $ AppendMessage $ "[😇] Removing domain: " <> domain
-        unableToSend "Not connected to server."
-      Just webSocket ->
-        H.liftEffect (WS.readyState webSocket) >>= case _ of
-          Connecting ->
-            unableToSend "Still connecting to server."
-
-          Closing ->
-            unableToSend "Connection to server is closing."
-
-          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 } }
-
-          Open -> do
-            H.liftEffect $ do
-              ab <- DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
-              sendArrayBuffer webSocket ab
-            appendMessage $ "[😇] Removing domain: " <> domain
 
   NewDomainAttempt ev -> do
     H.liftEffect $ Event.preventDefault ev
 
-    { wsInfo, newDomainForm } <- H.get
+    { newDomainForm } <- H.get
     let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain
 
     case new_domain of
       "" ->
-        unableToSend "You didn't enter the new domain!"
+        H.raise $ 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"
+        H.raise $ AppendMessage "[😇] Trying to add a new domain"
         handleAction $ HandleNewDomainInput $ INP_newdomain ""
 
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
 
   MessageReceived message a -> do
-    receivedMessage <- H.liftEffect $ DNSManager.deserialize messageEvent.message
+    receivedMessage <- H.liftEffect $ DNSManager.deserialize message
     case receivedMessage of
         -- Cases where we didn't understand the message.
-        Left err -> do
+        Left _ -> do
-          case err of
+        --  case err of
-            (DNSManager.JSONERROR jerr) -> do
+        --    (DNSManager.JSONERROR jerr) -> do
-              print_json_string messageEvent.message
+        --      print_json_string message
-              handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr)
+        --      handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr)
-            (DNSManager.UnknownError   unerr) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownError" <> (show unerr))
+        --    (DNSManager.UnknownError   unerr) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownError" <> (show unerr))
-            (DNSManager.UnknownNumber       ) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownNumber")
+        --    (DNSManager.UnknownNumber       ) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownNumber")
           pure Nothing
 
         -- Cases where we understood the message.
@@ -303,44 +243,45 @@ handleQuery = case _ of
           case received_msg of
             -- The authentication failed.
             (DNSManager.MkError errmsg) -> do
-              appendMessage $ "[😈] Failed, reason is: " <> errmsg.reason
+              H.raise $ AppendMessage $ "[😈] Failed, reason is: " <> errmsg.reason
             (DNSManager.MkErrorUserNotLogged _) -> do
-              appendMessage $ "[😈] Failed! The user isn't connected!"
+              H.raise $ AppendMessage $ "[😈] Failed! The user isn't connected!"
+              H.raise $ AppendMessage $ "[🤖] Trying to authenticate to fix the problem..."
               handleAction AuthenticateToDNSManager
             (DNSManager.MkErrorInvalidToken _) -> do
-              appendMessage $ "[😈] Failed connection! Invalid token!"
+              H.raise $ AppendMessage $ "[😈] Failed connection! Invalid token!"
             (DNSManager.MkDomainAlreadyExists _) -> do
-              appendMessage $ "[😈] Failed! The domain already exists."
+              H.raise $ AppendMessage $ "[😈] Failed! The domain already exists."
             (DNSManager.MkUnacceptableDomain _) -> do
-              appendMessage $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)."
+              H.raise $ AppendMessage $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)."
 
             (DNSManager.MkAcceptedDomains response) -> do
-              appendMessage $ "[😈] Received the list of accepted domains!"
+              H.raise $ AppendMessage $ "[😈] Received the list of accepted domains!"
               handleAction $ UpdateAcceptedDomains response.domains
 
             (DNSManager.MkLogged response) -> do
-              appendMessage $ "[😈] Logged!"
+              H.raise $ AppendMessage $ "[😈] Authenticated!"
               handleAction $ UpdateAcceptedDomains response.accepted_domains
               handleAction $ UpdateMyDomains response.my_domains
 
             (DNSManager.MkDomainAdded response) -> do
               { my_domains } <- H.get
-              appendMessage $ "[😈] Domain added: " <> response.domain
+              H.raise $ AppendMessage $ "[😈] Domain added: " <> response.domain
               handleAction $ UpdateMyDomains (my_domains <> [response.domain])
 
             (DNSManager.MkInvalidDomainName _) -> do
-              appendMessage $ "[😈] Failed! The domain is not valid!"
+              H.raise $ AppendMessage $ "[😈] Failed! The domain is not valid!"
 
             (DNSManager.MkDomainDeleted response) -> do
               { my_domains } <- H.get
-              appendMessage $ "[😈] The domain '" <> response.domain <> "' has been deleted!"
+              H.raise $ AppendMessage $ "[😈] The domain '" <> response.domain <> "' has been deleted!"
               handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
 
             (DNSManager.MkSuccess _) -> do
-              appendMessage $ "[😈] Success!"
+              H.raise $ AppendMessage $ "[😈] Success!"
             -- WTH?!
             _ -> do
-              appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
+              H.raise $ AppendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
           pure (Just a)
 
   ConnectionIsDown a -> do
@@ -349,6 +290,8 @@ handleQuery = case _ of
 
   ConnectionIsUp a -> do
     H.modify_ _ { wsUp = true }
+    H.raise $ AppendMessage "Connection with dnsmanagerd was closed, let's re-authenticate"
+    handleAction AuthenticateToDNSManager
     pure (Just a)
 
 build_new_domain :: String -> String -> String
@@ -356,10 +299,10 @@ build_new_domain sub tld
   | endsWith "." sub = sub <> tld
   | otherwise        = sub <> "." <> tld
 
-print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
+--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
-  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