Compare commits
No commits in common. "d6249f363cc29465e218fdcb4948967c1ed12e70" and "56cd0134716c1d703742a41c2681ea5ab6cf5117" have entirely different histories.
d6249f363c
...
56cd013471
7 changed files with 61 additions and 73 deletions
|
|
@ -11,19 +11,11 @@ import App.Validation.DNS as ValidationDNS
|
||||||
import App.Validation.Login as L
|
import App.Validation.Login as L
|
||||||
import App.Validation.Email as E
|
import App.Validation.Email as E
|
||||||
import App.Validation.Password as P
|
import App.Validation.Password as P
|
||||||
import App.Type.Delegation as Delegation
|
|
||||||
import App.Validation.Label as ValidationLabel
|
import App.Validation.Label as ValidationLabel
|
||||||
import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
|
import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
|
||||||
import GenericParser.IPAddress as IPAddress
|
import GenericParser.IPAddress as IPAddress
|
||||||
|
|
||||||
import Web as Web
|
import Web as Web
|
||||||
delegation_error_to_paragraph :: forall w i. Delegation.Error -> HH.HTML w i
|
|
||||||
delegation_error_to_paragraph v = Web.error_message (Web.p $ show_delegation_error_title v)
|
|
||||||
(case v of
|
|
||||||
Delegation.VENameServer1 err -> maybe default_error show_error_domain err.error
|
|
||||||
Delegation.VENameServer2 err -> maybe default_error show_error_domain err.error
|
|
||||||
)
|
|
||||||
where default_error = Web.p ""
|
|
||||||
|
|
||||||
error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i
|
error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i
|
||||||
error_to_paragraph v = Web.error_message (Web.p $ show_error_title v)
|
error_to_paragraph v = Web.error_message (Web.p $ show_error_title v)
|
||||||
|
|
@ -73,13 +65,6 @@ show_error_key_sizes min max
|
||||||
else Web.p $ "Chosen signature algorithm only accepts public key input between "
|
else Web.p $ "Chosen signature algorithm only accepts public key input between "
|
||||||
<> show min <> " and " <> show max <> " characters."
|
<> show min <> " and " <> show max <> " characters."
|
||||||
|
|
||||||
-- | `show_delegation_error_title` provide a simple title string to display to the user
|
|
||||||
-- | in case of an error with an entry in the delegation form.
|
|
||||||
show_delegation_error_title :: Delegation.Error -> String
|
|
||||||
show_delegation_error_title v = case v of
|
|
||||||
Delegation.VENameServer1 _ -> "Invalid domain for name server 1"
|
|
||||||
Delegation.VENameServer2 _ -> "Invalid domain for name server 2"
|
|
||||||
|
|
||||||
-- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry.
|
-- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry.
|
||||||
show_error_title :: ValidationDNS.Error -> String
|
show_error_title :: ValidationDNS.Error -> String
|
||||||
show_error_title v = case v of
|
show_error_title v = case v of
|
||||||
|
|
|
||||||
|
|
@ -442,15 +442,7 @@ handleAction = case _ of
|
||||||
-- | Validate the delegation of the domain.
|
-- | Validate the delegation of the domain.
|
||||||
ValidateDelegation -> do
|
ValidateDelegation -> do
|
||||||
H.raise $ Log $ SystemLog "Validate the delegation"
|
H.raise $ Log $ SystemLog "Validate the delegation"
|
||||||
|
handleAction $ SaveDelegation
|
||||||
state <- H.get
|
|
||||||
|
|
||||||
case ValidationDelegation.validation state._delegation_form of
|
|
||||||
Left delegation_errors -> do
|
|
||||||
H.modify_ _ { _delegation_form { errors = delegation_errors } }
|
|
||||||
Right _ -> do
|
|
||||||
H.modify_ _ { _delegation_form { errors = [] } }
|
|
||||||
handleAction $ SaveDelegation
|
|
||||||
|
|
||||||
-- | Save the delegation of the domain.
|
-- | Save the delegation of the domain.
|
||||||
SaveDelegation -> do
|
SaveDelegation -> do
|
||||||
|
|
|
||||||
|
|
@ -34,7 +34,7 @@ import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||||
import App.Type.ResourceRecord (mechanism_types, modifier_types, qualifier_types, show_qualifier)
|
import App.Type.ResourceRecord (mechanism_types, modifier_types, qualifier_types, show_qualifier)
|
||||||
import App.Type.ResourceRecord as RR
|
import App.Type.ResourceRecord as RR
|
||||||
|
|
||||||
import App.DisplayErrors (error_to_paragraph, delegation_error_to_paragraph, show_error_email)
|
import App.DisplayErrors (error_to_paragraph, show_error_email)
|
||||||
|
|
||||||
type ActionCancelModal :: forall k. k -> k
|
type ActionCancelModal :: forall k. k -> k
|
||||||
type ActionCancelModal i = i
|
type ActionCancelModal i = i
|
||||||
|
|
@ -52,7 +52,6 @@ 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 :: forall a. Array a -> Array String -> Array (Tuple a String)
|
||||||
zip_nullable txt raw = A.zip txt ([""] <> raw)
|
zip_nullable txt raw = A.zip txt ([""] <> raw)
|
||||||
|
|
||||||
type ActionValidate :: forall i. i -> i
|
|
||||||
type ActionValidate i = i
|
type ActionValidate i = i
|
||||||
type ActionUpdateDelegationForm i = (Delegation.Field -> i)
|
type ActionUpdateDelegationForm i = (Delegation.Field -> i)
|
||||||
delegation_modal :: forall w i.
|
delegation_modal :: forall w i.
|
||||||
|
|
@ -66,7 +65,6 @@ delegation_modal selected_domain form action_update_form action_validate action_
|
||||||
[ HH.div [HP.classes [C.notification, C.is_warning]]
|
[ HH.div [HP.classes [C.notification, C.is_warning]]
|
||||||
[ Web.p "⚠️ You are about to delegate your domain to another server, you won't be able to manage entries from netlibre."
|
[ Web.p "⚠️ You are about to delegate your domain to another server, you won't be able to manage entries from netlibre."
|
||||||
]
|
]
|
||||||
, render_errors
|
|
||||||
, Web.box_input "nameserver1" "name server 1" "ns0.example.com"
|
, Web.box_input "nameserver1" "name server 1" "ns0.example.com"
|
||||||
(action_update_form <<< Delegation.NameServer1)
|
(action_update_form <<< Delegation.NameServer1)
|
||||||
form.nameserver1
|
form.nameserver1
|
||||||
|
|
@ -76,12 +74,11 @@ delegation_modal selected_domain form action_update_form action_validate action_
|
||||||
]
|
]
|
||||||
modal_foot :: Array (HH.HTML w i)
|
modal_foot :: Array (HH.HTML w i)
|
||||||
modal_foot =
|
modal_foot =
|
||||||
[ Web.info_btn "Delegate the domain" action_validate
|
[ Web.btn_add action_validate
|
||||||
, Web.cancel_button action_cancel_modal
|
, Web.cancel_button action_cancel_modal
|
||||||
]
|
]
|
||||||
render_errors = if A.length form.errors > 0
|
side_text_for_name_input name_id
|
||||||
then HH.div_ $ [ Web.h3 "Errors: " ] <> map delegation_error_to_paragraph form.errors
|
= Web.side_text_above_input name_id "Name" (HH.text $ "Empty name = root domain (" <> selected_domain <> ".)")
|
||||||
else HH.div_ [ ]
|
|
||||||
|
|
||||||
type Domain = String
|
type Domain = String
|
||||||
type ActionUpdateForm i = (Field.Field -> i)
|
type ActionUpdateForm i = (Field.Field -> i)
|
||||||
|
|
|
||||||
|
|
@ -1,30 +1,15 @@
|
||||||
module App.Type.Delegation where
|
module App.Type.Delegation where
|
||||||
|
|
||||||
import GenericParser.Parser as G
|
type Form = { nameserver1 :: String, nameserver2 :: String }
|
||||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
|
||||||
|
|
||||||
type Form
|
|
||||||
= { nameserver1 :: String
|
|
||||||
, nameserver2 :: String
|
|
||||||
, errors :: Array Error
|
|
||||||
}
|
|
||||||
|
|
||||||
data Field
|
data Field
|
||||||
= NameServer1 String
|
= NameServer1 String
|
||||||
| NameServer2 String
|
| NameServer2 String
|
||||||
|
|
||||||
mkEmptyDelegationForm :: Form
|
mkEmptyDelegationForm :: Form
|
||||||
mkEmptyDelegationForm
|
mkEmptyDelegationForm = { nameserver1: "ns0.example.com", nameserver2: "ns1.example.com" }
|
||||||
= { nameserver1: "ns0.example.com"
|
|
||||||
, nameserver2: "ns1.example.com"
|
|
||||||
, errors: []
|
|
||||||
}
|
|
||||||
|
|
||||||
update_delegation_field :: Form -> Field -> Form
|
update_delegation_field :: Form -> Field -> Form
|
||||||
update_delegation_field form updated_field = case updated_field of
|
update_delegation_field form updated_field = case updated_field of
|
||||||
NameServer1 val -> form { nameserver1 = val }
|
NameServer1 val -> form { nameserver1 = val }
|
||||||
NameServer2 val -> form { nameserver2 = val }
|
NameServer2 val -> form { nameserver2 = val }
|
||||||
|
|
||||||
data Error
|
|
||||||
= VENameServer1 (G.Error DomainParser.DomainError)
|
|
||||||
| VENameServer2 (G.Error DomainParser.DomainError)
|
|
||||||
|
|
|
||||||
|
|
@ -1,29 +1,66 @@
|
||||||
module App.Validation.Delegation where
|
module App.Validation.DNS where
|
||||||
|
|
||||||
import Prelude (apply, map, pure, ($))
|
import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<>), (==))
|
||||||
|
|
||||||
|
import Control.Alt ((<|>))
|
||||||
|
import Data.Array as A
|
||||||
import Data.Either (Either(..))
|
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 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.Parser as G
|
||||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||||
import GenericParser.DomainParser (name) as DomainParser
|
import GenericParser.DomainParser (name, sub_eof) as DomainParser
|
||||||
|
import GenericParser.IPAddress as IPAddress
|
||||||
|
import GenericParser.RFC5234 as RFC5234
|
||||||
|
|
||||||
import App.Type.Delegation (mkEmptyDelegationForm, Form, Error(..)) as Delegation
|
import App.Type.DKIM as DKIM
|
||||||
|
import App.Type.DMARC as DMARC
|
||||||
|
import App.Type.CAA as CAA
|
||||||
|
|
||||||
-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error.
|
import Utils (id)
|
||||||
-- | The actual validation error contains the parser's error including the position.
|
|
||||||
parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Delegation.Error) -> V (Array Delegation.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
|
|
||||||
|
|
||||||
validation_nameservers :: Delegation.Form -> V (Array Delegation.Error) Delegation.Form
|
data Error
|
||||||
|
= UNKNOWN
|
||||||
|
| 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 }
|
||||||
|
|
||||||
|
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 form = ado
|
validation_nameservers form = ado
|
||||||
nameserver1 <- parse DomainParser.name form.nameserver1 Delegation.VENameServer1
|
nameserver1 <- parse DomainParser.name form.name VEName
|
||||||
nameserver2 <- parse DomainParser.name form.nameserver2 Delegation.VENameServer2
|
nameserver2 <- parse DomainParser.name form.name VEName
|
||||||
in Delegation.mkEmptyDelegationForm
|
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 }
|
||||||
|
|
||||||
-- | `validation` provides a way to validate the content of a RR.
|
-- | `validation` provides a way to validate the content of a RR.
|
||||||
validation :: Delegation.Form -> Either (Array Delegation.Error) Delegation.Form
|
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
|
||||||
validation entry = toEither $ validation_nameservers entry
|
validation entry = toEither $ validation_nameservers entry
|
||||||
|
"DKIM" -> toEither $ validationDKIM entry
|
||||||
|
"DMARC" -> toEither $ validationDMARC entry
|
||||||
|
_ -> toEither $ invalid [UNKNOWN]
|
||||||
|
|
|
||||||
|
|
@ -24,7 +24,7 @@ module Web
|
||||||
|
|
||||||
import Web.Basics
|
import Web.Basics
|
||||||
import Web.Box (box, box_, box_with_tag)
|
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, info_btn, info_btn_abbr)
|
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.Checkbox (checkbox)
|
import Web.Checkbox (checkbox)
|
||||||
import Web.Column (column, column_, columns, columns_)
|
import Web.Column (column, column_, columns, columns_)
|
||||||
import Web.Data (data_target)
|
import Web.Data (data_target)
|
||||||
|
|
|
||||||
|
|
@ -17,8 +17,6 @@ module Web.Button
|
||||||
, btn_validation_
|
, btn_validation_
|
||||||
, cancel_button
|
, cancel_button
|
||||||
, delete_btn
|
, delete_btn
|
||||||
, info_btn
|
|
||||||
, info_btn_abbr
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Prelude (($), (<>))
|
import Prelude (($), (<>))
|
||||||
|
|
@ -95,12 +93,6 @@ btn_ classes title action
|
||||||
btn :: forall w action. String -> action -> HH.HTML w action
|
btn :: forall w action. String -> action -> HH.HTML w action
|
||||||
btn title action = btn_ [] title 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 :: forall w action. String -> action -> HH.HTML w action
|
||||||
alert_btn title action = btn_ [C.is_danger] title action
|
alert_btn title action = btn_ [C.is_danger] title action
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue