WIP: replacing the dedicated records with ResourceRecord. Compiles again!
parent
0cc1fec90b
commit
cf6370640d
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 }
|
||||
|
|
|
|||
Loading…
Reference in New Issue