From 4b36b196ba76e0095dc34db7c644c6c2952b6741 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sun, 27 Jul 2025 20:56:49 +0200 Subject: [PATCH] Refactoring: split SRV protocol in a dedicated module. --- src/App/Type/Form/ResourceRecord.purs | 5 +-- src/App/Type/ResourceRecord.purs | 10 +++--- .../Type/ResourceRecord/ResourceRecord.purs | 34 +++---------------- src/App/Type/ResourceRecord/SRV.purs | 32 +++++++++++++++++ 4 files changed, 46 insertions(+), 35 deletions(-) create mode 100644 src/App/Type/ResourceRecord/SRV.purs diff --git a/src/App/Type/Form/ResourceRecord.purs b/src/App/Type/Form/ResourceRecord.purs index abc9200..44b19ce 100644 --- a/src/App/Type/Form/ResourceRecord.purs +++ b/src/App/Type/Form/ResourceRecord.purs @@ -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 }}} diff --git a/src/App/Type/ResourceRecord.purs b/src/App/Type/ResourceRecord.purs index cb173d8..43161c9 100644 --- a/src/App/Type/ResourceRecord.purs +++ b/src/App/Type/ResourceRecord.purs @@ -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) diff --git a/src/App/Type/ResourceRecord/ResourceRecord.purs b/src/App/Type/ResourceRecord/ResourceRecord.purs index 3391e4b..222933b 100644 --- a/src/App/Type/ResourceRecord/ResourceRecord.purs +++ b/src/App/Type/ResourceRecord/ResourceRecord.purs @@ -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 = "" } diff --git a/src/App/Type/ResourceRecord/SRV.purs b/src/App/Type/ResourceRecord/SRV.purs new file mode 100644 index 0000000..03dafe5 --- /dev/null +++ b/src/App/Type/ResourceRecord/SRV.purs @@ -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