From a1c1c462c9eb5218956328faed0ab1b8b13fbc53 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Fri, 30 Jun 2023 01:56:40 +0200
Subject: [PATCH] Show acceptable domains and my own domains.

---
 src/App/DNSManagerDomainsInterface.purs | 44 +++++++++++++++++++++++--
 src/App/Messages/DNSManagerDaemon.purs  | 15 +++++++++
 2 files changed, 57 insertions(+), 2 deletions(-)

diff --git a/src/App/DNSManagerDomainsInterface.purs b/src/App/DNSManagerDomainsInterface.purs
index 407f2ce..9b14c97 100644
--- a/src/App/DNSManagerDomainsInterface.purs
+++ b/src/App/DNSManagerDomainsInterface.purs
@@ -152,6 +152,9 @@ data Action
   | WebSocketParseError String
   | ConnectWebSocket
 
+  | UpdateAcceptedDomains (Array String)
+  | UpdateMyDomains (Array String)
+
   | AuthenticateToDNSManager
 
   | HandleNewDomainInput NewDomainFormAction
@@ -170,6 +173,9 @@ type State =
   , token                  :: String
   , newDomainForm          :: NewDomainFormState
 
+  , accepted_domains       :: Array String
+  , my_domains             :: Array String
+
   -- TODO: put network stuff in a record.
   , wsUrl                  :: String
   , wsConnection           :: Maybe WS.WebSocket
@@ -196,6 +202,9 @@ initialState (Tuple url token) =
   , token: token
   , newDomainForm: { new_domain: "" }
 
+  , accepted_domains: [ "netlib.re" ]
+  , my_domains: [ ]
+
   -- TODO: put network stuff in a record.
   , wsUrl: url
   , wsConnection: Nothing
@@ -205,11 +214,15 @@ initialState (Tuple url token) =
 render :: forall m. State -> H.ComponentHTML Action () m
 render {
   messages,
+  accepted_domains,
+  my_domains,
   wsConnection,
   canReconnect,
   newDomainForm }
     = HH.div_
-       [ Bulma.columns_ [ Bulma.column_ newdomain_form, Bulma.column_ list_of_own_domains ]
+       [ Bulma.columns_ [ Bulma.column_ newdomain_form
+                        , Bulma.column_ list_acceptable_domains
+                        , Bulma.column_ list_of_own_domains ]
        , render_messages
        , renderReconnectButton (isNothing wsConnection && canReconnect)
        ]
@@ -220,8 +233,15 @@ render {
           , render_adduser_form
           ]
 
+      list_acceptable_domains
+        = [ Bulma.h3 "Acceptable domains:"
+          , HH.ul_ $ map (\domain -> HH.li_ [ HH.text domain ]) accepted_domains
+          ]
+
       list_of_own_domains
-        = [ Bulma.h3 "You domains: (TODO)" ]
+        = [ Bulma.h3 "My domains:"
+          , HH.ul_ $ map (\domain -> HH.li_ [ HH.text domain ]) my_domains
+          ]
 
       should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection)
 
@@ -288,6 +308,12 @@ handleAction = case _ of
     H.modify_ _ { wsConnection = Just webSocket }
     void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
 
+  UpdateAcceptedDomains domains -> do
+    H.modify_ _ { accepted_domains = domains }
+
+  UpdateMyDomains domains -> do
+    H.modify_ _ { my_domains = domains }
+
   AuthenticateToDNSManager -> do
     { wsConnection, token } <- H.get
     appendMessage $ "[🤖] Trying to authenticate..."
@@ -362,6 +388,20 @@ handleAction = case _ of
                   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
+                  appendMessage $ "[😈] Received the list of accepted domains!"
+                  handleAction $ UpdateAcceptedDomains response.domains
+
+                (DNSManager.MkLogged response) -> do
+                  appendMessage $ "[😈] Logged!"
+                  handleAction $ UpdateAcceptedDomains response.accepted_domains
+                  handleAction $ UpdateMyDomains response.my_domains
+
+                (DNSManager.MkInvalidDomainName _) -> do
+                  appendMessage $ "[😈] Failed! The domain is not valid!"
                 (DNSManager.MkSuccess _) -> do
                   appendMessage $ "[😈] Success!"
                 -- WTH?!
diff --git a/src/App/Messages/DNSManagerDaemon.purs b/src/App/Messages/DNSManagerDaemon.purs
index 8937457..e7eb78a 100644
--- a/src/App/Messages/DNSManagerDaemon.purs
+++ b/src/App/Messages/DNSManagerDaemon.purs
@@ -158,6 +158,17 @@ type DomainList = { domains :: Array String }
 codecDomainList ∷ CA.JsonCodec DomainList
 codecDomainList = CA.object "DomainList" (CAR.record { domains: CA.array CA.string })
 
+{- 15  -}
+type AcceptedDomains = { domains :: Array String }
+codecAcceptedDomains ∷ CA.JsonCodec AcceptedDomains
+codecAcceptedDomains = CA.object "AcceptedDomains" (CAR.record { domains: CA.array CA.string })
+
+{- 16  -}
+type Logged = { accepted_domains :: Array String, my_domains :: Array String }
+codecLogged ∷ CA.JsonCodec Logged
+codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string
+                                             ,       my_domains: CA.array CA.string })
+
 {- 50  -}
 type UnknownUser = { }
 codecUnknownUser ∷ CA.JsonCodec UnknownUser
@@ -198,6 +209,8 @@ data AnswerMessage
  | MkZone                Zone                -- 12
  | MkUnknownZone         UnknownZone         -- 13
  | MkDomainList          DomainList          -- 14
+ | MkAcceptedDomains     AcceptedDomains     -- 15
+ | MkLogged              Logged              -- 16
  | MkUnknownUser         UnknownUser         -- 50
  | MkNoOwnership         NoOwnership         -- 51
 
@@ -240,6 +253,8 @@ decode number string
     12 -> error_management codecZone                MkZone
     13 -> error_management codecUnknownZone         MkUnknownZone
     14 -> error_management codecDomainList          MkDomainList
+    15 -> error_management codecAcceptedDomains     MkAcceptedDomains
+    16 -> error_management codecLogged              MkLogged
     50 -> error_management codecUnknownUser         MkUnknownUser
     51 -> error_management codecNoOwnership         MkNoOwnership
     _  -> Left UnknownNumber