-- | `App.ZoneInterface` provides an interface to display and modify a DNS zone.
-- |
-- | This interface allows to:
-- |   - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
-- |   - TODO: dedicated interfaces for: SPF, DKIM, DMARC
-- |   - add, modify, remove resource records
-- |
-- | **WIP**: Display relevant information for each record type in the (add/mod) modal.
-- | This includes explaining use cases and displaying an appropriate interface for the
-- | task at hand. For example, having a dedicated interface for DKIM.
-- |
-- | TODO: display errors not only for a record but for the whole zone.
-- | A DNS zone is bound by a set of rules, the whole zone must be consistent.
-- | For example, a CNAME `target` has to point to the `name` of an existing record.
-- |
-- | TODO: do not allow for the modification of read-only resource records.
-- |
-- | TODO: move all serialization code to a single module.
module App.Page.Zone where

import Prelude (Unit, unit, void
               , bind, pure
               , not, comparing, discard, map, show
               , (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#))


import Data.Eq (class Eq)
import Data.Array as A
import Data.Int (fromString)
import Data.Tuple (Tuple(..))
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..))
import Data.String.CodePoints as CP
-- import Data.Foldable as Foldable
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP

import Bulma as Bulma
import CSSClasses as C

import App.Text.Explanations as Explanations

import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord (ResourceRecord, emptyRR
                          , show_qualifier, show_qualifier_char
                          , show_mechanism_type, show_mechanism, to_mechanism
                          , show_modifier_type, show_modifier, to_modifier
                          , all_qualifiers
                          , mechanism_types, qualifier_types, modifier_types)
import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
import App.Type.DKIM as DKIM

import App.DisplayErrors (error_to_paragraph)

import App.Type.LogMessage (LogMessage(..))
import App.Message.DNSManagerDaemon as DNSManager
import App.Validation.DNS as Validation

type RRId = Int

id :: forall a. a -> a
id x = x

-- | `App.ZoneInterface` can send messages through websocket interface
-- | connected to dnsmanagerd. See `App.WS`.
-- |
-- | Also, this component can log messages and ask its parent (`App.Container`) to
-- | reconnect the websocket to `dnsmanagerd`.

data Output
  = MessageToSend ArrayBuffer
  | Log LogMessage

-- | `App.ZoneInterface` can receive messages from `dnsmanagerd`.
-- |
-- | The component is also informed when the connection is lost or up again.

data Query a
  = MessageReceived DNSManager.AnswerMessage a
  | ConnectionIsDown a
  | ConnectionIsUp a

type Slot = H.Slot Query Output

-- | `App.ZoneInterface` has a single input: the domain name.

type Input = String

data Field
  = Field_Domain    String
  | Field_TTL       String
  | Field_Target    String
  | Field_Priority  String
  | Field_Protocol  String
  | Field_Weight    String
  | Field_Port      String
  | Field_SPF_v          String
  | Field_SPF_mechanisms (Array RR.Mechanism)
  | Field_SPF_modifiers  (Array RR.Modifier)
  | Field_SPF_q          RR.Qualifier

-- | Steps to create a new RR:
-- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
-- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR.
-- | 3. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_currentRR`.
-- |    In case it works, automatically call `AddRR` then `CancelModal`.
-- | 4. `AddRR AcceptedRRTypes 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.
-- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR.
-- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the RR.
-- | 4. `SaveRR ResourceRecord`: save the _validated_ RR by sending a message to `dnsmanagerd`.

data Action
  -- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`.
  = Initialize

  -- | Cancel the current displayed modal.
  | CancelModal

  -- | Create a new resource record modal (a form) for a certain type of component.
  | CreateNewRRModal AcceptedRRTypes

  -- | Create modal (a form) for a resource record to update.
  | CreateUpdateRRModal RRId

  -- | Create a modal to ask confirmation before deleting a resource record.
  | DeleteRRModal RRId

  -- | Change the current tab.
  | ChangeTab Tab

  -- | Update new entry form (in the `rr_modal` modal).
  | UpdateCurrentRR Field

  -- | Validate a new resource record before adding it.
  | ValidateRR AcceptedRRTypes

  -- | Validate the entries in an already existing resource record.
  -- | Automatically calls for `SaveRR` once record is verified.
  | ValidateLocal

  -- | Add a new resource record to the zone.
  | AddRR AcceptedRRTypes ResourceRecord

  -- | Save the changes done in an already existing resource record.
  | SaveRR ResourceRecord

  -- | Send a message to remove a resource record.
  -- | Automatically closes the modal.
  | RemoveRR RRId

  -- | Ask a (new) token for a RR.
  | NewToken RRId

  -- | Ask `dnsmanagerd` for the generated zone file.
  | AskZoneFile

  | 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

  | DKIM_hash_algo Int
  | DKIM_sign_algo Int
  | DKIM_pubkey    String
  | DKIM_note      String

data RRModal
  = NoModal
  | NewRRModal AcceptedRRTypes
  | UpdateRRModal
  | RemoveRRModal RRId

show_accepted_type :: AcceptedRRTypes -> String
show_accepted_type = case _ of
  A     -> "A"
  AAAA  -> "AAAA"
  TXT   -> "TXT"
  CNAME -> "CNAME"
  NS    -> "NS"
  MX    -> "MX"
  SRV   -> "SRV"
  SPF   -> "SPF"
  DKIM  -> "DKIM"

string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
string_to_acceptedtype str = case str of
  "A"     -> Just     A
  "AAAA"  -> Just  AAAA
  "TXT"   -> Just   TXT
  "CNAME" -> Just CNAME
  "NS"    -> Just    NS
  "MX"    -> Just    MX
  "SRV"   -> Just   SRV
  "SPF"   -> Just   SPF
  "DKIM"  -> Just  DKIM
  _       -> Nothing

data Tab = Zone | TokenExplanation
derive instance eqTab :: Eq Tab

type State =
  { _domain :: String
  , wsUp :: Boolean

  -- A modal to present a form for adding a new RR.
  , rr_modal :: RRModal

  -- | All resource records.
  , _resources :: Array ResourceRecord
  --, _local_errors :: Hash.HashMap RRId (Array Validation.Error)

  -- Unique RR form.
  , _currentRR :: ResourceRecord
  , _currentRR_errors :: Array Validation.Error

  -- SPF details.
  , spf_mechanism_q :: String
  , spf_mechanism_t :: String
  , spf_mechanism_v :: String
  , spf_modifier_t  :: String
  , spf_modifier_v  :: String

  , dkim :: DKIM.DKIM

  , _zonefile :: Maybe String

  , current_tab :: Tab
  }

component :: forall m. MonadAff m => H.Component Query Input Output m
component =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval
        { initialize   = Just Initialize
        , handleAction = handleAction
        , handleQuery  = handleQuery
        }
    }

-- | Default available domain: netlib.re.

default_domain :: String
default_domain = "netlib.re"

default_rr_A :: ResourceRecord
default_rr_A = emptyRR { rrtype = "A", name = "www", target = "192.0.2.1" }

default_empty_rr :: ResourceRecord
default_empty_rr = default_rr_A

default_qualifier_str = "hard_fail" :: String

initialState :: Input -> State
initialState domain =
  { wsUp: true
  , rr_modal: NoModal

  , _domain: domain

  , _resources: []
  --, _local_errors: Hash.empty

  -- This is the state for the new RR modal.
  , _currentRR: default_empty_rr
  -- List of errors within the form in new RR modal.
  , _currentRR_errors: []
  , _zonefile: Nothing

  , spf_mechanism_q: "pass"
  , spf_mechanism_t: "a"
  , spf_mechanism_v: ""
  , spf_modifier_t:  "redirect"
  , spf_modifier_v:  ""
  , dkim: DKIM.emptyDKIMRR

  , current_tab: Zone
  }

type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)

render :: forall m. State -> H.ComponentHTML Action () m
render state
  = Bulma.section_small
      [ fancy_tab
      , case state.current_tab of
          Zone -> render_zone
          TokenExplanation -> Explanations.tokens
      ]
  where
    fancy_tab =
      Bulma.fancy_tabs
        [ Bulma.tab_entry (is_tab_active Zone)             "Zone"       (ChangeTab Zone)
        , Bulma.tab_entry (is_tab_active TokenExplanation) "Tokens? 🤨" (ChangeTab TokenExplanation)
        ]
    is_tab_active tab = state.current_tab == tab

    render_zone =
      case state.wsUp, state.rr_modal of
          false, _                   -> Bulma.p "You are disconnected."
          true,  RemoveRRModal rr_id -> modal_rr_delete rr_id
          true,  NewRRModal _        -> render_current_rr_modal
          true,  UpdateRRModal       -> render_current_rr_modal
          true,  NoModal -> HH.div_
            [ Bulma.h1 state._domain
            , Bulma.hr
            , render_resources $ sorted state._resources
            , Bulma.hr
            , render_new_records state
            , render_zonefile state._zonefile
            ]

    sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l))
    sorted array =
      A.groupAllBy (comparing (_.rrtype)) array    -- [x2 z2 x1 y z1 z3] -> [ NE[x2x1] NE[y] NE[z2z1z3] ]
      # map NonEmpty.toArray                       -- -> [[x2x1][y][z2z1z3]]
      # map (A.sortBy (comparing (_.rrid)))        -- -> [[x1x2][y][z1z2z3]]
      # A.concat                                   -- -> [x1 x2 y z1 z2 z3]

    modal_rr_delete :: forall w. Int -> HH.HTML w Action
    modal_rr_delete rr_id = Bulma.modal "Deleting a resource record"
      [warning_message] [modal_delete_button, Bulma.cancel_button CancelModal]
      where
      modal_delete_button = Bulma.alert_btn "Delete the resource record." (RemoveRR rr_id)
      warning_message
        = HH.p [] [ HH.text "You are about to delete a resource record, this actions is "
                  , Bulma.strong "irreversible"
                  , HH.text "."
                  ]

    render_current_rr_modal :: forall w. HH.HTML w Action
    render_current_rr_modal =
      case state._currentRR.rrtype of
      "A"     -> template modal_content_simple (foot_content A)
      "AAAA"  -> template modal_content_simple (foot_content AAAA)
      "TXT"   -> template modal_content_simple (foot_content TXT)
      "CNAME" -> template modal_content_simple (foot_content CNAME)
      "NS"    -> template modal_content_simple (foot_content NS)
      "MX"    -> template modal_content_mx     (foot_content MX)
      "SRV"   -> template modal_content_srv    (foot_content SRV)
      "SPF"   -> template modal_content_spf    (foot_content SPF)
      "DKIM"  -> template modal_content_dkim   (foot_content DKIM)
      _       -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype
      where
        -- DRY
        updateForm x = UpdateCurrentRR <<< x
        render_errors = if A.length state._currentRR_errors > 0
                        then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._currentRR_errors
                        else HH.div_ [ ]
        modal_content_simple :: Array (HH.HTML w Action)
        modal_content_simple =
          [ render_errors
          , Bulma.input_with_side_text ("domain" <> state._currentRR.rrtype) "Name" "www"
              (updateForm Field_Domain)
              state._currentRR.name
              display_domain_side
          , Bulma.box_input ("ttl" <> state._currentRR.rrtype) "TTL" "600"
              (updateForm Field_TTL)
              (show state._currentRR.ttl)
              should_be_disabled
          , Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "198.51.100.5"
              (updateForm Field_Target)
              state._currentRR.target
              should_be_disabled
          ] <> case state.rr_modal of
                 UpdateRRModal ->
                   if A.elem state._currentRR.rrtype ["A", "AAAA"]
                   then [ Bulma.labeled_field ("token" <> state._currentRR.rrtype) "Token"
                            (Bulma.p $ fromMaybe "❌​" state._currentRR.token)
                        ]
                   else []
                 _             -> []
        modal_content_mx :: Array (HH.HTML w Action)
        modal_content_mx =
          [ render_errors
          , Bulma.input_with_side_text "domainMX" "Name" "www"
              (updateForm Field_Domain)
              state._currentRR.name
              display_domain_side
          , Bulma.box_input ("ttlMX") "TTL" "600"
              (updateForm Field_TTL)
              (show state._currentRR.ttl)
              should_be_disabled
          , Bulma.box_input ("targetMX") "Target" "www"
              (updateForm Field_Target)
              state._currentRR.target
              should_be_disabled
          , Bulma.box_input ("priorityMX") "Priority" "10"
              (updateForm Field_Priority)
              (maybe "" show state._currentRR.priority)
              should_be_disabled
          ]
        modal_content_srv :: Array (HH.HTML w Action)
        modal_content_srv =
          [ Bulma.div_content [Bulma.explanation Explanations.srv_introduction]
          , render_errors
          , Bulma.box_input "domainSRV" "Service name" "service name"
              (updateForm Field_Domain)
              state._currentRR.name
              should_be_disabled
          , Bulma.box_input ("protocolSRV") "Protocol" "tcp"
              (updateForm Field_Protocol)
              (fromMaybe "tcp" state._currentRR.protocol)
              should_be_disabled
          , Bulma.box_input ("targetSRV") "Where the server is" "www"
              (updateForm Field_Target)
              state._currentRR.target
              should_be_disabled
          , Bulma.box_input ("portSRV") "Port of the service" "5061"
              (updateForm Field_Port)
              (maybe "" show state._currentRR.port)
              should_be_disabled
          , Bulma.box_input ("prioritySRV") "Priority" "10"
              (updateForm Field_Priority)
              (maybe "" show state._currentRR.priority)
              should_be_disabled
          , Bulma.box_input ("ttlSRV") "TTL" "600"
              (updateForm Field_TTL)
              (show state._currentRR.ttl)
              should_be_disabled
          , Bulma.box_input ("weightSRV") "Weight" "100"
              (updateForm Field_Weight)
              (maybe "" show state._currentRR.weight)
              should_be_disabled
          ]
        modal_content_spf :: Array (HH.HTML w Action)
        modal_content_spf =
          [ Bulma.div_content [Bulma.explanation Explanations.spf_introduction]
          , render_errors
          , Bulma.input_with_side_text "domainSPF" "Name" "Let this alone."
              (updateForm Field_Domain)
              state._currentRR.name
              display_domain_side
          , Bulma.box_input "ttlSPF" "TTL" "600"
              (updateForm Field_TTL)
              (show state._currentRR.ttl)
              should_be_disabled
          --, case state._currentRR.v of
          --  Nothing -> Bulma.p "default value for the version (spf1)"
          --  Just v  -> Bulma.box_input "vSPF" "Version" "spf1" (updateForm Field_SPF_v) v should_be_disabled
          , Bulma.hr
          , maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms
          , Bulma.box
            [ Bulma.h3 "New mechanism"
            , Bulma.selection_field "idMechanismQ" "Policy" SPF_Mechanism_q qualifier_types state.spf_mechanism_q
            , Bulma.selection_field "idMechanismT" "Type"   SPF_Mechanism_t mechanism_types state.spf_mechanism_t
            , Bulma.box_input "valueNewMechanismSPF" "Value" ""
                SPF_Mechanism_v
                state.spf_mechanism_v
                should_be_disabled
            , Bulma.btn "Add" SPF_Mechanism_Add
            ]
          , Bulma.hr
          , maybe (Bulma.p "no modifier") display_modifiers state._currentRR.modifiers
          , Bulma.box
            [ Bulma.h3 "New modifier"
            , Bulma.selection_field "idModifierT" "Modifier" SPF_Modifier_t modifier_types state.spf_modifier_t
            , Bulma.box_input "valueNewModifierSPF" "Value" ""
                SPF_Modifier_v
                state.spf_modifier_v
                should_be_disabled
            , Bulma.btn "Add" SPF_Modifier_Add
            ]
          , Bulma.hr
          , Bulma.box
            [ Bulma.h3 "Default behavior"
            , Bulma.div_content [Bulma.explanation Explanations.spf_default_behavior]
            , Bulma.selection SPF_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q)
            ]
          ]
        modal_content_dkim :: Array (HH.HTML w Action)
        modal_content_dkim =
          [ Bulma.div_content [Bulma.explanation Explanations.dkim_introduction]
          , render_errors
          , Bulma.input_with_side_text "domainDKIM" "Name" "default._domainkey"
              (updateForm Field_Domain)
              state._currentRR.name
              display_domain_side
          , Bulma.box_input "ttlDKIM" "TTL" "600"
              (updateForm Field_TTL)
              (show state._currentRR.ttl)
              should_be_disabled
          , Bulma.hr
          , Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
          , Bulma.selection_field "idDKIMSignature" "Signature algo"
              DKIM_sign_algo
              (map DKIM.show_signature_algorithm DKIM.sign_algos)
              (DKIM.show_signature_algorithm $ fromMaybe DKIM.RSA state.dkim.k)
          , Bulma.selection_field "idDKIMHash"      "Hash algo"
              DKIM_hash_algo
              (map DKIM.show_hashing_algorithm DKIM.hash_algos)
              (DKIM.show_hashing_algorithm   $ fromMaybe DKIM.SHA256 state.dkim.h)
          , Bulma.box_input "pkDKIM" "Public Key" "Your public key, such as 'MIIBIjANBgqh...'"
              DKIM_pubkey state.dkim.p should_be_disabled
          , Bulma.box_input "noteDKIM" "Note" "Note for fellow administrators."
              DKIM_note
              (fromMaybe "" state.dkim.n)
              should_be_disabled
          ]

        display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
        should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
        newtokenbtn = Bulma.btn "🏁​ Ask for a token!" (NewToken state._currentRR.rrid)
        foot_content x =
          case state.rr_modal of
            NewRRModal _  -> [Bulma.btn_add (ValidateRR x)]
            UpdateRRModal -> [Bulma.btn_save ValidateLocal] <> case x of
              A    -> [newtokenbtn]
              AAAA -> [newtokenbtn]
              _    -> []
            _ -> [Bulma.p "state.rr_modal should either be NewRRModal or UpdateRRModal."]
        template content foot_ = Bulma.modal title content foot
          where
          title = case state.rr_modal of
            NoModal             -> "Error: no modal should be displayed"
            NewRRModal t_       -> "New " <> show_accepted_type t_ <> " resource record"
            UpdateRRModal       -> "Update RR " <> show state._currentRR.rrid
            RemoveRRModal rr_id -> "Error: should display removal modal instead (for RR " <> show rr_id <> ")"
          foot = foot_ <> [Bulma.cancel_button CancelModal]

handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
  -- | Cancel the current modal being presented.
  -- | Works for both "new RR", "update RR" and "remove RR" modals.
  CancelModal -> do
    H.modify_ _ { rr_modal = NoModal }
    H.modify_ _ { _currentRR_errors = [] }

  -- | Create the RR modal.
  DeleteRRModal rr_id -> do
    H.modify_ _ { rr_modal = RemoveRRModal rr_id }

  -- | Change the current tab.
  ChangeTab new_tab -> do
    H.modify_ _ { current_tab = new_tab }

  -- | Create modal (a form) for a resource record to update.
  CreateUpdateRRModal rr_id -> do
    state <- H.get
    case first (\rr -> rr.rrid == rr_id) state._resources of
      Nothing -> H.raise $ Log $ ErrorLog $ "RR not found (RR " <> show rr_id <> ")"
      Just rr -> do
        H.modify_ _ { _currentRR = rr }
        _ <- case rr.rrtype of
          "DKIM" -> H.modify_ _ { dkim = fromMaybe DKIM.emptyDKIMRR rr.dkim }
          _      -> pure unit
        H.modify_ _ { rr_modal = UpdateRRModal }

  -- | Each time a "new RR" button is clicked, the form resets.
  CreateNewRRModal t -> do
    state <- H.get
    H.modify_ _ { rr_modal = NewRRModal t }
    let default_rr_AAAA  = emptyRR { rrtype = "AAAA", name = "www", target = "2001:db8::1" }
        default_rr_TXT   = emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
        default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "blog", target = "www" }
        default_rr_NS    = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." }
        default_rr_MX    = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 }
        default_rr_SRV   = emptyRR { rrtype = "SRV", name = "voip", target = "server1"
                                   , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
        default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
        default_rr_SPF   = emptyRR { rrtype = "SPF", name = "", target = ""
                                   , mechanisms = Just default_mechanisms
                                   , q = Just RR.HardFail
                                   }
        default_rr_DKIM  = emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }

    case t of
      A     -> H.modify_ _ { _currentRR = default_rr_A }
      AAAA  -> H.modify_ _ { _currentRR = default_rr_AAAA }
      TXT   -> H.modify_ _ { _currentRR = default_rr_TXT }
      CNAME -> H.modify_ _ { _currentRR = default_rr_CNAME }
      NS    -> H.modify_ _ { _currentRR = default_rr_NS }
      MX    -> H.modify_ _ { _currentRR = default_rr_MX }
      SRV   -> H.modify_ _ { _currentRR = default_rr_SRV }
      SPF   -> H.modify_ _ { _currentRR = default_rr_SPF }
      DKIM  -> H.modify_ _ { _currentRR = default_rr_DKIM }

  -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
  Initialize -> do
    { _domain } <- H.get
    H.raise $ Log $ SystemLog $ "Asking the domain " <> _domain
    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain }
    H.raise $ MessageToSend message

  -- | Perform validation. In case the record is valid, it is added to the zone then the modal is closed.
  -- | Else, the different errors are added to the state.
  ValidateRR t -> do
    -- In case the `name` part of the resource record is empty, consider the name to be the domain itself.
    H.modify_ \s -> s { _currentRR = replace_name s._domain s._currentRR }

    -- TODO: should the code design change? Would the code be simplified by working only on _currentRR.dkim?
    -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
    _ <- case t of
           DKIM -> H.modify_ \state -> state { _currentRR { dkim = Just state.dkim } }
           _ -> pure unit

    state <- H.get
    case Validation.validation state._currentRR of
      Left actual_errors -> do
        -- H.raise $ Log $ ErrorLog $ "Cannot add this " <> show t <> " RR, some errors occured in the record:"
        -- loopE (\v -> H.raise $ Log $ ErrorLog $ "==> " <> show_error v) actual_errors
        H.modify_ _ { _currentRR_errors = actual_errors }
      Right newrr -> do
        H.modify_ _ { _currentRR_errors = [], dkim = DKIM.emptyDKIMRR }
        handleAction $ AddRR t newrr
        handleAction CancelModal

  -- | Try to add a resource record to the zone.
  -- | Can fail if the content of the form isn't valid.
  AddRR t newrr -> do
    state <- H.get
    H.raise $ Log $ SystemLog $ "Add new " <> show t
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
    H.raise $ MessageToSend message

  -- | Update the currently displayed RR form (new or update RR).
  UpdateCurrentRR field -> do
    state <- H.get
    let newRR = update_field state._currentRR field
    H.modify_ _ { _currentRR = newRR }

  -- | Validate any local RR with the new `_resources` and `_local_errors`.
  ValidateLocal -> do
    -- In case the `name` part of the resource record is empty, consider the name to be the domain itself.
    H.modify_ \s -> s { _currentRR = replace_name s._domain s._currentRR }

    -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
    state0 <- H.get
    _ <- case state0._currentRR.rrtype of
           "DKIM" -> H.modify_ _ { _currentRR { dkim = Just state0.dkim } }
           _      -> pure unit

    state <- H.get
    case Validation.validation state._currentRR of
      Left actual_errors -> do
        H.modify_ _ { _currentRR_errors = actual_errors }
      Right rr -> do
        H.modify_ _ { _currentRR_errors = [] }
        handleAction $ SaveRR rr

  SaveRR rr -> do
    state <- H.get
    H.raise $ Log $ SystemLog $ "Updating RR " <> show rr.rrid
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkUpdateRR { domain: state._domain, rr: rr }
    H.raise $ MessageToSend message

  RemoveRR rr_id -> do
    { _domain } <- H.get
    H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
    -- Send a removal message.
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id }
    H.raise $ MessageToSend message
    -- Modal doesn't need to be active anymore.
    handleAction CancelModal

  NewToken rr_id -> do
    { _domain } <- H.get
    H.raise $ Log $ SystemLog $ "Ask a token for rrid " <> show rr_id
    -- Send a NewToken message.
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkNewToken { domain: _domain, rrid: rr_id }
    H.raise $ MessageToSend message

  AskZoneFile -> do
    state <- H.get
    H.raise $ Log $ SystemLog $ "Asking for the '" <> state._domain <> "' zonefile"
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkAskGeneratedZoneFile { domain: state._domain }
    H.raise $ MessageToSend message

  SPF_Mechanism_q v -> H.modify_ _ { spf_mechanism_q = maybe "pass"     id $ qualifier_types A.!! v }
  SPF_Mechanism_t v -> H.modify_ _ { spf_mechanism_t = maybe "a"        id $ mechanism_types A.!! v }
  SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v                                            }
  SPF_Modifier_t v  -> H.modify_ _ { spf_modifier_t  = maybe "redirect" id $ modifier_types  A.!! v }
  SPF_Modifier_v v  -> H.modify_ _ { spf_modifier_v  = v                                            }
  SPF_Qualifier v   -> H.modify_ _ { _currentRR { q  = all_qualifiers  A.!! v                     } }
  SPF_remove_mechanism i ->
    H.modify_ \s -> s { _currentRR { mechanisms = case s._currentRR.mechanisms of
                                       Just ms -> Just (remove_id i $ attach_id 0 ms)
                                       Nothing -> Nothing
                                   }
                      }
  SPF_remove_modifier i ->
    H.modify_ \s -> s { _currentRR { modifiers = case s._currentRR.modifiers of
                                       Just ms -> Just (remove_id i $ attach_id 0 ms)
                                       Nothing -> Nothing
                                   }
                      }

  SPF_Mechanism_Add -> do
    state <- H.get
    let m = state._currentRR.mechanisms
        m_q = state.spf_mechanism_q
        m_t = state.spf_mechanism_t
        m_v = state.spf_mechanism_v
        new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (to_mechanism m_q m_t m_v)
        new_value = case new_list_of_mechanisms of
          [] -> Nothing
          v  -> Just v
    H.modify_ _ { _currentRR { mechanisms = new_value }}

  SPF_Modifier_Add -> do
    state <- H.get
    let m = state._currentRR.modifiers
        m_t = state.spf_modifier_t
        m_v = state.spf_modifier_v
        new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (to_modifier m_t m_v)
        new_value = case new_list_of_modifiers of
          [] -> Nothing
          v  -> Just v
    H.modify_ _ { _currentRR { modifiers = new_value }}

  DKIM_hash_algo v -> H.modify_ _ { dkim { h = DKIM.hash_algos A.!! v } }
  DKIM_sign_algo v -> H.modify_ _ { dkim { k = DKIM.sign_algos A.!! v } }
  DKIM_pubkey    v -> H.modify_ _ { dkim { p =                      v } }
  DKIM_note      v -> H.modify_ _ { dkim { n = Just                 v } }

  where
  -- In case the `name` part of the resource record is empty replace it with the domain name.
  replace_name domain rr = case rr.name of
                         "" -> rr { name = domain <> "." }
                         _  -> rr

handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of

  MessageReceived message a -> do
    case message of
      (DNSManager.MkRRUpdated response) -> do
        replace_entry response.rr
        -- When an update is received for a record, it means
        -- the update request has been accepted, the current modal can be closed.
        H.modify_ _ { rr_modal = NoModal }
      (DNSManager.MkRRAdded response) -> do
        state <- H.get
        H.put $ add_RR state response.rr
      (DNSManager.MkRRDeleted response) -> do
        -- Remove the resource record.
        state <- H.get
        H.modify_ _ { _resources = A.filter (\rr -> rr.rrid /= response.rrid) state._resources }
      (DNSManager.MkGeneratedZoneFile response) -> do
        H.modify_ _ { _zonefile = Just response.zonefile }
      (DNSManager.MkZone response) -> do
        add_entries response.zone.resources

      _ -> H.raise $ Log $ ErrorLog $ "Message not handled in ZoneInterface."
    pure (Just a)

  ConnectionIsDown a -> do
    H.modify_ _ { wsUp = false }
    pure (Just a)

  ConnectionIsUp a -> do
    H.modify_ _ { wsUp = true }
    pure (Just a)

  where
    -- replace_entry :: ResourceRecord
    replace_entry new_rr = do
      state <- H.get
      H.modify_ _ { _resources = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._resources }

      new_state <- H.get
      H.put $ add_RR new_state new_rr

    add_entries []  = pure unit
    add_entries arr = do
      case A.head arr, A.tail arr of
        Nothing, _ -> pure unit
        Just new_rr, tail -> do
            state <- H.get
            H.put $ add_RR state new_rr
            add_entries $ fromMaybe [] tail

    add_RR :: State -> ResourceRecord -> State
    add_RR state new_rr = state { _resources = (state._resources <> [ new_rr ]) }

-- Rendering
bg_color_ro = C.has_background_warning_light :: Array HH.ClassName

tag :: forall w i. String -> HH.HTML w i
tag str = HH.span [HP.classes (C.tag <> C.is_dark)] [HH.text str]

tag_ro :: forall w i. String -> HH.HTML w i
tag_ro str = HH.span [HP.classes (C.tag <> C.is_warning)] [HH.text str]

tags :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
tags xs = HH.span [HP.classes (C.tags <> C.no_margin_bottom <> C.no_padding_bottom)] xs

-- | Render all Resource Records.
render_resources :: forall w. Array ResourceRecord -> HH.HTML w Action
render_resources [] = Bulma.box [Bulma.zone_rr_title "Resource records", Bulma.subtitle "No records for now"]
render_resources records
  = HH.div_ $
         (rr_box tag_soa       bg_color_ro Bulma.soa_table_header       table_content        all_soa_rr)
      <> (rr_box tag_basic     []          Bulma.simple_table_header    table_content_w_seps all_basic_rr)
      <> (rr_box tag_mx        []          Bulma.mx_table_header        table_content        all_mx_rr)
      <> (rr_box tag_srv       []          Bulma.srv_table_header       table_content        all_srv_rr)
      <> (rr_box tag_spf       []          Bulma.spf_table_header       table_content        all_spf_rr)
      <> (rr_box tag_dkim      []          Bulma.dkim_table_header      table_content        all_dkim_rr)
      <> (rr_box tag_basic_ro  bg_color_ro Bulma.simple_table_header_ro table_content_w_seps all_basic_ro_rr)
  where
  all_basic_rr    = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records
  all_basic_ro_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && rr.readonly)     records
  all_XX_rr str   = A.filter (\rr -> rr.rrtype == str) records
  all_soa_rr      = all_XX_rr "SOA"
  all_mx_rr       = all_XX_rr "MX"
  all_srv_rr      = all_XX_rr "SRV"
  all_spf_rr      = all_XX_rr "SPF"
  all_dkim_rr     = all_XX_rr "DKIM"

  tag_soa      = tags [tag_ro "SOA", tag_ro "read only"]
  tag_basic    = tags [tag "Basic RRs (A, AAAA, PTR, NS, TXT)"]
  tag_mx       = tags [tag "MX"]
  tag_srv      = tags [tag "SRV"]
  tag_spf      = tags [tag "SPF"]
  tag_dkim     = tags [tag "DKIM"]
  tag_basic_ro = tags [tag_ro "Basic RRs", tag_ro "read only"]

  rr_box :: HH.HTML w Action                                          -- box title (type of data)
            -> Array HH.ClassName
            -> HH.HTML w Action                             -- table title
            -> (Array ResourceRecord -> HH.HTML w Action)
            -> Array ResourceRecord
            -> Array (HH.HTML w Action)
  rr_box title colors header dp rrs =
    if A.length rrs > 0
    then [ Bulma.box_ (C.no_padding_left <> C.no_padding_top <> colors)
             [title, Bulma.table_ (C.margin_left 3) [] [header, dp rrs]] ]
    else []
  --title_col_props = C.is 1

  table_content_w_seps records_ = HH.tbody_ $
    A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]]
    # map NonEmpty.toArray                       -- -> [[xx], [yy], [z]]
    # map (map rows)                             -- -> [[hh], [hh], [h]] ('h' means 'html')
    # A.intersperse [emptyline]                  -- -> [[hh], [line], [hh], [line], [h]]
    # A.concat                                   -- -> [h h line h h line h]

  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 = if rr.readonly
            then HH.tr [ HP.classes C.has_background_warning_light ] $ render_row rr
            else HH.tr_ $ render_row rr

  render_row :: ResourceRecord -> Array (HH.HTML w Action)
  render_row rr =
    case rr.rrtype of
      "SOA" ->
        [ HH.td_ [ HH.text rr.name ]
        , HH.td_ [ HH.text $ show rr.ttl ]
        , HH.td_ [ HH.text rr.target ]
        , HH.td_ [ HH.text $ maybe "" id rr.mname   ]
        , HH.td_ [ HH.text $ maybe "" id rr.rname   ]
        , HH.td_ [ HH.text $ maybe "" show rr.serial  ]
        , HH.td_ [ HH.text $ maybe "" show rr.refresh ]
        , HH.td_ [ HH.text $ maybe "" show rr.retry   ]
        , HH.td_ [ HH.text $ maybe "" show rr.expire  ]
        , HH.td_ [ HH.text $ maybe "" show rr.minttl  ]
        ]
      "SRV" ->
        [ HH.td_ [ Bulma.p rr.name ]
        , HH.td_ [ Bulma.p $ maybe "" id rr.protocol ]
        , HH.td_ [ Bulma.p rr.target ]
        , HH.td_ [ Bulma.p $ maybe "" show rr.port ]
        , HH.td_ [ Bulma.p $ show rr.ttl ]
        , HH.td_ [ Bulma.p $ maybe "" show rr.priority ]
        , HH.td_ [ Bulma.p $ maybe "" show rr.weight ]
        , if rr.readonly
          then HH.td_ [ Bulma.btn_readonly ]
          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
        ]
      "SPF"  ->
        [ HH.td_ [ Bulma.p rr.name ]
        , HH.td_ [ Bulma.p $ show rr.ttl ]
        -- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed.
        , HH.td_ [ Bulma.p $ maybe "" (A.fold <<< A.intersperse " " <<< map show_mechanism) rr.mechanisms ]
        , HH.td_ [ Bulma.p $ maybe "" (A.fold <<< A.intersperse " " <<< map show_modifier)  rr.modifiers ]
        , HH.td_ [ Bulma.p $ maybe "" fancy_qualifier_display rr.q ]
        , if rr.readonly
          then HH.td_ [ Bulma.btn_readonly ]
          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
        ]
      "DKIM"  ->
        [ HH.td_ [ Bulma.p rr.name ]
        , HH.td_ [ Bulma.p $ show rr.ttl ]
        ] <> case rr.dkim of
          Just dkim ->
            [
            -- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DKIM1.
              HH.td_ [ Bulma.p $ maybe "" DKIM.show_hashing_algorithm    dkim.h ]
            , HH.td_ [ Bulma.p $ maybe "" DKIM.show_signature_algorithm  dkim.k ]
            , HH.td_ [ Bulma.p $ CP.take 5                               dkim.p ]
            , HH.td_ [ Bulma.p $ fromMaybe ""                            dkim.n ]
            , if rr.readonly
              then HH.td_ [ Bulma.btn_readonly ]
              else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
            ]
          Nothing -> [Bulma.p "Problem: there is no DKIM data." ]
      "MX"  ->
        [ 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 ]
        , if rr.readonly
          then HH.td_ [ Bulma.btn_readonly ]
          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), 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 ]
        ] <> if rr.readonly
          then [ HH.td_ [ Bulma.btn_readonly ] ]
          else [ HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
               , HH.td_ [ maybe (show_token_or_btn rr) Bulma.p rr.token ]
               ]

  show_token_or_btn rr =
    case rr.rrtype of
      "A"    -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token!" (NewToken rr.rrid)
      "AAAA" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token!" (NewToken rr.rrid)
      _      -> HH.text ""

  fancy_qualifier_display :: RR.Qualifier -> String
  fancy_qualifier_display qualifier = "(" <> show_qualifier_char qualifier <> ") " <> show_qualifier qualifier

display_mechanisms :: forall w. Array RR.Mechanism -> HH.HTML w Action
display_mechanisms ms =
  Bulma.box_ C.has_background_warning_light
    [ Bulma.table [] [ Bulma.mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms] ]
  where
  render_mechanism_row :: (Tuple Int RR.Mechanism) -> HH.HTML w Action
  render_mechanism_row (Tuple i m) = HH.tr_
    [ Bulma.txt_name $ maybe "" show_qualifier m.q
    , HH.td_ [ Bulma.p $ show_mechanism_type m.t ]
    , HH.td_ [ Bulma.p m.v ]
    , HH.td_ [ Bulma.alert_btn "x" (SPF_remove_mechanism i) ]
    ]

display_modifiers :: forall w. Array RR.Modifier -> HH.HTML w Action
display_modifiers ms =
  Bulma.box_ C.has_background_warning_light
    [ Bulma.table [] [ Bulma.modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms] ]
  where
  render_modifier_row :: (Tuple Int RR.Modifier) -> HH.HTML w Action
  render_modifier_row (Tuple i m) = HH.tr_
    [ HH.td_ [ Bulma.p $ show_modifier_type m.t ]
    , HH.td_ [ Bulma.p m.v ]
    , HH.td_ [ Bulma.alert_btn "x" (SPF_remove_modifier i) ]
    ]

baseRecords :: Array String
baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]

-- Component definition and initial state

render_new_records :: forall (w :: Type). State -> HH.HTML w Action
render_new_records _
  = Bulma.hdiv
      [ Bulma.h1 "Adding new records"
      -- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
      , Bulma.level [
            Bulma.btn     "A" (CreateNewRRModal A)
          , Bulma.btn  "AAAA" (CreateNewRRModal AAAA)
          , Bulma.btn   "TXT" (CreateNewRRModal TXT)
          , Bulma.btn "CNAME" (CreateNewRRModal CNAME)
          , Bulma.btn    "NS" (CreateNewRRModal NS)
          , Bulma.btn    "MX" (CreateNewRRModal MX)
          , Bulma.btn   "SRV" (CreateNewRRModal SRV)
          ] []
      , Bulma.hr
      , Bulma.h1 "Special records about the mail system (soon)"
      -- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
      , Bulma.level [
            Bulma.btn "SPF" (CreateNewRRModal SPF)
          , Bulma.btn "DKIM" (CreateNewRRModal DKIM)
          , Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC"
          ] []
      , Bulma.hr
      , Bulma.level [
            Bulma.btn "Get the final zone file." AskZoneFile
          ] [HH.text "For debug purposes. ⚠"]
      ]

render_zonefile :: forall (w :: Type). Maybe String -> HH.HTML w Action
render_zonefile zonefile = Bulma.box [ maybe (HH.text "") (\x -> HH.pre_ [HH.text x]) zonefile ]

-- ACTIONS

first :: forall a. (a -> Boolean) -> Array a -> Maybe a
first condition = A.head <<< (A.filter condition)

loopE :: forall state action input output m a b
  .  (a -> H.HalogenM state action input output m b)
  -> Array a
  -> H.HalogenM state action input output m Unit
loopE f a = case (A.head a) of
  Nothing -> pure unit
  Just x  -> do void $ f x
                case (A.tail a) of
                  Nothing -> pure unit
                  Just xs -> loopE f xs

update_field :: ResourceRecord -> Field -> ResourceRecord
update_field rr updated_field = case updated_field of
  Field_Domain val           -> rr { name       = val }
  Field_Target val           -> rr { target     = val }
  Field_TTL val              -> rr { ttl        = fromMaybe 0 (fromString val) }
  Field_Priority val         -> rr { priority   = fromString val }
  Field_Protocol val         -> rr { protocol   = Just val }
  Field_Weight val           -> rr { weight     = fromString val }
  Field_Port val             -> rr { port       = fromString val }
  Field_SPF_v val            -> rr { v          = Just val }
  Field_SPF_mechanisms val   -> rr { mechanisms = Just val }
  Field_SPF_modifiers val    -> rr { modifiers  = Just val }
  Field_SPF_q val            -> rr { q          = Just val }

attach_id :: forall a. Int -> Array a -> Array (Tuple Int a)
attach_id _ []  = []
attach_id i arr = case A.head arr of
  Just x -> [Tuple i x] <> attach_id (i + 1) (fromMaybe [] $ A.tail arr)
  Nothing -> []

remove_id :: forall a. Int -> Array (Tuple Int a) -> Array a
remove_id _ []  = []
remove_id i arr = case A.head arr of
  Just (Tuple n x) -> if i == n
                      then remove_id i (fromMaybe [] $ A.tail arr)
                      else [x] <> remove_id i (fromMaybe [] $ A.tail arr)
  Nothing -> []