Baguette/dnsmanager-webclient
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix some warnings.

Browse source
This commit is contained in:
Philippe Pittoli 2025-05-05 19:37:54 +02:00
parent c9aee9943a
commit b21cebaf30
1 changed files with 29 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
src/App/Type/RRForm.purs
View file

@ -3,20 +3,18 @@
-- | FIXME: this state is messy AF and should be replaced.
module App.Type.RRForm where
import Prelude
import Utils
import Prelude (($), (-), (<>))
import Utils (id, attach_id, remove_id)
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord
import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC
import Data.Maybe
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import App.Type.ResourceRecord as RR
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.Either (Either(..))
import Data.Int (fromString)
-- | TMP: temporary stored values regarding specific records such as SPF,
@ -43,43 +41,40 @@ type TMP =
-- | `RRForm` is the necessary state to modify a resource record.
-- | It contains the currently manipulated record, detected errors, along with some temporary values.
type RRForm =
{ _rr :: ResourceRecord
{ _rr :: RR.ResourceRecord
, _errors :: Array Validation.Error
, _dmarc_mail_errors :: Array Email.Error
, _zonefile :: Maybe String
, tmp :: TMP
}
default_empty_rr :: ResourceRecord
default_empty_rr = default_rr A ""
default_qualifier_str = "hard_fail" :: String
default_caa = { flag: 0, tag: CAA.Issue, value: "letsencrypt.org" } :: CAA.CAA
default_rr :: AcceptedRRTypes -> String -> ResourceRecord
default_rr :: AcceptedRRTypes -> String -> RR.ResourceRecord
default_rr t domain =
case t of
A -> emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
AAAA -> emptyRR { rrtype = "AAAA", name = "server1", target = "2001:db8::1" }
TXT -> emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
CNAME -> emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
NS -> emptyRR { rrtype = "NS", name = (domain <> "."), target = "ns0.example.com." }
MX -> emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
CAA -> emptyRR { rrtype = "CAA", name = "", target = "", caa = Just default_caa }
SRV -> emptyRR { rrtype = "SRV", name = "voip", target = "server1"
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just RR.TCP }
SPF -> emptyRR { rrtype = "SPF", name = "", target = ""
, mechanisms = Just default_mechanisms, q = Just RR.HardFail }
DKIM -> emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
A -> RR.emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
AAAA -> RR.emptyRR { rrtype = "AAAA", name = "server1", target = "2001:db8::1" }
TXT -> RR.emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
CNAME -> RR.emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
NS -> RR.emptyRR { rrtype = "NS", name = (domain <> "."), target = "ns0.example.com." }
MX -> RR.emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
CAA -> RR.emptyRR { rrtype = "CAA", name = "", target = "", caa = Just default_caa }
SRV -> RR.emptyRR { rrtype = "SRV", name = "voip", target = "server1"
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just RR.TCP }
SPF -> RR.emptyRR { rrtype = "SPF", name = "", target = ""
, mechanisms = Just default_mechanisms, q = Just RR.HardFail }
DKIM -> RR.emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
DMARC -> RR.emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
where
default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
default_mechanisms = maybe [] (\x -> [x]) $ RR.to_mechanism "pass" "mx" ""
mkEmptyRRForm :: RRForm
mkEmptyRRForm =
{
-- This is the state for the new RR modal.
_rr: default_empty_rr
_rr: default_rr A ""
-- List of errors within the form in new RR modal.
, _errors: []
, _dmarc_mail_errors: []
@ -164,12 +159,12 @@ update_form form new_field_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_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ RR.qualifier_types A.!! v }}}
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ RR.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 $ RR.modifier_types A.!! v }}}
SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}}
SPF_Qualifier v -> form { _rr { q = RR.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)
@ -186,7 +181,7 @@ update_form form new_field_value =
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_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (RR.to_mechanism m_q m_t m_v)
new_value = case new_list_of_mechanisms of
[] -> Nothing
v -> Just v
@ -196,7 +191,7 @@ update_form form new_field_value =
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_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (RR.to_modifier m_t m_v)
new_value = case new_list_of_modifiers of
[] -> Nothing
v -> Just v