WIP: switching to ResourceRecord everywhere. Cannot compile ATM.

src/App/Validation.purs

@@ -559,7 +559,7 @@ validationSRV form = ado
   weight   <- parse weight_parser        form.weight   VEWeight
   in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight
 
-validation :: forall l. SRVRR (|l) -> AcceptedRRTypes -> Either AVErrors ResourceRecord
+validation :: ResourceRecord -> AcceptedRRTypes -> Either AVErrors ResourceRecord
 validation entry t = case t of
   A     -> toEither $ validationA     entry
   AAAA  -> toEither $ validationAAAA  entry

src/App/ZoneInterface.purs

@@ -219,7 +219,7 @@ type State =
 
   -- TODO: get all the resources in a single entry.
   --       Better that way: simpler code.
-  , _resources :: Array (SRVRR ())
+  , _resources :: Array ResourceRecord
   , _local_errors :: Hash.HashMap RRId (Array Validation.ValidationError)
 
   -- current entries
@@ -230,7 +230,7 @@ type State =
   , _errors :: Hash.HashMap RRId Validation.Errors
 
   -- Unique RR form.
-  , _currentRR :: (SRVRR ()) -- SRVRR contains all relevant information for every RR.
+  , _currentRR :: ResourceRecord
   , _currentRR_errors :: Array Validation.ValidationError
 
   -- potential future entries
@@ -259,6 +259,32 @@ component =
 default_domain :: String
 default_domain = "netlib.re"
 
+default_empty_rr
+  = { rrtype: "A"
+    , rrid: "0"
+    , name: "www"
+    , ttl: 1800
+    , target: "10.0.0.1"
+    , readonly: false
+
+    -- MX (and SRV) specific entry.
+    , priority: Nothing
+
+    -- SRV specific entries.
+    , port: Nothing
+    , protocol: Nothing
+    , weight: Nothing
+
+    -- SOA specific entries.
+    , mname: Nothing
+    , rname: Nothing
+    , serial: Nothing
+    , refresh: Nothing
+    , retry: Nothing
+    , expire: Nothing
+    , minttl: Nothing
+    }
+
 initialState :: Input -> State
 initialState domain =
   { wsUp: true
@@ -276,7 +302,7 @@ initialState domain =
   , _errors: Hash.empty
 
   -- This is the state for the new RR modal.
-  , _currentRR: defaultResourceSRV
+  , _currentRR: default_empty_rr
   -- List of errors within the form in new RR modal.
   , _currentRR_errors: []
 
@@ -359,17 +385,17 @@ render state
           , Bulma.box_input ("domain" <> state._currentRR.rrtype) "Name" "www"   -- id, title, placeholder
               (updateForm Field_Domain)             -- action
               state._currentRR.name                            -- value
-              state._currentRR.valid                           -- validity (TODO)
+              true -- state._currentRR.valid                           -- validity (TODO)
               should_be_disabled                           -- condition
           , Bulma.box_input ("ttl" <> state._currentRR.rrtype) "TTL" "600"
               (updateForm Field_TTL)
-              state._currentRR.ttl
+              (show state._currentRR.ttl)
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "198.51.100.5"
               (updateForm Field_Target)
               state._currentRR.target
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           ]
         content_mx :: Array (HH.HTML w Action)
@@ -378,22 +404,22 @@ render state
           , Bulma.box_input ("domainMX") "Name" "mail"   -- id, title, placeholder
               (updateForm Field_Domain)           -- action
               state._currentRR.name                          -- value
-              state._currentRR.valid                         -- validity (TODO)
+              true -- state._currentRR.valid                         -- validity (TODO)
               should_be_disabled                         -- condition
           , Bulma.box_input ("ttlMX") "TTL" "600"
               (updateForm Field_TTL)
-              state._currentRR.ttl
+              (show state._currentRR.ttl)
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("targetMX") "Target" "www"
               (updateForm Field_Target)
               state._currentRR.target
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("priorityMX") "Priority" "10"
               (updateForm Field_Priority)
-              state._currentRR.priority
+              (maybe "" show state._currentRR.priority)
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           ]
         content_srv :: Array (HH.HTML w Action)
@@ -402,37 +428,37 @@ render state
           , Bulma.box_input ("domainSRV") "Name" "_sip._tcp"   -- id, title, placeholder
               (updateForm Field_Domain)                 -- action
               state._currentRR.name                                -- value
-              state._currentRR.valid                               -- validity (TODO)
+              true -- state._currentRR.valid                               -- validity (TODO)
               should_be_disabled                               -- condition
           , Bulma.box_input ("ttlSRV") "TTL" "600"
               (updateForm Field_TTL)
-              state._currentRR.ttl
+              (show state._currentRR.ttl)
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("targetSRV") "Target" "www"
               (updateForm Field_Target)
               state._currentRR.target
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("prioritySRV") "Priority" "10"
               (updateForm Field_Priority)
-              state._currentRR.priority
+              (maybe "" show state._currentRR.priority)
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("portSRV") "Port" "5061"
               (updateForm Field_Port)
-              state._currentRR.port
+              (maybe "" show state._currentRR.port)
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("weightSRV") "Weight" "100"
               (updateForm Field_Weight)
-              state._currentRR.weight
+              (maybe "" show state._currentRR.weight)
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           , Bulma.box_input ("protocolSRV") "Protocol" "tcp"
               (updateForm Field_Protocol)
               state._currentRR.protocol
-              state._currentRR.valid
+              true -- state._currentRR.valid
               should_be_disabled
           ]
 
@@ -474,34 +500,132 @@ handleAction = case _ of
   CreateNewRRModal t -> do
     state <- H.get
     H.modify_ _ { rr_modal = NewRRModal t }
-    let defaultA = { rrtype: "A", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
+    let defaultA = { rrtype: "A"
-                   , name:     "www"
+          , rrid: 0
-                   , target:   "192.0.2.1"
+          , ttl: 600
-                   , port: "", weight: "", priority: "", protocol: ""}
+          , readonly: false
-        defaultAAAA = { rrtype: "AAAA", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
+          , name:     "www"
-                      , name:     "www"
+          , target:   "192.0.2.1"
-                      , target:   "2001:db8::1"
+          , port: Nothing
-                      , port: "", weight: "", priority: "", protocol: ""}
+          , weight: Nothing
-        defaultTXT = { rrtype: "TXT", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
+          , priority: Nothing
-                     , name:     "txt"
+          , protocol: Nothing
-                     , target:   "some text"
+          , mname: Nothing
-                     , port: "", weight: "", priority: "", protocol: ""}
+          , rname: Nothing
-        defaultCNAME = { rrtype: "CNAME", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
+          , serial: Nothing
-                       , name:     "blog"
+          , refresh: Nothing
-                       , target:   "www"
+          , retry: Nothing
-                       , port: "", weight: "", priority: "", protocol: ""}
+          , expire: Nothing
-        defaultNS = { rrtype: "NS", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
+          , minttl: Nothing
-                    , name:     (state._domain <> ".")
+          }
-                    , target:   "ns0.example.com."
+        defaultAAAA = { rrtype: "AAAA"
-                    , port: "", weight: "", priority: "", protocol: ""}
+          , rrid: 0
-        defaultMX = { rrtype: "MX", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
+          , ttl: 600
-                    , name:     "mail"
+          , readonly: false
-                    , target:   "www"
+          , name:     "www"
-                    , port: "", weight: "", priority: "10", protocol: ""}
+          , target:   "2001:db8::1"
-        defaultSRV = { rrtype: "SRV", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
+          , port: Nothing
-                     , name:     "_sip._tcp"
+          , weight: Nothing
-                     , target:   "www"
+          , priority: Nothing
-                     , port: "5061", weight: "100", priority: "10", protocol: "tcp"}
+          , protocol: Nothing
+          , mname: Nothing
+          , rname: Nothing
+          , serial: Nothing
+          , refresh: Nothing
+          , retry: Nothing
+          , expire: Nothing
+          , minttl: Nothing
+          }
+        defaultTXT = { rrtype: "TXT"
+          , rrid: 0
+          , ttl: 600
+          , readonly: false
+          , name:     "txt"
+          , target:   "some text"
+          , port: Nothing
+          , weight: Nothing
+          , priority: Nothing
+          , protocol: Nothing
+          , mname: Nothing
+          , rname: Nothing
+          , serial: Nothing
+          , refresh: Nothing
+          , retry: Nothing
+          , expire: Nothing
+          , minttl: Nothing
+          }
+        defaultCNAME = { rrtype: "CNAME"
+          , rrid: 0
+          , ttl: 600
+          , readonly: false
+          , name:     "blog"
+          , target:   "www"
+          , port: Nothing
+          , weight: Nothing
+          , priority: Nothing
+          , protocol: Nothing
+          , mname: Nothing
+          , rname: Nothing
+          , serial: Nothing
+          , refresh: Nothing
+          , retry: Nothing
+          , expire: Nothing
+          , minttl: Nothing
+          }
+        defaultNS = { rrtype: "NS"
+          , rrid: 0
+          , ttl: 600
+          , readonly: false
+          , name:     (state._domain <> ".")
+          , target:   "ns0.example.com."
+          , port: Nothing
+          , weight: Nothing
+          , priority: Nothing
+          , protocol: Nothing
+          , mname: Nothing
+          , rname: Nothing
+          , serial: Nothing
+          , refresh: Nothing
+          , retry: Nothing
+          , expire: Nothing
+          , minttl: Nothing
+          }
+        defaultMX = { rrtype: "MX"
+          , rrid: 0
+          , ttl: 600
+          , readonly: false
+          , name:     "mail"
+          , target:   "www"
+          , port: Nothing
+          , weight: Nothing
+          , priority: Just 10
+          , protocol: Nothing
+          , mname: Nothing
+          , rname: Nothing
+          , serial: Nothing
+          , refresh: Nothing
+          , retry: Nothing
+          , expire: Nothing
+          , minttl: Nothing
+          }
+        defaultSRV = { rrtype: "SRV"
+          , rrid: 0
+          , ttl: 600
+          , readonly: false
+          , name:     "_sip._tcp"
+          , target:   "www"
+          , port: Just 5061
+          , weight: Just 100
+          , priority: Just 10
+          , protocol: Just "tcp"
+          , mname: Nothing
+          , rname: Nothing
+          , serial: Nothing
+          , refresh: Nothing
+          , retry: Nothing
+          , expire: Nothing
+          , minttl: Nothing
+          }
     case t of
       A     -> H.modify_ _ { _currentRR = defaultA }
       AAAA  -> H.modify_ _ { _currentRR = defaultAAAA }
@@ -688,8 +812,7 @@ handleAction = case _ of
   where
     try_update_entry :: forall r
       . String
-      -> (AtLeastRRID r
+      -> (AtLeastRRID r -> Either Validation.Errors ResourceRecord)
-      -> Either Validation.Errors ResourceRecord)
       -> Maybe (AtLeastRRID r)
       -> String
       -> H.HalogenM State Action () Output m Unit
@@ -728,6 +851,8 @@ handleQuery = case _ of
         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
+        nstate <- H.get
+        H.put $ add_RR nstate new_rr
       (DNSManager.MkRRDeleted response) -> do
         -- Remove the resource record.
         state <- H.get
@@ -765,6 +890,8 @@ handleQuery = case _ of
       case add_entry new_state new_rr of
         Left errmsg -> H.raise $ Log $ SimpleLog $ "Error while replacing a resource record: " <> errmsg
         Right s     -> H.put s
+      new_state2 <- H.get
+      H.put $ add_RR new_state2 new_rr
 
     add_entries []  = H.raise $ Log $ SimpleLog "[🎉] Zone fully loaded!"
     add_entries arr = do
@@ -775,10 +902,29 @@ handleQuery = case _ of
           Left error_message -> do
             H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
             add_entries $ fromMaybe [] tail
-          Right new_state    -> do
+          Right new_state -> do
-            H.put new_state
+            H.put $ add_RR new_state new_rr -- TODO: add to `_resources`
             add_entries $ fromMaybe [] tail
 
+    add_RR :: State -> ResourceRecord -> State
+    add_RR state new_rr = state { _resources = (state._resources <> [ fromRRToSRVRR new_rr ]) }
+
+    fromRRToSRVRR :: ResourceRecord -> SRVRR ()
+    fromRRToSRVRR new_rr = do
+      { rrtype:    new_rr.rrtype
+      , rrid:      new_rr.rrid
+      , modified:  false
+      , valid:     true
+      , readonly:  new_rr.readonly
+      , ttl:       show new_rr.ttl
+      , name:      new_rr.name
+      , target:    new_rr.target
+      , port:      maybe "" show new_rr.port
+      , weight:    maybe "" show new_rr.weight
+      , priority:  maybe "" show new_rr.priority
+      , protocol:  maybe "" id   new_rr.protocol
+      }
+
     add_entry :: State -> ResourceRecord -> Either String State
     add_entry state new_rr = do
       case new_rr.rrtype, (A.elem new_rr.rrtype baseRecords) of
@@ -789,6 +935,42 @@ handleQuery = case _ of
         _, _     -> Left  $ "TODO: cannot add '" <> new_rr.rrtype <> "' resource records at the moment."
 
 -- Rendering
+render_soa2 :: forall (w :: Type). Maybe ResourceRecord -> HH.HTML w Action
+render_soa2 Nothing    = Bulma.box [ HH.text "SOA not loaded, yet" ]
+render_soa2 (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SOA)"
+                                   , table_rr
+                                   ]
+  where table_rr = Bulma.table [] [ simple_SOA_table_header, table_content ]
+        simple_SOA_table_header
+          = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "name"]
+                               , HH.th_ [ HH.text "ttl"]
+                               , HH.th_ [ HH.text "target"]
+                               , HH.th_ [ HH.text "mname"]
+                               , HH.th_ [ HH.text "rname"]
+                               , HH.th_ [ HH.text "serial"]
+                               , HH.th_ [ HH.text "refresh"]
+                               , HH.th_ [ HH.text "retry"]
+                               , HH.th_ [ HH.text "expire"]
+                               , HH.th_ [ HH.text "minttl"]
+                               ]
+                      ]
+        table_content
+          = HH.tbody_ $ [ HH.tr_ $ [
+                                   --, Bulma.p $ "rrtype: "   <>      soa.rrtype
+                                   --, Bulma.p $ "rrid: "     <> show soa.rrid
+                                     HH.td_ [ HH.text soa.name ]
+                                   , HH.td_ [ HH.text $ show soa.ttl ]
+                                   , HH.td_ [ HH.text soa.target ]
+                                   , HH.td_ [ HH.text $ maybe "" id soa.mname   ]
+                                   , HH.td_ [ HH.text $ maybe "" id soa.rname   ]
+                                   , HH.td_ [ HH.text $ maybe "" show soa.serial  ]
+                                   , HH.td_ [ HH.text $ maybe "" show soa.refresh ]
+                                   , HH.td_ [ HH.text $ maybe "" show soa.retry   ]
+                                   , HH.td_ [ HH.text $ maybe "" show soa.expire  ]
+                                   , HH.td_ [ HH.text $ maybe "" show soa.minttl  ]
+                                   ]
+                        ]
+
 render_soa :: forall (w :: Type). Maybe (SOARR ()) -> HH.HTML w Action
 render_soa Nothing    = Bulma.box [ HH.text "SOA not loaded, yet" ]
 render_soa (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SOA)"
@@ -826,47 +1008,68 @@ render_soa (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SOA
                         ]
 
 -- | Render all Resource Records.
-render_resources :: forall (w :: Type). Hash.HashMap RRId (Array Validation.ValidationError) -> Array (SRVRR ()) -> HH.HTML w Action
+render_resources :: forall w
+  .  Hash.HashMap RRId (Array Validation.ValidationError)
+  -> Array (ResourceRecord)
+  -> HH.HTML w Action
 render_resources _ []
   = Bulma.box [ Bulma.zone_rr_title "All records (TEST)"
               , Bulma.subtitle "No records for now"
               ]
 render_resources errors records
   = Bulma.box [ Bulma.zone_rr_title "All records (TEST)"
-              , Bulma.subtitle "TODO: display the records."
+              , render_soa2 $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records
+              , table_rr
               ]
---render_resources errors records
+  where
---  = Bulma.box [ Bulma.zone_rr_title "All records (TEST)"
+  table_rr = Bulma.table [] [ table_content ]
---              , table_rr
+  table_content = HH.tbody_ $ A.concat $ map rows records
---              ]
+  rows rr = [ HH.tr_ $ render_row rr ] -- <> error_row rr
---  where
+
---    table_rr = Bulma.table [] [ Bulma.zone_rr_title "XXX", table_content ]
+--  error_row rr = case Hash.lookup rr.rrid errors of
---    table_content = HH.tbody_ $ A.concat $ map rows records
+--    Nothing -> []
---    rows rr
+--    Just error_array -> [ HH.tr_ $
---      = [ HH.tr_ $
+--        [ Bulma.txt_name ""
---          [ Bulma.txt_name rr.rrtype
+--        , HH.td_ $ from_error_array_to_td error_array Validation.Name
---          , HH.td_ [ Bulma.input_domain (update_simple rr.rrid Update_SRR_Domain) rr.name   rr.valid ]
+--        , HH.td_ $ from_error_array_to_td error_array Validation.TTL
---          , HH.td_ [ Bulma.input_ttl    (update_simple rr.rrid Update_SRR_TTL  )  rr.ttl    rr.valid ]
+--        , HH.td_ $ from_error_array_to_td error_array Validation.Target
---          , HH.td_ [ case rr.rrtype of
+--        , HH.td_ []
---              "TXT" -> Bulma.textarea   (update_simple rr.rrid Update_SRR_Target) rr.target rr.valid
+--        , HH.td_ []
---              _ -> Bulma.input_target   (update_simple rr.rrid Update_SRR_Target) rr.target rr.valid
---            ]
---          , HH.td_ [ Bulma.btn_change (SaveSRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ]
---          , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
---          ]
---        ] <> error_row rr
---    update_simple rrid v = (UpdateLocalRR rrid) <<< Update_Local_Form_SRR <<< v
---    error_row rr = case Hash.lookup rr.rrid errors of
---      Nothing -> []
---      Just error_array -> [ HH.tr_ $
---          [ Bulma.txt_name ""
---          , HH.td_ $ from_error_array_to_td error_array Validation.Name
---          , HH.td_ $ from_error_array_to_td error_array Validation.TTL
---          , HH.td_ $ from_error_array_to_td error_array Validation.Target
---          , HH.td_ []
---          , HH.td_ []
---          ]
 --        ]
+--      ]
+
+  render_row :: ResourceRecord -> Array (HH.HTML w Action)
+  render_row rr = 
+    case rr.rrtype of
+      "SRV" ->
+        [ Bulma.txt_name rr.rrtype
+        , HH.td_ [ Bulma.p rr.name]
+        , HH.td_ [ Bulma.p $ show rr.ttl ]
+        , HH.td_ [ Bulma.p $ maybe "" show rr.priority ]
+        , HH.td_ [ Bulma.p $ maybe "" id rr.protocol ]
+        , HH.td_ [ Bulma.p $ maybe "" show rr.weight ]
+        , HH.td_ [ Bulma.p $ maybe "" show rr.port ]
+        , HH.td_ [ Bulma.p rr.target ]
+        , HH.td_ [ Bulma.btn_change (CreateUpdateRRModal rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") true true ]
+        , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
+        ]
+      "MX"  ->
+        [ Bulma.txt_name rr.rrtype
+        , HH.td_ [ Bulma.p rr.name]
+        , HH.td_ [ Bulma.p $ show rr.ttl ]
+        , HH.td_ [ Bulma.p $ maybe "" show rr.priority ]
+        , HH.td_ [ Bulma.p rr.target ]
+        , HH.td_ [ Bulma.btn_change (CreateUpdateRRModal rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") true true ]
+        , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
+        ]
+      _     ->
+        [ Bulma.txt_name rr.rrtype
+        , HH.td_ [ Bulma.p rr.name]
+        , HH.td_ [ Bulma.p $ show rr.ttl ]
+        , HH.td_ [ Bulma.p rr.target ]
+        , HH.td_ [ Bulma.btn_change (CreateUpdateRRModal rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") true true ]
+        , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
+        ]
 
 render_records :: forall (w :: Type). Hash.HashMap RRId Validation.Errors -> Array (SimpleRR ()) -> HH.HTML w Action
 render_records _ []