Compare commits

..

No commits in common. "8f16222114549b392f3be354fa8b5f281d63340d" and "6cda323c9fbf59e0ea908a3105da96c6b7c8645c" have entirely different histories.

3 changed files with 22 additions and 36 deletions

View File

@ -26,25 +26,11 @@
-- | handle messages in the different pages. -- | handle messages in the different pages.
-- | Pages could handle semantic operations directly instead. -- | Pages could handle semantic operations directly instead.
-- | -- |
-- | Tested features: -- | TODO:
-- | - registration, mail validation, login, disconnection -- | Allow users to provide a validation code (received by email).
-- | - domain registration
-- | - zone display, RR creation, update and removal
-- | -- |
-- | Validation: -- | TODO:
-- | - registration page: login, password, mail -- | Verify that a user can register, update its password, login.
-- | - login and password recovery page: TODO
-- | - mail verification: TODO
-- | - domain list: domain (`label`) is insufficient.
-- |
-- | TODO: when reading a RR `name`, always make it an FQDN by adding `<user-domain>.netlib.re.".
-- |
-- | TODO: remove the FQDN when showing RR names.
-- |
-- | TODO: authd administrative page
-- |
-- | Untested features:
-- | - mail recovery, password change
module App.Container where module App.Container where
import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure) import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure)

View File

@ -1,6 +1,6 @@
module App.Validation.DNS where module App.Validation.DNS where
import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<<<)) import Prelude (apply, between, bind, map, pure, ($), (-), (<))
import Control.Alt ((<|>)) import Control.Alt ((<|>))
import Data.Array as A import Data.Array as A
@ -13,7 +13,7 @@ import App.ResourceRecord (ResourceRecord)
import GenericParser.SomeParsers as SomeParsers 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 (label, sub_eof) as DomainParser import GenericParser.DomainParser (sub_eof) as DomainParser
import GenericParser.IPAddress as IPAddress import GenericParser.IPAddress as IPAddress
import GenericParser.RFC5234 as RFC5234 import GenericParser.RFC5234 as RFC5234
@ -161,19 +161,19 @@ txt_parser = do pos <- G.current_position
-- | `parse` allows to run any parser based on `GenericParser` and provide a validation error. -- | `parse` allows to run any parser based on `GenericParser` and provide a validation error.
-- | The actual validation error contains the parser's error including the position. -- | 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 :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V AVErrors v
parse (G.Parser p) str c = case p { string: str, position: 0 } of parse (G.Parser p) str c = case p { string: str, position: 0 } of
Left x -> invalid $ [c x] Left x -> invalid $ [c x]
Right x -> pure x.result Right x -> pure x.result
validationA :: ResourceRecord -> V (Array Error) ResourceRecord validationA :: ResourceRecord -> V AVErrors ResourceRecord
validationA form = ado validationA form = ado
name <- parse DomainParser.sub_eof form.name VEName name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse IPAddress.ipv4 form.target VEIPv4 target <- parse IPAddress.ipv4 form.target VEIPv4
in toRR_basic form.rrid form.readonly "A" name ttl target in toRR_basic form.rrid form.readonly "A" name ttl target
validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord validationAAAA :: ResourceRecord -> V AVErrors ResourceRecord
validationAAAA form = ado validationAAAA form = ado
name <- parse DomainParser.sub_eof form.name VEName name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -181,21 +181,21 @@ validationAAAA form = ado
target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6 target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6
in toRR_basic form.rrid form.readonly "AAAA" name ttl target in toRR_basic form.rrid form.readonly "AAAA" name ttl target
validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord validationTXT :: ResourceRecord -> V AVErrors ResourceRecord
validationTXT form = ado validationTXT form = ado
name <- parse DomainParser.sub_eof form.name VEName name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse txt_parser form.target VETXT target <- parse txt_parser form.target VETXT
in toRR_basic form.rrid form.readonly "TXT" name ttl target in toRR_basic form.rrid form.readonly "TXT" name ttl target
validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord validationCNAME :: ResourceRecord -> V AVErrors ResourceRecord
validationCNAME form = ado validationCNAME form = ado
name <- parse DomainParser.sub_eof form.name VEName name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse DomainParser.sub_eof form.target VECNAME target <- parse DomainParser.sub_eof form.target VECNAME
in toRR_basic form.rrid form.readonly "CNAME" name ttl target in toRR_basic form.rrid form.readonly "CNAME" name ttl target
validationNS :: ResourceRecord -> V (Array Error) ResourceRecord validationNS :: ResourceRecord -> V AVErrors ResourceRecord
validationNS form = ado validationNS form = ado
name <- parse DomainParser.sub_eof form.name VEName name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -210,12 +210,12 @@ protocol_parser = do
pos <- G.current_position pos <- G.current_position
G.string "tcp" <|> G.string "udp" <|> G.Parser \_ -> G.failureError pos (Just InvalidProtocol) G.string "tcp" <|> G.string "udp" <|> G.Parser \_ -> G.failureError pos (Just InvalidProtocol)
is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V AVErrors Int
is_between min max n ve = if between min max n is_between min max n ve = if between min max n
then pure n then pure n
else invalid [ve min max n] else invalid [ve min max n]
validationMX :: ResourceRecord -> V (Array Error) ResourceRecord validationMX :: ResourceRecord -> V AVErrors ResourceRecord
validationMX form = ado validationMX form = ado
name <- parse DomainParser.sub_eof form.name VEName name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -223,7 +223,7 @@ validationMX form = ado
priority <- is_between min_priority max_priority (maybe 0 id 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 in toRR_mx form.rrid form.readonly "MX" name ttl target priority
validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord validationSRV :: ResourceRecord -> V AVErrors ResourceRecord
validationSRV form = ado validationSRV form = ado
name <- parse DomainParser.sub_eof form.name VEName name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -234,7 +234,7 @@ validationSRV form = ado
weight <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight 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 in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight
validation :: ResourceRecord -> Either (Array Error) ResourceRecord validation :: ResourceRecord -> Either AVErrors ResourceRecord
validation entry = case entry.rrtype of validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry "A" -> toEither $ validationA entry
"AAAA" -> toEither $ validationAAAA entry "AAAA" -> toEither $ validationAAAA entry

View File

@ -4,6 +4,7 @@ import Prelude
import Control.Alt ((<|>)) import Control.Alt ((<|>))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.String.CodeUnits as CU
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Validation.Semigroup (V, invalid, toEither) import Data.Validation.Semigroup (V, invalid, toEither)
@ -31,13 +32,12 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of
login_parser :: G.Parser LoginParsingError String login_parser :: G.Parser LoginParsingError String
login_parser = do login_parser = do
input <- G.current_input l <- G.many1 (alpha <|> digit) <|> G.Parser \i -> G.failureError i.position (Just CannotParse)
_ <- G.many1 (alpha <|> digit) G.<:> \_ -> CannotParse _ <- SomeParsers.eof <|> G.Parser \i -> G.failureError i.position (Just CannotEntirelyParse)
_ <- SomeParsers.eof G.<:> \_ -> CannotEntirelyParse
pos <- G.current_position pos <- G.current_position
if between min_login_size max_login_size pos if pos < min_login_size || pos > max_login_size
then pure input.string then G.Parser \i -> G.failureError i.position (Just $ Size min_login_size max_login_size pos)
else G.errorParser (Just $ Size min_login_size max_login_size pos) else pure $ CU.fromCharArray l
login :: String -> Either (Array Error) String login :: String -> Either (Array Error) String
login s = toEither $ parse login_parser s ParsingError login s = toEither $ parse login_parser s ParsingError