Compare commits
No commits in common. "8f16222114549b392f3be354fa8b5f281d63340d" and "6cda323c9fbf59e0ea908a3105da96c6b7c8645c" have entirely different histories.
8f16222114
...
6cda323c9f
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user