Fix some warnings.

This commit is contained in:
Philippe Pittoli 2025-05-05 19:37:54 +02:00
parent c9aee9943a
commit b21cebaf30

View file

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