Massive code removal!
This commit is contained in:
parent
e63bfdca3c
commit
32fe44e34c
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user