Add real data from the server: WIP.

src/App/Messages/DNSManagerDaemon.purs

@@ -182,6 +182,12 @@ type RRDeleted = { rrid :: Int }
 codecRRDeleted ∷ CA.JsonCodec RRDeleted
 codecRRDeleted = CA.object "RRDeleted" (CAR.record { rrid: CA.int })
 
+{- 19  -}
+type RRAdded = { domain :: String, rr :: ResourceRecord.ResourceRecord }
+codecRRAdded ∷ CA.JsonCodec RRAdded
+codecRRAdded = CA.object "RRAdded" (CAR.record { domain: CA.string, rr: ResourceRecord.codec })
+
+
 {- 50  -}
 type UnknownUser = { }
 codecUnknownUser ∷ CA.JsonCodec UnknownUser
@@ -227,6 +233,7 @@ data AnswerMessage
  | MkLogged              Logged              -- 16
  | MkDomainAdded         DomainAdded         -- 17
  | MkRRDeleted           RRDeleted           -- 18
+ | MkRRAdded             RRAdded             -- 19
  | MkUnknownUser         UnknownUser         -- 50
  | MkNoOwnership         NoOwnership         -- 51
 
@@ -274,6 +281,7 @@ decode number string
     16 -> error_management codecLogged              MkLogged
     17 -> error_management codecDomainAdded         MkDomainAdded
     18 -> error_management codecRRDeleted           MkRRDeleted
+    19 -> error_management codecRRAdded             MkRRAdded
     50 -> error_management codecUnknownUser         MkUnknownUser
     51 -> error_management codecNoOwnership         MkNoOwnership
     _  -> Left UnknownNumber

src/App/ZoneInterface.purs

@@ -32,6 +32,7 @@ import Bulma as Bulma
 import CSSClasses as C
 
 import App.RR
+import App.ResourceRecord
 
 import App.LogMessage (LogMessage(..))
 import App.Messages.DNSManagerDaemon as DNSManager
@@ -300,32 +301,11 @@ handleAction = case _ of
     H.raise $ Log $ SimpleLog ("Add simple entry")
     state <- H.get
     H.raise $ Log $ SimpleLog ("Add simple entry: " <> show state._current_entry)
-    H.put $ add_new_entry state state._current_entry
+    -- H.put $ add_new_entry state state._current_entry
   AddMX -> do
     state <- H.get
-    let form = state._current_entry_mx
+    let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx
-        newttl      = fromMaybe 3600 $ fromString form.ttl
-        newpriority = fromMaybe 10   $ fromString form.priority
-        newrr = { rrtype:         form.t
-                  , rrid:         0            -- garbage value anyway
-                  , name:         form.domain
-                  , ttl:          newttl
-                  , target:       form.value
-                  , readonly:     false
-                  , priority:     Just newpriority
-                  , port:         Nothing
-                  , protocol:     Nothing
-                  , weight:       Nothing
-                  , mname:        Nothing
-                  , rname:        Nothing
-                  , serial:       Nothing
-                  , refresh:      Nothing
-                  , retry:        Nothing
-                  , expire:       Nothing
-                  , minttl:       Nothing
-                  }
     H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx)
-    -- H.put $ add_new_mx state state._current_entry_mx
     message <- H.liftEffect
       $ DNSManager.serialize
       $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
@@ -333,7 +313,7 @@ handleAction = case _ of
   AddSRV -> do
     state <- H.get
     H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv)
-    H.put $ add_new_srv state state._current_entry_srv
+    -- H.put $ add_new_srv state state._current_entry_srv
 
   UpdateLocalSRRForm rr_id rr_update -> case rr_update of
     Update_SRR_Type val -> do
@@ -489,23 +469,33 @@ handleQuery = case _ of
 
             (DNSManager.MkAcceptedDomains _) -> do
               H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!"
-              -- handleAction $ UpdateAcceptedDomains response.domains
 
             (DNSManager.MkLogged _) -> do
               H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
-              -- handleAction $ UpdateAcceptedDomains response.accepted_domains
-              -- handleAction $ UpdateMyDomains response.my_domains
 
             (DNSManager.MkDomainAdded response) -> do
               H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
-              -- handleAction $ UpdateMyDomains (my_domains <> [response.domain])
+
+            (DNSManager.MkRRAdded     response) -> do
+              state <- H.get
+              let new_rr = response.rr
+              H.raise $ Log $ SimpleLog
+                $ "[TODO] Resource Record added: " <> response.domain
+                  <> " rrid: " <> show new_rr.rrid
+                  <> " rrtype: " <> new_rr.rrtype
+                  <> " name: " <> new_rr.name
+                  <> " ttl: "  <> show new_rr.ttl
+                  <> " target: "  <> new_rr.target
+                  <> " readonly: "  <> show new_rr.readonly
+              case add_entry state new_rr of
+                Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
+                Right new_state    -> H.put new_state
 
             (DNSManager.MkInvalidDomainName _) -> do
               H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"
 
             (DNSManager.MkDomainDeleted response) -> do
               H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
-              -- handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
             (DNSManager.MkRRDeleted response) -> do
               H.raise $ Log $ SimpleLog $ "[🎉] RR (id: '" <> show response.rrid <> "') has been deleted!"
               state <- H.get
@@ -543,6 +533,14 @@ handleQuery = case _ of
           Just { head: x, tail: xs } -> "(" <> x.rrtype <> ": " <> show x.rrid <> ") " <> resource_list xs
           Nothing                    -> ""
 
+    add_entry :: State -> ResourceRecord -> Either String State
+    add_entry state new_rr = do
+      case new_rr.rrtype, (A.elem new_rr.rrtype baseRecords) of
+        _, true  -> Right $ add_new_entry state $ fromResourceRecordToLocalRepresentationSimpleRR new_rr
+        "MX", _  -> Right $ add_new_mx    state $ fromResourceRecordToLocalRepresentationMXRR     new_rr
+        "SRV", _ -> Right $ add_new_srv   state $ fromResourceRecordToLocalRepresentationSRVRR    new_rr
+        _, _     -> Left "TODO: CAN'T ADD THIS KIND OF RR RIGHT NOW"
+
 -- Rendering
 class_title_size :: Array (HH.ClassName)
 class_title_size = [HH.ClassName "is-4"]
@@ -767,28 +765,22 @@ render_new_record_colunm_srv rr
 -- ACTIONS
 
 -- add a new record and get a new placeholter
-add_new_entry :: State -> (SimpleRR ()) -> State
+add_new_entry :: State -> Maybe (SimpleRR ()) -> State
-add_new_entry state rr
+add_new_entry state = case _ of
-  = state { _srr = new_rr_list, _current_entry = new_placeholder }
+  Nothing -> state
-  where new_placeholder = defaultResourceA
+  Just rr -> state { _srr = (state._srr <> [ rr ]), _current_entry = defaultResourceA }
-        new_rr_list     = state._srr <> [ new_rr ]
-        new_rr          = rr { id = getNewID state }
 
 -- add a new record and get a new placeholter
-add_new_mx :: State -> (MXRR ()) -> State
+add_new_mx :: State -> Maybe (MXRR ()) -> State
-add_new_mx state rr
+add_new_mx state = case _ of
-  = state { _mxrr = new_rr_list, _current_entry_mx = new_placeholder }
+  Nothing -> state
-  where new_placeholder = defaultResourceMX
+  Just rr -> state { _mxrr = (state._mxrr <> [ rr ]), _current_entry_mx = defaultResourceMX }
-        new_rr_list     = state._mxrr <> [ new_rr ]
-        new_rr          = rr { id = getNewID state }
 
 -- add a new record and get a new placeholter
-add_new_srv :: State -> (SRVRR ()) -> State
+add_new_srv :: State -> Maybe (SRVRR ()) -> State
-add_new_srv state rr
+add_new_srv state = case _ of
-  = state { _srvrr = new_rr_list, _current_entry_srv = new_placeholder }
+  Nothing -> state
-  where new_placeholder = defaultResourceSRV
+  Just rr -> state { _srvrr = (state._srvrr <> [ rr ]), _current_entry_srv = defaultResourceSRV }
-        new_rr_list     = state._srvrr <> [ new_rr ]
-        new_rr          = rr { id = getNewID state }
   
 changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l)
 changeType rr Nothing = rr
@@ -832,6 +824,72 @@ update f rr_id records = map doSmth records
       | rr_id == rr.id = f rr
       | otherwise     = rr
 
+fromResourceRecordToLocalRepresentationSimpleRR :: ResourceRecord -> Maybe (SimpleRR ())
+fromResourceRecordToLocalRepresentationSimpleRR new_rr =
+  Just { t:         new_rr.rrtype
+       , id:        new_rr.rrid
+       , modified:  false
+       , valid:     true
+       , ttl:       show new_rr.ttl
+       , domain:    new_rr.name
+       , value:     new_rr.target
+       }
+
+fromResourceRecordToLocalRepresentationMXRR :: ResourceRecord -> Maybe (MXRR ())
+fromResourceRecordToLocalRepresentationMXRR new_rr = do
+  priority <- new_rr.priority
+  Just { t:         new_rr.rrtype
+       , id:        new_rr.rrid
+       , modified:  false
+       , valid:     true
+       , ttl:       show new_rr.ttl
+       , domain:    new_rr.name
+       , value:     new_rr.target
+       , priority:  show priority
+       }
+-- TODO: would be nice to have a simpler implementation, something like this:
+--fromResourceRecordToLocalRepresentationMXRR new_rr
+--  = let simple_rr = fromResourceRecordToLocalRepresentationSimpleRR new_rr
+--    simple_rr { priority = show new_rr.priority }
+
+fromResourceRecordToLocalRepresentationSRVRR :: ResourceRecord -> Maybe (SRVRR ())
+fromResourceRecordToLocalRepresentationSRVRR new_rr = do
+  case new_rr.priority, new_rr.weight, new_rr.port of
+    Just priority, Just weight, Just port ->
+      Just { t:         new_rr.rrtype
+           , id:        new_rr.rrid
+           , modified:  false
+           , valid:     true
+           , ttl:       show new_rr.ttl
+           , domain:    new_rr.name
+           , value:     new_rr.target
+           , priority:  show priority
+           , port:      show port
+           , weight:    show weight
+           -- , protocol:  protocol
+           }
+    _, _, _ -> Nothing
+
+fromLocalMXRRRepresentationToResourceRecord :: MXRR () -> ResourceRecord
+fromLocalMXRRRepresentationToResourceRecord form
+  = { rrtype:       form.t
+    , rrid:         form.id
+    , name:         form.domain
+    , ttl:          fromMaybe 3600 $ fromString form.ttl
+    , target:       form.value
+    , readonly:     false
+    , priority:     Just $ fromMaybe 10 $ fromString form.priority
+    , port:         Nothing
+    , protocol:     Nothing
+    , weight:       Nothing
+    , mname:        Nothing
+    , rname:        Nothing
+    , serial:       Nothing
+    , refresh:      Nothing
+    , retry:        Nothing
+    , expire:       Nothing
+    , minttl:       Nothing
+    }
 
 getNewID :: State -> Int
 getNewID state = (_ + 1)