From cf6370640d0664b0b5a377d2c421050239c16391 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 5 Feb 2024 23:29:07 +0100 Subject: [PATCH] WIP: replacing the dedicated records with ResourceRecord. Compiles again! --- src/App/Validation.purs | 71 ++++++++++++++------- src/App/ZoneInterface.purs | 127 +++++++++++++------------------------ 2 files changed, 92 insertions(+), 106 deletions(-) diff --git a/src/App/Validation.purs b/src/App/Validation.purs index cdbbcab..7776d6e 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation.purs @@ -6,7 +6,7 @@ import Prelude (class Eq, apply, map, otherwise, pure, show, between, bind import Data.Validation.Semigroup (V, andThen, invalid, toEither) import Data.Array as A import Parsing (runParser) -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe(..), maybe) import Data.Either (Either(..)) import Data.Tuple (Tuple(..)) import Data.String.Regex as R @@ -29,6 +29,21 @@ import GenericParser.DomainParser as DomainParser import GenericParser.IPAddress as IPAddress import GenericParser.RFC5234 as RFC5234 +-- | **History** +-- | The module once used dedicated types for each type of RR. +-- | That comes with several advantages. +-- | First, type verification was a thing, and function were dedicated to a certain type of record. +-- | Second, these dedicated types used strings for their fields, +-- | which simplifies the typing when dealing with forms. +-- | Finally, the validation was a way to convert dedicated types (used in forms) +-- | to the general type (used for network serialization). +-- | This ensures each resource record is verified before being sent to `dnsmanagerd`. +-- | +-- | The problem is that, with dedicated types, you are then required to have dedicated functions. +-- | Conversion functions are also required. +-- | +-- | Maybe the code will change again in the future, but for now it will be enough. + --andThenDrop :: forall errors a b. V errors a -> V errors b -> V errors b -- andThenDrop f1 f2 = f1 !> (\ _ -> f2) @@ -54,16 +69,16 @@ data ValidationError | VEIPv4 (G.Error IPAddress.IPv4Error) | VEIPv6 (G.Error IPAddress.IPv6Error) | VEName (G.Error DomainParser.DomainError) - | VETTL (G.Error TTLError) + | VETTL Int Int Int | VETXT (G.Error TXTError) | VECNAME (G.Error DomainParser.DomainError) | VENS (G.Error DomainParser.DomainError) | VEMX (G.Error DomainParser.DomainError) - | VEPriority (G.Error PriorityError) + | VEPriority Int Int Int | VESRV (G.Error DomainParser.DomainError) | VEProtocol (G.Error ProtocolError) - | VEPort (G.Error PortError) - | VEWeight (G.Error WeightError) + | VEPort Int Int Int + | VEWeight Int Int Int type AVErrors = Array ValidationError @@ -460,39 +475,39 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of Left x -> invalid $ [c x] Right x -> pure x.result -validationA :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord +validationA :: ResourceRecord -> V AVErrors ResourceRecord validationA form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- parse ttl_parser form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse IPAddress.ipv4 form.target VEIPv4 in toRR_basic form.rrid form.readonly "A" name ttl target -validationAAAA :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord +validationAAAA :: ResourceRecord -> V AVErrors ResourceRecord validationAAAA form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- parse ttl_parser form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL -- use read_input to get unaltered input (the IPv6 parser expands the input) target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6 in toRR_basic form.rrid form.readonly "AAAA" name ttl target -validationTXT :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord +validationTXT :: ResourceRecord -> V AVErrors ResourceRecord validationTXT form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- parse ttl_parser form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse txt_parser form.target VETXT in toRR_basic form.rrid form.readonly "TXT" name ttl target -validationCNAME :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord +validationCNAME :: ResourceRecord -> V AVErrors ResourceRecord validationCNAME form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- parse ttl_parser form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VECNAME in toRR_basic form.rrid form.readonly "CNAME" name ttl target -validationNS :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord +validationNS :: ResourceRecord -> V AVErrors ResourceRecord validationNS form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- parse ttl_parser form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VENS in toRR_basic form.rrid form.readonly "NS" name ttl target @@ -532,6 +547,11 @@ data WeightError = WeightNotInt | WeightNotBetween Int Int Int -- min max value +is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> ValidationError) -> V AVErrors Int +is_between min max n ve = if between min max n + then pure n + else invalid [ve min max n] + weight_parser :: G.Parser WeightError Int weight_parser = do pos <- G.current_position @@ -540,23 +560,23 @@ weight_parser = do then pure n else G.Parser \_ -> G.failureError pos (Just $ WeightNotBetween min_weight max_weight n) -validationMX :: forall l. MXRR (|l) -> V AVErrors ResourceRecord +validationMX :: ResourceRecord -> V AVErrors ResourceRecord validationMX form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- parse ttl_parser form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VEMX - priority <- parse priority_parser form.priority VEPriority + priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority in toRR_mx form.rrid form.readonly "MX" name ttl target priority -validationSRV :: forall l. SRVRR (|l) -> V AVErrors ResourceRecord +validationSRV :: ResourceRecord -> V AVErrors ResourceRecord validationSRV form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- parse ttl_parser form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VESRV - priority <- parse priority_parser form.priority VEPriority - protocol <- parse protocol_parser form.protocol VEProtocol - port <- parse port_parser form.port VEPort - weight <- parse weight_parser form.weight VEWeight + 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 toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight validation :: ResourceRecord -> AcceptedRRTypes -> Either AVErrors ResourceRecord @@ -569,3 +589,6 @@ validation entry t = case t of MX -> toEither $ validationMX entry SRV -> toEither $ validationSRV entry --_ -> toEither $ invalid [UNKNOWN] + +id :: forall a. a -> a +id x = x diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index f536e0e..4c0e0e3 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -28,6 +28,7 @@ import Prelude (Unit, unit, void import Data.HashMap as Hash import Data.Array as A +import Data.Int (fromString) import Data.Tuple (Tuple(..)) import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Array.NonEmpty as NonEmpty @@ -259,9 +260,10 @@ component = default_domain :: String default_domain = "netlib.re" +default_empty_rr :: ResourceRecord default_empty_rr = { rrtype: "A" - , rrid: "0" + , rrid: 0 , name: "www" , ttl: 1800 , target: "10.0.0.1" @@ -457,7 +459,7 @@ render state should_be_disabled , Bulma.box_input ("protocolSRV") "Protocol" "tcp" (updateForm Field_Protocol) - state._currentRR.protocol + (fromMaybe "tcp" state._currentRR.protocol) true -- state._currentRR.valid should_be_disabled ] @@ -465,7 +467,8 @@ render state should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) foot_content x = [ Bulma.btn_add (ValidateRR x) (TellSomethingWentWrong state._currentRR.rrid "cannot add") - state._currentRR.valid ] + true -- state._currentRR.valid + ] template content foot = Bulma.modal [ Bulma.modal_background , Bulma.modal_card [Bulma.modal_header $ case state.rr_modal of @@ -907,23 +910,7 @@ handleQuery = case _ of add_entries $ fromMaybe [] tail add_RR :: State -> ResourceRecord -> State - add_RR state new_rr = state { _resources = (state._resources <> [ fromRRToSRVRR new_rr ]) } - - fromRRToSRVRR :: ResourceRecord -> SRVRR () - fromRRToSRVRR new_rr = do - { rrtype: new_rr.rrtype - , rrid: new_rr.rrid - , modified: false - , valid: true - , readonly: new_rr.readonly - , ttl: show new_rr.ttl - , name: new_rr.name - , target: new_rr.target - , port: maybe "" show new_rr.port - , weight: maybe "" show new_rr.weight - , priority: maybe "" show new_rr.priority - , protocol: maybe "" id new_rr.protocol - } + add_RR state new_rr = state { _resources = (state._resources <> [ new_rr ]) } add_entry :: State -> ResourceRecord -> Either String State add_entry state new_rr = do @@ -1389,20 +1376,24 @@ getNewID state = (_ + 1) error_to_paragraph :: forall w. Validation.ValidationError -> HH.HTML w Action error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) (case v of - Validation.UNKNOWN -> Bulma.p "An internal error happened." - Validation.VEIPv4 err -> maybe default_error show_error_ip4 err.error - Validation.VEIPv6 err -> maybe default_error show_error_ip6 err.error - Validation.VEName err -> maybe default_error show_error_domain err.error - Validation.VETTL err -> maybe default_error show_error_ttl err.error - Validation.VETXT err -> maybe default_error show_error_txt err.error - Validation.VECNAME err -> maybe default_error show_error_domain err.error - Validation.VENS err -> maybe default_error show_error_domain err.error - Validation.VEMX err -> maybe default_error show_error_domain err.error - Validation.VEPriority err -> maybe default_error show_error_priority err.error - Validation.VESRV err -> maybe default_error show_error_domain err.error - Validation.VEProtocol err -> maybe default_error show_error_protocol err.error - Validation.VEPort err -> maybe default_error show_error_port err.error - Validation.VEWeight err -> maybe default_error show_error_weight err.error + Validation.UNKNOWN -> Bulma.p "An internal error happened." + Validation.VEIPv4 err -> maybe default_error show_error_ip4 err.error + Validation.VEIPv6 err -> maybe default_error show_error_ip6 err.error + Validation.VEName err -> maybe default_error show_error_domain err.error + Validation.VETTL min max n -> Bulma.p $ "TTL should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + Validation.VETXT err -> maybe default_error show_error_txt err.error + Validation.VECNAME err -> maybe default_error show_error_domain err.error + Validation.VENS err -> maybe default_error show_error_domain err.error + Validation.VEMX err -> maybe default_error show_error_domain err.error + Validation.VEPriority min max n -> Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + Validation.VESRV err -> maybe default_error show_error_domain err.error + Validation.VEProtocol err -> maybe default_error show_error_protocol err.error + Validation.VEPort min max n -> Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + Validation.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." -- Nothing -> "no error reported" -- Just e -> "error reported, will soon appear!" ) @@ -1411,20 +1402,20 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) -- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry. show_error_title :: Validation.ValidationError -> String show_error_title v = case v of - Validation.UNKNOWN -> "Unknown" - Validation.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")" - Validation.VEIPv6 err -> "The IPv6 address is wrong (position: " <> show err.position <> ")" - Validation.VEName err -> "The name (domain label) is wrong (position: " <> show err.position <> ")" - Validation.VETTL err -> "The TTL input is wrong (position: " <> show err.position <> ")" - Validation.VETXT err -> "The TXT input is wrong (position: " <> show err.position <> ")" - Validation.VECNAME err -> "The CNAME input is wrong (position: " <> show err.position <> ")" - Validation.VENS err -> "The NS input is wrong (position: " <> show err.position <> ")" - Validation.VEMX err -> "The MX target input is wrong (position: " <> show err.position <> ")" - Validation.VEPriority err -> "The Priority input is wrong (position: " <> show err.position <> ")" - Validation.VESRV err -> "The SRV target input is wrong (position: " <> show err.position <> ")" - Validation.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")" - Validation.VEPort err -> "The Port input is wrong (position: " <> show err.position <> ")" - Validation.VEWeight err -> "The Weight input is wrong (position: " <> show err.position <> ")" + Validation.UNKNOWN -> "Unknown" + Validation.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")" + Validation.VEIPv6 err -> "The IPv6 address is wrong (position: " <> show err.position <> ")" + Validation.VEName err -> "The name (domain label) is wrong (position: " <> show err.position <> ")" + Validation.VETTL min max n -> "Invalid TTL (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + Validation.VETXT err -> "The TXT input is wrong (position: " <> show err.position <> ")" + Validation.VECNAME err -> "The CNAME input is wrong (position: " <> show err.position <> ")" + Validation.VENS err -> "The NS input is wrong (position: " <> show err.position <> ")" + Validation.VEMX err -> "The MX target input is wrong (position: " <> show err.position <> ")" + Validation.VEPriority min max n -> "Invalid Priority (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + Validation.VESRV err -> "The SRV target input is wrong (position: " <> show err.position <> ")" + Validation.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")" + Validation.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + Validation.VEWeight min max n -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" show_error_domain :: forall w. DomainParser.DomainError -> HH.HTML w Action show_error_domain e = case e of @@ -1441,34 +1432,6 @@ show_error_domain e = case e of and must finish with either a letter or a digit. """ -show_error_priority :: forall w. Validation.PriorityError -> HH.HTML w Action -show_error_priority e = case e of - Validation.PriorityNotInt -> Bulma.p "Priority should be an integer value." - Validation.PriorityNotBetween min max n -> - Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - -show_error_weight :: forall w. Validation.WeightError -> HH.HTML w Action -show_error_weight e = case e of - Validation.WeightNotInt -> Bulma.p "Weight should be an integer value." - Validation.WeightNotBetween min max n -> - Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - -show_error_port :: forall w. Validation.PortError -> HH.HTML w Action -show_error_port e = case e of - Validation.PortNotInt -> Bulma.p "Port should be an integer value." - Validation.PortNotBetween min max n -> - Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - -show_error_ttl :: forall w. Validation.TTLError -> HH.HTML w Action -show_error_ttl e = case e of - Validation.TTLNotInt -> Bulma.p "TTL should be an integer value." - Validation.TTLNotBetween min max n -> - Bulma.p $ "TTL should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - show_error_protocol :: forall w. Validation.ProtocolError -> HH.HTML w Action show_error_protocol e = case e of Validation.InvalidProtocol -> Bulma.p "Protocol should be a value as 'tcp' or 'udp'." @@ -1501,12 +1464,12 @@ show_error_txt e = case e of Bulma.p $ "An TXT field is limited to " <> show max <> " characters (currently there are " <> show n <> " characters)." -update_field :: SRVRR () -> Field -> SRVRR () +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 = val, valid = isInteger val } - Field_Priority val -> rr { priority = val } - Field_Protocol val -> rr { protocol = val } - Field_Weight val -> rr { weight = val } - Field_Port val -> rr { port = 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 }