1283 lines
54 KiB
Plaintext
1283 lines
54 KiB
Plaintext
-- | `App.ZoneInterface` provides an interface to display and modify a DNS zone.
|
|
-- |
|
|
-- | This interface enables to:
|
|
-- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
|
|
-- | - provide dedicated interfaces for SPF and DKIM (TODO: 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.
|
|
-- |
|
|
-- | 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: 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, class Show
|
|
, (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#), (=<<), (-))
|
|
|
|
import Data.Generic.Rep (class Generic)
|
|
import Data.Show.Generic (genericShow)
|
|
|
|
import Web.HTML (window) as HTML
|
|
import Web.HTML.Window (sessionStorage) as Window
|
|
import Web.Storage.Storage as Storage
|
|
|
|
import App.Validation.Email as Email
|
|
|
|
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 (toLower)
|
|
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
|
|
, qualifiers
|
|
, mechanism_types, qualifier_types, modifier_types)
|
|
import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
|
|
import App.Type.DKIM as DKIM
|
|
import App.Type.DMARC as DMARC
|
|
|
|
import App.DisplayErrors (error_to_paragraph, show_error_email)
|
|
|
|
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`.
|
|
|
|
data Query a
|
|
= MessageReceived DNSManager.AnswerMessage 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
|
|
|
|
-- | Reset the different temporary values, such as SPF mechanisms or DMARC mail entry.
|
|
| ResetTemporaryValues
|
|
|
|
-- | 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
|
|
|
|
-- | 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
|
|
|
|
data RRModal
|
|
= NoModal
|
|
| NewRRModal AcceptedRRTypes
|
|
| UpdateRRModal
|
|
| RemoveRRModal RRId
|
|
|
|
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
|
|
"DMARC" -> Just DMARC
|
|
_ -> Nothing
|
|
|
|
data Tab = Zone | TheBasics | TokenExplanation
|
|
derive instance eqTab :: Eq Tab
|
|
derive instance genericTab :: Generic Tab _
|
|
instance showTab :: Show Tab where
|
|
show = genericShow
|
|
|
|
type State =
|
|
{ _domain :: String
|
|
|
|
-- 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
|
|
, _dmarc_mail_errors :: Array Email.Error
|
|
|
|
-- SPF details.
|
|
, spf_mechanism_q :: String
|
|
, spf_mechanism_t :: String
|
|
, spf_mechanism_v :: String
|
|
, spf_modifier_t :: String
|
|
, spf_modifier_v :: String
|
|
|
|
, dmarc_mail :: String
|
|
, dmarc_mail_limit :: Maybe Int
|
|
|
|
, dkim :: DKIM.DKIM
|
|
, dmarc :: DMARC.DMARC
|
|
|
|
, _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 =
|
|
{ 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: []
|
|
, _dmarc_mail_errors: []
|
|
, _zonefile: Nothing
|
|
|
|
, spf_mechanism_q: "pass"
|
|
, spf_mechanism_t: "a"
|
|
, spf_mechanism_v: ""
|
|
, spf_modifier_t: "redirect"
|
|
, spf_modifier_v: ""
|
|
|
|
, dkim: DKIM.emptyDKIMRR
|
|
, dmarc: DMARC.emptyDMARCRR
|
|
|
|
, dmarc_mail: ""
|
|
, dmarc_mail_limit: Nothing
|
|
|
|
, 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
|
|
TheBasics -> Explanations.basics
|
|
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 TheBasics) "The basics 🧠" (ChangeTab TheBasics)
|
|
, Bulma.tab_entry (is_tab_active TokenExplanation) "Tokens? 🤨" (ChangeTab TokenExplanation)
|
|
]
|
|
is_tab_active tab = state.current_tab == tab
|
|
|
|
render_zone =
|
|
case state.rr_modal of
|
|
RemoveRRModal rr_id -> modal_rr_delete rr_id
|
|
NewRRModal _ -> render_current_rr_modal
|
|
UpdateRRModal -> render_current_rr_modal
|
|
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)
|
|
"DMARC" -> template modal_content_dmarc (foot_content DMARC)
|
|
_ -> 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)
|
|
, case state._currentRR.rrtype of
|
|
"AAAA" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "2001:db8::1" (updateForm Field_Target) state._currentRR.target
|
|
"TXT" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Your text" "blah blah" (updateForm Field_Target) state._currentRR.target
|
|
"CNAME" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "www" (updateForm Field_Target) state._currentRR.target
|
|
"NS" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "ns0.example.com." (updateForm Field_Target) state._currentRR.target
|
|
_ -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "198.51.100.5" (updateForm Field_Target) state._currentRR.target
|
|
] <> 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)
|
|
, Bulma.box_input ("targetMX") "Target" "www"
|
|
(updateForm Field_Target)
|
|
state._currentRR.target
|
|
, Bulma.box_input ("priorityMX") "Priority" "10"
|
|
(updateForm Field_Priority)
|
|
(maybe "" show state._currentRR.priority)
|
|
]
|
|
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
|
|
, Bulma.box_input ("protocolSRV") "Protocol" "tcp"
|
|
(updateForm Field_Protocol)
|
|
(fromMaybe "tcp" state._currentRR.protocol)
|
|
, Bulma.box_input ("targetSRV") "Where the server is" "www"
|
|
(updateForm Field_Target)
|
|
state._currentRR.target
|
|
, Bulma.box_input ("portSRV") "Port of the service" "5061"
|
|
(updateForm Field_Port)
|
|
(maybe "" show state._currentRR.port)
|
|
, Bulma.box_input ("prioritySRV") "Priority" "10"
|
|
(updateForm Field_Priority)
|
|
(maybe "" show state._currentRR.priority)
|
|
, Bulma.box_input ("ttlSRV") "TTL" "600"
|
|
(updateForm Field_TTL)
|
|
(show state._currentRR.ttl)
|
|
, Bulma.box_input ("weightSRV") "Weight" "100"
|
|
(updateForm Field_Weight)
|
|
(maybe "" show state._currentRR.weight)
|
|
]
|
|
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)
|
|
--, 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
|
|
, Bulma.hr
|
|
, Bulma.box
|
|
[ Bulma.h3 "Current mechanisms"
|
|
, maybe (Bulma.p "You don't have any mechanism.") display_mechanisms state._currentRR.mechanisms
|
|
, 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
|
|
, Bulma.btn "Add a mechanism" SPF_Mechanism_Add
|
|
]
|
|
, Bulma.hr
|
|
, Bulma.box
|
|
[ Bulma.h3 "Current modifiers"
|
|
, maybe (Bulma.p "You don't have any modifier.") display_modifiers state._currentRR.modifiers
|
|
, 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
|
|
, Bulma.btn "Add a modifier" 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)
|
|
, Bulma.hr
|
|
, Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
|
|
, Bulma.selection_field "idDKIMSignature" "Signature algo"
|
|
DKIM_sign_algo
|
|
(map show DKIM.sign_algos)
|
|
(show $ fromMaybe DKIM.RSA state.dkim.k)
|
|
, Bulma.selection_field "idDKIMHash" "Hash algo"
|
|
DKIM_hash_algo
|
|
(map show DKIM.hash_algos)
|
|
(show $ fromMaybe DKIM.SHA256 state.dkim.h)
|
|
, Bulma.box_input "pkDKIM" "Public Key" "Your public key, such as \"MIIBIjANBgqh...\"" DKIM_pubkey state.dkim.p
|
|
, Bulma.box_input "noteDKIM" "Note" "Note for fellow administrators." DKIM_note (fromMaybe "" state.dkim.n)
|
|
]
|
|
|
|
modal_content_dmarc :: Array (HH.HTML w Action)
|
|
modal_content_dmarc =
|
|
[ Bulma.div_content [Bulma.explanation Explanations.dmarc_introduction]
|
|
, render_errors
|
|
, Bulma.input_with_side_text "domainDMARC" "Name" "_dmarc"
|
|
(updateForm Field_Domain)
|
|
state._currentRR.name
|
|
display_domain_side
|
|
, Bulma.box_input "ttlDMARC" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl)
|
|
|
|
, Bulma.hr
|
|
, Bulma.div_content [Bulma.explanation Explanations.dmarc_policy]
|
|
, Bulma.selection_field' "idDMARCPolicy" "Policy" DMARC_policy
|
|
(A.zip DMARC.policies_txt DMARC.policies_raw)
|
|
(show state.dmarc.p)
|
|
, Bulma.div_content [Bulma.explanation Explanations.dmarc_sp_policy]
|
|
, Bulma.selection_field' "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
|
|
(zip_nullable DMARC.policies_txt_with_null DMARC.policies_raw)
|
|
(maybe "-" show state.dmarc.sp)
|
|
|
|
, Bulma.hr
|
|
, Bulma.div_content [Bulma.explanation Explanations.dmarc_adkim]
|
|
, Bulma.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim
|
|
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
|
|
(maybe "-" show state.dmarc.adkim)
|
|
, Bulma.div_content [Bulma.explanation Explanations.dmarc_aspf]
|
|
, Bulma.selection_field' "idDMARCaspf" "Consistency Policy for SPF" DMARC_aspf
|
|
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
|
|
(maybe "-" show state.dmarc.aspf)
|
|
|
|
, Bulma.hr
|
|
, Bulma.div_content [Bulma.explanation Explanations.dmarc_pct]
|
|
, Bulma.box_input "idDMARCpct" "Sample rate [0..100]" "100" DMARC_pct (maybe "100" show state.dmarc.pct)
|
|
|
|
, Bulma.hr
|
|
, Bulma.selection_field' "idDMARCfo" "When to send a report" DMARC_fo
|
|
(zip_nullable DMARC.report_occasions_txt DMARC.report_occasions_raw)
|
|
(maybe "-" show state.dmarc.fo)
|
|
|
|
, Bulma.hr
|
|
, Bulma.div_content [Bulma.explanation Explanations.dmarc_contact]
|
|
, maybe (Bulma.p "There is no address to send aggregated reports to.")
|
|
(display_dmarc_mail_addresses "Addresses to contact for aggregated reports" DMARC_remove_rua) state.dmarc.rua
|
|
, maybe (Bulma.p "There is no address to send detailed reports to.")
|
|
(display_dmarc_mail_addresses "Addresses to contact for detailed reports" DMARC_remove_ruf) state.dmarc.ruf
|
|
|
|
, Bulma.hr
|
|
, render_dmarc_mail_errors
|
|
, Bulma.box_input "idDMARCmail" "Address to contact" "admin@example.com" DMARC_mail state.dmarc_mail
|
|
, Bulma.box_input "idDMARCmaillimit" "Report size limit (in KB)" "2000" DMARC_mail_limit (maybe "0" show state.dmarc_mail_limit)
|
|
, Bulma.level [ Bulma.btn "New address for aggregated report" DMARC_rua_Add
|
|
, Bulma.btn "New address for specific report" DMARC_ruf_Add
|
|
] []
|
|
|
|
, Bulma.hr
|
|
, Bulma.div_content [Bulma.explanation Explanations.dmarc_ri]
|
|
, Bulma.box_input "idDMARCri" "Report interval (in seconds)" "86400" DMARC_ri (maybe "0" show state.dmarc.ri)
|
|
]
|
|
|
|
render_dmarc_mail_errors
|
|
= if A.length state._dmarc_mail_errors > 0
|
|
then Bulma.notification_danger_block'
|
|
$ [ Bulma.h3 "Invalid mail 😥" ] <> map (Bulma.p <<< show_error_email) state._dmarc_mail_errors
|
|
else HH.div_ [ ]
|
|
|
|
display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
|
|
newtokenbtn = Bulma.btn (maybe "🏁 Ask for a token" (\_ -> "🏁 Ask for a new token") state._currentRR.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 t_ <> " resource record"
|
|
UpdateRRModal -> "Update " <> state._currentRR.rrtype <> " Resource Record"
|
|
RemoveRRModal rr_id -> "Error: should display removal modal instead (for RR " <> show rr_id <> ")"
|
|
foot = foot_ <> [Bulma.cancel_button CancelModal]
|
|
|
|
zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String)
|
|
zip_nullable txt raw = A.zip txt ([""] <> raw)
|
|
|
|
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 = [] }
|
|
H.modify_ _ { _dmarc_mail_errors = [] }
|
|
handleAction $ ResetTemporaryValues
|
|
|
|
-- | Create the RR modal.
|
|
DeleteRRModal rr_id -> do
|
|
H.modify_ _ { rr_modal = RemoveRRModal rr_id }
|
|
|
|
-- | Change the current tab.
|
|
ChangeTab new_tab -> do
|
|
-- Store the current tab we are on and restore it when we reload.
|
|
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
|
H.liftEffect $ Storage.setItem "current-zone-tab" (show new_tab) sessionstorage
|
|
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 }
|
|
"DMARC" -> H.modify_ _ { dmarc = fromMaybe DMARC.emptyDMARCRR rr.dmarc }
|
|
_ -> 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 = "" }
|
|
default_rr_DMARC = emptyRR { rrtype = "DMARC", name = "_dmarc", 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 }
|
|
DMARC -> H.modify_ _ { _currentRR = default_rr_DMARC }
|
|
|
|
-- | 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
|
|
|
|
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
|
old_tab <- H.liftEffect $ Storage.getItem "current-zone-tab" sessionstorage
|
|
case old_tab of
|
|
Nothing -> pure unit
|
|
Just current_tab -> case current_tab of
|
|
"Zone" -> handleAction $ ChangeTab Zone
|
|
"TheBasics" -> handleAction $ ChangeTab TheBasics
|
|
"TokenExplanation" -> handleAction $ ChangeTab TokenExplanation
|
|
_ -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab
|
|
|
|
-- | 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 } }
|
|
DMARC -> H.modify_ \state -> state { _currentRR { dmarc = Just state.dmarc } }
|
|
_ -> 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 = []
|
|
, _dmarc_mail_errors = []
|
|
, dkim = DKIM.emptyDKIMRR
|
|
, dmarc = DMARC.emptyDMARCRR
|
|
}
|
|
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
|
|
H.modify_ _ { _zonefile = Nothing }
|
|
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 } }
|
|
"DMARC" -> H.modify_ _ { _currentRR { dmarc = Just state0.dmarc } }
|
|
_ -> 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 = [], _dmarc_mail_errors = [] }
|
|
handleAction $ SaveRR rr
|
|
|
|
ResetTemporaryValues -> do
|
|
H.modify_ _ { spf_mechanism_q = "pass"
|
|
, spf_mechanism_t = "a"
|
|
, spf_mechanism_v = ""
|
|
, spf_modifier_t = "redirect"
|
|
, spf_modifier_v = ""
|
|
, dmarc_mail = ""
|
|
, dmarc_mail_limit = Nothing
|
|
, _dmarc_mail_errors = []
|
|
}
|
|
|
|
SaveRR rr -> do
|
|
state <- H.get
|
|
H.raise $ Log $ SystemLog $ "Updating RR " <> show rr.rrid
|
|
H.modify_ _ { _zonefile = Nothing }
|
|
message <- H.liftEffect
|
|
$ DNSManager.serialize
|
|
$ DNSManager.MkUpdateRR { domain: state._domain, rr: rr }
|
|
H.raise $ MessageToSend message
|
|
handleAction $ ResetTemporaryValues
|
|
|
|
RemoveRR rr_id -> do
|
|
{ _domain } <- H.get
|
|
H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
|
|
H.modify_ _ { _zonefile = Nothing }
|
|
-- 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 = 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 }}
|
|
handleAction $ ResetTemporaryValues
|
|
|
|
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 }}
|
|
handleAction $ ResetTemporaryValues
|
|
|
|
DMARC_mail v -> H.modify_ _ { dmarc_mail = v }
|
|
DMARC_mail_limit v -> H.modify_ _ { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v }
|
|
DMARC_ri v -> H.modify_ _ { dmarc { ri = fromString v } }
|
|
DMARC_rua_Add -> do
|
|
state <- H.get
|
|
case Email.email state.dmarc_mail of
|
|
Left errors -> H.modify_ _ { _dmarc_mail_errors = errors }
|
|
Right _ -> do
|
|
let current_ruas = fromMaybe [] state.dmarc.rua
|
|
dmarc_mail = state.dmarc_mail
|
|
dmarc_mail_limit = state.dmarc_mail_limit
|
|
new_list = current_ruas <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
|
|
H.modify_ _ { dmarc { rua = Just new_list }}
|
|
handleAction $ ResetTemporaryValues
|
|
|
|
DMARC_ruf_Add -> do
|
|
state <- H.get
|
|
case Email.email state.dmarc_mail of
|
|
Left errors -> H.modify_ _ { _dmarc_mail_errors = errors }
|
|
Right _ -> do
|
|
let current_rufs = fromMaybe [] state.dmarc.ruf
|
|
dmarc_mail = state.dmarc_mail
|
|
dmarc_mail_limit = state.dmarc_mail_limit
|
|
new_list = current_rufs <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
|
|
H.modify_ _ { dmarc { ruf = Just new_list } }
|
|
handleAction $ ResetTemporaryValues
|
|
|
|
DMARC_remove_rua i -> do
|
|
state <- H.get
|
|
let current_ruas = case state._currentRR.dmarc of
|
|
Nothing -> []
|
|
Just dmarc -> fromMaybe [] dmarc.rua
|
|
new_value = case (remove_id i $ attach_id 0 current_ruas) of
|
|
[] -> Nothing
|
|
v -> Just v
|
|
new_dmarc = case state._currentRR.dmarc of
|
|
Nothing -> DMARC.emptyDMARCRR { rua = new_value }
|
|
Just dmarc -> dmarc { rua = new_value }
|
|
H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
|
|
|
|
DMARC_remove_ruf i -> do
|
|
state <- H.get
|
|
let current_rufs = case state._currentRR.dmarc of
|
|
Nothing -> []
|
|
Just dmarc -> fromMaybe [] dmarc.ruf
|
|
new_value = case (remove_id i $ attach_id 0 current_rufs) of
|
|
[] -> Nothing
|
|
v -> Just v
|
|
new_dmarc = case state._currentRR.dmarc of
|
|
Nothing -> DMARC.emptyDMARCRR { ruf = new_value }
|
|
Just dmarc -> dmarc { ruf = new_value }
|
|
H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
|
|
|
|
DMARC_policy v -> H.modify_ _ { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } }
|
|
DMARC_sp_policy v -> H.modify_ _ { dmarc { sp = DMARC.policies A.!! (v - 1) } }
|
|
DMARC_adkim v -> H.modify_ _ { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } }
|
|
DMARC_aspf v -> H.modify_ _ { dmarc { aspf = DMARC.consistency_policies A.!! (v - 1) } }
|
|
DMARC_pct v -> H.modify_ _ { dmarc { pct = Just $ fromMaybe 100 (fromString v) } }
|
|
DMARC_fo v -> H.modify_ _ { dmarc { fo = DMARC.report_occasions A.!! (v - 1) } }
|
|
|
|
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)
|
|
|
|
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_dmarc [] Bulma.dmarc_table_header table_content all_dmarc_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"
|
|
all_dmarc_rr = all_XX_rr "DMARC"
|
|
|
|
tag_soa = tags [tag_ro "SOA", tag_ro "read only"]
|
|
tag_basic = tags [tag "Basic Resource Records (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_dmarc = tags [tag "DMARC"]
|
|
tag_basic_ro = tags [tag_ro "Basic Resource Records", 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 "" show dkim.h ]
|
|
, HH.td_ [ Bulma.p $ maybe "" show dkim.k ]
|
|
, HH.td_ [ Bulma.p $ CP.take 20 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." ]
|
|
"DMARC" ->
|
|
[ HH.td_ [ Bulma.p rr.name ]
|
|
, HH.td_ [ Bulma.p $ show rr.ttl ]
|
|
] <> case rr.dmarc of
|
|
Just dmarc ->
|
|
[
|
|
-- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DMARC1.
|
|
HH.td_ [ Bulma.p $ show dmarc.p ]
|
|
, HH.td_ [ Bulma.p $ maybe "" show dmarc.sp ]
|
|
, HH.td_ [ Bulma.p $ maybe "" show dmarc.adkim ]
|
|
, HH.td_ [ Bulma.p $ maybe "" show dmarc.aspf ]
|
|
, HH.td_ [ Bulma.p $ maybe "" show dmarc.pct ]
|
|
, HH.td_ [ Bulma.p $ maybe "" show dmarc.fo ]
|
|
, HH.td_ [ Bulma.p $ maybe "" show dmarc.ri ]
|
|
-- TODO? rua & ruf
|
|
-- , HH.td_ [ ] -- For now, assume AFRF.
|
|
, 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 DMARC 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 [] = Bulma.p "You don't have any mechanism."
|
|
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 [] = Bulma.p "You don't have any modifier."
|
|
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) ]
|
|
]
|
|
|
|
display_dmarc_mail_addresses :: forall w. String -> (Int -> Action) -> Array DMARC.DMARCURI -> HH.HTML w Action
|
|
display_dmarc_mail_addresses t f ms =
|
|
Bulma.box_ C.has_background_warning_light
|
|
[ Bulma.h3 t
|
|
, Bulma.table [] [ Bulma.dmarc_dmarcuri_table_header, HH.tbody_ $ map render_dmarcuri_row $ attach_id 0 ms] ]
|
|
where
|
|
render_dmarcuri_row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w Action
|
|
render_dmarcuri_row (Tuple i m) = HH.tr_
|
|
[ HH.td_ [ Bulma.p m.mail ]
|
|
, HH.td_ [ Bulma.p $ maybe "(no size limit)" show m.limit ]
|
|
, HH.td_ [ Bulma.alert_btn "x" (f 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"
|
|
-- 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 "DMARC" (CreateNewRRModal 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 = toLower 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 -> []
|