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

Protocol isn't a simple string anymore, but still WIP.

Browse source
This commit is contained in:
Philippe Pittoli 2024-11-09 00:12:40 +01:00
parent 5819ed0ed4
commit 408f8da669
5 changed files with 47 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
src/App/DisplayErrors.purs
View file

@ -40,7 +40,6 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
ValidationDNS.VEPriority min max n -> Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
ValidationDNS.VESRV err -> maybe default_error show_error_domain err.error
ValidationDNS.VEProtocol err -> maybe protocol_error show_error_protocol err.error
ValidationDNS.VEPort min max n -> Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
@ -58,7 +57,6 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
ValidationDNS.DKIMInvalidKeySize min max -> show_error_key_sizes min max
)
where default_error = Bulma.p ""
protocol_error = Bulma.p "Accepted protocols are: tcp, udp. You need more? Contact us."
show_error_key_sizes :: forall w i. Int -> Int -> HH.HTML w i
show_error_key_sizes min max
@ -81,7 +79,6 @@ show_error_title v = case v of
ValidationDNS.VEMX _ -> "Invalid MX Target"
ValidationDNS.VEPriority _ _ _ -> "Invalid Priority"
ValidationDNS.VESRV _ -> "Invalid SRV Target"
ValidationDNS.VEProtocol _ -> "Invalid Protocol"
ValidationDNS.VEPort _ _ _ -> "Invalid Port"
ValidationDNS.VEWeight _ _ _ -> "Invalid Weight"
ValidationDNS.VECAAflag _ _ _ -> "Invalid CAA Flag"
@ -109,10 +106,6 @@ show_error_domain e = case e of
and must finish with either a letter or a digit.
"""
show_error_protocol :: forall w i. ValidationDNS.ProtocolError -> HH.HTML w i
show_error_protocol e = case e of
ValidationDNS.InvalidProtocol -> Bulma.p "Protocol should be a value as 'tcp' or 'udp'."
show_error_ip6 :: forall w i. IPAddress.IPv6Error -> HH.HTML w i
show_error_ip6 e = case e of
IPAddress.IP6TooManyHexaDecimalCharacters ->

26
src/App/Page/Zone.purs
View file

@ -58,7 +58,8 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR
, 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.ResourceRecord (Mechanism, Modifier, Qualifier(..), SRVProtocol(..)
, srv_protocols_txt, str_to_srv_protocol) as RR
import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC
@ -99,7 +100,6 @@ data Field
| Field_TTL String
| Field_Target String
| Field_Priority String
| Field_Protocol String
| Field_Weight String
| Field_Port String
| Field_SPF_v String
@ -173,6 +173,8 @@ data Action
| CAA_tag Int
| SRV_Protocol Int
| SPF_Mechanism_q Int
| SPF_Mechanism_t Int
| SPF_Mechanism_v String
@ -250,6 +252,8 @@ type State =
, _currentRR_errors :: Array Validation.Error
, _dmarc_mail_errors :: Array Email.Error
, srv_protocol :: String -- :: RR.SRVProtocol
-- SPF details.
, spf_mechanism_q :: String
, spf_mechanism_t :: String
@ -310,6 +314,8 @@ initialState domain =
, _dmarc_mail_errors: []
, _zonefile: Nothing
, srv_protocol: "tcp" -- RR.TCP
, spf_mechanism_q: "pass"
, spf_mechanism_t: "a"
, spf_mechanism_v: ""
@ -478,9 +484,7 @@ render state
, 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.selection_field "protocolSRV" "Protocol" SRV_Protocol RR.srv_protocols_txt state.srv_protocol
, Bulma.box_input ("targetSRV") "Where the server is" "www"
(updateForm Field_Target)
state._currentRR.target
@ -698,7 +702,8 @@ handleAction = case _ of
default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
default_rr_CAA = emptyRR { rrtype = "CAA", name = "", caa = Just default_caa }
default_rr_SRV = emptyRR { rrtype = "SRV", name = "voip", target = "server1"
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
, port = Just 5061, weight = Just 100, priority = Just 10
, protocol = Just RR.TCP }
default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
default_rr_SPF = emptyRR { rrtype = "SPF", name = "", target = ""
, mechanisms = Just default_mechanisms
@ -746,6 +751,7 @@ handleAction = case _ of
-- 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
SRV -> H.modify_ \state -> state { _currentRR { protocol = RR.str_to_srv_protocol state.srv_protocol }}
DKIM -> H.modify_ \state -> state { _currentRR { dkim = Just state.dkim } }
DMARC -> H.modify_ \state -> state { _currentRR { dmarc = Just state.dmarc } }
_ -> pure unit
@ -759,6 +765,7 @@ handleAction = case _ of
Right newrr -> do
H.modify_ _ { _currentRR_errors = []
, _dmarc_mail_errors = []
, srv_protocol = "tcp"
, dkim = DKIM.emptyDKIMRR
, dmarc = DMARC.emptyDMARCRR
}
@ -790,6 +797,7 @@ handleAction = case _ of
-- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
state0 <- H.get
_ <- case state0._currentRR.rrtype of
"SRV" -> H.modify_ _ { _currentRR { protocol = RR.str_to_srv_protocol state0.srv_protocol }}
"DKIM" -> H.modify_ _ { _currentRR { dkim = Just state0.dkim } }
"DMARC" -> H.modify_ _ { _currentRR { dmarc = Just state0.dmarc } }
_ -> pure unit
@ -806,6 +814,7 @@ handleAction = case _ of
H.modify_ _ { spf_mechanism_q = "pass"
, spf_mechanism_t = "a"
, spf_mechanism_v = ""
, srv_protocol = "tcp"
, spf_modifier_t = "redirect"
, spf_modifier_v = ""
, dmarc_mail = ""
@ -857,6 +866,8 @@ handleAction = case _ of
let new_caa = (fromMaybe default_caa state._currentRR.caa) { tag = fromMaybe CAA.Issue $ CAA.tags A.!! v }
H.modify_ _ { _currentRR { caa = Just new_caa } }
SRV_Protocol v -> H.modify_ _ { srv_protocol = maybe "tcp" id $ RR.srv_protocols_txt A.!! v }
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 }
@ -1100,7 +1111,7 @@ render_resources records
]
"SRV" ->
[ HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ maybe "" id rr.protocol ]
, HH.td_ [ Bulma.p $ maybe "tcp" show rr.protocol ]
, HH.td_ [ Bulma.p rr.target ]
, HH.td_ [ Bulma.p $ maybe "" show rr.port ]
, HH.td_ [ Bulma.p $ show rr.ttl ]
@ -1299,7 +1310,6 @@ update_field rr updated_field = case updated_field of
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 }

2
src/App/Text/Explanations.purs
View file

@ -457,7 +457,7 @@ srv_introduction =
, HH.p_ [ HH.text "For example, for a service named "
, HH.u_ [HH.text "voip"]
, HH.text " and given that this service uses the TCP protocol, the target "
, HH.u_ [HH.text "server1.example.com."]
, HH.u_ [HH.text "\"server1.example.com.\""]
, HH.text " could be specified."
]
]

30
src/App/Type/ResourceRecord.purs
View file

@ -1,6 +1,10 @@
module App.Type.ResourceRecord where
import Prelude ((<>), map, bind, pure)
import Prelude ((<>), map, bind, pure, class Show)
-- import Data.String (toLower)
import Data.Generic.Rep (class Generic)
import App.Type.GenericSerialization (generic_serialization)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..), maybe)
@ -25,7 +29,7 @@ type ResourceRecord
-- SRV specific entries.
, port :: Maybe Int
, protocol :: Maybe String
, protocol :: Maybe SRVProtocol
, weight :: Maybe Int
-- SOA specific entries.
@ -65,7 +69,7 @@ codec = CA.object "ResourceRecord"
-- SRV specific entries.
, port: CAR.optional CA.int
, protocol: CAR.optional CA.string
, protocol: CAR.optional codecSRVProtocol
, weight: CAR.optional CA.int
-- SOA specific entries.
@ -257,3 +261,23 @@ show_qualifier = case _ of
Neutral -> "neutral"
SoftFail -> "soft_fail"
HardFail -> "hard_fail"
data SRVProtocol = TCP | UDP
-- srv_protocols :: Array SRVProtocol
-- srv_protocols = [TCP, UDP]
srv_protocols_txt :: Array String
srv_protocols_txt = ["tcp", "udp"]
derive instance genericSRVProtocol :: Generic SRVProtocol _
instance showSRVProtocol :: Show SRVProtocol where
show = genericShow
-- | Codec for just encoding a single value of type `Qualifier`.
codecSRVProtocol :: CA.JsonCodec SRVProtocol
codecSRVProtocol = CA.prismaticCodec "SRVProtocol" str_to_srv_protocol generic_serialization CA.string
str_to_srv_protocol :: String -> Maybe SRVProtocol
str_to_srv_protocol = case _ of
"tcp" -> Just TCP
"udp" -> Just UDP
_ -> Nothing

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

@ -50,7 +50,6 @@ data Error
| VEMX (G.Error DomainParser.DomainError)
| VEPriority Int Int Int
| VESRV (G.Error DomainParser.DomainError)
| VEProtocol (G.Error ProtocolError)
| VEPort Int Int Int
| VEWeight Int Int Int
| VEDMARCpct Int Int Int
@ -84,7 +83,6 @@ max_weight = 65535 :: Int
type RRPriority = Maybe Int
type RRPort = Maybe Int
type RRProtocol = Maybe String
type RRWeight = Maybe Int
type RRMname = Maybe String
type RRRname = Maybe String
@ -156,13 +154,6 @@ validationNS form = ado
target <- parse DomainParser.sub_eof form.target VENS
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target }
data ProtocolError
= InvalidProtocol
protocol_parser :: G.Parser ProtocolError String
protocol_parser = do
G.string "tcp" <|> G.string "udp" G.<:> \_ -> InvalidProtocol
is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int
is_between min max n ve = if between min max n
then pure n
@ -183,12 +174,11 @@ validationSRV form = ado
ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse DomainParser.sub_eof form.target VESRV
priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
protocol <- parse protocol_parser (maybe "" id form.protocol) VEProtocol
port <- is_between min_port max_port (maybe 0 id form.port) VEPort
weight <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
, name = name, ttl = ttl, target = target
, priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight }
, priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
-- My version of "map" lol.
verification_loop :: forall a e. (a -> V (Array e) a) -> Array a -> V (Array e) (Array a)