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

Refactoring: split SRV protocol in a dedicated module.

Browse source
This commit is contained in:
Philippe Pittoli 2025-07-27 20:56:49 +02:00
parent 4b59d52684
commit 4b36b196ba
4 changed files with 46 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/App/Type/Form/ResourceRecord.purs
View file

@ -13,7 +13,8 @@ import App.Validation.Email as Email
import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord.ResourceRecord (ResourceRecord, default_caa, default_rr, srv_protocols)
import App.Type.ResourceRecord.ResourceRecord (ResourceRecord, default_caa, default_rr)
import App.Type.ResourceRecord.SRV as SRV
import App.Type.ResourceRecord.CAA as CAA
import App.Type.ResourceRecord.DKIM as DKIM
import App.Type.ResourceRecord.DMARC as DMARC
@ -156,7 +157,7 @@ update_form form new_field_value =
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 = srv_protocols A.!! v } }
SRV_Protocol v -> form { _rr { protocol = SRV.srv_protocols A.!! v } }
SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ SPF.qualifier_types A.!! v }}}
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ SPF.mechanism_types A.!! v }}}
SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v }}}

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

@ -3,13 +3,15 @@ module App.Type.ResourceRecord
, module App.Type.Form.ResourceRecord
, module App.Type.ResourceRecord.AcceptedRRTypes
, module App.Type.ResourceRecord.ResourceRecord
, module App.Type.ResourceRecord.SRV
) where
import App.Type.Error.ResourceRecord
import App.Type.Form.ResourceRecord (Field(..), Form, RRUpdateValue(..), TMP, mkEmptyRRForm, update_form)
import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord.ResourceRecord (RRId, ResourceRecord, SRVProtocol(..)
, codec, codecSRVProtocol, default_caa
, default_qualifier_str, default_rr
, emptyRR, srv_protocols, srv_protocols_txt, str_to_srv_protocol)
import App.Type.ResourceRecord.ResourceRecord ( RRId, ResourceRecord
, codec, default_caa
, default_qualifier_str, default_rr, emptyRR)
import App.Type.ResourceRecord.SRV (Protocol(..), codecSRVProtocol, srv_protocols, srv_protocols_txt, str_to_srv_protocol)

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

@ -1,11 +1,6 @@
module App.Type.ResourceRecord.ResourceRecord where
import Prelude (class Show, ($), (<>))
-- import Data.String (toLower)
import Data.Generic.Rep (class Generic)
import App.Type.GenericSerialization (generic_serialization)
import Data.Show.Generic (genericShow)
import Prelude (($), (<>))
import Data.Maybe (Maybe(..), maybe)
@ -19,6 +14,7 @@ import App.Type.ResourceRecord.CAA as CAA
import App.Type.ResourceRecord.DKIM as DKIM
import App.Type.ResourceRecord.DMARC as DMARC
import App.Type.ResourceRecord.SPF as SPF
import App.Type.ResourceRecord.SRV as SRV
type RRId = Int
@ -35,7 +31,7 @@ type ResourceRecord
-- SRV specific entries.
, port :: Maybe Int
, protocol :: Maybe SRVProtocol
, protocol :: Maybe SRV.Protocol
, weight :: Maybe Int
-- SOA specific entries.
@ -75,7 +71,7 @@ codec = CA.object "ResourceRecord"
-- SRV specific entries.
, port: CAR.optional CA.int
, protocol: CAR.optional codecSRVProtocol
, protocol: CAR.optional SRV.codecSRVProtocol
, weight: CAR.optional CA.int
-- SOA specific entries.
@ -139,26 +135,6 @@ emptyRR
, caa: Nothing
}
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
default_qualifier_str = "hard_fail" :: String
default_caa = { flag: 0, tag: CAA.Issue, value: "letsencrypt.org" } :: CAA.CAA
@ -173,7 +149,7 @@ default_rr t domain =
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 TCP }
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just SRV.TCP }
SPF -> emptyRR { rrtype = "SPF", name = "", target = ""
, mechanisms = Just default_mechanisms, q = Just SPF.HardFail }
DKIM -> emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }

32
src/App/Type/ResourceRecord/SRV.purs Normal file
View file

@ -0,0 +1,32 @@
module App.Type.ResourceRecord.SRV where
import Prelude (class Show, ($), (<>))
import Data.Maybe (Maybe(..), maybe)
import Data.Generic.Rep (class Generic)
import App.Type.GenericSerialization (generic_serialization)
import Data.Show.Generic (genericShow)
import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
data Protocol = TCP | UDP
srv_protocols :: Array Protocol
srv_protocols = [TCP, UDP]
srv_protocols_txt :: Array String
srv_protocols_txt = ["tcp", "udp"]
derive instance genericSRVProtocol :: Generic Protocol _
instance showSRVProtocol :: Show Protocol where
show = genericShow
-- | Codec for just encoding a single value of type `Qualifier`.
codecSRVProtocol :: CA.JsonCodec Protocol
codecSRVProtocol = CA.prismaticCodec "SRVProtocol" str_to_srv_protocol generic_serialization CA.string
str_to_srv_protocol :: String -> Maybe Protocol
str_to_srv_protocol = case _ of
"tcp" -> Just TCP
"udp" -> Just UDP
_ -> Nothing