Compiles again, yay
This commit is contained in:
parent
57e212420c
commit
fc21cee4ae
3 changed files with 162 additions and 154 deletions
|
|
@ -64,6 +64,8 @@ import App.Type.LogMessage (LogMessage(..))
|
|||
import App.Message.DNSManagerDaemon as DNSManager
|
||||
import App.Validation.DNS as Validation
|
||||
|
||||
import App.Type.RRForm
|
||||
|
||||
-- | `App.Page.Zone` can send messages through websocket interface
|
||||
-- | connected to dnsmanagerd. See `App.WS`.
|
||||
-- |
|
||||
|
|
@ -150,14 +152,15 @@ data Action
|
|||
-- | Modification of any attribute of the current RR.
|
||||
| RRUpdate RRUpdateValue
|
||||
|
||||
-- | Ask a (new) token for a resource record.
|
||||
| NewToken RRId
|
||||
|
||||
data Tab = Zone | TheBasics | TokenExplanation
|
||||
derive instance eqTab :: Eq Tab
|
||||
derive instance genericTab :: Generic Tab _
|
||||
instance showTab :: Show Tab where
|
||||
show = genericShow
|
||||
|
||||
import App.Type.RRForm
|
||||
|
||||
-- FIXME: this state is a mess.
|
||||
type State =
|
||||
{ _domain :: String
|
||||
|
|
@ -227,7 +230,7 @@ render state
|
|||
is_tab_active tab = state.current_tab == tab
|
||||
|
||||
call_to_current_rr_modal
|
||||
= Modal.current_rr_modal state._domain state._currentRR state.rr_modal
|
||||
= Modal.current_rr_modal state._domain state._rr_form state.rr_modal
|
||||
UpdateCurrentRR NewToken RRUpdate ValidateRR ValidateLocal CancelModal
|
||||
|
||||
render_zone =
|
||||
|
|
@ -243,7 +246,7 @@ render state
|
|||
, Table.resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal NewToken
|
||||
, Web.hr
|
||||
, render_new_records state
|
||||
, render_zonefile state._zonefile
|
||||
, render_zonefile state._rr_form._zonefile
|
||||
]
|
||||
|
||||
sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l))
|
||||
|
|
@ -259,9 +262,11 @@ 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_ _ { _errors = [] }
|
||||
H.modify_ _ { _dmarc_mail_errors = [] }
|
||||
H.modify_ _ { rr_modal = NoModal
|
||||
, _rr_form { _errors = []
|
||||
, _dmarc_mail_errors = []
|
||||
}
|
||||
}
|
||||
handleAction $ ResetTemporaryValues
|
||||
|
||||
-- | Create the RR modal.
|
||||
|
|
@ -287,8 +292,8 @@ handleAction = case _ of
|
|||
Just rr -> do
|
||||
H.modify_ _ { _rr_form { _rr = rr } }
|
||||
_ <- case rr.rrtype of
|
||||
"DKIM" -> H.modify_ _ { dkim = fromMaybe DKIM.emptyDKIMRR rr.dkim }
|
||||
"DMARC" -> H.modify_ _ { dmarc = fromMaybe DMARC.emptyDMARCRR rr.dmarc }
|
||||
"DKIM" -> H.modify_ _ { _rr_form { tmp { dkim = fromMaybe DKIM.emptyDKIMRR rr.dkim } }}
|
||||
"DMARC" -> H.modify_ _ { _rr_form { tmp { dmarc = fromMaybe DMARC.emptyDMARCRR rr.dmarc } }}
|
||||
_ -> pure unit
|
||||
H.modify_ _ { rr_modal = UpdateRRModal }
|
||||
|
||||
|
|
@ -323,8 +328,8 @@ handleAction = case _ of
|
|||
-- TODO: should the code design change? Would the code be simplified by working only on _rr_form._rr.dkim?
|
||||
-- Since _rr_form._rr.dkim isn't modified directly, it is copied from `State`.
|
||||
_ <- case t of
|
||||
DKIM -> H.modify_ \state -> state { _rr_form { _rr { dkim = Just state.dkim } } }
|
||||
DMARC -> H.modify_ \state -> state { _rr_form { _rr { dmarc = Just state.dmarc } } }
|
||||
DKIM -> H.modify_ \state -> state { _rr_form { _rr { dkim = Just state._rr_form.tmp.dkim } } }
|
||||
DMARC -> H.modify_ \state -> state { _rr_form { _rr { dmarc = Just state._rr_form.tmp.dmarc } } }
|
||||
_ -> pure unit
|
||||
|
||||
state <- H.get
|
||||
|
|
@ -332,12 +337,14 @@ handleAction = case _ of
|
|||
Left actual_errors -> do
|
||||
-- H.raise $ Log $ ErrorLog $ "Cannot add this " <> show t <> " resource record, some errors occured in the record:"
|
||||
-- loopE (\v -> H.raise $ Log $ ErrorLog $ "==> " <> show_error v) actual_errors
|
||||
H.modify_ _ { _errors = actual_errors }
|
||||
H.modify_ _ { _rr_form { _errors = actual_errors } }
|
||||
Right newrr -> do
|
||||
H.modify_ _ { _errors = []
|
||||
, _dmarc_mail_errors = []
|
||||
, dkim = DKIM.emptyDKIMRR
|
||||
, dmarc = DMARC.emptyDMARCRR
|
||||
H.modify_ _ { _rr_form { _errors = []
|
||||
, _dmarc_mail_errors = []
|
||||
, tmp { dkim = DKIM.emptyDKIMRR
|
||||
, dmarc = DMARC.emptyDMARCRR
|
||||
}
|
||||
}
|
||||
}
|
||||
handleAction $ AddRR t newrr
|
||||
handleAction CancelModal
|
||||
|
|
@ -347,7 +354,7 @@ handleAction = case _ of
|
|||
AddRR t newrr -> do
|
||||
state <- H.get
|
||||
H.raise $ Log $ SystemLog $ "Add new " <> show t
|
||||
H.modify_ _ { _zonefile = Nothing }
|
||||
H.modify_ _ { _rr_form { _zonefile = Nothing } }
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
|
||||
|
|
@ -367,33 +374,36 @@ handleAction = case _ of
|
|||
-- Since _rr_form._rr.dkim isn't modified directly, it is copied from `State`.
|
||||
state0 <- H.get
|
||||
_ <- case state0._rr_form._rr.rrtype of
|
||||
"DKIM" -> H.modify_ _ { _rr_form { _rr { dkim = Just state0.dkim } } }
|
||||
"DMARC" -> H.modify_ _ { _rr_form { _rr { dmarc = Just state0.dmarc } } }
|
||||
"DKIM" -> H.modify_ _ { _rr_form { _rr { dkim = Just state0._rr_form.tmp.dkim } } }
|
||||
"DMARC" -> H.modify_ _ { _rr_form { _rr { dmarc = Just state0._rr_form.tmp.dmarc } } }
|
||||
_ -> pure unit
|
||||
|
||||
state <- H.get
|
||||
case Validation.validation state._rr_form._rr of
|
||||
Left actual_errors -> do
|
||||
H.modify_ _ { _errors = actual_errors }
|
||||
H.modify_ _ { _rr_form { _errors = actual_errors } }
|
||||
Right rr -> do
|
||||
H.modify_ _ { _errors = [], _dmarc_mail_errors = [] }
|
||||
H.modify_ _ { _rr_form { _errors = [], _dmarc_mail_errors = [] } }
|
||||
handleAction $ SaveRR rr
|
||||
|
||||
ResetTemporaryValues -> do
|
||||
H.modify_ _ { _rr_form { tmp { spf { mechanism_q = "pass" } } }
|
||||
, _rr_form { tmp { spf { mechanism_t = "a" } } }
|
||||
, _rr_form { tmp { spf { mechanism_v = "" } } }
|
||||
, _rr_form { tmp { spf { modifier_t = "redirect" } } }
|
||||
, _rr_form { tmp { spf { modifier_v = "" } } }
|
||||
, dmarc_mail = ""
|
||||
, dmarc_mail_limit = Nothing
|
||||
, _dmarc_mail_errors = []
|
||||
H.modify_ _ { _rr_form { tmp { spf { mechanism_q = "pass"
|
||||
, mechanism_t = "a"
|
||||
, mechanism_v = ""
|
||||
, modifier_t = "redirect"
|
||||
, modifier_v = ""
|
||||
}
|
||||
, dmarc_mail = ""
|
||||
, dmarc_mail_limit = Nothing
|
||||
}
|
||||
, _dmarc_mail_errors = []
|
||||
}
|
||||
}
|
||||
|
||||
SaveRR rr -> do
|
||||
state <- H.get
|
||||
H.raise $ Log $ SystemLog $ "Updating resource record " <> show rr.rrid
|
||||
H.modify_ _ { _zonefile = Nothing }
|
||||
H.modify_ _ { _rr_form { _zonefile = Nothing } }
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkUpdateRR { domain: state._domain, rr: rr }
|
||||
|
|
@ -403,7 +413,7 @@ handleAction = case _ of
|
|||
RemoveRR rr_id -> do
|
||||
{ _domain } <- H.get
|
||||
H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
|
||||
H.modify_ _ { _zonefile = Nothing }
|
||||
H.modify_ _ { _rr_form { _zonefile = Nothing } }
|
||||
-- Send a removal message.
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
|
|
@ -429,115 +439,15 @@ handleAction = case _ of
|
|||
$ DNSManager.MkAskGeneratedZoneFile { domain: state._domain }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
CAA_tag v -> do
|
||||
RRUpdate value_to_update -> do
|
||||
state <- H.get
|
||||
let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v
|
||||
new_value = case new_tag of
|
||||
CAA.Issue -> "letsencrypt.org"
|
||||
CAA.ContactEmail -> "contact@example.com"
|
||||
CAA.ContactPhone -> "0203040506"
|
||||
_ -> ""
|
||||
new_caa = (fromMaybe default_caa state._rr_form._rr.caa) { tag = new_tag, value = new_value }
|
||||
H.modify_ _ { _rr_form { _rr { caa = Just new_caa } } }
|
||||
|
||||
SRV_Protocol v -> H.modify_ _ { _rr_form { _rr { protocol = RR.srv_protocols A.!! v } } }
|
||||
|
||||
SPF_Mechanism_q v -> H.modify_ _ { _rr_form { tmp { spf { mechanism_q = maybe "pass" id $ qualifier_types A.!! v }}}
|
||||
SPF_Mechanism_t v -> H.modify_ _ { _rr_form { tmp { spf { mechanism_t = maybe "a" id $ mechanism_types A.!! v }}}
|
||||
SPF_Mechanism_v v -> H.modify_ _ { _rr_form { tmp { spf { mechanism_v = v }}}
|
||||
SPF_Modifier_t v -> H.modify_ _ { _rr_form { tmp { spf { modifier_t = maybe "redirect" id $ modifier_types A.!! v }}}
|
||||
SPF_Modifier_v v -> H.modify_ _ { _rr_form { tmp { spf { modifier_v = v }}}
|
||||
SPF_Qualifier v -> H.modify_ _ { _rr_form { _rr { q = qualifiers A.!! v } }
|
||||
SPF_remove_mechanism i ->
|
||||
H.modify_ \s -> s { _rr_form { _rr { mechanisms = case s._rr_form._rr.mechanisms of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} } }
|
||||
SPF_remove_modifier i ->
|
||||
H.modify_ \s -> s { _rr_form { _rr { modifiers = case s._rr_form._rr.modifiers of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} } }
|
||||
|
||||
SPF_Mechanism_Add -> do
|
||||
state <- H.get
|
||||
let m = state._rr_form._rr.mechanisms
|
||||
m_q = state._rr_form.tmp.spf.mechanism_q
|
||||
m_t = state._rr_form.tmp.spf.mechanism_t
|
||||
m_v = state._rr_form.tmp.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_ _ { _rr_form { _rr { mechanisms = new_value }}}
|
||||
handleAction $ ResetTemporaryValues
|
||||
|
||||
SPF_Modifier_Add -> do
|
||||
state <- H.get
|
||||
let m = state._rr_form._rr.modifiers
|
||||
m_t = state._rr_form.tmp.spf.modifier_t
|
||||
m_v = state._rr_form.tmp.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_ _ { _rr_form._rr { 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 = fromMaybe [] state.dmarc.rua
|
||||
new_value = case (remove_id i $ attach_id 0 current_ruas) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
H.modify_ \s -> s { dmarc { rua = new_value } }
|
||||
|
||||
DMARC_remove_ruf i -> do
|
||||
state <- H.get
|
||||
let current_rufs = fromMaybe [] state.dmarc.ruf
|
||||
new_value = case (remove_id i $ attach_id 0 current_rufs) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
H.modify_ \s -> s { dmarc { ruf = new_value } }
|
||||
|
||||
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 } }
|
||||
H.modify_ _ { _rr_form = update_form state._rr_form value_to_update }
|
||||
case value_to_update of
|
||||
SPF_Mechanism_Add -> handleAction $ ResetTemporaryValues
|
||||
SPF_Modifier_Add -> handleAction $ ResetTemporaryValues
|
||||
DMARC_rua_Add -> handleAction $ ResetTemporaryValues
|
||||
DMARC_ruf_Add -> handleAction $ ResetTemporaryValues
|
||||
_ -> pure unit
|
||||
|
||||
where
|
||||
-- In case the `name` part of the resource record is empty replace it with the domain name.
|
||||
|
|
@ -563,7 +473,7 @@ handleQuery = case _ of
|
|||
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 }
|
||||
H.modify_ _ { _rr_form { _zonefile = Just response.zonefile } }
|
||||
(DNSManager.MkZone response) -> do
|
||||
add_entries response.zone.resources
|
||||
|
||||
|
|
|
|||
|
|
@ -35,8 +35,8 @@ import App.Type.ResourceRecord as RR
|
|||
|
||||
import App.DisplayErrors (error_to_paragraph, show_error_email)
|
||||
|
||||
type ActionCancelModal = forall i. i
|
||||
modal_rr_delete :: forall w i. Int -> (Int -> i) -> ActionCancelModal -> HH.HTML w i
|
||||
type ActionCancelModal i = i
|
||||
modal_rr_delete :: forall w i. Int -> (Int -> i) -> ActionCancelModal i -> HH.HTML w i
|
||||
modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting a resource record"
|
||||
[warning_message] [modal_delete_button, Web.cancel_button action_cancel_modal]
|
||||
where
|
||||
|
|
@ -50,16 +50,16 @@ modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting
|
|||
zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String)
|
||||
zip_nullable txt raw = A.zip txt ([""] <> raw)
|
||||
|
||||
type Domain = String
|
||||
type ActionUpdateForm = forall i. (Field.Field -> i)
|
||||
type ActionNewToken = forall i. (RRId -> i)
|
||||
type ActionUpdateRR = forall i. (RRUpdateValue -> i)
|
||||
type ActionValidateNewRR = forall i. (AcceptedRRTypes -> i)
|
||||
type ActionValidateLocalRR = forall i. i
|
||||
type Domain = String
|
||||
type ActionUpdateForm i = (Field.Field -> i)
|
||||
type ActionNewToken i = (RRId -> i)
|
||||
type ActionUpdateRR i = (RRUpdateValue -> i)
|
||||
type ActionValidateNewRR i = (AcceptedRRTypes -> i)
|
||||
type ActionValidateLocalRR i = i
|
||||
current_rr_modal :: forall w i.
|
||||
Domain -> RRForm -> RRModal
|
||||
-> ActionUpdateForm -> ActionNewToken
|
||||
-> ActionUpdateRR -> ActionValidateNewRR -> ActionValidateLocalRR -> ActionCancelModal
|
||||
-> ActionUpdateForm i -> ActionNewToken i
|
||||
-> ActionUpdateRR i -> ActionValidateNewRR i -> ActionValidateLocalRR i -> ActionCancelModal i
|
||||
-> HH.HTML w i
|
||||
current_rr_modal selected_domain form rr_modal
|
||||
action_update_form action_new_token
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
module App.Type.RRForm where
|
||||
|
||||
import Prelude
|
||||
import Utils
|
||||
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||
import App.Type.ResourceRecord
|
||||
import App.Type.DKIM as DKIM
|
||||
|
|
@ -14,6 +15,9 @@ import App.Type.CAA as CAA
|
|||
import App.Validation.Email as Email
|
||||
import App.Validation.DNS as Validation
|
||||
import App.Type.RRId
|
||||
import Data.Array as A
|
||||
import Data.Either
|
||||
import Data.Int (fromString)
|
||||
|
||||
-- | TMP: temporary stored values regarding specific records such as SPF,
|
||||
-- | DKIM and DMARC.
|
||||
|
|
@ -88,15 +92,13 @@ mkEmptyRRForm =
|
|||
}
|
||||
, dkim: DKIM.emptyDKIMRR
|
||||
, dmarc: DMARC.emptyDMARCRR
|
||||
, dmarc_mail: ""
|
||||
, dmarc_mail: ""
|
||||
, dmarc_mail_limit: Nothing
|
||||
}
|
||||
}
|
||||
|
||||
data RRUpdateValue
|
||||
-- | Ask a (new) token for a RR.
|
||||
= NewToken RRId
|
||||
| CAA_tag Int
|
||||
= CAA_tag Int
|
||||
| SRV_Protocol Int
|
||||
| SPF_Mechanism_q Int
|
||||
| SPF_Mechanism_t Int
|
||||
|
|
@ -147,3 +149,99 @@ data RRUpdateValue
|
|||
| DKIM_sign_algo Int
|
||||
| DKIM_pubkey String
|
||||
| DKIM_note String
|
||||
|
||||
update_form :: RRForm -> RRUpdateValue -> RRForm
|
||||
update_form form new_field_value =
|
||||
case new_field_value of
|
||||
CAA_tag v ->
|
||||
let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v
|
||||
new_value = case new_tag of
|
||||
CAA.Issue -> "letsencrypt.org"
|
||||
CAA.ContactEmail -> "contact@example.com"
|
||||
CAA.ContactPhone -> "0203040506"
|
||||
_ -> ""
|
||||
new_caa = (fromMaybe default_caa form._rr.caa) { tag = new_tag, value = new_value }
|
||||
in form { _rr { caa = Just new_caa } }
|
||||
|
||||
SRV_Protocol v -> form { _rr { protocol = RR.srv_protocols A.!! v } }
|
||||
SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ qualifier_types A.!! v }}}
|
||||
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ mechanism_types A.!! v }}}
|
||||
SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v }}}
|
||||
SPF_Modifier_t v -> form { tmp { spf { modifier_t = maybe "redirect" id $ modifier_types A.!! v }}}
|
||||
SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}}
|
||||
SPF_Qualifier v -> form { _rr { q = qualifiers A.!! v }}
|
||||
SPF_remove_mechanism i ->
|
||||
form { _rr { mechanisms = case form._rr.mechanisms of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} }
|
||||
SPF_remove_modifier i ->
|
||||
form { _rr { modifiers = case form._rr.modifiers of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} }
|
||||
|
||||
SPF_Mechanism_Add ->
|
||||
let m = form._rr.mechanisms
|
||||
m_q = form.tmp.spf.mechanism_q
|
||||
m_t = form.tmp.spf.mechanism_t
|
||||
m_v = form.tmp.spf.mechanism_v
|
||||
new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (to_mechanism m_q m_t m_v)
|
||||
new_value = case new_list_of_mechanisms of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { _rr { mechanisms = new_value }}
|
||||
|
||||
SPF_Modifier_Add ->
|
||||
let m = form._rr.modifiers
|
||||
m_t = form.tmp.spf.modifier_t
|
||||
m_v = form.tmp.spf.modifier_v
|
||||
new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (to_modifier m_t m_v)
|
||||
new_value = case new_list_of_modifiers of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { _rr { modifiers = new_value }}
|
||||
|
||||
DMARC_mail v -> form { tmp { dmarc_mail = v } }
|
||||
DMARC_mail_limit v -> form { tmp { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } }
|
||||
DMARC_ri v -> form { tmp { dmarc { ri = fromString v } } }
|
||||
DMARC_rua_Add ->
|
||||
case Email.email form.tmp.dmarc_mail of
|
||||
Left errors -> form { _dmarc_mail_errors = errors }
|
||||
Right _ ->
|
||||
let current_ruas = fromMaybe [] form.tmp.dmarc.rua
|
||||
new_list = current_ruas <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
|
||||
in form { tmp { dmarc { rua = Just new_list }}}
|
||||
|
||||
DMARC_ruf_Add ->
|
||||
case Email.email form.tmp.dmarc_mail of
|
||||
Left errors -> form { _dmarc_mail_errors = errors }
|
||||
Right _ ->
|
||||
let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
|
||||
new_list = current_rufs <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
|
||||
in form { tmp { dmarc { ruf = Just new_list }}}
|
||||
|
||||
DMARC_remove_rua i ->
|
||||
let current_ruas = fromMaybe [] form.tmp.dmarc.rua
|
||||
new_value = case (remove_id i $ attach_id 0 current_ruas) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { tmp { dmarc { rua = new_value } } }
|
||||
|
||||
DMARC_remove_ruf i ->
|
||||
let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
|
||||
new_value = case (remove_id i $ attach_id 0 current_rufs) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { tmp { dmarc { ruf = new_value } } }
|
||||
|
||||
DMARC_policy v -> form { tmp { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } }
|
||||
DMARC_sp_policy v -> form { tmp { dmarc { sp = DMARC.policies A.!! (v - 1) } } }
|
||||
DMARC_adkim v -> form { tmp { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } } }
|
||||
DMARC_aspf v -> form { tmp { dmarc { aspf = DMARC.consistency_policies A.!! (v - 1) } } }
|
||||
DMARC_pct v -> form { tmp { dmarc { pct = Just $ fromMaybe 100 (fromString v) } } }
|
||||
DMARC_fo v -> form { tmp { dmarc { fo = DMARC.report_occasions A.!! (v - 1) } } }
|
||||
DKIM_hash_algo v -> form { tmp { dkim { h = DKIM.hash_algos A.!! v } } }
|
||||
DKIM_sign_algo v -> form { tmp { dkim { k = DKIM.sign_algos A.!! v } } }
|
||||
DKIM_pubkey v -> form { tmp { dkim { p = v } } }
|
||||
DKIM_note v -> form { tmp { dkim { n = Just v } } }
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue