Local addresses.

src/App/Container.purs

@@ -112,8 +112,8 @@ foreign import unsafeSetInnerHTML :: HTMLElement -> RawHTML -> Effect Unit
 -- | Current limit is 30 minutes (`max_keepalive` = 60, 60 * 30 seconds = 30 minutes).
 max_keepalive = 60 :: Int
 
-wsURLauthd       = "wss://www.netlib.re/ws/authd"       :: String
+wsURLauthd       = "ws://localhost:8080" :: String
-wsURLdnsmanagerd = "wss://www.netlib.re/ws/dnsmanagerd" :: String
+wsURLdnsmanagerd = "ws://localhost:8081" :: String
 
 data PageEvent
   = EventPageAuthentication       PageAuthentication.Output
@@ -601,6 +601,9 @@ act_on_page_event page_event = case page_event of
     PageZone.AskSaveDelegation domain nameserver1 nameserver2 -> do
       message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDelegateDomain { domain, nameserver1, nameserver2 }
       H.tell _ws_dns unit (WS.ToSend message)
+    PageZone.AskResetDelegation domain -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkResetDelegation { domain }
+      H.tell _ws_dns unit (WS.ToSend message)
     PageZone.AskAddRR domain rr -> do
       message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAddRR { domain, rr }
       H.tell _ws_dns unit (WS.ToSend message)

src/App/Message/DNSManagerDaemon.purs

@@ -140,6 +140,18 @@ codecDelegateDomain = CA.object "DelegateDomain" (CAR.record { domain: CA.string
                                                              , nameserver1: CA.string
                                                              , nameserver2: CA.string })
 
+{- 26  -}
+type EditDelegation = { domain :: String, nameserver1 :: String, nameserver2 :: String }
+codecEditDelegation ∷ CA.JsonCodec EditDelegation
+codecEditDelegation = CA.object "EditDelegation" (CAR.record { domain: CA.string
+                                                             , nameserver1: CA.string
+                                                             , nameserver2: CA.string })
+
+{- 27  -}
+type ResetDelegation = { domain :: String }
+codecResetDelegation ∷ CA.JsonCodec ResetDelegation
+codecResetDelegation = CA.object "ResetDelegation" (CAR.record { domain: CA.string })
+
 {- 100 -}
 type GenerateAllZoneFiles = {}
 codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles
@@ -345,6 +357,8 @@ data RequestMessage
   | MkGainOwnership        GainOwnership        -- 23
   | MkSearchDomain         SearchDomain         -- 24
   | MkDelegateDomain       DelegateDomain       -- 25
+  | MkEditDelegation       EditDelegation       -- 26
+  | MkResetDelegation      ResetDelegation      -- 27
   | MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100
   | MkGenerateZoneFile     GenerateZoneFile     -- 101
   | MkKeepAlive            KeepAlive            -- 250
@@ -406,6 +420,8 @@ encode m = case m of
     (MkGainOwnership        request) -> get_tuple 23  codecGainOwnership        request
     (MkSearchDomain         request) -> get_tuple 24  codecSearchDomain         request
     (MkDelegateDomain       request) -> get_tuple 25  codecDelegateDomain       request
+    (MkEditDelegation       request) -> get_tuple 26  codecEditDelegation       request
+    (MkResetDelegation      request) -> get_tuple 27  codecResetDelegation      request
     (MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request
     (MkGenerateZoneFile     request) -> get_tuple 101 codecGenerateZoneFile     request
     (MkKeepAlive            request) -> get_tuple 250 codecKeepAlive            request

src/App/Page/Zone.purs

@@ -40,12 +40,11 @@ import CSSClasses as C
 
 import App.Text.Explanations as Explanations
 
-import App.Type.RRId (RRId)
 import App.Type.ResourceRecord as RR
-import App.Type.Delegation (mkEmptyDelegationForm, update, Form, Field) as Delegation
+import App.Type.Delegation (mkUpdateDelegationForm, mkEmptyDelegationForm, update, Form, Field) as Delegation
 import App.Type.RRModal (RRModal(..))
-import App.Type.DKIM as DKIM
+import App.Type.ResourceRecord.DKIM as DKIM
-import App.Type.DMARC as DMARC
+import App.Type.ResourceRecord.DMARC as DMARC
 
 import App.Type.LogMessage (LogMessage(..))
 import App.Message.DNSManagerDaemon as DNSManager
@@ -67,6 +66,7 @@ data Output
   | AskDeleteRR String Int
   | AskSaveRR String RR.ResourceRecord
   | AskSaveDelegation String String String
+  | AskResetDelegation String
   | AskAddRR String RR.ResourceRecord
   | AskGetZone String
 
@@ -89,9 +89,9 @@ type Input = String
 -- | 4. `AddRR RR.AcceptedRRTypes RR.ResourceRecord`: send a message to `dnsmanagerd`.
 -- |
 -- | Steps to update an entry:
--- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update.
+-- | 1. `CreateUpdateRRModal RR.RRId`: create a modal from the values of the RR in `_resources` to update.
 -- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR.
--- | 3. `ValidateLocal RRId RR.AcceptedRRTypes`: validate the RR.
+-- | 3. `ValidateLocal RR.RRId RR.AcceptedRRTypes`: validate the RR.
 -- | 4. `SaveRR RR.ResourceRecord`: save the _validated_ RR by sending a message to `dnsmanagerd`.
 
 data Action
@@ -107,11 +107,17 @@ data Action
   -- | Delegation modal.
   | CreateDelegationModal
 
+  -- | Update Delegation modal.
+  | UpdateDelegationModal Delegation
+
+  -- | Reset Delegation modal.
+  | DisplayResetDelegationModal
+
   -- | Create modal (a form) for a resource record to update.
-  | CreateUpdateRRModal RRId
+  | CreateUpdateRRModal RR.RRId
 
   -- | Create a modal to ask confirmation before deleting a resource record.
-  | DeleteRRModal RRId
+  | DeleteRRModal RR.RRId
 
   -- | Change the current tab.
   | ChangeTab Tab
@@ -131,6 +137,9 @@ data Action
   -- | Save the delegation.
   | SaveDelegation
 
+  -- | Reset the delegation.
+  | ResetDelegation
+
   -- | Validate a new resource record before adding it.
   | ValidateRR RR.AcceptedRRTypes
 
@@ -149,7 +158,7 @@ data Action
 
   -- | Send a message to remove a resource record.
   -- | Automatically closes the modal.
-  | RemoveRR RRId
+  | RemoveRR RR.RRId
 
   -- | Ask `dnsmanagerd` for the generated zone file.
   | AskGeneratedZoneFile
@@ -158,7 +167,7 @@ data Action
   | RRUpdate RR.RRUpdateValue
 
   -- | Ask a (new) token for a resource record.
-  | NewToken RRId
+  | NewToken RR.RRId
 
 data Tab = Zone | TheBasics | TokenExplanation
 derive instance eqTab :: Eq Tab
@@ -177,7 +186,7 @@ type State =
 
   -- | All resource records.
   , _resources :: Array RR.ResourceRecord
-  --, _local_errors :: Hash.HashMap RRId (Array Validation.Error)
+  --, _local_errors :: Hash.HashMap RR.RRId (Array Validation.Error)
 
   -- Unique RR form.
   , _rr_form :: RR.Form
@@ -253,12 +262,16 @@ render state
       = Modal.delegation_modal state._domain state._delegation_form
           UpdateDelegationForm ValidateDelegation CancelModal
 
+    reset_delegation_modal
+      = Modal.reset_delegation_modal state._domain ResetDelegation CancelModal
+
     render_zone =
       case state.rr_modal of
-          RemoveRRModal rr_id -> Modal.modal_rr_delete rr_id RemoveRR CancelModal
+          RemoveRRModal rr_id  -> Modal.modal_rr_delete rr_id RemoveRR CancelModal
-          NewRRModal _        -> call_to_current_rr_modal
+          NewRRModal _         -> call_to_current_rr_modal
-          UpdateRRModal       -> call_to_current_rr_modal
+          UpdateRRModal        -> call_to_current_rr_modal
-          DelegationModal     -> delegation_modal
+          DelegationModal      -> delegation_modal
+          ResetDelegationModal -> reset_delegation_modal
           NoModal -> HH.div_ $
             [ Web.level [ Web.btn_ [C.is_large, C.is_info]  "Back to the domain list" ReturnToDomainList
                         , Web.h1 state._domain
@@ -268,7 +281,17 @@ render state
 
     -- render_zone_records :: Maybe Delegation -> HH.HTML i Action
     render_zone_records (Just delegation) =
-      [ Web.p $ "This domain has been delegated to " <> delegation.nameserver1 <> " and " <> delegation.nameserver2 ]
+      [ Web.p "This domain has been delegated to the following nameservers:"
+      , Web.ul [ HH.li_ [ Web.btn_ro [C.is_warning] delegation.nameserver1 ]
+               , HH.li_ [ Web.btn_ro [C.is_warning] delegation.nameserver2 ]
+               ]
+      , Web.level [
+            Web.btn "Edit the name servers" (UpdateDelegationModal delegation)
+          ] []
+      , Web.level [
+            Web.btn "Reset this domain, forget about delegation" DisplayResetDelegationModal
+          ] []
+      ]
     render_zone_records _ =
       [ Table.resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal NewToken
       , Web.hr
@@ -333,6 +356,14 @@ handleAction = case _ of
   CreateDelegationModal -> do
     H.modify_ _ { rr_modal = DelegationModal, _delegation_form = Delegation.mkEmptyDelegationForm }
 
+  -- | Delegation modal presents a simple form with two entries (chosen nameservers).
+  UpdateDelegationModal delegation -> do
+    H.modify_ _ { rr_modal = DelegationModal, _delegation_form = Delegation.mkUpdateDelegationForm delegation }
+
+  -- | Delegation modal presents a simple form with two entries (chosen nameservers).
+  DisplayResetDelegationModal -> do
+    H.modify_ _ { rr_modal = ResetDelegationModal }
+
   -- | Initialize the Zone component: ask for the domain zone to `dnsmanagerd`.
   Initialize -> do
     { _domain } <- H.get
@@ -470,6 +501,13 @@ handleAction = case _ of
     H.raise $ AskSaveDelegation state._domain df.nameserver1 df.nameserver2
     H.modify_ _ { rr_modal = NoModal }
 
+  -- | Save the delegation of the domain.
+  ResetDelegation -> do
+    state <- H.get
+    H.raise $ Log $ SystemLog $ "Reset the delegation for domain '" <> state._domain <> "'"
+    H.raise $ AskResetDelegation state._domain
+    H.modify_ _ { rr_modal = NoModal }
+
   NewToken rr_id -> do
     { _domain } <- H.get
     H.raise $ Log $ SystemLog $ "Ask a token for rrid " <> show rr_id
@@ -517,7 +555,9 @@ handleQuery = case _ of
         H.modify_ _ { _rr_form { _zonefile = Just response.zonefile } }
       (DNSManager.MkZone response) -> do
         case response.zone.delegation of
-          Nothing -> add_entries response.zone.resources
+          Nothing -> do
+            H.modify_ _ { delegation = Nothing, _resources = [] }
+            add_entries response.zone.resources
           Just _  -> H.modify_ _ { delegation = response.zone.delegation }
       (DNSManager.MkDomainDelegated response) -> do
         H.modify_ _ { delegation = Just { nameserver1: response.nameserver1, nameserver2: response.nameserver2} }

src/App/Templates/Modal.purs

@@ -12,20 +12,20 @@ import Data.Maybe (Maybe(..), fromMaybe, maybe)
 
 import Data.Tuple (Tuple)
 
-import App.Type.CAA as CAA
-import App.Text.Explanations as Explanations
 import Web as Web
 import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
-import App.Type.RRId (RRId)
-import App.Type.DMARC as DMARC
-import App.Type.DKIM as DKIM
-import App.Type.Delegation as Delegation
-import App.Templates.Table as Table
 import Data.String (toLower)
 
+import App.Text.Explanations as Explanations
+import App.Templates.Table as Table
+
+import App.Type.Delegation as Delegation
 import App.Type.RRModal (RRModal(..))
 
+import App.Type.ResourceRecord.CAA as CAA
+import App.Type.ResourceRecord.DMARC as DMARC
+import App.Type.ResourceRecord.DKIM as DKIM
 import App.Type.ResourceRecord.SPF (mechanism_types, modifier_types, qualifier_types, show_qualifier) as SPF
 import App.Type.ResourceRecord as RR
 
@@ -47,6 +47,28 @@ modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting
 zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String)
 zip_nullable txt raw = A.zip txt ([""] <> raw)
 
+type ActionResetDelegation :: forall i. i -> i
+type ActionResetDelegation i = i
+reset_delegation_modal :: forall w i. Domain -> ActionResetDelegation i -> ActionCancelModal i -> HH.HTML w i
+reset_delegation_modal selected_domain action_reset_delegation action_cancel_modal =
+    Web.modal modal_title modal_content modal_foot
+    where
+    modal_title = "Reset delegation for " <> selected_domain
+    modal_content :: Array (HH.HTML w i)
+    modal_content =
+      [ HH.div [HP.classes [C.notification, C.is_warning]]
+          [ Web.p "⚠️​  You are about to remove delegation for this domain."
+          , Web.p """
+                  The domain will be reset to the default values from a template, you'll be able to modify the domain as a new domain.
+                  """
+          ]
+      ]
+    modal_foot :: Array (HH.HTML w i)
+    modal_foot =
+        [ Web.info_btn "Reset this domain" action_reset_delegation
+        , Web.cancel_button action_cancel_modal
+        ]
+
 type ActionValidate :: forall i. i -> i
 type ActionValidate i = i
 type ActionUpdateDelegationForm  i = (Delegation.Field -> i)
@@ -58,9 +80,9 @@ delegation_modal selected_domain form action_update_form action_validate action_
     modal_title = "Delegation for " <> selected_domain
     modal_content :: Array (HH.HTML w i)
     modal_content =
-      [ HH.div [HP.classes [C.notification, C.is_warning]]
+      [ if form.new then HH.div [HP.classes [C.notification, C.is_warning]]
-          [ Web.p "⚠️​  You are about to delegate your domain to another server, you won't be able to manage entries from netlibre."
+          [ Web.p "⚠️​  You are about to delegate your domain to another server, you won't be able to manage entries from netlibre." ]
-          ]
+                    else HH.div [] []
       , render_errors
       , Web.box_input "nameserver1" "name server 1" "ns0.example.com"
           (action_update_form <<< Delegation.NameServer1)
@@ -71,7 +93,8 @@ delegation_modal selected_domain form action_update_form action_validate action_
       ]
     modal_foot :: Array (HH.HTML w i)
     modal_foot =
-        [ Web.info_btn "Delegate the domain" action_validate
+        [ if form.new then Web.info_btn "Delegate the domain" action_validate
+                      else Web.info_btn "Update the name servers" action_validate
         , Web.cancel_button action_cancel_modal
         ]
     render_errors = if A.length form.errors > 0
@@ -80,7 +103,7 @@ delegation_modal selected_domain form action_update_form action_validate action_
 
 type Domain                  = String
 type ActionUpdateForm      i = (RR.Field -> i)
-type ActionNewToken        i = (RRId -> i)
+type ActionNewToken        i = (RR.RRId -> i)
 type ActionUpdateRR        i = (RR.RRUpdateValue -> i)
 type ActionValidateNewRR   i = (RR.AcceptedRRTypes -> i)
 type ActionValidateLocalRR :: forall k. k -> k
@@ -397,9 +420,10 @@ current_rr_modal selected_domain form rr_modal
     template content foot_ = Web.modal title content foot
       where
       title = case rr_modal of
-        NoModal             -> "Error: no modal should be displayed"
+        NoModal              -> "Error: no modal should be displayed"
-        DelegationModal     -> "Error: the delegation modal should be displayed"
+        DelegationModal      -> "Error: the delegation modal should be displayed"
-        NewRRModal t_       -> "New " <> show t_ <> " resource record"
+        ResetDelegationModal -> "Error: the reset delegation modal should be displayed"
-        UpdateRRModal       -> "Update " <> form._rr.rrtype <> " Resource Record"
+        NewRRModal t_        -> "New " <> show t_ <> " resource record"
-        RemoveRRModal rr_id -> "Error: should display removal modal instead (for resource record " <> show rr_id <> ")"
+        UpdateRRModal        -> "Update " <> form._rr.rrtype <> " Resource Record"
+        RemoveRRModal rr_id  -> "Error: should display removal modal instead (for resource record " <> show rr_id <> ")"
       foot = foot_ <> [Web.cancel_button action_cancel_modal]

src/App/Templates/Table.purs

@@ -29,7 +29,7 @@ import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
 import Data.String.CodePoints as CP
 import Utils (id, attach_id)
-import App.Type.DMARC as DMARC
+import App.Type.ResourceRecord.DMARC as DMARC
 
 import App.Type.ResourceRecord (ResourceRecord)
 import App.Type.ResourceRecord.SPF ( show_mechanism, show_mechanism_type

src/App/Type/Delegation.purs

@@ -1,45 +1,7 @@
-module App.Type.Delegation where
+module App.Type.Delegation
+  ( module App.Type.Form.Delegation
+  , module App.Type.Error.Delegation
+  ) where
 
-import GenericParser.Parser as G
+import App.Type.Form.Delegation (Form, Field(..), update, mkEmptyDelegationForm, mkUpdateDelegationForm)
-import GenericParser.DomainParser.Common (DomainError) as DomainParser
+import App.Type.Error.Delegation (Error(..))
-
--- | The required data needed to properly delegate a domain: two name servers.
--- | The type also includes potential errors found while validating the data.
-type Form
-  = { nameserver1 :: String
-    , nameserver2 :: String
-    , errors      :: Array Error
-    }
-
--- | Empty delegation form, with default inputs.
-mkEmptyDelegationForm :: Form
-mkEmptyDelegationForm
-  = { nameserver1: "ns0.example.com"
-    , nameserver2: "ns1.example.com"
-    , errors: []
-    }
-
--- | What are the **fields** of our delegation form?
--- | This *Field* data type provides a way to update the form with `update`.
-data Field
-  = NameServer1 String
-  | NameServer2 String
-
--- | Utility function to update a field of the form, based on the previous `Form` and `Field` types.
--- |
--- | RATIONALE: this utility function enables a generic way of handling field updates.
--- | In Halogen, a single *Action* is required to update all fields:
--- |```
--- |  UpdateDelegationForm field -> do
--- |    state <- H.get
--- |    H.modify_ _ { delegation_form = Delegation.update state.delegation_form field }
--- |```
-update :: Form -> Field -> Form
-update form updated_field = case updated_field of
-  NameServer1 val -> form { nameserver1 = val }
-  NameServer2 val -> form { nameserver2 = val }
-
--- | Possible errors regarding the form (domain parsing errors).
-data Error
-  = VENameServer1 (G.Error DomainParser.DomainError)
-  | VENameServer2 (G.Error DomainParser.DomainError)

src/App/Type/Error/Delegation.purs

@@ -0,0 +1,10 @@
+-- | Possible errors while verifying the Delegation form.
+module App.Type.Error.Delegation where
+
+import GenericParser.Parser as G
+import GenericParser.DomainParser.Common (DomainError) as DomainParser
+
+-- | Possible errors regarding the form (domain parsing errors).
+data Error
+  = VENameServer1 (G.Error DomainParser.DomainError)
+  | VENameServer2 (G.Error DomainParser.DomainError)

src/App/Type/Error/ResourceRecord.purs

@@ -0,0 +1,54 @@
+module App.Type.Error.ResourceRecord where
+
+import GenericParser.Parser as G
+import GenericParser.IPAddress as IPAddress
+import GenericParser.DomainParser.Common (DomainError) as DomainParser
+
+-- | Errors that might be catched in for the form upon validation (`App.Validation.DNS`).
+-- |
+-- | **History:**
+-- | The module once used dedicated types for each type of RR.
+-- | That comes with several advantages.
+-- | First, type verification was a thing, and function were dedicated to a certain type of record.
+-- | Second, these dedicated types used strings for their fields,
+-- | which simplifies the typing when dealing with forms.
+-- | Finally, the validation was a way to convert dedicated types (used in forms)
+-- | to the general type (used for network serialization).
+-- | This ensures each resource record is verified before being sent to `dnsmanagerd`.
+-- |
+-- | The problem is that, with dedicated types, you are then required to have dedicated functions.
+-- | Conversion functions are also required.
+-- |
+-- | Maybe the code will change again in the future, but for now it will be enough.
+
+data Error
+  = UNKNOWN
+  | VEIPv4 (G.Error IPAddress.IPv4Error)
+  | VEIPv6 (G.Error IPAddress.IPv6Error)
+  | VEName (G.Error DomainParser.DomainError)
+  | VETTL Int Int Int
+  | VETXT (G.Error TXTError)
+  | VECNAME (G.Error DomainParser.DomainError)
+  | VENS (G.Error DomainParser.DomainError)
+  | VEMX (G.Error DomainParser.DomainError)
+  | VEPriority Int Int Int
+  | VESRV (G.Error DomainParser.DomainError)
+  | VEPort Int Int Int
+  | VEWeight Int Int Int
+  | VEDMARCpct Int Int Int
+  | VEDMARCri  Int Int Int
+
+  | VECAAflag  Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
+
+  -- SPF
+  | VESPFMechanismName (G.Error DomainParser.DomainError)
+  | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
+  | VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
+
+  | VESPFModifierName (G.Error DomainParser.DomainError)
+
+  | DKIMInvalidKeySize Int Int
+
+data TXTError
+  = TXTInvalidCharacter
+  | TXTTooLong Int Int -- max current

src/App/Type/Form/Delegation.purs

@@ -0,0 +1,52 @@
+module App.Type.Form.Delegation where
+
+import App.Type.Error.Delegation (Error)
+
+type Delegation = { nameserver1 :: String, nameserver2 :: String }
+
+-- | The required data needed to properly delegate a domain: two name servers.
+-- | The type also includes potential errors found while validating the data.
+type Form
+  = { nameserver1 :: String
+    , nameserver2 :: String
+    , errors      :: Array Error
+    , new         :: Boolean
+    }
+
+-- | Empty delegation form, with default inputs.
+mkEmptyDelegationForm :: Form
+mkEmptyDelegationForm
+  = { nameserver1: "ns0.example.com"
+    , nameserver2: "ns1.example.com"
+    , errors: []
+    , new: true
+    }
+
+-- | Empty delegation form, with default inputs.
+mkUpdateDelegationForm :: Delegation -> Form
+mkUpdateDelegationForm delegation
+  = { nameserver1: delegation.nameserver1
+    , nameserver2: delegation.nameserver2
+    , errors: []
+    , new: false
+    }
+
+-- | What are the **fields** of our delegation form?
+-- | This *Field* data type provides a way to update the form with `update`.
+data Field
+  = NameServer1 String
+  | NameServer2 String
+
+-- | Utility function to update a field of the form, based on the previous `Form` and `Field` types.
+-- |
+-- | RATIONALE: this utility function enables a generic way of handling field updates.
+-- | In Halogen, a single *Action* is required to update all fields:
+-- |```
+-- |  UpdateDelegationForm field -> do
+-- |    state <- H.get
+-- |    H.modify_ _ { delegation_form = Delegation.update state.delegation_form field }
+-- |```
+update :: Form -> Field -> Form
+update form updated_field = case updated_field of
+  NameServer1 val -> form { nameserver1 = val }
+  NameServer2 val -> form { nameserver2 = val }

src/App/Type/Form/ResourceRecord.purs

@@ -0,0 +1,241 @@
+module App.Type.Form.ResourceRecord where
+
+import Prelude (($), (-), (<>))
+
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Array as A
+import Data.Int (fromString)
+import Data.Either (Either(..))
+
+import Utils (id, attach_id, remove_id)
+
+import App.Validation.Email as Email
+
+import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
+
+import App.Type.ResourceRecord.ResourceRecord (ResourceRecord, default_caa, default_rr)
+import App.Type.ResourceRecord.SRV as SRV
+import App.Type.ResourceRecord.CAA as CAA
+import App.Type.ResourceRecord.DKIM as DKIM
+import App.Type.ResourceRecord.DMARC as DMARC
+import App.Type.ResourceRecord.SPF as SPF
+
+import App.Type.Error.ResourceRecord (Error)
+
+-- | `Form` is the necessary state to modify a resource record.
+-- | It contains the currently manipulated record, detected errors, along with some temporary values.
+-- | FIXME: this form is messy AF and should be replaced.
+type Form =
+  { _rr                :: ResourceRecord
+  , _errors            :: Array Error
+  , _dmarc_mail_errors :: Array Email.Error
+  , _zonefile          :: Maybe String
+  , tmp                :: TMP
+  }
+
+data Field
+  = Domain    String
+  | TTL       String
+  | Target    String
+  | Priority  String
+  | Weight    String
+  | Port      String
+  | SPF_v          String
+  | SPF_mechanisms (Array SPF.Mechanism)
+  | SPF_modifiers  (Array SPF.Modifier)
+  | SPF_q          SPF.Qualifier
+
+  | CAA_flag  String
+  | CAA_value String
+
+-- | TMP: temporary stored values regarding specific records such as SPF,
+-- | DKIM and DMARC.
+type TMP =
+  {
+    -- SPF details.
+    spf :: { mechanism_q :: String
+           , mechanism_t :: String
+           , mechanism_v :: String
+           , modifier_t  :: String
+           , modifier_v  :: String
+           }
+
+    -- DMARC details.
+  , dmarc_mail       :: String
+  , dmarc_mail_limit :: Maybe Int
+  , dmarc            :: DMARC.DMARC
+
+    -- DKIM details.
+  , dkim :: DKIM.DKIM
+  }
+
+mkEmptyRRForm :: Form
+mkEmptyRRForm =
+  {
+  -- This is the state for the new RR modal.
+    _rr: default_rr A ""
+  -- List of errors within the form in new RR modal.
+  , _errors: []
+  , _dmarc_mail_errors: []
+  , _zonefile: Nothing
+  , tmp: { spf: { mechanism_q: "pass"
+                , mechanism_t: "a"
+                , mechanism_v: ""
+                , modifier_t:  "redirect"
+                , modifier_v:  ""
+                }
+         , dkim:  DKIM.emptyDKIMRR
+         , dmarc: DMARC.emptyDMARCRR
+         , dmarc_mail: ""
+         , dmarc_mail_limit: Nothing
+         }
+  }
+
+data RRUpdateValue
+  = CAA_tag Int
+  | SRV_Protocol Int
+  | SPF_Mechanism_q Int
+  | SPF_Mechanism_t Int
+  | SPF_Mechanism_v String
+  | SPF_Modifier_t  Int
+  | SPF_Modifier_v  String
+  | SPF_Qualifier   Int
+
+  -- | Remove a SPF mechanism of the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_remove_mechanism Int
+  -- | Remove a SPF modifier of the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_remove_modifier Int
+
+  -- | Add a SPF mechanism to the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_Mechanism_Add
+  -- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_Modifier_Add
+
+  -- | Change the temporary mail address for DMARC.
+  | DMARC_mail String
+
+  -- | Change the temporary report size limit for DMARC.
+  | DMARC_mail_limit String
+
+  -- | Change the requested report interval.
+  | DMARC_ri String
+
+  -- | Add a new mail address to the DMARC rua list.
+  | DMARC_rua_Add
+
+  -- | Add a new mail address to the DMARC ruf list.
+  | DMARC_ruf_Add
+
+  -- | Remove a mail address of the DMARC rua list.
+  | DMARC_remove_rua Int
+
+  -- | Remove a mail address of the DMARC ruf list.
+  | DMARC_remove_ruf Int
+
+  | DMARC_policy Int
+  | DMARC_sp_policy Int
+  | DMARC_adkim Int
+  | DMARC_aspf Int
+  | DMARC_pct  String
+  | DMARC_fo Int
+
+  | DKIM_hash_algo Int
+  | DKIM_sign_algo Int
+  | DKIM_pubkey    String
+  | DKIM_note      String
+
+update_form :: Form -> RRUpdateValue -> Form
+update_form form new_field_value =
+  case new_field_value of
+  CAA_tag         v ->
+    let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v
+        new_value = case new_tag of
+          CAA.Issue -> "letsencrypt.org"
+          CAA.ContactEmail -> "contact@example.com"
+          CAA.ContactPhone -> "0203040506"
+          _                -> ""
+        new_caa = (fromMaybe default_caa form._rr.caa) { tag = new_tag, value = new_value }
+    in form { _rr { caa = Just new_caa } }
+
+  SRV_Protocol v    -> form { _rr { protocol = SRV.srv_protocols A.!! v } }
+  SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass"     id $ SPF.qualifier_types A.!! v  }}}
+  SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a"        id $ SPF.mechanism_types A.!! v  }}}
+  SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v                                                 }}}
+  SPF_Modifier_t v  -> form { tmp { spf { modifier_t  = maybe "redirect" id $ SPF.modifier_types  A.!! v  }}}
+  SPF_Modifier_v v  -> form { tmp { spf { modifier_v  = v                                                 }}}
+  SPF_Qualifier v   -> form { _rr { q  = SPF.qualifiers A.!! v                                             }}
+  SPF_remove_mechanism i ->
+    form { _rr { mechanisms = case form._rr.mechanisms of
+                   Just ms -> Just (remove_id i $ attach_id 0 ms)
+                   Nothing -> Nothing
+               } }
+  SPF_remove_modifier i ->
+    form { _rr { modifiers = case form._rr.modifiers of
+                   Just ms -> Just (remove_id i $ attach_id 0 ms)
+                   Nothing -> Nothing
+               } }
+
+  SPF_Mechanism_Add ->
+    let m = form._rr.mechanisms
+        m_q = form.tmp.spf.mechanism_q
+        m_t = form.tmp.spf.mechanism_t
+        m_v = form.tmp.spf.mechanism_v
+        new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_mechanism m_q m_t m_v)
+        new_value = case new_list_of_mechanisms of
+          [] -> Nothing
+          v  -> Just v
+    in form { _rr { mechanisms = new_value }}
+
+  SPF_Modifier_Add ->
+    let m = form._rr.modifiers
+        m_t = form.tmp.spf.modifier_t
+        m_v = form.tmp.spf.modifier_v
+        new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_modifier m_t m_v)
+        new_value = case new_list_of_modifiers of
+          [] -> Nothing
+          v  -> Just v
+    in form { _rr { modifiers = new_value }}
+
+  DMARC_mail       v -> form { tmp { dmarc_mail = v } }
+  DMARC_mail_limit v -> form { tmp { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } }
+  DMARC_ri         v -> form { tmp { dmarc { ri = fromString v } } }
+  DMARC_rua_Add ->
+    case Email.email form.tmp.dmarc_mail of
+      Left errors -> form { _dmarc_mail_errors = errors }
+      Right _     ->
+        let current_ruas = fromMaybe [] form.tmp.dmarc.rua
+            new_list = current_ruas <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
+        in form { tmp { dmarc { rua = Just new_list }}}
+
+  DMARC_ruf_Add ->
+    case Email.email form.tmp.dmarc_mail of
+      Left errors -> form { _dmarc_mail_errors = errors }
+      Right _     ->
+        let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
+            new_list = current_rufs <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
+        in form { tmp { dmarc { ruf = Just new_list }}}
+
+  DMARC_remove_rua i ->
+    let current_ruas = fromMaybe [] form.tmp.dmarc.rua
+        new_value = case (remove_id i $ attach_id 0 current_ruas) of
+          [] -> Nothing
+          v -> Just v
+    in form { tmp { dmarc { rua = new_value } } }
+
+  DMARC_remove_ruf i ->
+    let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
+        new_value = case (remove_id i $ attach_id 0 current_rufs) of
+          [] -> Nothing
+          v -> Just v
+    in form { tmp { dmarc { ruf = new_value } } }
+
+  DMARC_policy    v -> form { tmp { dmarc { p     = fromMaybe DMARC.None $ DMARC.policies A.!! v       } } }
+  DMARC_sp_policy v -> form { tmp { dmarc { sp    =                        DMARC.policies A.!! (v - 1) } } }
+  DMARC_adkim     v -> form { tmp { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1)            } } }
+  DMARC_aspf      v -> form { tmp { dmarc { aspf  = DMARC.consistency_policies A.!! (v - 1)            } } }
+  DMARC_pct       v -> form { tmp { dmarc { pct   = Just $ fromMaybe 100 (fromString v)                } } }
+  DMARC_fo        v -> form { tmp { dmarc { fo    = DMARC.report_occasions A.!! (v - 1)                } } }
+  DKIM_hash_algo  v -> form { tmp { dkim  { h     = DKIM.hash_algos A.!! v                             } } }
+  DKIM_sign_algo  v -> form { tmp { dkim  { k     = DKIM.sign_algos A.!! v                             } } }
+  DKIM_pubkey     v -> form { tmp { dkim  { p     =                      v                             } } }
+  DKIM_note       v -> form { tmp { dkim  { n     = Just                 v                             } } }

src/App/Type/RRId.purs

@@ -1,3 +0,0 @@
-module App.Type.RRId where
-
-type RRId = Int

src/App/Type/RRModal.purs

@@ -6,12 +6,12 @@
 -- | FIXME: TODO: WIP: should this be replaced by something like `CRUD`?
 module App.Type.RRModal where
 
-import App.Type.RRId
+import App.Type.ResourceRecord (AcceptedRRTypes, RRId) as RR
-import App.Type.ResourceRecord (AcceptedRRTypes)
 
 data RRModal
   = NoModal
-  | NewRRModal AcceptedRRTypes
+  | NewRRModal RR.AcceptedRRTypes
   | UpdateRRModal
-  | RemoveRRModal RRId
+  | RemoveRRModal RR.RRId
   | DelegationModal
+  | ResetDelegationModal

src/App/Type/ResourceRecord.purs

@@ -1,476 +1,17 @@
-module App.Type.ResourceRecord where
+module App.Type.ResourceRecord
-
+  ( module App.Type.Error.ResourceRecord
-import Prelude (($), (-), (<>), map, bind, pure, class Show)
+  , module App.Type.Form.ResourceRecord
--- import Data.String (toLower)
+  , module App.Type.ResourceRecord.AcceptedRRTypes
-import Data.Generic.Rep (class Generic)
+  , module App.Type.ResourceRecord.ResourceRecord
-import App.Type.GenericSerialization (generic_serialization)
+  , module App.Type.ResourceRecord.SRV
-import Data.Show.Generic (genericShow)
+  ) where
-
+
-import Data.Array as A
+import App.Type.Error.ResourceRecord
-import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import App.Type.Form.ResourceRecord (Field(..), Form, RRUpdateValue(..), TMP, mkEmptyRRForm, update_form)
-import Data.Either (Either(..))
+import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
-
+
-import GenericParser.Parser as G
+import App.Type.ResourceRecord.ResourceRecord ( RRId, ResourceRecord
-import GenericParser.IPAddress as IPAddress
+                                              , codec, default_caa
-import GenericParser.DomainParser.Common (DomainError) as DomainParser
+                                              , default_qualifier_str, default_rr, emptyRR)
-
+
-import Utils (id, attach_id, remove_id)
+import App.Type.ResourceRecord.SRV (Protocol(..), codecSRVProtocol, srv_protocols, srv_protocols_txt, str_to_srv_protocol)
-
-import App.Validation.Email as Email
-
-import Data.Codec.Argonaut (JsonCodec)
-import Data.Codec.Argonaut as CA
-import Data.Codec.Argonaut.Record as CAR
-import Data.Int (fromString)
-
-import App.Type.DKIM as DKIM
-import App.Type.DMARC as DMARC
-import App.Type.ResourceRecord.SPF as SPF
-import App.Type.CAA as CAA
-
-type ResourceRecord
-  = { rrtype   :: String
-    , rrid     :: Int
-    , name     :: String
-    , ttl      :: Int
-    , target   :: String
-    , readonly :: Boolean
-
-    -- MX (and SRV) specific entry.
-    , priority :: Maybe Int
-
-    -- SRV specific entries.
-    , port     :: Maybe Int
-    , protocol :: Maybe SRVProtocol
-    , weight   :: Maybe Int
-
-    -- SOA specific entries.
-    , mname   :: Maybe String
-    , rname   :: Maybe String
-    , serial  :: Maybe Int
-    , refresh :: Maybe Int
-    , retry   :: Maybe Int
-    , expire  :: Maybe Int
-    , minttl  :: Maybe Int
-
-    , token   :: Maybe String
-
-    -- SPF specific entries.
-    , v :: Maybe String -- Default: spf1
-    , mechanisms :: Maybe (Array SPF.Mechanism)
-    , modifiers  :: Maybe (Array SPF.Modifier)
-    , q          :: Maybe SPF.Qualifier  -- Qualifier for default mechanism (`all`).
-
-    , dkim :: Maybe DKIM.DKIM
-    , dmarc :: Maybe DMARC.DMARC
-    , caa :: Maybe CAA.CAA
-    }
-
-codec :: JsonCodec ResourceRecord
-codec = CA.object "ResourceRecord"
-  (CAR.record
-    { rrtype:   CA.string
-    , rrid:     CA.int
-    , name:     CA.string
-    , ttl:      CA.int
-    , target:   CA.string
-    , readonly: CA.boolean
-
-    -- MX (and SRV) specific entry.
-    , priority: CAR.optional CA.int
-
-    -- SRV specific entries.
-    , port:     CAR.optional CA.int
-    , protocol: CAR.optional codecSRVProtocol
-    , weight:   CAR.optional CA.int
-
-    -- SOA specific entries.
-    , mname:   CAR.optional CA.string
-    , rname:   CAR.optional CA.string
-    , serial:  CAR.optional CA.int
-    , refresh: CAR.optional CA.int
-    , retry:   CAR.optional CA.int
-    , expire:  CAR.optional CA.int
-    , minttl:  CAR.optional CA.int
-
-    , token:   CAR.optional CA.string
-
-    -- SPF specific entries.
-    , v:          CAR.optional CA.string
-    , mechanisms: CAR.optional (CA.array SPF.codecMechanism)
-    , modifiers:  CAR.optional (CA.array SPF.codecModifier)
-    , q:          CAR.optional SPF.codecQualifier
-
-    , dkim:       CAR.optional DKIM.codec
-    , dmarc:      CAR.optional DMARC.codec
-    , caa:        CAR.optional CAA.codec
-    })
-
-emptyRR :: ResourceRecord
-emptyRR
-  = { rrid:         0
-    , readonly:     false
-    , rrtype:       ""
-    , name:         ""
-    , ttl:          1800
-    , target:       ""
-
-    -- MX + SRV
-    , priority:     Nothing
-
-    -- SRV
-    , port:         Nothing
-    , protocol:     Nothing
-    , weight:       Nothing
-
-    -- SOA
-    , mname:        Nothing
-    , rname:        Nothing
-    , serial:       Nothing
-    , refresh:      Nothing
-    , retry:        Nothing
-    , expire:       Nothing
-    , minttl:       Nothing
-
-    , token:        Nothing
-
-    -- SPF specific entries.
-    , v:            Nothing
-    , mechanisms:   Nothing
-    , modifiers:    Nothing
-    , q:            Nothing
-
-    , dkim:         Nothing
-    , dmarc:        Nothing
-    , caa:          Nothing
-    }
-
-data SRVProtocol = TCP | UDP
-srv_protocols :: Array SRVProtocol
-srv_protocols = [TCP, UDP]
-srv_protocols_txt :: Array String
-srv_protocols_txt = ["tcp", "udp"]
-
-derive instance genericSRVProtocol :: Generic SRVProtocol _
-instance showSRVProtocol :: Show SRVProtocol where
-  show = genericShow
-
--- | Codec for just encoding a single value of type `Qualifier`.
-codecSRVProtocol :: CA.JsonCodec SRVProtocol
-codecSRVProtocol = CA.prismaticCodec "SRVProtocol" str_to_srv_protocol generic_serialization CA.string
-
-str_to_srv_protocol :: String -> Maybe SRVProtocol
-str_to_srv_protocol = case _ of
-  "tcp" -> Just TCP
-  "udp" -> Just UDP
-  _ -> Nothing
-
-data Field
-  = Domain    String
-  | TTL       String
-  | Target    String
-  | Priority  String
-  | Weight    String
-  | Port      String
-  | SPF_v          String
-  | SPF_mechanisms (Array SPF.Mechanism)
-  | SPF_modifiers  (Array SPF.Modifier)
-  | SPF_q          SPF.Qualifier
-
-  | CAA_flag  String
-  | CAA_value String
-
--- | TMP: temporary stored values regarding specific records such as SPF,
--- | DKIM and DMARC.
-type TMP =
-  {
-    -- SPF details.
-    spf :: { mechanism_q :: String
-           , mechanism_t :: String
-           , mechanism_v :: String
-           , modifier_t  :: String
-           , modifier_v  :: String
-           }
-
-    -- DMARC details.
-  , dmarc_mail       :: String
-  , dmarc_mail_limit :: Maybe Int
-  , dmarc            :: DMARC.DMARC
-
-    -- DKIM details.
-  , dkim :: DKIM.DKIM
-  }
-
--- | `Form` is the necessary state to modify a resource record.
--- | It contains the currently manipulated record, detected errors, along with some temporary values.
--- | FIXME: this form is messy AF and should be replaced.
-type Form =
-  { _rr                :: ResourceRecord
-  , _errors            :: Array Error
-  , _dmarc_mail_errors :: Array Email.Error
-  , _zonefile          :: Maybe String
-  , tmp                :: TMP
-  }
-
-default_qualifier_str = "hard_fail" :: String
-default_caa = { flag: 0, tag: CAA.Issue, value: "letsencrypt.org" } :: CAA.CAA
-
-default_rr :: AcceptedRRTypes -> String -> ResourceRecord
-default_rr t domain =
-  case t of
-    A     -> emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
-    AAAA  -> emptyRR { rrtype = "AAAA",  name = "server1",        target = "2001:db8::1" }
-    TXT   -> emptyRR { rrtype = "TXT",   name = "txt",            target = "some text" }
-    CNAME -> emptyRR { rrtype = "CNAME", name = "www",            target = "server1" }
-    NS    -> emptyRR { rrtype = "NS",    name = (domain <> "."),  target = "ns0.example.com." }
-    MX    -> emptyRR { rrtype = "MX",    name = "mail",           target = "server1", priority = Just 10 }
-    CAA   -> emptyRR { rrtype = "CAA",   name = "",               target = "",        caa = Just default_caa }
-    SRV   -> emptyRR { rrtype = "SRV",   name = "voip",           target = "server1"
-                     , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just TCP }
-    SPF   -> emptyRR { rrtype = "SPF",   name = "",               target = ""
-                     , mechanisms = Just default_mechanisms, q = Just SPF.HardFail }
-    DKIM  -> emptyRR { rrtype = "DKIM",  name = "default._domainkey", target = "" }
-    DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc",             target = "" }
-  where
-  default_mechanisms = maybe [] (\x -> [x]) $ SPF.to_mechanism "pass" "mx" ""
-
-mkEmptyRRForm :: Form
-mkEmptyRRForm =
-  {
-  -- This is the state for the new RR modal.
-    _rr: default_rr A ""
-  -- List of errors within the form in new RR modal.
-  , _errors: []
-  , _dmarc_mail_errors: []
-  , _zonefile: Nothing
-  , tmp: { spf: { mechanism_q: "pass"
-                , mechanism_t: "a"
-                , mechanism_v: ""
-                , modifier_t:  "redirect"
-                , modifier_v:  ""
-                }
-         , dkim:  DKIM.emptyDKIMRR
-         , dmarc: DMARC.emptyDMARCRR
-         , dmarc_mail: ""
-         , dmarc_mail_limit: Nothing
-         }
-  }
-
-data RRUpdateValue
-  = CAA_tag Int
-  | SRV_Protocol Int
-  | SPF_Mechanism_q Int
-  | SPF_Mechanism_t Int
-  | SPF_Mechanism_v String
-  | SPF_Modifier_t  Int
-  | SPF_Modifier_v  String
-  | SPF_Qualifier   Int
-
-  -- | Remove a SPF mechanism of the currently modified (SPF) entry (see `_currentRR`).
-  | SPF_remove_mechanism Int
-  -- | Remove a SPF modifier of the currently modified (SPF) entry (see `_currentRR`).
-  | SPF_remove_modifier Int
-
-  -- | Add a SPF mechanism to the currently modified (SPF) entry (see `_currentRR`).
-  | SPF_Mechanism_Add
-  -- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`).
-  | SPF_Modifier_Add
-
-  -- | Change the temporary mail address for DMARC.
-  | DMARC_mail String
-
-  -- | Change the temporary report size limit for DMARC.
-  | DMARC_mail_limit String
-
-  -- | Change the requested report interval.
-  | DMARC_ri String
-
-  -- | Add a new mail address to the DMARC rua list.
-  | DMARC_rua_Add
-
-  -- | Add a new mail address to the DMARC ruf list.
-  | DMARC_ruf_Add
-
-  -- | Remove a mail address of the DMARC rua list.
-  | DMARC_remove_rua Int
-
-  -- | Remove a mail address of the DMARC ruf list.
-  | DMARC_remove_ruf Int
-
-  | DMARC_policy Int
-  | DMARC_sp_policy Int
-  | DMARC_adkim Int
-  | DMARC_aspf Int
-  | DMARC_pct  String
-  | DMARC_fo Int
-
-  | DKIM_hash_algo Int
-  | DKIM_sign_algo Int
-  | DKIM_pubkey    String
-  | DKIM_note      String
-
-update_form :: Form -> RRUpdateValue -> Form
-update_form form new_field_value =
-  case new_field_value of
-  CAA_tag         v ->
-    let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v
-        new_value = case new_tag of
-          CAA.Issue -> "letsencrypt.org"
-          CAA.ContactEmail -> "contact@example.com"
-          CAA.ContactPhone -> "0203040506"
-          _                -> ""
-        new_caa = (fromMaybe default_caa form._rr.caa) { tag = new_tag, value = new_value }
-    in form { _rr { caa = Just new_caa } }
-
-  SRV_Protocol v    -> form { _rr { protocol = srv_protocols A.!! v } }
-  SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass"     id $ SPF.qualifier_types A.!! v  }}}
-  SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a"        id $ SPF.mechanism_types A.!! v  }}}
-  SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v                                                 }}}
-  SPF_Modifier_t v  -> form { tmp { spf { modifier_t  = maybe "redirect" id $ SPF.modifier_types  A.!! v  }}}
-  SPF_Modifier_v v  -> form { tmp { spf { modifier_v  = v                                                 }}}
-  SPF_Qualifier v   -> form { _rr { q  = SPF.qualifiers A.!! v                                             }}
-  SPF_remove_mechanism i ->
-    form { _rr { mechanisms = case form._rr.mechanisms of
-                   Just ms -> Just (remove_id i $ attach_id 0 ms)
-                   Nothing -> Nothing
-               } }
-  SPF_remove_modifier i ->
-    form { _rr { modifiers = case form._rr.modifiers of
-                   Just ms -> Just (remove_id i $ attach_id 0 ms)
-                   Nothing -> Nothing
-               } }
-
-  SPF_Mechanism_Add ->
-    let m = form._rr.mechanisms
-        m_q = form.tmp.spf.mechanism_q
-        m_t = form.tmp.spf.mechanism_t
-        m_v = form.tmp.spf.mechanism_v
-        new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_mechanism m_q m_t m_v)
-        new_value = case new_list_of_mechanisms of
-          [] -> Nothing
-          v  -> Just v
-    in form { _rr { mechanisms = new_value }}
-
-  SPF_Modifier_Add ->
-    let m = form._rr.modifiers
-        m_t = form.tmp.spf.modifier_t
-        m_v = form.tmp.spf.modifier_v
-        new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_modifier m_t m_v)
-        new_value = case new_list_of_modifiers of
-          [] -> Nothing
-          v  -> Just v
-    in form { _rr { modifiers = new_value }}
-
-  DMARC_mail       v -> form { tmp { dmarc_mail = v } }
-  DMARC_mail_limit v -> form { tmp { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } }
-  DMARC_ri         v -> form { tmp { dmarc { ri = fromString v } } }
-  DMARC_rua_Add ->
-    case Email.email form.tmp.dmarc_mail of
-      Left errors -> form { _dmarc_mail_errors = errors }
-      Right _     ->
-        let current_ruas = fromMaybe [] form.tmp.dmarc.rua
-            new_list = current_ruas <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
-        in form { tmp { dmarc { rua = Just new_list }}}
-
-  DMARC_ruf_Add ->
-    case Email.email form.tmp.dmarc_mail of
-      Left errors -> form { _dmarc_mail_errors = errors }
-      Right _     ->
-        let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
-            new_list = current_rufs <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
-        in form { tmp { dmarc { ruf = Just new_list }}}
-
-  DMARC_remove_rua i ->
-    let current_ruas = fromMaybe [] form.tmp.dmarc.rua
-        new_value = case (remove_id i $ attach_id 0 current_ruas) of
-          [] -> Nothing
-          v -> Just v
-    in form { tmp { dmarc { rua = new_value } } }
-
-  DMARC_remove_ruf i ->
-    let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
-        new_value = case (remove_id i $ attach_id 0 current_rufs) of
-          [] -> Nothing
-          v -> Just v
-    in form { tmp { dmarc { ruf = new_value } } }
-
-  DMARC_policy    v -> form { tmp { dmarc { p     = fromMaybe DMARC.None $ DMARC.policies A.!! v       } } }
-  DMARC_sp_policy v -> form { tmp { dmarc { sp    =                        DMARC.policies A.!! (v - 1) } } }
-  DMARC_adkim     v -> form { tmp { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1)            } } }
-  DMARC_aspf      v -> form { tmp { dmarc { aspf  = DMARC.consistency_policies A.!! (v - 1)            } } }
-  DMARC_pct       v -> form { tmp { dmarc { pct   = Just $ fromMaybe 100 (fromString v)                } } }
-  DMARC_fo        v -> form { tmp { dmarc { fo    = DMARC.report_occasions A.!! (v - 1)                } } }
-  DKIM_hash_algo  v -> form { tmp { dkim  { h     = DKIM.hash_algos A.!! v                             } } }
-  DKIM_sign_algo  v -> form { tmp { dkim  { k     = DKIM.sign_algos A.!! v                             } } }
-  DKIM_pubkey     v -> form { tmp { dkim  { p     =                      v                             } } }
-  DKIM_note       v -> form { tmp { dkim  { n     = Just                 v                             } } }
-
--- | Errors that might be catched in for the form upon validation (`App.Validation.DNS`).
--- |
--- | **History:**
--- | The module once used dedicated types for each type of RR.
--- | That comes with several advantages.
--- | First, type verification was a thing, and function were dedicated to a certain type of record.
--- | Second, these dedicated types used strings for their fields,
--- | which simplifies the typing when dealing with forms.
--- | Finally, the validation was a way to convert dedicated types (used in forms)
--- | to the general type (used for network serialization).
--- | This ensures each resource record is verified before being sent to `dnsmanagerd`.
--- |
--- | The problem is that, with dedicated types, you are then required to have dedicated functions.
--- | Conversion functions are also required.
--- |
--- | Maybe the code will change again in the future, but for now it will be enough.
-
-data Error
-  = UNKNOWN
-  | VEIPv4 (G.Error IPAddress.IPv4Error)
-  | VEIPv6 (G.Error IPAddress.IPv6Error)
-  | VEName (G.Error DomainParser.DomainError)
-  | VETTL Int Int Int
-  | VETXT (G.Error TXTError)
-  | VECNAME (G.Error DomainParser.DomainError)
-  | VENS (G.Error DomainParser.DomainError)
-  | VEMX (G.Error DomainParser.DomainError)
-  | VEPriority Int Int Int
-  | VESRV (G.Error DomainParser.DomainError)
-  | VEPort Int Int Int
-  | VEWeight Int Int Int
-  | VEDMARCpct Int Int Int
-  | VEDMARCri  Int Int Int
-
-  | VECAAflag  Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
-
-  -- SPF
-  | VESPFMechanismName (G.Error DomainParser.DomainError)
-  | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
-  | VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
-
-  | VESPFModifierName (G.Error DomainParser.DomainError)
-
-  | DKIMInvalidKeySize Int Int
-
--- | The application accepts to add a few new entry types in a DNS zone.
--- | Each resource record has a specific form, with dedicated inputs and
--- | dedicated validation.
-data AcceptedRRTypes
-  = A
-  | AAAA
-  | TXT
-  | CNAME
-  | NS
-  | MX
-  | CAA
-  | SRV
-  | SPF
-  | DKIM
-  | DMARC
-
-derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
-
-instance showAcceptedRRTypes :: Show AcceptedRRTypes where
-  show = genericShow
-
-data TXTError
-  = TXTInvalidCharacter
-  | TXTTooLong Int Int -- max current

src/App/Type/ResourceRecord/AcceptedRRTypes.purs

@@ -0,0 +1,27 @@
+module App.Type.ResourceRecord.AcceptedRRTypes where
+
+import Prelude (class Show)
+
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+
+-- | The application accepts to add a few new entry types in a DNS zone.
+-- | Each resource record has a specific form, with dedicated inputs and
+-- | dedicated validation.
+data AcceptedRRTypes
+  = A
+  | AAAA
+  | TXT
+  | CNAME
+  | NS
+  | MX
+  | CAA
+  | SRV
+  | SPF
+  | DKIM
+  | DMARC
+
+derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
+
+instance showAcceptedRRTypes :: Show AcceptedRRTypes where
+  show = genericShow

src/App/Type/ResourceRecord/CAA.purs

@@ -1,6 +1,6 @@
 -- | The Certification Authority Authorization (CAA) record is described in RFC8859.
 -- | The CAA record allows to specify Certification Authorities (CAs) authorized to issue certificates.
-module App.Type.CAA where
+module App.Type.ResourceRecord.CAA where
 
 import Prelude
 import Data.Generic.Rep (class Generic)

src/App/Type/ResourceRecord/DKIM.purs

@@ -1,4 +1,4 @@
-module App.Type.DKIM where
+module App.Type.ResourceRecord.DKIM where
 
 import Prelude
 import Data.Generic.Rep (class Generic)

src/App/Type/ResourceRecord/DMARC.purs

@@ -1,6 +1,6 @@
 -- | DMARC is a spam mitigation mechanism described in RFC7489.
 -- | DMARC is built on top of DKIM and SPF.
-module App.Type.DMARC where
+module App.Type.ResourceRecord.DMARC where
 
 import Prelude
 import Data.Generic.Rep (class Generic)

src/App/Type/ResourceRecord/ResourceRecord.purs

@@ -0,0 +1,158 @@
+module App.Type.ResourceRecord.ResourceRecord where
+
+import Prelude (($), (<>))
+
+import Data.Maybe (Maybe(..), maybe)
+
+import Data.Codec.Argonaut (JsonCodec)
+import Data.Codec.Argonaut as CA
+import Data.Codec.Argonaut.Record as CAR
+
+import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
+
+import App.Type.ResourceRecord.CAA as CAA
+import App.Type.ResourceRecord.DKIM as DKIM
+import App.Type.ResourceRecord.DMARC as DMARC
+import App.Type.ResourceRecord.SPF as SPF
+import App.Type.ResourceRecord.SRV as SRV
+
+type RRId = Int
+
+type ResourceRecord
+  = { rrtype   :: String
+    , rrid     :: RRId
+    , name     :: String
+    , ttl      :: Int
+    , target   :: String
+    , readonly :: Boolean
+
+    -- MX (and SRV) specific entry.
+    , priority :: Maybe Int
+
+    -- SRV specific entries.
+    , port     :: Maybe Int
+    , protocol :: Maybe SRV.Protocol
+    , weight   :: Maybe Int
+
+    -- SOA specific entries.
+    , mname   :: Maybe String
+    , rname   :: Maybe String
+    , serial  :: Maybe Int
+    , refresh :: Maybe Int
+    , retry   :: Maybe Int
+    , expire  :: Maybe Int
+    , minttl  :: Maybe Int
+
+    , token   :: Maybe String
+
+    -- SPF specific entries.
+    , v :: Maybe String -- Default: spf1
+    , mechanisms :: Maybe (Array SPF.Mechanism)
+    , modifiers  :: Maybe (Array SPF.Modifier)
+    , q          :: Maybe SPF.Qualifier  -- Qualifier for default mechanism (`all`).
+
+    , dkim :: Maybe DKIM.DKIM
+    , dmarc :: Maybe DMARC.DMARC
+    , caa :: Maybe CAA.CAA
+    }
+
+codec :: JsonCodec ResourceRecord
+codec = CA.object "ResourceRecord"
+  (CAR.record
+    { rrtype:   CA.string
+    , rrid:     CA.int
+    , name:     CA.string
+    , ttl:      CA.int
+    , target:   CA.string
+    , readonly: CA.boolean
+
+    -- MX (and SRV) specific entry.
+    , priority: CAR.optional CA.int
+
+    -- SRV specific entries.
+    , port:     CAR.optional CA.int
+    , protocol: CAR.optional SRV.codecSRVProtocol
+    , weight:   CAR.optional CA.int
+
+    -- SOA specific entries.
+    , mname:   CAR.optional CA.string
+    , rname:   CAR.optional CA.string
+    , serial:  CAR.optional CA.int
+    , refresh: CAR.optional CA.int
+    , retry:   CAR.optional CA.int
+    , expire:  CAR.optional CA.int
+    , minttl:  CAR.optional CA.int
+
+    , token:   CAR.optional CA.string
+
+    -- SPF specific entries.
+    , v:          CAR.optional CA.string
+    , mechanisms: CAR.optional (CA.array SPF.codecMechanism)
+    , modifiers:  CAR.optional (CA.array SPF.codecModifier)
+    , q:          CAR.optional SPF.codecQualifier
+
+    , dkim:       CAR.optional DKIM.codec
+    , dmarc:      CAR.optional DMARC.codec
+    , caa:        CAR.optional CAA.codec
+    })
+
+emptyRR :: ResourceRecord
+emptyRR
+  = { rrid:         0
+    , readonly:     false
+    , rrtype:       ""
+    , name:         ""
+    , ttl:          1800
+    , target:       ""
+
+    -- MX + SRV
+    , priority:     Nothing
+
+    -- SRV
+    , port:         Nothing
+    , protocol:     Nothing
+    , weight:       Nothing
+
+    -- SOA
+    , mname:        Nothing
+    , rname:        Nothing
+    , serial:       Nothing
+    , refresh:      Nothing
+    , retry:        Nothing
+    , expire:       Nothing
+    , minttl:       Nothing
+
+    , token:        Nothing
+
+    -- SPF specific entries.
+    , v:            Nothing
+    , mechanisms:   Nothing
+    , modifiers:    Nothing
+    , q:            Nothing
+
+    , dkim:         Nothing
+    , dmarc:        Nothing
+    , caa:          Nothing
+    }
+
+default_qualifier_str = "hard_fail" :: String
+default_caa = { flag: 0, tag: CAA.Issue, value: "letsencrypt.org" } :: CAA.CAA
+
+default_rr :: AcceptedRRTypes -> String -> ResourceRecord
+default_rr t domain =
+  case t of
+    A     -> emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
+    AAAA  -> emptyRR { rrtype = "AAAA",  name = "server1",        target = "2001:db8::1" }
+    TXT   -> emptyRR { rrtype = "TXT",   name = "txt",            target = "some text" }
+    CNAME -> emptyRR { rrtype = "CNAME", name = "www",            target = "server1" }
+    NS    -> emptyRR { rrtype = "NS",    name = (domain <> "."),  target = "ns0.example.com." }
+    MX    -> emptyRR { rrtype = "MX",    name = "mail",           target = "server1", priority = Just 10 }
+    CAA   -> emptyRR { rrtype = "CAA",   name = "",               target = "",        caa = Just default_caa }
+    SRV   -> emptyRR { rrtype = "SRV",   name = "voip",           target = "server1"
+                     , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just SRV.TCP }
+    SPF   -> emptyRR { rrtype = "SPF",   name = "",               target = ""
+                     , mechanisms = Just default_mechanisms, q = Just SPF.HardFail }
+    DKIM  -> emptyRR { rrtype = "DKIM",  name = "default._domainkey", target = "" }
+    DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc",             target = "" }
+  where
+  default_mechanisms = maybe [] (\x -> [x]) $ SPF.to_mechanism "pass" "mx" ""

src/App/Type/ResourceRecord/SRV.purs

@@ -0,0 +1,31 @@
+module App.Type.ResourceRecord.SRV where
+
+import Prelude (class Show)
+
+import Data.Maybe (Maybe(..))
+
+import Data.Generic.Rep (class Generic)
+import App.Type.GenericSerialization (generic_serialization)
+import Data.Show.Generic (genericShow)
+
+import Data.Codec.Argonaut as CA
+
+data Protocol = TCP | UDP
+srv_protocols :: Array Protocol
+srv_protocols = [TCP, UDP]
+srv_protocols_txt :: Array String
+srv_protocols_txt = ["tcp", "udp"]
+
+derive instance genericSRVProtocol :: Generic Protocol _
+instance showSRVProtocol :: Show Protocol where
+  show = genericShow
+
+-- | Codec for just encoding a single value of type `Qualifier`.
+codecSRVProtocol :: CA.JsonCodec Protocol
+codecSRVProtocol = CA.prismaticCodec "SRVProtocol" str_to_srv_protocol generic_serialization CA.string
+
+str_to_srv_protocol :: String -> Maybe Protocol
+str_to_srv_protocol = case _ of
+  "tcp" -> Just TCP
+  "udp" -> Just UDP
+  _ -> Nothing

src/App/Validation/DNS.purs

@@ -18,9 +18,9 @@ import GenericParser.DomainParser (name, sub_eof) as DomainParser
 import GenericParser.IPAddress as IPAddress
 import GenericParser.RFC5234 as RFC5234
 
-import App.Type.DKIM as DKIM
+import App.Type.ResourceRecord.DKIM as DKIM
-import App.Type.DMARC as DMARC
+import App.Type.ResourceRecord.DMARC as DMARC
-import App.Type.CAA as CAA
+import App.Type.ResourceRecord.CAA as CAA
 
 import Utils (id)