From 32fe44e34ce02c51e39cc8feb7a7c04dff111b7f Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 6 Feb 2024 04:21:26 +0100 Subject: [PATCH] Massive code removal! --- src/App/Validation.purs | 363 +-------------------- src/App/ZoneInterface.purs | 641 +++---------------------------------- 2 files changed, 54 insertions(+), 950 deletions(-) diff --git a/src/App/Validation.purs b/src/App/Validation.purs index 0ae9d03..26ab3f2 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation.purs @@ -1,31 +1,19 @@ module App.Validation where -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(..), maybe) -import Data.Either (Either(..)) -import Data.Tuple (Tuple(..)) -import Data.String.Regex as R -import Data.String.Regex.Flags as RF -import Data.String as S -import Data.String.CodeUnits as CU -import Data.Int (fromString) -import URI.Host.IPv4Address as IPv4 -import URI.Host.IPv6Address as IPv6 +import Prelude (apply, between, bind, map, pure, ($), (-), (<)) import Control.Alt ((<|>)) +import Data.Array as A +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..), maybe) +import Data.String.CodeUnits as CU +import Data.Validation.Semigroup (V, invalid, toEither) -import App.RR -import App.AcceptedRRTypes (AcceptedRRTypes(..)) import App.ResourceRecord (ResourceRecord) import GenericParser.SomeParsers as SomeParsers import GenericParser.Parser as G -import GenericParser.DomainParser.Common as DomainParser -import GenericParser.DomainParser as DomainParser +import GenericParser.DomainParser.Common (DomainError) as DomainParser +import GenericParser.DomainParser (sub_eof) as DomainParser import GenericParser.IPAddress as IPAddress import GenericParser.RFC5234 as RFC5234 @@ -44,26 +32,6 @@ import GenericParser.RFC5234 as RFC5234 -- | -- | 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) - -infixl 8 andThen as !> --- infixl 8 andThenDrop as !< - -data Attribute - = Name - | TTL - | RRType - | Id - | Target - | Priority - | Protocol - | Weight - | Port - | NotAnAttribute - -derive instance eqAttribute :: Eq Attribute - data ValidationError = UNKNOWN | VEIPv4 (G.Error IPAddress.IPv4Error) @@ -82,10 +50,7 @@ data ValidationError type AVErrors = Array ValidationError -type Errors = Array (Tuple Attribute String) - --- | Totally garbage values at the moment. Please fix. **TODO** - +-- | Current default values. min_ttl :: Int min_ttl = 30 max_ttl :: Int @@ -104,270 +69,6 @@ min_weight :: Int min_weight = 0 max_weight :: Int max_weight = 65535 -name_min_len :: Int -name_min_len = 1 -name_max_len :: Int -name_max_len = 50 -target_min_len :: Int -target_min_len = 1 -target_max_len :: Int -target_max_len = 50 -target_TXT_max_len :: Int -target_TXT_max_len = 500 -protocol_min_len :: Int -protocol_min_len = 1 -protocol_max_len :: Int -protocol_max_len = 10 -name_format :: String -name_format = "[a-zA-Z]+" -hostname_format :: String -hostname_format = "^(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9-]*[a-zA-Z0-9]).)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9-]*[A-Za-z0-9])[.]?$" -protocol_format :: String -protocol_format = "^(tcp|udp|sctp)$" - --- Basic tools for validation. - -lengthIsBetween :: Attribute -> Int -> Int -> String -> V Errors String -lengthIsBetween field minlen maxlen value - = if valid_condition - then pure value - else invalid [ Tuple field error_message ] - where - actual_len = S.length value - valid_condition = actual_len >= minlen && actual_len <= maxlen - error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]" - --- | `matches` is a simple format verification based on regex parsing. --- | `verify_regex` is a handler to use `matches` with a string regex format. --- | --- | ``` --- | verify_regex Name name_format name --- | ``` -matches :: Attribute -> String -> R.Regex -> V Errors String -matches field value regex - | R.test regex value = pure value - | otherwise = invalid [Tuple field "unacceptable format"] - -intBetween :: Attribute -> Int -> Int -> Int -> V Errors Int -intBetween field min max value - | min <= value && value <= max = pure value - | otherwise = invalid [Tuple field error_message] - where - error_message = "acceptable value [" <> show min <> "-" <> show max <> "]" - -validate_integer :: Attribute -> String -> V Errors Int -validate_integer field string - = case fromString string of - Nothing -> invalid [Tuple field "not an integer"] - Just i -> pure i - --- | `verify_domain` provides a SIMPLISTIC verification for hostname format. - -verify_domain :: Attribute -> String -> V Errors String -verify_domain field value = verify_regex field hostname_format value - --- | `verify_regex` provides a reasonable way to verify a value based on a regex. --- | The regex is a simple string. --- | An example: --- | --- | ``` --- | verify_length name --- | !> verify_regex Name name_format --- | ``` - -verify_regex :: Attribute -> String -> String -> V Errors String -verify_regex field restr value - = case R.regex restr RF.unicode of - Left error_string -> invalid [Tuple field $ "error in regex: " <> error_string] - Right regex -> matches field value regex - -verify_ipv4 :: Attribute -> String -> V Errors String -verify_ipv4 field str = case runParser str IPv4.parser of - Left _ -> invalid [Tuple field "cannot parse this IPv4"] - Right _ -> pure str - -verify_ipv6 :: Attribute -> String -> V Errors String -verify_ipv6 field str = case runParser str IPv6.parser of - Left _ -> invalid [Tuple field "cannot parse this IPv6"] - Right _ -> pure str - --- Field-related validations. - -validate_name :: String -> V Errors String -validate_name name - = verify_length name !> verify_regex Name name_format - where - verify_length = lengthIsBetween Name name_min_len name_max_len - -validate_ttl :: String -> V Errors Int -validate_ttl str_ttl - = is_int str_ttl !> right_range - where - is_int = validate_integer TTL - right_range = intBetween TTL min_ttl max_ttl - -validate_priority :: String -> V Errors Int -validate_priority str_priority - = is_int str_priority !> right_range - where - is_int = validate_integer Priority - right_range = intBetween Priority min_priority max_priority - -validate_protocol :: String -> V Errors String -validate_protocol protocol - = verify_length protocol !> verify_regex Protocol protocol_format - where - verify_length = lengthIsBetween Protocol protocol_min_len protocol_max_len - -validate_weight :: String -> V Errors Int -validate_weight str_weight - = is_int str_weight !> right_range - where - is_int = validate_integer Weight - right_range = intBetween Weight min_weight max_weight - -validate_port :: String -> V Errors Int -validate_port str_port - = is_int str_port !> right_range - where - is_int = validate_integer Port - right_range = intBetween Port min_port max_port - -validate_target_A :: String -> V Errors String -validate_target_A target - = verify_length target !> verify_format - where - verify_length = lengthIsBetween Target target_min_len target_max_len - verify_format = verify_ipv4 Target - -validate_target_AAAA :: String -> V Errors String -validate_target_AAAA target - = verify_length target !> verify_format - where - verify_length = lengthIsBetween Target target_min_len target_max_len - verify_format = verify_ipv6 Target - -validate_target_TXT :: String -> V Errors String -validate_target_TXT target - = verify_length target - where - verify_length = lengthIsBetween Target target_min_len target_TXT_max_len - -validate_target_CNAME :: String -> V Errors String -validate_target_CNAME target - = verify_length target - where - verify_length = lengthIsBetween Target target_min_len target_max_len - -validate_target_NS :: String -> V Errors String -validate_target_NS target - = verify_length target !> verify_domain Target - where - verify_length = lengthIsBetween Target target_min_len target_max_len - -validate_target_MX :: String -> V Errors String -validate_target_MX target - = verify_length target !> verify_domain Target - where - verify_length = lengthIsBetween Target target_min_len target_max_len - -validate_target_SRV :: String -> V Errors String -validate_target_SRV target - = verify_length target !> verify_domain Target - where - verify_length = lengthIsBetween Target target_min_len target_max_len - --- Resource-related validations. - -validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateA form = ado - name <- validate_name form.name - ttl <- validate_ttl form.ttl - target <- validate_target_A form.target - in toRR_basic form.rrid form.readonly "A" name ttl target - -validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateAAAA form = ado - name <- validate_name form.name - ttl <- validate_ttl form.ttl - target <- validate_target_AAAA form.target - in toRR_basic form.rrid form.readonly "AAAA" name ttl target - -validateTXT :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateTXT form = ado - name <- validate_name form.name - ttl <- validate_ttl form.ttl - target <- validate_target_TXT form.target - in toRR_basic form.rrid form.readonly "TXT" name ttl target - -validateCNAME :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateCNAME form = ado - name <- validate_name form.name - ttl <- validate_ttl form.ttl - target <- validate_target_CNAME form.target - in toRR_basic form.rrid form.readonly "CNAME" name ttl target - -validateNS :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateNS form = ado - name <- validate_name form.name - ttl <- validate_ttl form.ttl - target <- validate_target_NS form.target - in toRR_basic form.rrid form.readonly "NS" name ttl target - -validateSRR_ :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateSRR_ form = case form.rrtype of - "A" -> validateA form - "AAAA" -> validateAAAA form - "TXT" -> validateTXT form - "CNAME" -> validateCNAME form - "NS" -> validateNS form - _ -> invalid [Tuple NotAnAttribute $ "invalid type: " <> form.rrtype] - -validateMX :: forall l. MXRR (|l) -> V Errors ResourceRecord -validateMX form = ado - name <- validate_name form.name - ttl <- validate_ttl form.ttl - target <- validate_target_MX form.target - priority <- validate_priority form.priority - in toRR_mx form.rrid form.readonly "MX" name ttl target priority - -validateMXRR_ :: forall l. MXRR (|l) -> V Errors ResourceRecord -validateMXRR_ form = case form.rrtype of - "MX" -> validateMX form - _ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: MX): " <> form.rrtype] - -validateSRV :: forall l. SRVRR (|l) -> V Errors ResourceRecord -validateSRV form = ado - name <- validate_name form.name - ttl <- validate_ttl form.ttl - target <- validate_target_SRV form.target - priority <- validate_priority form.priority - protocol <- validate_protocol form.protocol - weight <- validate_weight form.weight - port <- validate_port form.port - in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight - -validateSRVRR_ :: forall l. SRVRR (|l) -> V Errors ResourceRecord -validateSRVRR_ form = case form.rrtype of - "SRV" -> validateSRV form - _ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: SRV): " <> form.rrtype] - -validateSRR :: forall l. SimpleRR (|l) -> Either Errors ResourceRecord -validateSRR = toEither <<< validateSRR_ - -validateMXRR :: forall l. MXRR (|l) -> Either Errors ResourceRecord -validateMXRR = toEither <<< validateMXRR_ - -validateSRVRR :: forall l. SRVRR (|l) -> Either Errors ResourceRecord -validateSRVRR = toEither <<< validateSRVRR_ - - --- Full zone validations. - --- type ZoneErrors = Array (Tuple Errors RRId) --- type Zone l = String -> Array (SimpleRR (|l)) -> Array (MXRR (|l)) -> Array (SRVRR (|l)) - --- validateZone :: forall l. Zone l -> Either Errors -- Functions handling network-related structures (ResourceRecord). @@ -441,16 +142,6 @@ toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight = toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight) Nothing Nothing Nothing Nothing Nothing Nothing Nothing -data TTLError - = TTLNotInt - | TTLNotBetween Int Int Int -- min max value -ttl_parser :: G.Parser TTLError Int -ttl_parser = do pos <- G.current_position - n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just TTLNotInt) - if between min_ttl max_ttl n - then pure n - else G.Parser \_ -> G.failureError pos (Just $ TTLNotBetween min_ttl max_ttl n) - data TXTError = TXTInvalidCharacter | TXTTooLong Int Int -- max current @@ -511,18 +202,6 @@ validationNS form = ado target <- parse DomainParser.sub_eof form.target VENS in toRR_basic form.rrid form.readonly "NS" name ttl target -data PriorityError - = PriorityNotInt - | PriorityNotBetween Int Int Int -- min max value - -priority_parser :: G.Parser PriorityError Int -priority_parser = do - pos <- G.current_position - n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just PriorityNotInt) - if between min_priority max_priority n - then pure n - else G.Parser \_ -> G.failureError pos (Just $ PriorityNotBetween min_priority max_priority n) - data ProtocolError = InvalidProtocol @@ -531,35 +210,11 @@ protocol_parser = do pos <- G.current_position G.string "tcp" <|> G.string "udp" <|> G.Parser \_ -> G.failureError pos (Just InvalidProtocol) -data PortError - = PortNotInt - | PortNotBetween Int Int Int -- min max value - -port_parser :: G.Parser PortError Int -port_parser = do - pos <- G.current_position - n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just PortNotInt) - if between min_port max_port n - then pure n - else G.Parser \_ -> G.failureError pos (Just $ PortNotBetween min_port max_port n) - -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 - n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just WeightNotInt) - if between min_weight max_weight n - then pure n - else G.Parser \_ -> G.failureError pos (Just $ WeightNotBetween min_weight max_weight n) - validationMX :: ResourceRecord -> V AVErrors ResourceRecord validationMX form = ado name <- parse DomainParser.sub_eof form.name VEName diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 516e8f9..f767d31 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -23,22 +23,17 @@ module App.ZoneInterface where import Prelude (Unit, unit, void , bind, pure - , comparing, discard, map, max, otherwise, show - , ($), (+), (/=), (<<<), (<>), (==), (>)) + , comparing, discard, map, show + , ($), (/=), (<<<), (<>), (==), (>)) -import Data.HashMap as Hash +--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 import Data.Either (Either(..)) import Data.Foldable as Foldable import Data.Maybe (Maybe(..), fromMaybe, maybe) -import Data.String as S -import Data.String.Regex as Regex -import Data.String.Regex.Flags as RegexFlags -import Data.String.Regex.Unsafe as RegexUnsafe import Effect.Aff.Class (class MonadAff) import Halogen as H import Halogen.HTML as HH @@ -49,8 +44,6 @@ import Bulma as Bulma import CSSClasses as C import App.AcceptedRRTypes (AcceptedRRTypes(..)) -import App.RR (MXRR, Port, Priority, Protocol, RRId, RecordName, RecordTarget, SOARR, SRVRR, SimpleRR, TTL, Weight - , defaultResourceA, defaultResourceMX, defaultResourceSRV) import App.ResourceRecord (ResourceRecord) import App.LogMessage (LogMessage(..)) @@ -60,6 +53,7 @@ import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser -- import GenericParser.DomainParser as DomainParser import GenericParser.IPAddress as IPAddress +type RRId = Int id :: forall a. a -> a id x = x @@ -90,38 +84,13 @@ type Slot = H.Slot Query Output type Input = String data Field - = Field_Domain RecordName - | Field_TTL TTL - | Field_Target RecordTarget - | Field_Priority Priority - | Field_Protocol Protocol - | Field_Weight Weight - | Field_Port Port - -data Update_SRR_Form - = Update_SRR_Domain RecordName - | Update_SRR_TTL TTL - | Update_SRR_Target RecordTarget - -data Update_MX_Form - = Update_MX_Domain RecordName - | Update_MX_TTL TTL - | Update_MX_Target RecordTarget - | Update_MX_Priority Priority - -data Update_SRV_Form - = Update_SRV_Domain RecordName - | Update_SRV_TTL TTL - | Update_SRV_Target RecordTarget - | Update_SRV_Priority Priority - | Update_SRV_Protocol Protocol - | Update_SRV_Weight Weight - | Update_SRV_Port Port - -data Update_Local_Form - = Update_Local_Form_SRR Update_SRR_Form - | Update_Local_Form_MXRR Update_MX_Form - | Update_Local_Form_SRVRR Update_SRV_Form + = Field_Domain String + | Field_TTL String + | Field_Target String + | Field_Priority String + | Field_Protocol String + | Field_Weight String + | Field_Port String -- | Steps to create a new RR: -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type. @@ -140,8 +109,8 @@ data Update_Local_Form -- | In both cases, once the add (or update) is performed, the resource should be added (updated) in `_resources`. data Action - -- | Create a modal to ask confirmation before deleting a resource record. - = DeleteRRModal RRId + -- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`. + = Initialize -- | Cancel the current displayed modal. | CancelModal @@ -152,11 +121,11 @@ data Action -- | Create modal (a form) for a resource record to update. | CreateUpdateRRModal RRId - -- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`. - | Initialize + -- | Create a modal to ask confirmation before deleting a resource record. + | DeleteRRModal RRId - -- | Add a new resource record to the zone. - | AddRR AcceptedRRTypes ResourceRecord + -- | Update new entry form (in the `rr_modal` modal). + | UpdateCurrentRR Field -- | Validate a new resource record before adding it. | ValidateRR AcceptedRRTypes @@ -165,26 +134,18 @@ data Action -- | Automatically calls for `SaveRR` once record is verified. | ValidateLocal + -- | Add a new resource record to the zone. + | AddRR AcceptedRRTypes ResourceRecord + -- | Save the changes done in an already existing resource record. | SaveRR ResourceRecord - -- | Update new entry form (in the `rr_modal` modal). - | UpdateCurrentRR Field - - -- | TODO: OLD: Update an already active entry. - | UpdateLocalRR RRId Update_Local_Form - - -- TODO: OLD: Update an already existing resource record (update _resources). - | SaveSRR RRId - | SaveMXRR RRId - | SaveSRVRR RRId - + -- | Send a message to remove a resource record. + -- | Automatically closes the modal. | RemoveRR RRId | TellSomethingWentWrong RRId String --- | - data RRModal = NoModal | NewRRModal AcceptedRRTypes @@ -213,35 +174,19 @@ string_to_acceptedtype str = case str of _ -> Nothing type State = - { _domain :: RecordName + { _domain :: String , wsUp :: Boolean -- A modal to present a form for adding a new RR. , rr_modal :: RRModal - -- TODO: get all the resources in a single entry. - -- Better that way: simpler code. + -- | All resource records. , _resources :: Array ResourceRecord - , _local_errors :: Hash.HashMap RRId (Array Validation.ValidationError) - - -- current entries - , _soa :: Maybe (SOARR ()) - , _srr :: Array (SimpleRR ()) - , _mxrr :: Array (MXRR ()) - , _srvrr :: Array (SRVRR ()) - , _errors :: Hash.HashMap RRId Validation.Errors + --, _local_errors :: Hash.HashMap RRId (Array Validation.ValidationError) -- Unique RR form. , _currentRR :: ResourceRecord , _currentRR_errors :: Array Validation.ValidationError - - -- potential future entries - , _newSRR :: (SimpleRR ()) - , _newMXRR :: (MXRR ()) - , _newSRVRR :: (SRVRR ()) - , _newSRR_errors :: Hash.HashMap RRId Validation.Errors - , _newMXRR_errors :: Hash.HashMap RRId Validation.Errors - , _newSRVRR_errors :: Hash.HashMap RRId Validation.Errors } component :: forall m. MonadAff m => H.Component Query Input Output m @@ -296,25 +241,12 @@ initialState domain = , _domain: domain , _resources: [] - , _local_errors: Hash.empty - - , _soa: Nothing - , _srr: [] - , _mxrr: [] - , _srvrr: [] - , _errors: Hash.empty + --, _local_errors: Hash.empty -- This is the state for the new RR modal. , _currentRR: default_empty_rr -- List of errors within the form in new RR modal. , _currentRR_errors: [] - - , _newSRR: defaultResourceA - , _newMXRR: defaultResourceMX - , _newSRVRR: defaultResourceSRV - , _newSRR_errors: Hash.empty - , _newMXRR_errors: Hash.empty - , _newSRVRR_errors: Hash.empty } type SortableRecord l = Record (rrtype :: String, rrid :: Int | l) @@ -330,12 +262,8 @@ render state true, NoModal -> HH.div_ [ Bulma.h1 state._domain , Bulma.hr - , render_resources state._local_errors $ sorted state._resources + , render_resources $ sorted state._resources , Bulma.hr - , render_soa state._soa - , render_records state._errors $ sorted state._srr - , render_mx_records state._errors $ sorted state._mxrr - , render_srv_records state._errors $ sorted state._srvrr , render_new_records state ] ] @@ -679,86 +607,6 @@ handleAction = case _ of let newRR = update_field state._currentRR field H.modify_ _ { _currentRR = newRR } --- TODO: this code can be used to replace the old RR with the updated one, once received by `dnsmanagerd`. --- Update_Current_RR rr_id field -> do --- state <- H.get --- H.raise $ Log $ SimpleLog $ "Let's try to update entry number " <> show rr_id --- let replaceRR rr1 rr2 | rr1.rrid == rr2.rrid = rr1 --- | otherwise = rr2 --- maybeentry = first (\rr -> rr.rrid == rr_id) state._resources --- case maybeentry of --- Nothing -> H.raise $ Log $ SimpleLog ("Local Update Failed (RR " <> show rr_id <> ")") --- Just entry -> do --- let new_entry = update_field entry field --- H.modify_ _ { _resources = (map (replaceRR entry) state._resources) } - - UpdateLocalRR rr_id form -> case form of - Update_Local_Form_SRR rr_update -> case rr_update of - Update_SRR_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " name: " <> val) - state <- H.get - H.modify_ _ { _srr = (update_domain rr_id val state._srr) } - Update_SRR_TTL val -> do - -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " TTL: " <> val) - state <- H.get - H.modify_ _ { _srr = (update_ttl rr_id val state._srr) } - Update_SRR_Target val -> do - -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " target: " <> val) - state <- H.get - H.modify_ _ { _srr = (update_target rr_id val state._srr) } - - Update_Local_Form_MXRR rr_update -> case rr_update of - -- TODO: FIXME: test all inputs - Update_MX_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " name: " <> val) - state <- H.get - H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) } - -- TODO: FIXME: test all inputs - Update_MX_TTL val -> do - -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry ttl: " <> val) - state <- H.get - H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) } - -- TODO: FIXME: test all inputs - Update_MX_Target val -> do - -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry target: " <> val) - state <- H.get - H.modify_ _ { _mxrr = (update_target rr_id val state._mxrr) } - Update_MX_Priority val -> do - -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val) - state <- H.get - H.modify_ _ { _mxrr = (update_priority rr_id val state._mxrr) } - - Update_Local_Form_SRVRR rr_update -> case rr_update of - Update_SRV_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry name: " <> val) - state <- H.get - H.modify_ _ { _srvrr = (update_domain rr_id val state._srvrr) } - Update_SRV_Target val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry target: " <> val) - state <- H.get - H.modify_ _ { _srvrr = (update_target rr_id val state._srvrr) } - -- TODO: FIXME: test all inputs - Update_SRV_TTL val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry ttl: " <> val) - state <- H.get - H.modify_ _ { _srvrr = (update_ttl rr_id val state._srvrr) } - Update_SRV_Priority val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry priority: " <> val) - state <- H.get - H.modify_ _ { _srvrr = (update_priority rr_id val state._srvrr) } - Update_SRV_Protocol val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) - state <- H.get - H.modify_ _ { _srvrr = (update_protocol rr_id val state._srvrr) } - Update_SRV_Weight val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry weight: " <> val) - state <- H.get - H.modify_ _ { _srvrr = (update_weight rr_id val state._srvrr) } - Update_SRV_Port val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry port: " <> val) - state <- H.get - H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) } - -- | Validate any local RR with the new `_resources` and `_local_errors`. ValidateLocal -> do state <- H.get @@ -779,21 +627,6 @@ handleAction = case _ of $ DNSManager.MkUpdateRR { domain: state._domain, rr: rr } H.raise $ MessageToSend message - SaveSRR local_rr_id -> do - state <- H.get - let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srr - try_update_entry state._domain Validation.validateSRR maybe_local_rr "simple" - - SaveMXRR local_rr_id -> do - state <- H.get - let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._mxrr - try_update_entry state._domain Validation.validateMXRR maybe_local_rr "MX" - - SaveSRVRR local_rr_id -> do - state <- H.get - let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srvrr - try_update_entry state._domain Validation.validateSRVRR maybe_local_rr "SRV" - RemoveRR rr_id -> do { _domain } <- H.get H.raise $ Log $ SimpleLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")" @@ -811,33 +644,6 @@ handleAction = case _ of -- H.raise $ Log $ SimpleLog (show rr) H.raise $ Log $ SimpleLog (" => " <> val) - where - try_update_entry :: forall r - . String - -> (AtLeastRRID r -> Either Validation.Errors ResourceRecord) - -> Maybe (AtLeastRRID r) - -> String - -> H.HalogenM State Action () Output m Unit - try_update_entry d validation v t = case v of - Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find " <> t <> " RR with this rrid" - Just local_rr -> do - state <- H.get - case validation local_rr of - Left validation_errors -> do - let new_error_hash = Hash.insert local_rr.rrid validation_errors state._errors - H.modify_ _ { _errors = new_error_hash } - H.raise $ Log $ SimpleLog $ "[😈] Errors in " - <> t - <> " RR! Please fix them before update." - Right rr -> do - -- H.raise $ Log $ SimpleLog $ "Save " <> t <> " RR" - let new_error_hash = Hash.delete local_rr.rrid state._errors - H.modify_ _ { _errors = new_error_hash } - message <- H.liftEffect - $ DNSManager.serialize - $ DNSManager.MkUpdateRR { domain: d, rr: rr } - H.raise $ MessageToSend message - type AtLeastRRID r = { rrid :: Int | r } handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) @@ -852,23 +658,11 @@ handleQuery = case _ of H.modify_ _ { rr_modal = NoModal } (DNSManager.MkRRAdded response) -> do state <- H.get - let new_rr = response.rr - case add_entry state new_rr of - Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message - Right new_state -> H.put new_state - nstate <- H.get - H.put $ add_RR nstate new_rr + H.put $ add_RR state response.rr (DNSManager.MkRRDeleted response) -> do -- Remove the resource record. state <- H.get - H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr - , _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr - , _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr - , _resources = A.filter (\rr -> rr.rrid /= response.rrid) state._resources - } - -- Remove its possible errors. - let new_error_hash = Hash.delete response.rrid state._errors - H.modify_ _ { _errors = new_error_hash } + H.modify_ _ { _resources = A.filter (\rr -> rr.rrid /= response.rrid) state._resources } (DNSManager.MkZone response) -> do add_entries response.zone.resources @@ -884,54 +678,34 @@ handleQuery = case _ of pure (Just a) where - -- replace_entry :: RRId + -- replace_entry :: ResourceRecord replace_entry new_rr = do state <- H.get - H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srr - , _mxrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._mxrr - , _srvrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srvrr - , _resources = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._resources - } + H.modify_ _ { _resources = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._resources } new_state <- H.get - case add_entry new_state new_rr of - Left errmsg -> H.raise $ Log $ SimpleLog $ "Error while replacing a resource record: " <> errmsg - Right s -> H.put s - new_state2 <- H.get - H.put $ add_RR new_state2 new_rr + H.put $ add_RR new_state new_rr H.raise $ Log $ SimpleLog $ "Replacing a resource record! Should be visible everywhere!" add_entries [] = H.raise $ Log $ SimpleLog "[🎉] Zone fully loaded!" add_entries arr = do - state <- H.get case A.head arr, A.tail arr of Nothing, _ -> H.raise $ Log $ SimpleLog "Done adding entries (but why this didn't performed pattern matching??)" - Just new_rr, tail -> case add_entry state new_rr of - Left error_message -> do - H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message - add_entries $ fromMaybe [] tail - Right new_state -> do - H.put $ add_RR new_state new_rr -- TODO: add to `_resources` + Just new_rr, tail -> do + state <- H.get + H.put $ add_RR state new_rr add_entries $ fromMaybe [] tail add_RR :: State -> ResourceRecord -> State add_RR state new_rr = state { _resources = (state._resources <> [ new_rr ]) } - add_entry :: State -> ResourceRecord -> Either String State - add_entry state new_rr = do - case new_rr.rrtype, (A.elem new_rr.rrtype baseRecords) of - _, true -> Right $ add_new_entry state $ fromResourceRecordToLocalRepresentationSimpleRR new_rr - "MX", _ -> Right $ add_new_mx state $ fromResourceRecordToLocalRepresentationMXRR new_rr - "SRV", _ -> Right $ add_new_srv state $ fromResourceRecordToLocalRepresentationSRVRR new_rr - "SOA", _ -> Right $ new_soa state $ fromResourceRecordToLocalRepresentationSOARR new_rr - _, _ -> Left $ "TODO: cannot add '" <> new_rr.rrtype <> "' resource records at the moment." -- Rendering -render_soa2 :: forall (w :: Type). Maybe ResourceRecord -> HH.HTML w Action -render_soa2 Nothing = Bulma.box [ HH.text "SOA not loaded, yet" ] -render_soa2 (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SOA)" - , table_rr - ] +render_soa :: forall (w :: Type). Maybe ResourceRecord -> HH.HTML w Action +render_soa Nothing = Bulma.box [ HH.text "SOA not loaded, yet" ] +render_soa (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SOA)" + , table_rr + ] where table_rr = Bulma.table [] [ simple_SOA_table_header, table_content ] simple_SOA_table_header = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "name"] @@ -963,54 +737,18 @@ render_soa2 (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SO ] ] -render_soa :: forall (w :: Type). Maybe (SOARR ()) -> HH.HTML w Action -render_soa Nothing = Bulma.box [ HH.text "SOA not loaded, yet" ] -render_soa (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SOA)" - , table_rr - ] - where table_rr = Bulma.table [] [ simple_SOA_table_header, table_content ] - simple_SOA_table_header - = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "name"] - , HH.th_ [ HH.text "ttl"] - , HH.th_ [ HH.text "target"] - , HH.th_ [ HH.text "mname"] - , HH.th_ [ HH.text "rname"] - , HH.th_ [ HH.text "serial"] - , HH.th_ [ HH.text "refresh"] - , HH.th_ [ HH.text "retry"] - , HH.th_ [ HH.text "expire"] - , HH.th_ [ HH.text "minttl"] - ] - ] - table_content - = HH.tbody_ $ [ HH.tr_ $ [ - --, Bulma.p $ "rrtype: " <> soa.rrtype - --, Bulma.p $ "rrid: " <> show soa.rrid - HH.td_ [ HH.text soa.name ] - , HH.td_ [ HH.text soa.ttl ] - , HH.td_ [ HH.text soa.target ] - , HH.td_ [ HH.text soa.mname ] - , HH.td_ [ HH.text soa.rname ] - , HH.td_ [ HH.text soa.serial ] - , HH.td_ [ HH.text soa.refresh ] - , HH.td_ [ HH.text soa.retry ] - , HH.td_ [ HH.text soa.expire ] - , HH.td_ [ HH.text soa.minttl ] - ] - ] - -- | Render all Resource Records. render_resources :: forall w - . Hash.HashMap RRId (Array Validation.ValidationError) - -> Array (ResourceRecord) + -- . Hash.HashMap RRId (Array Validation.ValidationError) + . Array (ResourceRecord) -> HH.HTML w Action -render_resources _ [] +render_resources [] = Bulma.box [ Bulma.zone_rr_title "All records (TEST)" , Bulma.subtitle "No records for now" ] -render_resources errors records +render_resources records = Bulma.box [ Bulma.zone_rr_title "All records (TEST)" - , render_soa2 $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records + , render_soa $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records , table_rr ] where @@ -1018,18 +756,6 @@ render_resources errors records table_content = HH.tbody_ $ A.concat $ map rows $ A.filter (\rr -> rr.rrtype /= "SOA") records rows rr = [ HH.tr_ $ render_row rr ] -- <> error_row rr --- error_row rr = case Hash.lookup rr.rrid errors of --- Nothing -> [] --- Just error_array -> [ HH.tr_ $ --- [ Bulma.txt_name "" --- , HH.td_ $ from_error_array_to_td error_array Validation.Name --- , HH.td_ $ from_error_array_to_td error_array Validation.TTL --- , HH.td_ $ from_error_array_to_td error_array Validation.Target --- , HH.td_ [] --- , HH.td_ [] --- ] --- ] - render_row :: ResourceRecord -> Array (HH.HTML w Action) render_row rr = case rr.rrtype of @@ -1063,137 +789,6 @@ render_resources errors records , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ] ] -render_records :: forall (w :: Type). Hash.HashMap RRId Validation.Errors -> Array (SimpleRR ()) -> HH.HTML w Action -render_records _ [] - = Bulma.box [ Bulma.zone_rr_title $ S.joinWith ", " baseRecords - , Bulma.subtitle "No records for now" - ] -render_records errors records - = Bulma.box [ Bulma.zone_rr_title $ S.joinWith ", " baseRecords - , table_rr - ] - where - -- subtitle_txt = "Each line is a resource record from your DNS zone." - -- <> " You can edit them, then click on the \"fix\" button to synchronize with the server." - table_rr = Bulma.table [] [ Bulma.simple_table_header, table_content ] - table_content = HH.tbody_ $ A.concat $ map rows records - - rows rr - = [ HH.tr_ $ - [ Bulma.txt_name rr.rrtype - , HH.td_ [ Bulma.input_domain (update_simple rr.rrid Update_SRR_Domain) rr.name rr.valid ] - , HH.td_ [ Bulma.input_ttl (update_simple rr.rrid Update_SRR_TTL ) rr.ttl rr.valid ] - , HH.td_ [ case rr.rrtype of - "TXT" -> Bulma.textarea (update_simple rr.rrid Update_SRR_Target) rr.target rr.valid - _ -> Bulma.input_target (update_simple rr.rrid Update_SRR_Target) rr.target rr.valid - ] - , HH.td_ [ Bulma.btn_change (SaveSRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ] - , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ] - ] - ] <> error_row rr - update_simple rrid v = (UpdateLocalRR rrid) <<< Update_Local_Form_SRR <<< v - error_row rr = case Hash.lookup rr.rrid errors of - Nothing -> [] - Just error_array -> [ HH.tr_ $ - [ Bulma.txt_name "" - , HH.td_ $ from_error_array_to_td error_array Validation.Name - , HH.td_ $ from_error_array_to_td error_array Validation.TTL - , HH.td_ $ from_error_array_to_td error_array Validation.Target - , HH.td_ [] - , HH.td_ [] - ] - ] - -from_error_array_to_td :: forall w i. Validation.Errors -> Validation.Attribute -> Array (HH.HTML w i) -from_error_array_to_td [] _ = [] -from_error_array_to_td errors attribute = case A.uncons errors of - Just { head: (Tuple attr err), tail: xs } -> if attr == attribute - then [Bulma.p_ (C.help <> C.is_danger) err] - else from_error_array_to_td xs attribute - Nothing -> [] - - -render_mx_records :: forall (w :: Type) (l :: Row Type) - . Hash.HashMap RRId Validation.Errors -> Array (MXRR l) -> HH.HTML w Action -render_mx_records _ [] - = Bulma.box [ Bulma.zone_rr_title "MX records" - , Bulma.subtitle "No records for now" - ] -render_mx_records errors records - = Bulma.box [ Bulma.zone_rr_title "MX records" - , table_rr - ] - where - table_rr = Bulma.table [] [ Bulma.mx_table_header, table_content ] - table_content = HH.tbody_ $ A.concat $ map rows records - - rows rr = [ HH.tr_ $ - [ HH.td_ [ Bulma.input_domain (update_mx rr.rrid Update_MX_Domain) rr.name rr.valid ] - , HH.td_ [ Bulma.input_ttl (update_mx rr.rrid Update_MX_TTL) rr.ttl rr.valid ] - , HH.td_ [ Bulma.input_priority (update_mx rr.rrid Update_MX_Priority) rr.priority rr.valid ] - , HH.td_ [ Bulma.input_target (update_mx rr.rrid Update_MX_Target) rr.target rr.valid ] - , HH.td_ [ Bulma.btn_change (SaveMXRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ] - , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ] - ] - ] <> error_row rr - update_mx rrid v = (UpdateLocalRR rrid) <<< Update_Local_Form_MXRR <<< v - error_row rr = case Hash.lookup rr.rrid errors of - Nothing -> [] - Just error_array -> - [ HH.tr_ $ - [ HH.td_ $ from_error_array_to_td error_array Validation.Name - , HH.td_ $ from_error_array_to_td error_array Validation.TTL - , HH.td_ $ from_error_array_to_td error_array Validation.Priority - , HH.td_ $ from_error_array_to_td error_array Validation.Target - , HH.td_ [] - , HH.td_ [] - ] - ] - -render_srv_records :: forall (w :: Type) (l :: Row Type) - . Hash.HashMap RRId Validation.Errors -> Array (SRVRR l) -> HH.HTML w Action -render_srv_records _ [] - = Bulma.box [ Bulma.zone_rr_title "SRV records" - , Bulma.subtitle "No records for now" - ] -render_srv_records errors records - = Bulma.box [ Bulma.zone_rr_title "SRV records" - , table_rr - ] - where - table_rr = Bulma.table [] [ Bulma.srv_table_header, table_content ] - table_content = HH.tbody_ $ A.concat $ map rows records - - rows rr - = [ HH.tr_ $ - [ HH.td_ [ Bulma.input_domain (update_srv rr.rrid Update_SRV_Domain ) rr.name rr.valid ] - , HH.td_ [ Bulma.input_ttl (update_srv rr.rrid Update_SRV_TTL ) rr.ttl rr.valid ] - , HH.td_ [ Bulma.input_priority (update_srv rr.rrid Update_SRV_Priority) rr.priority rr.valid ] - , HH.td_ [ Bulma.input_protocol (update_srv rr.rrid Update_SRV_Protocol) rr.protocol rr.valid ] - , HH.td_ [ Bulma.input_weight (update_srv rr.rrid Update_SRV_Weight ) rr.weight rr.valid ] - , HH.td_ [ Bulma.input_port (update_srv rr.rrid Update_SRV_Port ) rr.port rr.valid ] - , HH.td_ [ Bulma.input_target (update_srv rr.rrid Update_SRV_Target ) rr.target rr.valid ] - , HH.td_ [ Bulma.btn_change (SaveSRVRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ] - , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ] - ] - ] <> error_row rr - update_srv rrid v = (UpdateLocalRR rrid) <<< Update_Local_Form_SRVRR <<< v - error_row rr = case Hash.lookup rr.rrid errors of - Nothing -> [] - Just error_array -> - [ HH.tr_ $ - [ HH.td_ $ from_error_array_to_td error_array Validation.Name - , HH.td_ $ from_error_array_to_td error_array Validation.TTL - , HH.td_ $ from_error_array_to_td error_array Validation.Priority - , HH.td_ $ from_error_array_to_td error_array Validation.Protocol - , HH.td_ $ from_error_array_to_td error_array Validation.Weight - , HH.td_ $ from_error_array_to_td error_array Validation.Port - , HH.td_ $ from_error_array_to_td error_array Validation.Target - , HH.td_ [] - , HH.td_ [] - ] - ] - baseRecords :: Array String baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ] @@ -1218,140 +813,6 @@ render_new_records _ -- ACTIONS --- add a new record and get a new placeholter -add_new_entry :: State -> Maybe (SimpleRR ()) -> State -add_new_entry state = case _ of - Nothing -> state - Just rr -> state { _srr = (state._srr <> [ rr ]), _newSRR = defaultResourceA } - --- add a new record and get a new placeholter -add_new_mx :: State -> Maybe (MXRR ()) -> State -add_new_mx state = case _ of - Nothing -> state - Just rr -> state { _mxrr = (state._mxrr <> [ rr ]), _newMXRR = defaultResourceMX } - --- add a new record and get a new placeholter -add_new_srv :: State -> Maybe (SRVRR ()) -> State -add_new_srv state = case _ of - Nothing -> state - Just rr -> state { _srvrr = (state._srvrr <> [ rr ]), _newSRVRR = defaultResourceSRV } - -new_soa :: State -> Maybe (SOARR ()) -> State -new_soa state = case _ of - Nothing -> state - Just rr -> state { _soa = Just rr } - -update_domain :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) -update_domain rr_id val = update (\rr -> rr { modified = true, name = val }) rr_id - -update_target :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) -update_target rr_id val = update (\rr -> rr { modified = true, target = val }) rr_id - -update_ttl :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) -update_ttl rr_id val = update (\rr -> rr { modified = true, ttl = val, valid = isInteger val }) rr_id - -update_priority :: forall (l :: Row Type). Int -> Priority -> Array (MXRR l) -> Array (MXRR l) -update_priority rr_id val = update (\rr -> rr { modified = true, priority = val}) rr_id - -update_protocol :: forall (l :: Row Type). Int -> Protocol -> Array (SRVRR l) -> Array (SRVRR l) -update_protocol rr_id val = update (\rr -> rr { modified = true, protocol = val}) rr_id - -update_weight :: forall (l :: Row Type). Int -> Priority -> Array (SRVRR l) -> Array (SRVRR l) -update_weight rr_id val = update (\rr -> rr { modified = true, weight = val}) rr_id - -update_port :: Int -> Priority -> Array (SRVRR ()) -> Array (SRVRR ()) -update_port rr_id val = update (\rr -> rr { modified = true, port = val}) rr_id - -isIntRegex :: Regex.Regex -isIntRegex = RegexUnsafe.unsafeRegex "^[0-9]*$" RegexFlags.noFlags - -isInteger :: String -> Boolean -isInteger = Regex.test isIntRegex - -update :: forall (l :: Row Type). - (SimpleRR l -> SimpleRR l) -> Int -> Array (SimpleRR l) -> Array (SimpleRR l) -update f rr_id records = map doSmth records - where - doSmth rr - | rr_id == rr.rrid = f rr - | otherwise = rr - -fromResourceRecordToLocalRepresentationSimpleRR :: ResourceRecord -> Maybe (SimpleRR ()) -fromResourceRecordToLocalRepresentationSimpleRR new_rr = - Just { 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 - } - -fromResourceRecordToLocalRepresentationMXRR :: ResourceRecord -> Maybe (MXRR ()) -fromResourceRecordToLocalRepresentationMXRR new_rr = do - priority <- new_rr.priority - Just { 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 - , priority: show priority - } --- TODO: would be nice to have a simpler implementation, something like this: ---fromResourceRecordToLocalRepresentationMXRR new_rr --- = let simple_rr = fromResourceRecordToLocalRepresentationSimpleRR new_rr --- simple_rr { priority = show new_rr.priority } - -fromResourceRecordToLocalRepresentationSRVRR :: ResourceRecord -> Maybe (SRVRR ()) -fromResourceRecordToLocalRepresentationSRVRR new_rr = do - port <- new_rr.port - weight <- new_rr.weight - priority <- new_rr.priority - protocol <- new_rr.protocol - Just { 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 - , priority: show priority - , port: show port - , weight: show weight - , protocol: protocol - } - -fromResourceRecordToLocalRepresentationSOARR :: ResourceRecord -> Maybe (SOARR ()) -fromResourceRecordToLocalRepresentationSOARR new_rr = do - mname <- new_rr.mname -- :: Maybe String - rname <- new_rr.rname -- :: Maybe String - serial <- new_rr.serial -- :: Maybe Int - refresh <- new_rr.refresh -- :: Maybe Int - retry <- new_rr.retry -- :: Maybe Int - expire <- new_rr.expire -- :: Maybe Int - minttl <- new_rr.minttl -- :: Maybe Int - Just { 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 - , mname: mname -- :: RR (Maybe String) Local (String) - , rname: rname -- :: RR (Maybe String) Local (String) - , serial: show serial -- :: RR (Maybe Int) Local (String) - , refresh: show refresh -- :: RR (Maybe Int) Local (String) - , retry: show retry -- :: RR (Maybe Int) Local (String) - , expire: show expire -- :: RR (Maybe Int) Local (String) - , minttl: show minttl -- :: RR (Maybe Int) Local (String) - } - first :: forall a. (a -> Boolean) -> Array a -> Maybe a first condition = A.head <<< (A.filter condition) @@ -1366,18 +827,6 @@ loopE f a = case (A.head a) of Nothing -> pure unit Just xs -> loopE f xs -getNewID :: State -> Int -getNewID state = (_ + 1) - $ Foldable.foldl max 0 [ maxIDrr - , maxIDmxrr - , maxIDsrvrr - ] - - where - maxIDrr = Foldable.foldl max 0 $ map _.rrid state._srr - maxIDmxrr = Foldable.foldl max 0 $ map _.rrid state._mxrr - maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr - 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