From 419d68784a983af99b1ddf22d028696ab4f719c6 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Wed, 21 Feb 2024 00:10:40 +0100
Subject: [PATCH] Do not allow modification of read only RRs.

---
 src/App/ZoneInterface.purs | 29 ++++++++++++++++++++++-------
 src/Bulma.purs             | 18 ++++++++++++++++++
 2 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs
index 9545c46..3839b79 100644
--- a/src/App/ZoneInterface.purs
+++ b/src/App/ZoneInterface.purs
@@ -35,6 +35,7 @@ import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
 
 import Bulma as Bulma
+import CSSClasses as C
 
 import App.AcceptedRRTypes (AcceptedRRTypes(..))
 import App.ResourceRecord (ResourceRecord)
@@ -729,7 +730,9 @@ render_resources records
   emptyline = HH.tr_ [ Bulma.txt_name "", HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [] ]
 
   table_content records_ = HH.tbody_ $ map rows records_
-  rows rr = HH.tr_ $ render_row rr -- <> error_row rr
+  rows rr = if rr.readonly
+            then HH.tr [ HP.classes C.has_background_warning_light ] $ render_row rr -- <> error_row rr
+            else HH.tr_ $ render_row rr -- <> error_row rr
 
   render_row :: ResourceRecord -> Array (HH.HTML w Action)
   render_row rr =
@@ -743,8 +746,12 @@ render_resources records
         , 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_modify (CreateUpdateRRModal rr.rrid) ]
-        , HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
       "MX"  ->
         [ Bulma.txt_name rr.rrtype
@@ -752,16 +759,24 @@ render_resources records
         , 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_modify (CreateUpdateRRModal rr.rrid) ]
-        , HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else 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_modify (CreateUpdateRRModal rr.rrid) ]
-        , HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
 
 baseRecords :: Array String
diff --git a/src/Bulma.purs b/src/Bulma.purs
index 58b4792..21ad8fd 100644
--- a/src/Bulma.purs
+++ b/src/Bulma.purs
@@ -138,6 +138,21 @@ btn_add action = btn_ C.is_info "Add" action
 btn_delete :: forall w i. i -> HH.HTML w i
 btn_delete action = btn_ (C.is_small <> C.is_danger) "remove" action
 
+btn_modify_ro :: forall w i. HH.HTML w i
+btn_modify_ro = btn_ro (C.is_small <> C.is_warning) "modify"
+
+btn_readonly :: forall w i. HH.HTML w i
+btn_readonly = btn_ro (C.is_small <> C.is_warning) "read only"
+
+btn_delete_ro :: forall w i. HH.HTML w i
+btn_delete_ro = btn_ro (C.is_small <> C.is_warning) "remove"
+
+btn_ro :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
+btn_ro classes title
+  = HH.button
+      [ HP.classes $ C.button <> classes
+      ] [ HH.text title ]
+
 -- | Create a `level`, different components that should appear on the same horizontal line.
 -- | First argument, elements that should appear on the left, second on the right.
 level :: forall w i. Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
@@ -174,11 +189,14 @@ render_input password id placeholder action value cond
         false -> []
         true -> [ HP.type_ HP.InputPassword ]
 
+div_field :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
 div_field = HH.div [HP.classes (C.field <> C.is_horizontal)]
 
+div_field_label :: forall w i. String -> String -> HH.HTML w i
 div_field_label id title = HH.div [HP.classes (C.field_label <> C.normal)]
                                   [HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
 
+div_field_content :: forall w i. HH.HTML w i -> HH.HTML w i
 div_field_content content
   = HH.div [ HP.classes C.field_body ]
            [ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.control ] [ content ] ] ]