karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

WIP: SPF interface.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-02-29 04:01:58 +01:00
parent 10f9f7ebb5
commit 0beba6ea6d
7 changed files with 119 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/App/AcceptedRRTypes.purs
View File

@ -15,6 +15,7 @@ data AcceptedRRTypes
| NS
| MX
| SRV
| SPF
derive instance genericMyADT :: Generic AcceptedRRTypes _

2
src/App/DisplayErrors.purs
View File

@ -34,6 +34,7 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
<> ", current value: " <> show n <> "."
ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
ValidationDNS.VESPF err -> maybe default_error show_error_domain err.error
)
where default_error = Bulma.p ""
@ -54,6 +55,7 @@ show_error_title v = case v of
ValidationDNS.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")"
ValidationDNS.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
ValidationDNS.VEWeight min max n -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
ValidationDNS.VESPF err -> "The SPF target input is wrong (position: " <> show err.position <> ")"
show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
show_error_domain e = case e of

4
src/App/ResourceRecord.purs
View File

@ -35,7 +35,7 @@ type ResourceRecord
, v :: Maybe String -- Default: spf1
, mechanisms :: Maybe (Array Mechanism)
, modifiers :: Maybe (Array Modifier)
, q :: Maybe Int -- Qualifier for default mechanism (`all`).
, q :: Maybe String -- Qualifier for default mechanism (`all`).
-- TODO: DKIM specific entries.
-- TODO: DMARC specific entries.
@ -72,7 +72,7 @@ codec = CA.object "ResourceRecord"
, v: CAR.optional CA.string
, mechanisms: CAR.optional (CA.array codecMechanism)
, modifiers: CAR.optional (CA.array codecModifier)
, q: CAR.optional CA.int
, q: CAR.optional CA.string
})
type Mechanism

5
src/App/Setup.purs
View File

@ -2,11 +2,9 @@
-- | Users can also erase their account.
module App.SetupInterface where
import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), (==))
import Prelude (Unit, bind, discard, pure, ($), (<<<), (==))
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
@ -17,7 +15,6 @@ import Web.Event.Event (Event)
import Bulma as Bulma
import App.Email as Email
import App.LogMessage
import App.Messages.AuthenticationDaemon as AuthD

12
src/App/Validation/DNS.purs
View File

@ -44,6 +44,7 @@ data Error
| VEMX (G.Error DomainParser.DomainError)
| VEPriority Int Int Int
| VESRV (G.Error DomainParser.DomainError)
| VESPF (G.Error DomainParser.DomainError)
| VEProtocol (G.Error ProtocolError)
| VEPort Int Int Int
| VEWeight Int Int Int
@ -178,6 +179,16 @@ validationSRV form = ado
, name = name, ttl = ttl, target = target
, priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight }
validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
validationSPF form = ado
name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse DomainParser.sub_eof form.target VESPF
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
, name = name, ttl = ttl, target = target
, v = form.v, mechanisms = maybe (Just []) Just form.mechanisms
, modifiers = form.modifiers, q = form.q }
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry
@ -187,6 +198,7 @@ validation entry = case entry.rrtype of
"NS" -> toEither $ validationNS entry
"MX" -> toEither $ validationMX entry
"SRV" -> toEither $ validationSRV entry
"SPF" -> toEither $ validationSPF entry
_ -> toEither $ invalid [UNKNOWN]
id :: forall a. a -> a

101
src/App/ZoneInterface.purs
View File

@ -2,6 +2,7 @@
-- |
-- | This interface allows to:
-- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
-- | - TODO: dedicated interfaces for: SPF, DKIM, DMARC
-- | - add, modify, remove resource records
-- |
-- | **WIP**: Display relevant information for each record type in the (add/mod) modal.
@ -38,7 +39,7 @@ import Bulma as Bulma
import CSSClasses as C
import App.AcceptedRRTypes (AcceptedRRTypes(..))
import App.ResourceRecord (ResourceRecord, emptyRR)
import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier)
import App.DisplayErrors (error_to_paragraph)
@ -84,6 +85,10 @@ data Field
| Field_Protocol String
| Field_Weight String
| Field_Port String
| Field_SPF_v String
| Field_SPF_mechanisms (Array Mechanism)
| Field_SPF_modifiers (Array Modifier)
| Field_SPF_q String
-- | Steps to create a new RR:
-- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
@ -152,6 +157,7 @@ show_accepted_type = case _ of
NS -> "NS"
MX -> "MX"
SRV -> "SRV"
SPF -> "SPF"
string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
string_to_acceptedtype str = case str of
@ -162,6 +168,7 @@ string_to_acceptedtype str = case str of
"NS" -> Just NS
"MX" -> Just MX
"SRV" -> Just SRV
"SPF" -> Just SPF
_ -> Nothing
type State =
@ -270,6 +277,7 @@ render state
"NS" -> template content_simple (foot_content NS)
"MX" -> template content_mx (foot_content MX)
"SRV" -> template content_srv (foot_content SRV)
"SPF" -> template content_spf (foot_content SPF)
_ -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype
where
-- DRY
@ -349,6 +357,34 @@ render state
(fromMaybe "tcp" state._currentRR.protocol)
should_be_disabled
]
content_spf :: Array (HH.HTML w Action)
content_spf =
[ render_errors
, Bulma.input_with_side_text "domainSPF" "Name" "www" -- id, title, placeholder
(updateForm Field_Domain) -- action
state._currentRR.name -- value
("." <> state._domain) -- sidetext
, Bulma.box_input ("ttlSPF") "TTL" "600"
(updateForm Field_TTL)
(show state._currentRR.ttl)
should_be_disabled
, Bulma.box_input ("targetSPF") "Target" "www"
(updateForm Field_Target)
state._currentRR.target
should_be_disabled
, 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 should_be_disabled
, Bulma.p "TODO: mechanisms"
, Bulma.p "TODO: modifiers"
, Bulma.p "TODO: qualifier"
--case state._currentRR.mechanisms of
-- Nothing -> Bulma.p "no mechanisms"
-- Just ms -> Bulma.box_input ("mechanismsSPF") "Mechanisms" ""
-- (updateForm Field_SPF_mechanisms)
-- (maybe "" show state._currentRR.v)
-- should_be_disabled
]
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
foot_content x = [ case state.rr_modal of
@ -397,6 +433,8 @@ handleAction = case _ of
default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 }
default_rr_SRV = emptyRR { rrtype = "SRV", name = "_sip._tcp", target = "www"
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
default_rr_SPF = emptyRR { rrtype = "SPF", name = "", target = "www" }
case t of
A -> H.modify_ _ { _currentRR = default_rr_A }
AAAA -> H.modify_ _ { _currentRR = default_rr_AAAA }
@ -405,6 +443,7 @@ handleAction = case _ of
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 }
-- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
Initialize -> do
@ -568,17 +607,19 @@ render_resources []
, Bulma.subtitle "No records for now"
]
render_resources records
= HH.div_ [ render_soa $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records
, Bulma.box [ basic_records_section ]
, Bulma.box [ mx_records_section ]
, Bulma.box [ srv_records_section ]
, Bulma.box_ C.has_background_warning_light [ basic_readonly_records_section ]
]
= HH.div_ $ [ render_soa $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records ]
<> (if A.length all_basic_rr > 0 then [Bulma.box [basic_records_section]] else [])
<> (if A.length all_mx_rr > 0 then [Bulma.box [mx_records_section ]] else [])
<> (if A.length all_srv_rr > 0 then [Bulma.box [srv_records_section ]] else [])
<> (if A.length all_spf_rr > 0 then [Bulma.box [spf_records_section ]] else [])
<> (if A.length all_basic_ro_rr > 0
then [Bulma.box_ C.has_background_warning_light [basic_readonly_records_section]] else [])
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_mx_rr = A.filter (\rr -> rr.rrtype == "MX") records
all_srv_rr = A.filter (\rr -> rr.rrtype == "SRV") records
all_mx_rr = A.filter (\rr -> rr.rrtype == "MX") records
all_srv_rr = A.filter (\rr -> rr.rrtype == "SRV") records
all_spf_rr = A.filter (\rr -> rr.rrtype == "SPF") records
basic_records_section
= if A.length all_basic_rr > 0
@ -600,9 +641,15 @@ render_resources records
then Bulma.table [] [ Bulma.srv_table_header, render_srv_records ]
else Bulma.p "no srv records"
spf_records_section
= if A.length all_spf_rr > 0
then Bulma.table [] [ Bulma.spf_table_header, render_spf_records ]
else Bulma.p "no spf records"
render_basic_records _rrs = table_content_with_separations _rrs
render_mx_records = table_content all_mx_rr
render_srv_records = table_content all_srv_rr
render_spf_records = table_content all_spf_rr
table_content_with_separations records_ = HH.tbody_ $
A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]]
@ -637,6 +684,22 @@ render_resources records
then HH.td_ [ Bulma.btn_readonly ]
else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
]
"SPF" ->
[ Bulma.txt_name rr.rrtype
, HH.td_ [ Bulma.p rr.name]
, HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p rr.target ]
, HH.td_ [ Bulma.p $ maybe "spf1 (default)" id rr.v ]
, HH.td_ [ Bulma.p $ maybe "" (\ _ -> "TODO: mechanisms") rr.mechanisms ]
, HH.td_ [ Bulma.p $ maybe "" (\ _ -> "TODO: modifiers") rr.modifiers ]
, HH.td_ [ Bulma.p $ maybe "qualifier" (\ _ -> "qualifier") rr.q ]
, if rr.readonly
then HH.td_ [ Bulma.btn_readonly ]
else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
, if rr.readonly
then HH.td_ [ Bulma.btn_readonly ]
else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
]
"MX" ->
[ Bulma.txt_name rr.rrtype
, HH.td_ [ Bulma.p rr.name]
@ -684,7 +747,7 @@ render_new_records _
, Bulma.h1 "Special records about the mail system (soon)"
-- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
, Bulma.level [
Bulma.btn_ro (C.is_small <> C.is_warning) "SPF"
Bulma.btn "SPF" (CreateNewRRModal SPF)
, Bulma.btn_ro (C.is_small <> C.is_warning) "DKIM"
, Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC"
] []
@ -715,10 +778,14 @@ loopE f a = case (A.head a) of
update_field :: ResourceRecord -> Field -> ResourceRecord
update_field rr updated_field = case updated_field of
Field_Domain val -> rr { name = 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_Domain val -> rr { name = 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 }

17
src/Bulma.purs
View File

@ -106,6 +106,23 @@ srv_table_header
]
]
spf_table_header :: forall w i. HH.HTML w i
spf_table_header
= HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ]
, HH.th_ [ HH.text "Name" ]
, HH.th_ [ HH.text "TTL" ]
, HH.th_ [ HH.text "Target" ]
, HH.th_ [ HH.text "Version" ]
, HH.th_ [ HH.text "Mechanisms" ]
, HH.th_ [ HH.text "Modifiers" ]
, HH.th_ [ HH.text "Qualifier" ]
, HH.th_ [ HH.text "" ]
, HH.th_ [ HH.text "" ]
, HH.th_ [ HH.text "" ]
, HH.th_ [ HH.text "" ]
]
]
soa_table_header :: forall w i. HH.HTML w i
soa_table_header
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "name"]