Compare commits
2 commits
b500679444
...
f2b88a1209
| Author | SHA1 | Date | |
|---|---|---|---|
| f2b88a1209 | |||
| 0296f27e27 |
9 changed files with 38 additions and 32 deletions
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.AuthenticationInterface` is both the authentication and password recovery interface.
|
||||
-- | `App.Page.Authentication` is both the authentication and password recovery interface.
|
||||
-- | TODO: token validation.
|
||||
module App.Page.Authentication where
|
||||
|
||||
|
|
@ -362,5 +362,5 @@ handleQuery = case _ of
|
|||
AuthD.GotPasswordRecoverySent _ -> do
|
||||
handleAction $ ChangeTab Recovery
|
||||
_ -> do
|
||||
H.raise $ Log $ ErrorLog $ "Message not handled in AuthenticationInterface."
|
||||
H.raise $ Log $ ErrorLog $ "Message not handled in Authentication."
|
||||
pure Nothing
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.DomainListInterface` is a simple component with the list of own domains
|
||||
-- | `App.Page.DomainList` is a simple component with the list of own domains
|
||||
-- | and a form to add a new domain.
|
||||
-- |
|
||||
-- | This interface enables to:
|
||||
|
|
@ -38,7 +38,7 @@ import App.Type.DomainInfo
|
|||
import App.Type.LogMessage (LogMessage(..))
|
||||
import App.Message.DNSManagerDaemon as DNSManager
|
||||
|
||||
-- | `App.DomainListInterface` can send messages through websocket interface
|
||||
-- | `App.Page.DomainList` can send messages through websocket interface
|
||||
-- | connected to dnsmanagerd. See `App.WS`.
|
||||
-- |
|
||||
-- | Also, this component can log messages and ask its parent (`App.Container`) to
|
||||
|
|
@ -58,7 +58,7 @@ data Output
|
|||
| AskState
|
||||
| StoreState State
|
||||
|
||||
-- | `App.DomainListInterface` can receive messages from `dnsmanagerd`.
|
||||
-- | `App.Page.DomainList` can receive messages from `dnsmanagerd`.
|
||||
-- |
|
||||
-- | The component is also informed when the connection is lost or up again.
|
||||
-- |
|
||||
|
|
@ -71,11 +71,11 @@ data Query a
|
|||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
-- | `App.DomainListInterface` has no input.
|
||||
-- | `App.Page.DomainList` has no input.
|
||||
|
||||
type Input = Unit
|
||||
|
||||
-- | `App.DomainListInterface` has a single form to add a new domain.
|
||||
-- | `App.Page.DomainList` has a single form to add a new domain.
|
||||
-- | Only two possible inputs: the (sub)domain name and the selection of the TLD.
|
||||
|
||||
data NewDomainFormAction
|
||||
|
|
@ -444,7 +444,7 @@ handleQuery = case _ of
|
|||
(DNSManager.MkDomainDeleted response) -> do
|
||||
{ my_domains } <- H.get
|
||||
handleAction $ UpdateMyDomains $ A.filter (\d -> d.name /= response.domain) my_domains
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainList."
|
||||
pure (Just a)
|
||||
|
||||
page_reload :: State -> DNSManager.AnswerMessage -> State
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.HomeInterface` presents the website and its features.
|
||||
-- | `App.Page.Home` presents the website and its features.
|
||||
module App.Page.Home where
|
||||
|
||||
import Prelude (Unit, pure, unit, ($))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.MailValidationInterface` is a simple interface for mail verification.
|
||||
-- | `App.Page.MailValidation` is a simple interface for mail verification.
|
||||
-- | A token is sent at registration at the provided email address.
|
||||
-- | This token has to be used to validate the email address.
|
||||
module App.Page.MailValidation where
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.NavigationInterface` is the navbar module.
|
||||
-- | `App.Page.Navigation` is the navbar module.
|
||||
-- |
|
||||
-- | This module is required since some javascript is needed to toggle display of hidden resources.
|
||||
-- | On mobile, a burger menu is displayed and hides the navigation buttons.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.RegistrationInterface` is a registration interface.
|
||||
-- | `App.Page.Registration` is a registration interface.
|
||||
-- | Registration requires a login, an email address and a password.
|
||||
module App.Page.Registration where
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.SetupInterface` enables users to change their password or their email address.
|
||||
-- | `App.Page.Setup` enables users to change their password or their email address.
|
||||
-- | Users can also erase their account.
|
||||
module App.Page.Setup where
|
||||
|
||||
|
|
@ -194,5 +194,5 @@ handleQuery = case _ of
|
|||
MessageReceived message _ -> do
|
||||
case message of
|
||||
_ -> do
|
||||
H.raise $ Log $ ErrorLog $ "Message not handled in SetupInterface."
|
||||
H.raise $ Log $ ErrorLog $ "Message not handled in Setup."
|
||||
pure Nothing
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
-- | `App.ZoneInterface` provides an interface to display and modify a DNS zone.
|
||||
-- | `App.Page.Zone` provides an interface to display and modify a DNS zone.
|
||||
-- |
|
||||
-- | This interface enables to:
|
||||
-- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
|
||||
|
|
@ -74,7 +74,7 @@ type RRId = Int
|
|||
id :: forall a. a -> a
|
||||
id x = x
|
||||
|
||||
-- | `App.ZoneInterface` can send messages through websocket interface
|
||||
-- | `App.Page.Zone` can send messages through websocket interface
|
||||
-- | connected to dnsmanagerd. See `App.WS`.
|
||||
-- |
|
||||
-- | Also, this component can log messages and ask its parent (`App.Container`) to
|
||||
|
|
@ -85,14 +85,14 @@ data Output
|
|||
| Log LogMessage
|
||||
| ToDomainList
|
||||
|
||||
-- | `App.ZoneInterface` can receive messages from `dnsmanagerd`.
|
||||
-- | `App.Page.Zone` can receive messages from `dnsmanagerd`.
|
||||
|
||||
data Query a
|
||||
= MessageReceived DNSManager.AnswerMessage a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
-- | `App.ZoneInterface` has a single input: the domain name.
|
||||
-- | `App.Page.Zone` has a single input: the domain name.
|
||||
|
||||
type Input = String
|
||||
|
||||
|
|
@ -753,7 +753,7 @@ handleAction = case _ of
|
|||
DKIM -> H.modify_ _ { _currentRR = default_rr_DKIM }
|
||||
DMARC -> H.modify_ _ { _currentRR = default_rr_DMARC }
|
||||
|
||||
-- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
|
||||
-- | Initialize the Zone component: ask for the domain zone to `dnsmanagerd`.
|
||||
Initialize -> do
|
||||
{ _domain } <- H.get
|
||||
H.raise $ Log $ SystemLog $ "Asking the domain " <> _domain
|
||||
|
|
@ -1025,7 +1025,7 @@ handleQuery = case _ of
|
|||
(DNSManager.MkZone response) -> do
|
||||
add_entries response.zone.resources
|
||||
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in ZoneInterface."
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in Page.Zone."
|
||||
pure (Just a)
|
||||
|
||||
where
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ 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 (sub_eof) as DomainParser
|
||||
import GenericParser.DomainParser (wildcard, wildcard_eof, sub_eof) as DomainParser
|
||||
import GenericParser.IPAddress as IPAddress
|
||||
import GenericParser.RFC5234 as RFC5234
|
||||
|
||||
|
|
@ -23,6 +23,10 @@ import App.Type.DKIM as DKIM
|
|||
import App.Type.DMARC as DMARC
|
||||
import App.Type.CAA as CAA
|
||||
|
||||
-- | `name_parser` parses `name` attributes of RRs.
|
||||
name_parser :: G.Parser DomainParser.DomainError String
|
||||
name_parser = DomainParser.wildcard <|> DomainParser.wildcard_eof <|> DomainParser.sub_eof
|
||||
|
||||
-- | **History:**
|
||||
-- | The module once used dedicated types for each type of RR.
|
||||
-- | That comes with several advantages.
|
||||
|
|
@ -118,7 +122,7 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of
|
|||
|
||||
validationA :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationA form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
target <- parse IPAddress.ipv4 form.target VEIPv4
|
||||
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target
|
||||
|
|
@ -126,7 +130,7 @@ validationA form = ado
|
|||
|
||||
validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationAAAA form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
-- use read_input to get unaltered input (the IPv6 parser expands the input)
|
||||
target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6
|
||||
|
|
@ -135,21 +139,21 @@ validationAAAA form = ado
|
|||
|
||||
validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationTXT form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
target <- parse txt_parser form.target VETXT
|
||||
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target }
|
||||
|
||||
validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationCNAME form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser 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 }
|
||||
|
||||
validationNS :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationNS form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VENS
|
||||
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target }
|
||||
|
|
@ -161,7 +165,7 @@ is_between min max n ve = if between min max n
|
|||
|
||||
validationMX :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationMX form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VEMX
|
||||
priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
|
||||
|
|
@ -170,7 +174,7 @@ validationMX form = ado
|
|||
|
||||
validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationSRV form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VESRV
|
||||
priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
|
||||
|
|
@ -252,7 +256,7 @@ validate_SPF_modifier m = case m.t of
|
|||
|
||||
validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||
validationSPF form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms)
|
||||
modifiers <- verification_loop validate_SPF_modifier (maybe [] id form.modifiers)
|
||||
|
|
@ -295,7 +299,7 @@ validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord
|
|||
validationDKIM form =
|
||||
let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim
|
||||
in ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
-- TODO: v n
|
||||
p <- verify_public_key (fromMaybe DKIM.RSA dkim.k) dkim.p
|
||||
|
|
@ -309,7 +313,7 @@ validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord
|
|||
validationDMARC form =
|
||||
let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc
|
||||
in ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
pct <- is_between 0 100 (fromMaybe 100 dmarc.pct) VEDMARCpct
|
||||
ri <- is_between 0 1000000 (fromMaybe 86400 dmarc.ri) VEDMARCri
|
||||
|
|
@ -323,7 +327,7 @@ validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord
|
|||
validationCAA form =
|
||||
let caa = fromMaybe CAA.emptyCAARR form.caa
|
||||
in ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
name <- parse name_parser form.name VEName
|
||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
||||
flag <- is_between 0 255 caa.flag VECAAflag
|
||||
-- TODO: verify the `value` field.
|
||||
|
|
@ -333,6 +337,8 @@ validationCAA form =
|
|||
, name = name, ttl = ttl, target = "" -- `target` is discarded!
|
||||
, caa = Just $ caa { flag = flag } }
|
||||
|
||||
|
||||
-- | `validation` provides a way to validate the content of a RR.
|
||||
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
|
||||
validation entry = case entry.rrtype of
|
||||
"A" -> toEither $ validationA entry
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue