Add proper delegation button.
This commit is contained in:
parent
56cd013471
commit
aa2e34e7cb
4 changed files with 28 additions and 54 deletions
|
@ -52,6 +52,7 @@ modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting
|
|||
zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String)
|
||||
zip_nullable txt raw = A.zip txt ([""] <> raw)
|
||||
|
||||
type ActionValidate :: forall i. i -> i
|
||||
type ActionValidate i = i
|
||||
type ActionUpdateDelegationForm i = (Delegation.Field -> i)
|
||||
delegation_modal :: forall w i.
|
||||
|
@ -74,11 +75,9 @@ delegation_modal selected_domain form action_update_form action_validate action_
|
|||
]
|
||||
modal_foot :: Array (HH.HTML w i)
|
||||
modal_foot =
|
||||
[ Web.btn_add action_validate
|
||||
[ Web.info_btn "Delegate the domain" action_validate
|
||||
, Web.cancel_button action_cancel_modal
|
||||
]
|
||||
side_text_for_name_input name_id
|
||||
= Web.side_text_above_input name_id "Name" (HH.text $ "Empty name = root domain (" <> selected_domain <> ".)")
|
||||
|
||||
type Domain = String
|
||||
type ActionUpdateForm i = (Field.Field -> i)
|
||||
|
|
|
@ -1,66 +1,33 @@
|
|||
module App.Validation.DNS where
|
||||
module App.Validation.Delegation where
|
||||
|
||||
import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<>), (==))
|
||||
import Prelude (apply, map, pure, ($))
|
||||
|
||||
import Control.Alt ((<|>))
|
||||
import Data.Array as A
|
||||
import Data.Either (Either(..))
|
||||
import Data.Maybe (Maybe(..), maybe, fromMaybe)
|
||||
import Data.String.CodeUnits as CU
|
||||
import Data.String as S
|
||||
import Data.Validation.Semigroup (V, invalid, toEither)
|
||||
|
||||
import App.Type.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier)
|
||||
import App.Type.ResourceRecord (MechanismType(..), ModifierType(..)) as RR
|
||||
import GenericParser.SomeParsers as SomeParsers
|
||||
import GenericParser.Parser as G
|
||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||
import GenericParser.DomainParser (name, sub_eof) as DomainParser
|
||||
import GenericParser.IPAddress as IPAddress
|
||||
import GenericParser.RFC5234 as RFC5234
|
||||
import GenericParser.DomainParser (name) as DomainParser
|
||||
|
||||
import App.Type.DKIM as DKIM
|
||||
import App.Type.DMARC as DMARC
|
||||
import App.Type.CAA as CAA
|
||||
|
||||
import Utils (id)
|
||||
import App.Type.Delegation as Delegation
|
||||
|
||||
data Error
|
||||
= UNKNOWN
|
||||
| VENameServer1 (G.Error DomainParser.DomainError)
|
||||
= VENameServer1 (G.Error DomainParser.DomainError)
|
||||
| VENameServer2 (G.Error DomainParser.DomainError)
|
||||
|
||||
validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationCNAME form = ado
|
||||
name <- parse DomainParser.name form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VECNAME
|
||||
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target }
|
||||
-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error.
|
||||
-- | The actual validation error contains the parser's error including the position.
|
||||
parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v
|
||||
parse (G.Parser p) str c = case p { string: str, position: 0 } of
|
||||
Left x -> invalid $ [c x]
|
||||
Right x -> pure x.result
|
||||
|
||||
is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int
|
||||
is_between min max n ve = if between min max n
|
||||
then pure n
|
||||
else invalid [ve min max n]
|
||||
|
||||
validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationSRV form = ado
|
||||
name <- parse DomainParser.name form.name VEName
|
||||
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
|
||||
, name = name, ttl = ttl, target = target
|
||||
, priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
|
||||
|
||||
validation_nameservers :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validation_nameservers :: Delegation.Form -> V (Array Error) Delegation.Form
|
||||
validation_nameservers form = ado
|
||||
nameserver1 <- parse DomainParser.name form.name VEName
|
||||
nameserver2 <- parse DomainParser.name form.name VEName
|
||||
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
|
||||
, name = name, ttl = ttl, target = "" -- `target` is discarded!
|
||||
, v = form.v, mechanisms = Just mechanisms
|
||||
, modifiers = Just modifiers, q = form.q }
|
||||
nameserver1 <- parse DomainParser.name form.nameserver1 VENameServer1
|
||||
nameserver2 <- parse DomainParser.name form.nameserver2 VENameServer2
|
||||
in { nameserver1, nameserver2 }
|
||||
|
||||
-- | `validation` provides a way to validate the content of a RR.
|
||||
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
|
||||
validation entry = toEither $ validation_nameservers entry
|
||||
"DKIM" -> toEither $ validationDKIM entry
|
||||
"DMARC" -> toEither $ validationDMARC entry
|
||||
_ -> toEither $ invalid [UNKNOWN]
|
||||
validation :: Delegation.Form -> Either (Array Error) Delegation.Form
|
||||
validation entry = toEither $ validation_nameservers entry
|
||||
|
|
|
@ -24,7 +24,7 @@ module Web
|
|||
|
||||
import Web.Basics
|
||||
import Web.Box (box, box_, box_with_tag)
|
||||
import Web.Button (alert_btn, alert_btn_abbr, btn, btn_, btn_abbr, btn_abbr_, btn_add, btn_delete, btn_delete_ro, btn_modify, btn_modify_ro, btn_readonly, btn_ro, btn_save, btn_validation, btn_validation_, cancel_button, delete_btn)
|
||||
import Web.Button (alert_btn, alert_btn_abbr, btn, btn_, btn_abbr, btn_abbr_, btn_add, btn_delete, btn_delete_ro, btn_modify, btn_modify_ro, btn_readonly, btn_ro, btn_save, btn_validation, btn_validation_, cancel_button, delete_btn, info_btn, info_btn_abbr)
|
||||
import Web.Checkbox (checkbox)
|
||||
import Web.Column (column, column_, columns, columns_)
|
||||
import Web.Data (data_target)
|
||||
|
|
|
@ -17,6 +17,8 @@ module Web.Button
|
|||
, btn_validation_
|
||||
, cancel_button
|
||||
, delete_btn
|
||||
, info_btn
|
||||
, info_btn_abbr
|
||||
) where
|
||||
|
||||
import Prelude (($), (<>))
|
||||
|
@ -93,6 +95,12 @@ btn_ classes title action
|
|||
btn :: forall w action. String -> action -> HH.HTML w action
|
||||
btn title action = btn_ [] title action
|
||||
|
||||
info_btn :: forall w action. String -> action -> HH.HTML w action
|
||||
info_btn title action = btn_ [C.is_info] title action
|
||||
|
||||
info_btn_abbr :: forall w action. String -> String -> action -> HH.HTML w action
|
||||
info_btn_abbr explanation_ title action = btn_abbr_ [C.is_info] [] explanation_ title action
|
||||
|
||||
alert_btn :: forall w action. String -> action -> HH.HTML w action
|
||||
alert_btn title action = btn_ [C.is_danger] title action
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue