halogen-websocket-ipc-playzone/src/App/ZoneInterface.purs

-- | `App.ZoneInterface` provides an interface to display and modify a DNS zone.
-- |
-- | This interface allows to:
-- |   - TODO: display all resource records of a zone
-- |   - TODO: add new resource records
-- |   - TODO: remove resource records
-- |   - TODO: ask for confirmation on deletion

module App.ZoneInterface where

import Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show, ($), (+), (/=), (<<<), (<>), (==))

import Data.Array as A
import Data.Int (fromString)
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..))
import Data.Foldable as Foldable
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String.Regex as Regex
import Data.String.Regex.Flags as RegexFlags
import Data.String.Regex.Unsafe as RegexUnsafe
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
--import Web.Event.Event as Event
--import Web.Event.Event (Event)

import Bulma as Bulma
import CSSClasses as C

import App.RR
import App.ResourceRecord

import App.LogMessage (LogMessage(..))
import App.Messages.DNSManagerDaemon as DNSManager

-- | `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
  | DNSManagerReconnect

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

data Query a
  = MessageReceived ArrayBuffer a
  | ConnectionIsDown a
  | ConnectionIsUp a

type Slot = H.Slot Query Output

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

type Input = String

-- | Possible component's actions are:
-- | - TODO: update the list of resource records
-- | - TODO: add a resource record
-- | - TODO: modify a resource record
-- | - TODO: remove a resource record
-- | - TODO: handle user inputs

data Update_SRR_Form
  = Update_SRR_Type      Int
  | Update_SRR_Domain    RecordDomain
  | Update_SRR_TTL       TTL
  | Update_SRR_Value     RecordValue

data Update_MX_Form
  = Update_MX_Domain     RecordDomain
  | Update_MX_TTL        TTL
  | Update_MX_Value      RecordValue
  | Update_MX_Priority   Priority

data Update_SRV_Form
  = Update_SRV_Domain    RecordDomain
  | Update_SRV_TTL       TTL
  | Update_SRV_Value     RecordValue
  | Update_SRV_Priority  Priority
  | Update_SRV_Weight    Weight
  | Update_SRV_Port      Port

data Action
  = DeleteRRModal RRId
  | CancelModal

  | Initialize
  | Finalize

  -- New entries.
  | UpdateNewSRRForm  Update_SRR_Form
  | UpdateNewMXForm   Update_MX_Form
  | UpdateNewSRVForm  Update_SRV_Form

  -- Add new entries.
  | AddSRR
  | AddMX
  | AddSRV

  -- Entry already in our zone.
  | UpdateLocalSRRForm  RRId Update_SRR_Form
  | UpdateLocalMXForm   RRId Update_MX_Form
  | UpdateLocalSRVForm  RRId Update_SRV_Form

  | SyncRR RRId
  | RemoveRR RRId

  | TellSomethingWentWrong RRId String

-- |

type State =
  { _current_domain :: RecordDomain
  , _srr   :: Array (SimpleRR ())
  , _mxrr  :: Array (MXRR ())
  , _srvrr :: Array (SRVRR ())
  , _current_entry :: (SimpleRR ())
  , _current_entry_mx  :: (MXRR ())
  , _current_entry_srv :: (SRVRR ())

  , wsUp :: Boolean
  , active_modal :: Maybe Int
  }

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
        , finalize     = Just Finalize
        }
    }

-- | Default available domain: netlib.re.

default_domain :: String
default_domain = "netlib.re"

initialState :: Input -> State
initialState domain =
  { wsUp: true
  , active_modal: Nothing

  , _current_domain: domain
  , _srr: []
  , _mxrr: []
  , _srvrr: []
  , _current_entry: defaultResourceA
  , _current_entry_mx: defaultResourceMX
  , _current_entry_srv: defaultResourceSRV
  }

render :: forall m. State -> H.ComponentHTML Action () m
render state
  = Bulma.section_small
      [ case state.wsUp, state.active_modal of
          false, _           -> Bulma.p "You are disconnected."
          true,  Just rr_id -> modal_rr_delete rr_id
          true,  Nothing     -> HH.div_ [ Bulma.h1 state._current_domain
                                        , Bulma.hr
                                        , render_records sorted
                                        , render_mx_records state._mxrr
                                        , render_srv_records state._srvrr
                                        , render_new_records state
                                        ]
      ]
  where
    sorted = Foldable.foldl (<>) []
      $ map (A.sortBy (comparing (_.domain)))
      $ map NonEmpty.toArray
      $ A.groupAllBy (comparing (_.t)) state._srr

    modal_rr_delete :: forall w. Int -> HH.HTML w Action
    modal_rr_delete rr_id =
      modal
        [ modal_background
        , modal_card [modal_header, modal_body]
        , modal_foot [modal_delete_button, modal_cancel_button]
        ]
        where
          modal = HH.div [HP.classes (C.modal <> C.is_active)]
          modal_background = HH.div [HP.classes C.modal_background] []
          modal_card = HH.div [HP.classes C.modal_card]
          modal_header = HH.header [HP.classes C.modal_card_head]
            [ HH.p [HP.classes C.modal_card_title] [HH.text "Deleting a resource record"]
            ]
          modal_body = HH.section [HP.classes C.modal_card_body] [ warning_message ]
          modal_foot = HH.div [HP.classes C.modal_card_foot]
          modal_delete_button
            = HH.button [ HP.classes (C.button <> C.is_success)
                        , HE.onClick \_ -> RemoveRR rr_id
                        ] [HH.text "Delete the resource record."]
          modal_cancel_button
            = HH.button [ HP.classes C.button
                        , HE.onClick \_ -> CancelModal
                        ] [HH.text "Cancel"]
          warning_message
            = HH.p [] [ HH.text $ "You are about to delete a resource record, this actions is "
                      , HH.strong_ [ HH.text "irreversible" ]
                      , HH.text "."
                      ]

handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
  CancelModal -> do
    H.modify_ _ { active_modal = Nothing }

  DeleteRRModal rr_id -> do
    H.modify_ _ { active_modal = Just rr_id }

  Initialize -> do
    { _current_domain } <- H.get
    H.raise $ Log $ SimpleLog $ "Asking the server for the zone" <> _current_domain
    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _current_domain }
    H.raise $ MessageToSend message

  Finalize -> do
    H.raise $ Log $ SimpleLog "Finalized!"

  UpdateNewSRRForm rr_update -> case rr_update of
    Update_SRR_Type val -> do
      let new_type = fromMaybe "unknown" (baseRecords A.!! val)
      H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
      state <- H.get
      H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords A.!! val) }
    Update_SRR_Domain val -> do
      H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val)
      H.modify_ _ { _current_entry { domain = val } }
    Update_SRR_TTL val -> do
      H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
      H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } }
    Update_SRR_Value val -> do
      H.raise $ Log $ SimpleLog ("Update new entry value: " <> val)
      H.modify_ _ { _current_entry { value = val } }

  UpdateNewMXForm rr_update -> case rr_update of
    -- TODO: FIXME: test all inputs
    Update_MX_Domain val -> do
      H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_mx = state._current_entry_mx { domain = val } }
    -- TODO: FIXME: test all inputs
    Update_MX_TTL val -> do
      H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
    -- TODO: FIXME: test all inputs
    Update_MX_Value val -> do
      H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_mx = state._current_entry_mx { value = val } }
    Update_MX_Priority val -> do
      H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_mx = state._current_entry_mx { priority = val } }

  UpdateNewSRVForm rr_update -> case rr_update of
    Update_SRV_Domain val -> do
      H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_srv = state._current_entry_srv { domain = val } }
    Update_SRV_Value val -> do
      H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_srv = state._current_entry_srv { value = val } }
      -- TODO: FIXME: test all inputs
    Update_SRV_TTL val -> do
      H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}}
    Update_SRV_Priority val -> do
      H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_srv = state._current_entry_srv { priority = val } }
    Update_SRV_Weight val -> do
      H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_srv = state._current_entry_srv { weight = val } }
    Update_SRV_Port val -> do
      H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
      state <- H.get
      H.modify_ _ { _current_entry_srv = state._current_entry_srv { port = val } }


  -- This action only is possible if inputs are correct.
  AddSRR -> do
    state <- H.get
    let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry
    H.raise $ Log $ SimpleLog ("Add new simple RR: " <> show state._current_entry)
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
    H.raise $ MessageToSend message
  AddMX -> do
    state <- H.get
    let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx
    H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx)
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
    H.raise $ MessageToSend message
  AddSRV -> do
    state <- H.get
    let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv
    H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv)
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
    H.raise $ MessageToSend message

  UpdateLocalSRRForm rr_id rr_update -> case rr_update of
    Update_SRR_Type val -> do
      let new_type = fromMaybe "unknown" (baseRecords A.!! val)
      H.raise $ Log $ SimpleLog ("TODO: Update local RR " <> show rr_id <> " type: " <> new_type)
      -- state <- H.get
      -- H.modify_ _ { _srr = changeType state._current_entry (baseRecords A.!! val) }
    Update_SRR_Domain val -> do
      H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " domain: " <> val)
      state <- H.get
      H.modify_ _ { _srr = (update_domain rr_id val state._srr) }
    Update_SRR_TTL val -> do
      H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " TTL: " <> val)
      state <- H.get
      H.modify_ _ { _srr = (update_ttl rr_id val state._srr) }
    Update_SRR_Value val -> do
      H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " value: " <> val)
      state <- H.get
      H.modify_ _ { _srr = (update_value rr_id val state._srr) }

  UpdateLocalMXForm rr_id rr_update -> case rr_update of
    -- TODO: FIXME: test all inputs
    Update_MX_Domain val -> do
      H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " domain: " <> val)
      state <- H.get
      H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) }
    -- TODO: FIXME: test all inputs
    Update_MX_TTL val -> do
      H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry ttl: " <> val)
      state <- H.get
      H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) }
    -- TODO: FIXME: test all inputs
    Update_MX_Value val -> do
      H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry value: " <> val)
      state <- H.get
      H.modify_ _ { _mxrr = (update_value rr_id val state._mxrr) }
    Update_MX_Priority val -> do
      H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val)
      state <- H.get
      H.modify_ _ { _mxrr = (update_priority rr_id val state._mxrr) }

  UpdateLocalSRVForm rr_id rr_update -> case rr_update of
    Update_SRV_Domain val -> do
      H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry domain: " <> val)
      state <- H.get
      H.modify_ _ { _srvrr = (update_domain rr_id val state._srvrr) }
    Update_SRV_Value val -> do
      H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry value: " <> val)
      state <- H.get
      H.modify_ _ { _srvrr = (update_value rr_id val state._srvrr) }
      -- TODO: FIXME: test all inputs
    Update_SRV_TTL val -> do
      H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry ttl: " <> val)
      state <- H.get
      H.modify_ _ { _srvrr = (update_ttl rr_id val state._srvrr) }
    Update_SRV_Priority val -> do
      H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry priority: " <> val)
      state <- H.get
      H.modify_ _ { _srvrr = (update_priority rr_id val state._srvrr) }
    Update_SRV_Weight val -> do
      H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry weight: " <> val)
      state <- H.get
      H.modify_ _ { _srvrr = (update_weight rr_id val state._srvrr) }
    Update_SRV_Port val -> do
      H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry port: " <> val)
      state <- H.get
      H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) }

  -- TODO: network operations
  SyncRR rr_id -> do
    H.raise $ Log $ SimpleLog ("TODO: SyncRR: " <> show rr_id)

  RemoveRR rr_id -> do
    { _current_domain } <- H.get
    H.raise $ Log $ SimpleLog $ "Ask to remove rr (id: " <> show rr_id <> ")"
    message <- H.liftEffect
      $ DNSManager.serialize
      $ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id }
    H.raise $ MessageToSend message
    H.modify_ _ { active_modal = Nothing }

  -- TODO: change the state to indicate problems?
  TellSomethingWentWrong rr_id val -> do
    H.raise $ Log $ SimpleLog ("Sorry, your record " <> show rr_id <> " has problems: ")
    -- H.raise $ Log $ SimpleLog (show rr)
    H.raise $ Log $ SimpleLog (" => " <> val)

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

  MessageReceived message a -> do
    receivedMessage <- H.liftEffect $ DNSManager.deserialize message
    case receivedMessage of
        -- Cases where we didn't understand the message.
        Left err -> do
          --H.raise $ Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err
          case err of
            (DNSManager.JSONERROR jerr) -> do
              H.raise $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr
            (DNSManager.UnknownError   unerr) ->
              H.raise $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr)
            (DNSManager.UnknownNumber       ) ->
              H.raise $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownNumber"
          pure Nothing

        -- Cases where we understood the message.
        Right received_msg -> do
          case received_msg of
            -- The authentication failed.
            (DNSManager.MkError errmsg) -> do
              H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason
            (DNSManager.MkErrorUserNotLogged _) -> do
              H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!"
              H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..."
              H.raise $ DNSManagerReconnect
            (DNSManager.MkErrorInvalidToken _) -> do
              H.raise $ Log $ SimpleLog $ "[TODO] Failed connection! Invalid token!"
            (DNSManager.MkDomainAlreadyExists _) -> do
              H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain already exists."
            (DNSManager.MkUnacceptableDomain _) -> do
              H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)."

            (DNSManager.MkAcceptedDomains _) -> do
              H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!"

            (DNSManager.MkLogged _) -> do
              H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"

            (DNSManager.MkDomainAdded response) -> do
              H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain

            (DNSManager.MkRRAdded     response) -> do
              state <- H.get
              let new_rr = response.rr
              H.raise $ Log $ SimpleLog
                $ "[TODO] Resource Record added: " <> response.domain
                  <> " rrid: " <> show new_rr.rrid
                  <> " rrtype: " <> new_rr.rrtype
                  <> " name: " <> new_rr.name
                  <> " ttl: "  <> show new_rr.ttl
                  <> " target: "  <> new_rr.target
                  <> " readonly: "  <> show new_rr.readonly
              case add_entry state new_rr of
                Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
                Right new_state    -> H.put new_state

            (DNSManager.MkInvalidDomainName _) -> do
              H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"

            (DNSManager.MkDomainDeleted response) -> do
              H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
            (DNSManager.MkRRDeleted response) -> do
              H.raise $ Log $ SimpleLog $ "[🎉] RR (id: '" <> show response.rrid <> "') has been deleted!"
              state <- H.get
              H.modify_ _ { _srr   = A.filter (\rr -> rr.id /= response.rrid) state._srr
                          , _mxrr  = A.filter (\rr -> rr.id /= response.rrid) state._mxrr
                          , _srvrr = A.filter (\rr -> rr.id /= response.rrid) state._srvrr
                          }

            (DNSManager.MkZone response) -> do
              H.raise $ Log $ SimpleLog $ "[🎉] Zone received!"
              add_entries response.zone.resources

            (DNSManager.MkInvalidRR response) -> do
              H.raise $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors

            (DNSManager.MkSuccess _) -> do
              H.raise $ Log $ SimpleLog $ "[🎉] Success!"
            -- WTH?!
            _ -> do
              H.raise $ Log $ SimpleLog $ "[😈] Failed! dnsmanager daemon didn't send a valid message."
          pure (Just a)

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

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

  where
    add_entries []  = H.raise $ Log $ SimpleLog "Done adding entries"
    add_entries arr = do
      state <- H.get
      case A.head arr, A.tail arr of
        Nothing, _ -> H.raise $ Log $ SimpleLog "Done adding entries (but why this didn't performed pattern matching??)"
        Just new_rr, tail -> case add_entry state new_rr of
          Left error_message -> do
            H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
            add_entries $ fromMaybe [] tail
          Right new_state    -> do
            H.put new_state
            add_entries $ fromMaybe [] tail

    add_entry :: State -> ResourceRecord -> Either String State
    add_entry state new_rr = do
      case new_rr.rrtype, (A.elem new_rr.rrtype baseRecords) of
        _, true  -> Right $ add_new_entry state $ fromResourceRecordToLocalRepresentationSimpleRR new_rr
        "MX", _  -> Right $ add_new_mx    state $ fromResourceRecordToLocalRepresentationMXRR     new_rr
        "SRV", _ -> Right $ add_new_srv   state $ fromResourceRecordToLocalRepresentationSRVRR    new_rr
        _, _     -> Left "TODO: CAN'T ADD THIS KIND OF RR RIGHT NOW"

-- Rendering
class_title_size :: Array (HH.ClassName)
class_title_size = [HH.ClassName "is-4"]

render_records :: forall (w :: Type). Array (SimpleRR ()) -> HH.HTML w Action
render_records []
  = Bulma.columns [] [ left_block, right_block  ]
  where left_block = Bulma.column class_title_size
                       [ Bulma.zone_rr_title "NS, A, AAAA, CNAME"
                       , Bulma.subtitle "and TXT records"
                       ]
        right_block = Bulma.column_ [ Bulma.subtitle "No records for now" ]

render_records records
  = Bulma.columns [] [ Bulma.column class_title_size [Bulma.zone_rr_title title_txt, Bulma.subtitle subtitle_txt ]
                     , Bulma.column_ [ Bulma.tile [ table_rr ] ]
                     ]
  where
    title_txt = "NS, A, AAAA, CNAME"
    subtitle_txt = "and TXT records"
    -- subtitle_txt = "Each line is a resource record from your DNS zone."
    --   <> " You can edit them, then click on the \"fix\" button to synchronize with the server."
    table_rr = HH.table [] [ Bulma.simple_table_header, table_content ]
    table_content = HH.tbody_ $ map row records

    row rr = HH.tr_ $
      [ Bulma.txt_name rr.t
      , HH.td_ [ Bulma.input_domain ((UpdateLocalSRRForm rr.id) <<< Update_SRR_Domain) rr.domain rr.valid ]
      , HH.td_ [ Bulma.input_ttl    ((UpdateLocalSRRForm rr.id) <<< Update_SRR_TTL  )  rr.ttl    rr.valid ]
      , HH.td_ [ Bulma.input_value  ((UpdateLocalSRRForm rr.id) <<< Update_SRR_Value)  rr.value  rr.valid ]
      , HH.td_ [ Bulma.btn_change  (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
      , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ]
      ]


render_mx_records :: forall (w :: Type) (l :: Row Type)
  . Array (MXRR l) -> HH.HTML w Action
render_mx_records []
  = Bulma.columns [] [ left_block, right_block ]
  where left_block = Bulma.column class_title_size [ Bulma.zone_rr_title "MX records" ]
        right_block = Bulma.column_ [ Bulma.subtitle "No records for now" ]
render_mx_records records
  = Bulma.columns [] [ Bulma.column class_title_size [ Bulma.zone_rr_title title_txt ]
                     , Bulma.column_ [ Bulma.tile [ table_rr ] ]
                     ]
  where
    title_txt = "MX records"
    table_rr      = HH.table [] [ Bulma.mx_table_header, table_content ]
    table_content = HH.tbody_ $ map row records

    row rr = HH.tr_ $
      [ HH.td_ [ Bulma.input_domain   ((UpdateLocalMXForm rr.id) <<< Update_MX_Domain)   rr.domain   rr.valid ]
      , HH.td_ [ Bulma.input_ttl      ((UpdateLocalMXForm rr.id) <<< Update_MX_TTL)      rr.ttl      rr.valid ]
      , HH.td_ [ Bulma.input_priority ((UpdateLocalMXForm rr.id) <<< Update_MX_Priority) rr.priority rr.valid ]
      , HH.td_ [ Bulma.input_value    ((UpdateLocalMXForm rr.id) <<< Update_MX_Value)    rr.value    rr.valid ]
      , HH.td_ [ Bulma.btn_change     (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
      , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ]
      ]


render_srv_records :: forall (w :: Type) (l :: Row Type)
  . Array (SRVRR l) -> HH.HTML w Action
render_srv_records []
  = Bulma.columns [] [ left_block, right_block  ]
  where left_block = Bulma.column class_title_size [ Bulma.zone_rr_title "SRV records" ]
        right_block = Bulma.column_ [ Bulma.subtitle "No records for now" ]
render_srv_records records
  = Bulma.columns [] [ Bulma.column class_title_size [ Bulma.zone_rr_title title_txt]
                     , Bulma.column_ [ Bulma.tile [ table_rr ] ] ]
  where
    title_txt = "SRV records"
    table_rr      = HH.table [] [ Bulma.srv_table_header, table_content ]
    table_content = HH.tbody_ $ map row records

    row rr = HH.tr_ $
      [ HH.td_ [ Bulma.input_domain   ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Domain  ) rr.domain   rr.valid ]
      , HH.td_ [ Bulma.input_ttl      ((UpdateLocalSRVForm rr.id) <<< Update_SRV_TTL     ) rr.ttl      rr.valid ]
      , HH.td_ [ Bulma.input_priority ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Priority) rr.priority rr.valid ]
      , HH.td_ [ Bulma.input_weight   ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Weight  ) rr.weight   rr.valid ]
      , HH.td_ [ Bulma.input_port     ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Port    ) rr.port     rr.valid ]
      , HH.td_ [ Bulma.input_value    ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Value   ) rr.value    rr.valid ]
      , HH.td_ [ Bulma.btn_change     (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
      , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ]
      ]


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

render_new_record :: forall (w :: Type). (SimpleRR ()) -> HH.HTML w Action
render_new_record rr
  = Bulma.hdiv [ Bulma.zone_rr_title "New record (NS, A, AAAA, CNAME, TXT)", table ]

  where
    table = HH.table [] [ Bulma.simple_table_header, render_record_builder ]

    -- render_record_builder :: forall w. HH.HTML w Action
    render_record_builder
      = HH.tr_
          [ HH.td_ [ type_selection ]
          , HH.td_ [ Bulma.input_domain (UpdateNewSRRForm <<< Update_SRR_Domain) rr.domain rr.valid ]
          , HH.td_ [ Bulma.input_ttl    (UpdateNewSRRForm <<< Update_SRR_TTL)   rr.ttl    rr.valid ]
          , HH.td_ [ Bulma.input_value  (UpdateNewSRRForm <<< Update_SRR_Value)  rr.value  rr.valid ]
          , HH.td_ [ Bulma.btn_add AddSRR (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
          ]

    -- type_selection :: forall w i. HH.HTML w i
    type_selection = HH.select
      [ HE.onSelectedIndexChange (UpdateNewSRRForm <<< Update_SRR_Type) ]
      $ map type_option baseRecords
    type_option n
      = HH.option
          [ HP.value n
          , HP.selected (n == rr.t)
          ] [ HH.text n ]


render_mx_new_record :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action
render_mx_new_record rr
  = Bulma.hdiv [ Bulma.zone_rr_title "New MX record", table ]

  where
    table = HH.table [] [ Bulma.mx_table_header, render_record_builder ]

    -- render_record_builder :: forall w. HH.HTML w Action
    render_record_builder
      = HH.tr_
          [ HH.td_ [ Bulma.input_domain   (UpdateNewMXForm <<< Update_MX_Domain)   rr.domain   rr.valid ]
          , HH.td_ [ Bulma.input_ttl      (UpdateNewMXForm <<< Update_MX_TTL)      rr.ttl      rr.valid ]
          , HH.td_ [ Bulma.input_priority (UpdateNewMXForm <<< Update_MX_Priority) rr.priority rr.valid ]
          , HH.td_ [ Bulma.input_value    (UpdateNewMXForm <<< Update_MX_Value)    rr.value    rr.valid ]
          , HH.td_ [ Bulma.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
          ]


render_srv_new_record :: forall (w :: Type). (SRVRR ()) -> HH.HTML w Action
render_srv_new_record rr
  = Bulma.hdiv [ Bulma.zone_rr_title "New SRV record", table ]
  where
    table = HH.table [] [ Bulma.srv_table_header, render_record_builder ]

    -- render_record_builder :: forall w. HH.HTML w Action
    render_record_builder
      = HH.tr_
          [ HH.td_ [ Bulma.input_domain   (UpdateNewSRVForm <<< Update_SRV_Domain)   rr.domain   rr.valid ]
          , HH.td_ [ Bulma.input_ttl      (UpdateNewSRVForm <<< Update_SRV_TTL)      rr.ttl      rr.valid ]
          , HH.td_ [ Bulma.input_priority (UpdateNewSRVForm <<< Update_SRV_Priority) rr.priority rr.valid ]
          , HH.td_ [ Bulma.input_weight   (UpdateNewSRVForm <<< Update_SRV_Weight)   rr.weight   rr.valid ]
          , HH.td_ [ Bulma.input_port     (UpdateNewSRVForm <<< Update_SRV_Port)     rr.port     rr.valid ]
          , HH.td_ [ Bulma.input_value    (UpdateNewSRVForm <<< Update_SRV_Value)    rr.value    rr.valid ]
          , HH.td_ [ Bulma.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
          ]


-- Component definition and initial state

render_new_records :: forall (w :: Type). State -> HH.HTML w Action
render_new_records state
  = Bulma.hdiv
      [ Bulma.h1 "Adding new records"
      , Bulma.hr
      , Bulma.columns []
          [ render_new_record_column_simple state._current_entry
          , render_new_record_colunm_mx     state._current_entry_mx
          , render_new_record_colunm_srv    state._current_entry_srv
          -- , render_current_value     state._current_entry
          -- , render_mx_current_value  state._current_entry_mx
          -- , render_srv_current_value state._current_entry_srv
          ]
      ]

render_new_record_column_simple :: forall (w :: Type).
  (SimpleRR ()) -> HH.HTML w Action
render_new_record_column_simple rr
  = Bulma.column_ $ [ Bulma.box
      [ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT"
      , type_selection
      , Bulma.box_input_domain (UpdateNewSRRForm <<< Update_SRR_Domain) rr.domain rr.valid
      , Bulma.box_input_ttl    (UpdateNewSRRForm <<< Update_SRR_TTL)    rr.ttl    rr.valid
      , Bulma.box_input_value  (UpdateNewSRRForm <<< Update_SRR_Value)   rr.value  rr.valid
      , Bulma.btn_add AddSRR   (TellSomethingWentWrong rr.id "cannot add") rr.valid
      ]
    ]
  where
    -- type_selection :: forall w i. HH.HTML w i
    type_selection = HH.select
      [ HE.onSelectedIndexChange (UpdateNewSRRForm <<< Update_SRR_Type) ]
      $ map type_option baseRecords
    type_option n
      = HH.option
          [ HP.value n
          , HP.selected (n == rr.t)
          ] [ HH.text n ]


render_new_record_colunm_mx :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action
render_new_record_colunm_mx rr
  = Bulma.column_ $ [ Bulma.box
      [ Bulma.zone_rr_title "MX"
      , Bulma.box_input_domain   (UpdateNewMXForm <<< Update_MX_Domain)   rr.domain   rr.valid
      , Bulma.box_input_ttl      (UpdateNewMXForm <<< Update_MX_TTL)      rr.ttl      rr.valid
      , Bulma.box_input_priority (UpdateNewMXForm <<< Update_MX_Priority) rr.priority rr.valid
      , Bulma.box_input_value    (UpdateNewMXForm <<< Update_MX_Value)    rr.value    rr.valid
      , Bulma.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid
      ]
    ]

render_new_record_colunm_srv :: forall (w :: Type). (SRVRR ()) -> HH.HTML w Action
render_new_record_colunm_srv rr
  = Bulma.column_ $ [ Bulma.box
      [ Bulma.zone_rr_title "SRV"
      , Bulma.box_input_domain   (UpdateNewSRVForm <<< Update_SRV_Domain)   rr.domain   rr.valid
      , Bulma.box_input_ttl      (UpdateNewSRVForm <<< Update_SRV_TTL)      rr.ttl      rr.valid
      , Bulma.box_input_priority (UpdateNewSRVForm <<< Update_SRV_Priority) rr.priority rr.valid
      , Bulma.box_input_weight   (UpdateNewSRVForm <<< Update_SRV_Weight)   rr.weight   rr.valid
      , Bulma.box_input_port     (UpdateNewSRVForm <<< Update_SRV_Port)     rr.port     rr.valid
      , Bulma.box_input_value    (UpdateNewSRVForm <<< Update_SRV_Value)    rr.value    rr.valid
      , Bulma.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid
      ]
    ]

-- ACTIONS

-- add a new record and get a new placeholter
add_new_entry :: State -> Maybe (SimpleRR ()) -> State
add_new_entry state = case _ of
  Nothing -> state
  Just rr -> state { _srr = (state._srr <> [ rr ]), _current_entry = defaultResourceA }

-- add a new record and get a new placeholter
add_new_mx :: State -> Maybe (MXRR ()) -> State
add_new_mx state = case _ of
  Nothing -> state
  Just rr -> state { _mxrr = (state._mxrr <> [ rr ]), _current_entry_mx = defaultResourceMX }

-- add a new record and get a new placeholter
add_new_srv :: State -> Maybe (SRVRR ()) -> State
add_new_srv state = case _ of
  Nothing -> state
  Just rr -> state { _srvrr = (state._srvrr <> [ rr ]), _current_entry_srv = defaultResourceSRV }
  
changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l)
changeType rr Nothing = rr
changeType rr (Just s) = rr { t = s }

update_domain :: forall (l :: Row Type).
  Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
update_domain rr_id val
  = update (\rr -> rr { modified = true, domain = val }) rr_id

update_value :: forall (l :: Row Type).
  Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
update_value rr_id val
  = update (\rr -> rr { modified = true, value = val }) rr_id

update_ttl :: forall (l :: Row Type).
  Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
update_ttl rr_id val
  = update (\rr -> rr { modified = true, ttl = val, valid = isInteger val }) rr_id

update_priority :: forall (l :: Row Type). Int -> Priority -> Array (MXRR l) -> Array (MXRR l)
update_priority rr_id val = update (\rr -> rr { modified = true, priority = val}) rr_id

update_weight :: forall (l :: Row Type). Int -> Priority -> Array (SRVRR l) -> Array (SRVRR l)
update_weight rr_id val = update (\rr -> rr { modified = true, weight = val}) rr_id

update_port :: Int -> Priority -> Array (SRVRR ()) -> Array (SRVRR ())
update_port rr_id val = update (\rr -> rr { modified = true, port = val}) rr_id

isIntRegex :: Regex.Regex
isIntRegex = RegexUnsafe.unsafeRegex "^[0-9]*$" RegexFlags.noFlags

isInteger :: String -> Boolean
isInteger = Regex.test isIntRegex

update :: forall (l :: Row Type).
  (SimpleRR l -> SimpleRR l) -> Int -> Array (SimpleRR l) -> Array (SimpleRR l)
update f rr_id records = map doSmth records
  where
    doSmth rr
      | rr_id == rr.id = f rr
      | otherwise     = rr

fromResourceRecordToLocalRepresentationSimpleRR :: ResourceRecord -> Maybe (SimpleRR ())
fromResourceRecordToLocalRepresentationSimpleRR new_rr =
  Just { t:         new_rr.rrtype
       , id:        new_rr.rrid
       , modified:  false
       , valid:     true
       , ttl:       show new_rr.ttl
       , domain:    new_rr.name
       , value:     new_rr.target
       }

fromResourceRecordToLocalRepresentationMXRR :: ResourceRecord -> Maybe (MXRR ())
fromResourceRecordToLocalRepresentationMXRR new_rr = do
  priority <- new_rr.priority
  Just { t:         new_rr.rrtype
       , id:        new_rr.rrid
       , modified:  false
       , valid:     true
       , ttl:       show new_rr.ttl
       , domain:    new_rr.name
       , value:     new_rr.target
       , priority:  show priority
       }
-- TODO: would be nice to have a simpler implementation, something like this:
--fromResourceRecordToLocalRepresentationMXRR new_rr
--  = let simple_rr = fromResourceRecordToLocalRepresentationSimpleRR new_rr
--    simple_rr { priority = show new_rr.priority }

fromResourceRecordToLocalRepresentationSRVRR :: ResourceRecord -> Maybe (SRVRR ())
fromResourceRecordToLocalRepresentationSRVRR new_rr = do
  case new_rr.priority, new_rr.weight, new_rr.port of
    Just priority, Just weight, Just port ->
      Just { t:         new_rr.rrtype
           , id:        new_rr.rrid
           , modified:  false
           , valid:     true
           , ttl:       show new_rr.ttl
           , domain:    new_rr.name
           , value:     new_rr.target
           , priority:  show priority
           , port:      show port
           , weight:    show weight
           -- , protocol:  protocol
           }
    _, _, _ -> Nothing

fromLocalSimpleRRRepresentationToResourceRecord :: SimpleRR () -> ResourceRecord
fromLocalSimpleRRRepresentationToResourceRecord form
  = { rrtype:       form.t
    , rrid:         form.id
    , name:         form.domain
    , ttl:          fromMaybe 3600 $ fromString form.ttl
    , target:       form.value
    , readonly:     false
    , priority:     Nothing
    , port:         Nothing
    , protocol:     Nothing
    , weight:       Nothing
    , mname:        Nothing
    , rname:        Nothing
    , serial:       Nothing
    , refresh:      Nothing
    , retry:        Nothing
    , expire:       Nothing
    , minttl:       Nothing
    }

fromLocalMXRRRepresentationToResourceRecord :: MXRR () -> ResourceRecord
fromLocalMXRRRepresentationToResourceRecord form
  = { rrtype:       form.t
    , rrid:         form.id
    , name:         form.domain
    , ttl:          fromMaybe 3600 $ fromString form.ttl
    , target:       form.value
    , readonly:     false
    , priority:     Just $ fromMaybe 10 $ fromString form.priority
    , port:         Nothing
    , protocol:     Nothing
    , weight:       Nothing
    , mname:        Nothing
    , rname:        Nothing
    , serial:       Nothing
    , refresh:      Nothing
    , retry:        Nothing
    , expire:       Nothing
    , minttl:       Nothing
    }

fromLocalSRVRRepresentationToResourceRecord :: SRVRR () -> ResourceRecord
fromLocalSRVRRepresentationToResourceRecord form
  = { rrtype:       form.t
    , rrid:         form.id
    , name:         form.domain
    , ttl:          fromMaybe 3600 $ fromString form.ttl
    , target:       form.value
    , readonly:     false
    , priority:     Just $ fromMaybe 10 $ fromString form.priority
    , port:         Just $ fromMaybe 10 $ fromString form.port
    , protocol:     Just "" -- TODO: 'protocol' seems to have been forgotten.
    , weight:       Just $ fromMaybe 10 $ fromString form.weight
    , mname:        Nothing
    , rname:        Nothing
    , serial:       Nothing
    , refresh:      Nothing
    , retry:        Nothing
    , expire:       Nothing
    , minttl:       Nothing
    }

getNewID :: State -> Int
getNewID state = (_ + 1)
  $ Foldable.foldl max 0 [ maxIDrr
                         , maxIDmxrr
                         , maxIDsrvrr
                         ]

  where
    maxIDrr    = Foldable.foldl max 0 $ map _.id state._srr
    maxIDmxrr  = Foldable.foldl max 0 $ map _.id state._mxrr
    maxIDsrvrr = Foldable.foldl max 0 $ map _.id state._srvrr