Compare commits

..

No commits in common. "dcc587bd1964138206f1a205252b05a27b48e07e" and "103fb0d6431a1d4c9222739aca4b69973bcf3ad6" have entirely different histories.

12 changed files with 121 additions and 517 deletions

View File

@ -573,45 +573,42 @@ handleAction = case _ of
handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent." handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent."
handleAction $ DispatchAuthDaemonMessage m handleAction $ DispatchAuthDaemonMessage m
(AuthD.GotErrorPasswordTooShort _) -> do (AuthD.GotErrorPasswordTooShort _) -> do
handleAction $ Log $ ErrorLog "Password too short." handleAction $ Log $ ErrorLog "Password too short!"
handleAction $ AddNotif $ BadNotification "The server told that your password is too short." handleAction $ AddNotif $ BadNotification "The server told that your password is too short."
(AuthD.GotErrorMailRequired _) -> do (AuthD.GotErrorMailRequired _) -> do
handleAction $ Log $ ErrorLog "Email required." handleAction $ Log $ ErrorLog "Email required!"
handleAction $ AddNotif $ BadNotification "An email is required." handleAction $ AddNotif $ BadNotification "An email is required."
(AuthD.GotErrorInvalidCredentials _) -> do (AuthD.GotErrorInvalidCredentials _) -> do
handleAction $ Log $ ErrorLog "Invalid credentials." handleAction $ Log $ ErrorLog "Invalid credentials!"
handleAction $ ToggleAuthenticated Nothing handleAction $ ToggleAuthenticated Nothing
handleAction $ AddNotif $ BadNotification "Invalid credentials." handleAction $ AddNotif $ BadNotification "Invalid credentials!"
(AuthD.GotErrorRegistrationsClosed _) -> do (AuthD.GotErrorRegistrationsClosed _) -> do
handleAction $ Log $ ErrorLog "Registration closed. Try another time or contact an administrator." handleAction $ Log $ ErrorLog "Registration closed. Try another time or contact an administrator."
handleAction $ AddNotif $ BadNotification "Registration are closed at the moment." handleAction $ AddNotif $ BadNotification "Registration are closed at the moment."
(AuthD.GotErrorInvalidLoginFormat _) -> do (AuthD.GotErrorInvalidLoginFormat _) -> do
handleAction $ Log $ ErrorLog "Invalid login format." handleAction $ Log $ ErrorLog "Invalid login format!"
handleAction $ AddNotif $ BadNotification "Invalid login format." handleAction $ AddNotif $ BadNotification "Invalid login format."
(AuthD.GotErrorInvalidEmailFormat _) -> do (AuthD.GotErrorInvalidEmailFormat _) -> do
handleAction $ Log $ ErrorLog "Invalid email format." handleAction $ Log $ ErrorLog "Invalid email format!"
handleAction $ AddNotif $ BadNotification "Invalid email format." handleAction $ AddNotif $ BadNotification "Invalid email format."
(AuthD.GotErrorAlreadyUsersInDB _) -> do (AuthD.GotErrorAlreadyUsersInDB _) -> do
handleAction $ Log $ ErrorLog "Login already taken." handleAction $ Log $ ErrorLog "GotErrorAlreadyUsersInDB"
handleAction $ AddNotif $ BadNotification "Login already taken." handleAction $ AddNotif $ BadNotification "Login already taken!"
(AuthD.GotErrorReadOnlyProfileKeys _) -> do (AuthD.GotErrorReadOnlyProfileKeys _) -> do
handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys." handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys!"
handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys." handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys!"
(AuthD.GotErrorInvalidActivationKey _) -> do (AuthD.GotErrorInvalidActivationKey _) -> do
handleAction $ Log $ ErrorLog "Invalid activation key." handleAction $ Log $ ErrorLog "Invalid activation key!"
handleAction $ AddNotif $ BadNotification "Invalid activation key." handleAction $ AddNotif $ BadNotification "Invalid activation key!"
(AuthD.GotErrorUserAlreadyValidated _) -> do (AuthD.GotErrorUserAlreadyValidated _) -> do
handleAction $ Log $ ErrorLog "User already validated." handleAction $ Log $ ErrorLog "User already validated!"
handleAction $ AddNotif $ BadNotification "User already validated." handleAction $ AddNotif $ BadNotification "User already validated!"
(AuthD.GotErrorCannotContactUser _) -> do (AuthD.GotErrorCannotContactUser _) -> do
handleAction $ Log $ ErrorLog "User cannot be contacted. Email address may be invalid." handleAction $ Log $ ErrorLog "User cannot be contacted. Email address may be invalid."
handleAction $ AddNotif $ BadNotification "User cannot be contacted. Email address may be invalid." handleAction $ AddNotif $ BadNotification "User cannot be contacted. Email address may be invalid."
(AuthD.GotErrorInvalidRenewKey _) -> do (AuthD.GotErrorInvalidRenewKey _) -> do
handleAction $ Log $ ErrorLog "Invalid renew key." handleAction $ Log $ ErrorLog "Invalid renew key!"
handleAction $ AddNotif $ BadNotification "Invalid renew key." handleAction $ AddNotif $ BadNotification "Invalid renew key!"
(AuthD.GotErrorPasswordTooLong _) -> do
handleAction $ Log $ ErrorLog "Password too long."
handleAction $ AddNotif $ BadNotification "Password too long."
-- The authentication was a success! -- The authentication was a success!
(AuthD.GotToken msg) -> do (AuthD.GotToken msg) -> do
handleAction $ Log $ SuccessLog $ "Authenticated to authd." handleAction $ Log $ SuccessLog $ "Authenticated to authd."
@ -687,9 +684,8 @@ handleAction = case _ of
(DNSManager.MkInvalidZone _) -> do (DNSManager.MkInvalidZone _) -> do
handleAction $ Log $ ErrorLog $ "InvalidZone" handleAction $ Log $ ErrorLog $ "InvalidZone"
handleAction $ AddNotif $ BadNotification $ "The domain zone is invalid." handleAction $ AddNotif $ BadNotification $ "The domain zone is invalid."
m@(DNSManager.MkDomainChanged response) -> do (DNSManager.MkDomainChanged _) -> do
handleAction $ Log $ SystemLog $ "Domain \"" <> response.domain.name <> "\" has been updated." handleAction $ Log $ ErrorLog $ "DomainChanged"
handleAction $ DispatchDNSMessage m
(DNSManager.MkUnknownZone _) -> do (DNSManager.MkUnknownZone _) -> do
handleAction $ Log $ ErrorLog $ "UnknownZone" handleAction $ Log $ ErrorLog $ "UnknownZone"
handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown." handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown."
@ -705,7 +701,7 @@ handleAction = case _ of
handleAction $ AddNotif $ BadNotification $ "You do not have sufficient rights." handleAction $ AddNotif $ BadNotification $ "You do not have sufficient rights."
-- The authentication failed. -- The authentication failed.
(DNSManager.MkError errmsg) -> do (DNSManager.MkError errmsg) -> do
handleAction $ Log $ ErrorLog errmsg.reason handleAction $ Log $ ErrorLog $ "reason is: " <> errmsg.reason
(DNSManager.MkErrorUserNotLogged _) -> do (DNSManager.MkErrorUserNotLogged _) -> do
handleAction $ Log $ ErrorLog $ "The user isn't connected!" handleAction $ Log $ ErrorLog $ "The user isn't connected!"
handleAction $ Log $ SystemLog $ "Trying to authenticate to fix the problem..." handleAction $ Log $ SystemLog $ "Trying to authenticate to fix the problem..."

View File

@ -339,11 +339,6 @@ type ErrorInvalidRenewKey = {}
codecGotErrorInvalidRenewKey :: CA.JsonCodec ErrorInvalidRenewKey codecGotErrorInvalidRenewKey :: CA.JsonCodec ErrorInvalidRenewKey
codecGotErrorInvalidRenewKey = CA.object "ErrorInvalidRenewKey" (CAR.record {}) codecGotErrorInvalidRenewKey = CA.object "ErrorInvalidRenewKey" (CAR.record {})
{- 35 -}
type ErrorPasswordTooLong = {}
codecGotErrorPasswordTooLong :: CA.JsonCodec ErrorPasswordTooLong
codecGotErrorPasswordTooLong = CA.object "ErrorPasswordTooLong" (CAR.record {})
{- 250 -} {- 250 -}
-- type KeepAlive = { } -- type KeepAlive = { }
codecGotKeepAlive ∷ CA.JsonCodec KeepAlive codecGotKeepAlive ∷ CA.JsonCodec KeepAlive
@ -398,7 +393,6 @@ data AnswerMessage
| GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32 | GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
| GotErrorCannotContactUser ErrorCannotContactUser -- 33 | GotErrorCannotContactUser ErrorCannotContactUser -- 33
| GotErrorInvalidRenewKey ErrorInvalidRenewKey -- 34 | GotErrorInvalidRenewKey ErrorInvalidRenewKey -- 34
| GotErrorPasswordTooLong ErrorPasswordTooLong -- 35
| GotKeepAlive KeepAlive -- 250 | GotKeepAlive KeepAlive -- 250
encode ∷ RequestMessage -> Tuple UInt String encode ∷ RequestMessage -> Tuple UInt String
@ -461,7 +455,6 @@ decode number string
32 -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated 32 -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
33 -> error_management codecGotErrorCannotContactUser GotErrorCannotContactUser 33 -> error_management codecGotErrorCannotContactUser GotErrorCannotContactUser
34 -> error_management codecGotErrorInvalidRenewKey GotErrorInvalidRenewKey 34 -> error_management codecGotErrorInvalidRenewKey GotErrorInvalidRenewKey
35 -> error_management codecGotErrorPasswordTooLong GotErrorPasswordTooLong
250 -> error_management codecGotKeepAlive GotKeepAlive 250 -> error_management codecGotKeepAlive GotKeepAlive
_ -> Left UnknownNumber _ -> Left UnknownNumber
where where

View File

@ -2,8 +2,6 @@ module App.Message.DNSManagerDaemon where
import Prelude (bind, pure, show, ($)) import Prelude (bind, pure, show, ($))
import App.Type.DomainInfo as DomainInfo
import Effect (Effect) import Effect (Effect)
import Data.Argonaut.Core as J import Data.Argonaut.Core as J
@ -107,27 +105,6 @@ type NewToken = { domain :: String, rrid :: Int }
codecNewToken ∷ CA.JsonCodec NewToken codecNewToken ∷ CA.JsonCodec NewToken
codecNewToken = CA.object "NewToken" (CAR.record { domain: CA.string, rrid: CA.int }) codecNewToken = CA.object "NewToken" (CAR.record { domain: CA.string, rrid: CA.int })
{- 19 is UseToken, which isn't useful in the webclient. -}
{- 20 -}
type AskShareToken = { domain :: String }
codecAskShareToken ∷ CA.JsonCodec AskShareToken
codecAskShareToken = CA.object "AskShareToken" (CAR.record { domain: CA.string })
{- 21 -}
type AskTransferToken = { domain :: String }
codecAskTransferToken ∷ CA.JsonCodec AskTransferToken
codecAskTransferToken = CA.object "AskTransferToken" (CAR.record { domain: CA.string })
{- 22 -}
type AskUnShareDomain = { domain :: String }
codecAskUnShareDomain ∷ CA.JsonCodec AskUnShareDomain
codecAskUnShareDomain = CA.object "AskUnShareDomain" (CAR.record { domain: CA.string })
{- 23 -}
type GainOwnership = { uuid :: String }
codecGainOwnership ∷ CA.JsonCodec GainOwnership
codecGainOwnership = CA.object "GainOwnership" (CAR.record { uuid: CA.string })
{- 100 -} {- 100 -}
type GenerateAllZoneFiles = {} type GenerateAllZoneFiles = {}
codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles
@ -206,9 +183,9 @@ codecInvalidZone ∷ CA.JsonCodec InvalidZone
codecInvalidZone = CA.object "InvalidZone" (CAR.record { errors: CA.array CA.string }) codecInvalidZone = CA.object "InvalidZone" (CAR.record { errors: CA.array CA.string })
{- 11 -} {- 11 -}
type DomainChanged = { domain :: DomainInfo.DomainInfo } type DomainChanged = { }
codecDomainChanged ∷ CA.JsonCodec DomainChanged codecDomainChanged ∷ CA.JsonCodec DomainChanged
codecDomainChanged = CA.object "DomainChanged" (CAR.record { domain: DomainInfo.codec }) codecDomainChanged = CA.object "DomainChanged" (CAR.record { })
{- 12 -} {- 12 -}
type Zone = { zone :: DNSZone.DNSZone } type Zone = { zone :: DNSZone.DNSZone }
@ -231,10 +208,10 @@ codecAcceptedDomains ∷ CA.JsonCodec AcceptedDomains
codecAcceptedDomains = CA.object "AcceptedDomains" (CAR.record { domains: CA.array CA.string }) codecAcceptedDomains = CA.object "AcceptedDomains" (CAR.record { domains: CA.array CA.string })
{- 16 -} {- 16 -}
type Logged = { accepted_domains :: Array String, my_domains :: Array DomainInfo.DomainInfo, admin :: Boolean } type Logged = { accepted_domains :: Array String, my_domains :: Array String, admin :: Boolean }
codecLogged ∷ CA.JsonCodec Logged codecLogged ∷ CA.JsonCodec Logged
codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string
, my_domains: CA.array DomainInfo.codec , my_domains: CA.array CA.string
, admin: CA.boolean , admin: CA.boolean
}) })
@ -318,10 +295,6 @@ data RequestMessage
| MkAskGeneratedZoneFile AskGeneratedZoneFile -- 17 | MkAskGeneratedZoneFile AskGeneratedZoneFile -- 17
| MkNewToken NewToken -- 18 | MkNewToken NewToken -- 18
--| MkUseToken UseToken -- 19 --| MkUseToken UseToken -- 19
| MkAskShareToken AskShareToken -- 20
| MkAskTransferToken AskTransferToken -- 21
| MkAskUnShareDomain AskUnShareDomain -- 22
| MkGainOwnership GainOwnership -- 23
| MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100 | MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100
| MkGenerateZoneFile GenerateZoneFile -- 101 | MkGenerateZoneFile GenerateZoneFile -- 101
| MkKeepAlive KeepAlive -- 250 | MkKeepAlive KeepAlive -- 250
@ -375,10 +348,6 @@ encode m = case m of
(MkAskGeneratedZoneFile request) -> get_tuple 17 codecAskGeneratedZoneFile request (MkAskGeneratedZoneFile request) -> get_tuple 17 codecAskGeneratedZoneFile request
(MkNewToken request) -> get_tuple 18 codecNewToken request (MkNewToken request) -> get_tuple 18 codecNewToken request
--(MkUseToken request) -> get_tuple 19 codecUseToken request --(MkUseToken request) -> get_tuple 19 codecUseToken request
(MkAskShareToken request) -> get_tuple 20 codecAskShareToken request
(MkAskTransferToken request) -> get_tuple 21 codecAskTransferToken request
(MkAskUnShareDomain request) -> get_tuple 22 codecAskUnShareDomain request
(MkGainOwnership request) -> get_tuple 23 codecGainOwnership request
(MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request (MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request
(MkGenerateZoneFile request) -> get_tuple 101 codecGenerateZoneFile request (MkGenerateZoneFile request) -> get_tuple 101 codecGenerateZoneFile request
(MkKeepAlive request) -> get_tuple 250 codecKeepAlive request (MkKeepAlive request) -> get_tuple 250 codecKeepAlive request

View File

@ -199,14 +199,14 @@ render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm,
auth_form = [ Bulma.h3 "Authentication", render_auth_form ] auth_form = [ Bulma.h3 "Authentication", render_auth_form ]
passrecovery_form = passrecovery_form =
[ Bulma.h3 "You forgot your password (or your login)" [ Bulma.h3 "You forgot your password (or your login)"
, Bulma.div_content [] , Bulma.div_content
[ Bulma.p "Enter either your login or email and you'll receive a recovery token." [ Bulma.p "Enter either your login or email and you'll receive a recovery token."
] ]
, render_password_recovery_form , render_password_recovery_form
] ]
newpass_form = newpass_form =
[ Bulma.h3 "You got the password recovery mail" [ Bulma.h3 "You got the password recovery mail"
, Bulma.div_content [] , Bulma.div_content
[ Bulma.p "Nice! You get to choose your new password." [ Bulma.p "Nice! You get to choose your new password."
] ]
, render_new_password_form , render_new_password_form

View File

@ -8,17 +8,16 @@
-- | - delete a domain -- | - delete a domain
-- | - ask for confirmation -- | - ask for confirmation
-- | - switch to the interface to show and modify the content of a Zone -- | - switch to the interface to show and modify the content of a Zone
-- | - validate the domain before sending a message to `dnsmanagerd` -- | - TODO: validate the domain before sending a message to `dnsmanagerd`
-- | - manage ownership of a domain: give, share, take back exclusive ownership.
module App.Page.DomainList where module App.Page.DomainList where
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==)) import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>))
import Data.Array as A import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer) import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.String (toLower) import Data.String (toLower)
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe)
import Data.String.Utils (endsWith) import Data.String.Utils (endsWith)
import Effect.Aff.Class (class MonadAff) import Effect.Aff.Class (class MonadAff)
import Halogen as H import Halogen as H
@ -33,9 +32,7 @@ import App.DisplayErrors (error_to_paragraph_label)
import App.Validation.Label as Validation import App.Validation.Label as Validation
import CSSClasses as C import App.Type.LogMessage
import App.Type.DomainInfo
import App.Type.LogMessage (LogMessage(..))
import App.Message.DNSManagerDaemon as DNSManager import App.Message.DNSManagerDaemon as DNSManager
-- | `App.DomainListInterface` can send messages through websocket interface -- | `App.DomainListInterface` can send messages through websocket interface
@ -87,26 +84,18 @@ data NewDomainFormAction
-- | - update the list of own domains -- | - update the list of own domains
-- | - handle user inputs -- | - handle user inputs
-- | - add a new domain -- | - add a new domain
-- | - delete a domain you exclusively own -- | - remove a domain
-- | - share or transfer a domain (through dedicated tokens) -- | - TODO: show the zone content (in another component)
-- | - gain ownership over a domain (through dedicated tokens)
-- | - gain exclusive ownership of a shared domain (if the user is currently the only owner)
-- | - show the zone content (in another page)
data Action data Action
= UpdateAcceptedDomains (Array String) = UpdateAcceptedDomains (Array String)
| UpdateMyDomains (Array DomainInfo) | UpdateMyDomains (Array String)
| HandleNewDomainInput NewDomainFormAction | HandleNewDomainInput NewDomainFormAction
| AskDomainTransferUUIDInput String
| NewDomainAttempt Event | NewDomainAttempt Event
| AskDomainTransferAttempt Event
| RemoveDomain String | RemoveDomain String
| EnterDomain String | EnterDomain String
| ShareDomain String
| UnShareDomain String
| TransferDomain String
| DeleteDomainModal String | DeleteDomainModal String
| CancelModal | CancelModal
@ -114,9 +103,8 @@ data Action
| Initialize | Initialize
| Finalize | Finalize
-- | The form only has two visible elements: -- | The form only has two elements:
-- | the subdomain name input and the selected TLD. -- | the subdomain name input and the selected TLD.
-- | The type also includes validation errors.
type NewDomainFormState type NewDomainFormState
= { new_domain :: String = { new_domain :: String
@ -124,21 +112,15 @@ type NewDomainFormState
, selected_domain :: String , selected_domain :: String
} }
-- | The form "askDomainTransfer" is simple enough: an input for the UUID and a button.
-- | The type also includes validation errors.
type AskDomainTransferState = { uuid :: String, _errors :: Array Validation.Error }
-- | The entire component's state contains the form, accepted domains, -- | The entire component's state contains the form, accepted domains,
-- | the list of own domains and a boolean to know if the connection is up. -- | the list of own domains and a boolean to know if the connection is up.
type State = type State =
{ newDomainForm :: NewDomainFormState { newDomainForm :: NewDomainFormState
, askDomainTransferForm :: AskDomainTransferState
, accepted_domains :: Array String , accepted_domains :: Array String
, my_domains :: Array DomainInfo , my_domains :: Array String
, deletion_modal :: Maybe String , active_modal :: Maybe String
} }
component :: forall m. MonadAff m => H.Component Query Input Output m component :: forall m. MonadAff m => H.Component Query Input Output m
@ -159,135 +141,47 @@ component =
default_domain :: String default_domain :: String
default_domain = "netlib.re" default_domain = "netlib.re"
--debug_domains :: Array DomainInfo
--debug_domains
-- = [ emptyDomainInfo { name = "test.example.com"
-- , share_key = Just "UUID"
-- , owners = ["myself", "you"] }
-- , emptyDomainInfo { name = "my-domain.example.com" }
-- , emptyDomainInfo { name = "my-other-domain.example.com" }
-- ]
initialState :: Input -> State initialState :: Input -> State
initialState _ = initialState _ =
{ newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain } { newDomainForm: { new_domain: ""
, askDomainTransferForm: { uuid: "", _errors: [] } , _errors: []
, selected_domain: default_domain
}
, accepted_domains: [ default_domain ] , accepted_domains: [ default_domain ]
, my_domains: [] , my_domains: [ ]
, deletion_modal: Nothing , active_modal: Nothing
} }
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, deletion_modal } render { accepted_domains, my_domains, newDomainForm, active_modal }
= Bulma.section_small = Bulma.section_small
[ case deletion_modal of [ case active_modal of
Nothing -> HH.div_ [ Bulma.columns_ domain_line Nothing -> Bulma.columns_
, Bulma.hr [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form]
, Bulma.columns_ new_domain_line , Bulma.column_ [ Bulma.h3 "My domains"
, Bulma.hr , if A.length my_domains > 0
, Bulma.columns_ explanations_line then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_domains
] else Bulma.p "No domain yet."
]
]
Just domain -> Bulma.modal "Deleting a domain" Just domain -> Bulma.modal "Deleting a domain"
[warning_message domain] [modal_delete_button domain, modal_cancel_button] [warning_message domain] [modal_delete_button domain, modal_cancel_button]
] ]
where where
c = Bulma.column_
domain_line = [ c render_my_domains, c render_my_shared_domains ]
new_domain_line = [ c render_new_domain, c render_gain_ownership ]
explanations_line = [ c render_share_ownership_explanation, c render_transfer_ownership_explanation ]
render_my_domains =
[ Bulma.h3 "My domains"
, Bulma.simple_quote "You are the exclusive owner of the following domains."
, if A.length domains_i_exclusively_own > 0
then Bulma.table [] [ Bulma.table_header_owned_domains
, HH.tbody_ $ map owned_domain_row domains_i_exclusively_own
]
else Bulma.p "No domain yet."
]
render_my_shared_domains =
[ Bulma.h3 "Shared domains"
, Bulma.simple_quote """
The following domains are shared with other users.
In case you are the last owner, you can "unshare" it and gain exclusive ownership.
"""
, if A.length domains_i_share > 0
then Bulma.table [] [ Bulma.table_header_shared_domains
, HH.tbody_ $ map shared_domain_row domains_i_share
]
else Bulma.p "No domain yet."
]
render_new_domain =
[ Bulma.h3 "New domain"
, Bulma.quote [ Bulma.p "The heart of dnsmanager! 🎉"
, Bulma.p "You can reserve a domain name, right here."
, HH.text """
Later you will be able to change the content, share, transfer or even delete the domain.
"""
]
, render_add_domain_form
]
render_gain_ownership =
[ Bulma.h3 "Get the ownership of a domain"
, Bulma.simple_quote """
Someone wants to give you (or share with you) the ownership of a domain.
Please enter the UUID of the transfer.
"""
, render_ask_domain_transfer_form
]
render_share_ownership_explanation =
[ Bulma.h3 "Share the ownership of a domain"
, Bulma.simple_quote """
Ask for a "share token" for your domain and give it to other users.
All the owners be able to make modifications to the domain.
"""
]
render_transfer_ownership_explanation =
[ Bulma.h3 "Transfer the ownership of a domain"
, Bulma.simple_quote """
Ask for a transfer token for your domain and give it to the new owner.
"""
]
modal_delete_button domain = Bulma.alert_btn "Delete the domain" (RemoveDomain domain) modal_delete_button domain = Bulma.alert_btn "Delete the domain" (RemoveDomain domain)
modal_cancel_button = Bulma.cancel_button CancelModal modal_cancel_button = Bulma.cancel_button CancelModal
-- I own all domain without a "share key".
domains_i_exclusively_own = A.sort $ A.filter (\domain -> domain.share_key == Nothing) my_domains
-- Shared domains are all domains with a share_key.
domains_i_share = A.sort $ A.filter (\domain -> domain.share_key /= Nothing) my_domains
warning_message domain warning_message domain
= HH.p [] [ HH.text $ "You are about to delete your domain \"" = HH.p [] [ HH.text $ "You are about to delete your domain \""
<> domain <> domain
<> "\". Are you sure you want to do this? This is " <> "\". Are you sure you want to do this? This is "
, HH.strong_ [ HH.text "irreversible" ] , HH.strong_ [ HH.text "irreversible" ]
, HH.text "." , HH.text "."
, Bulma.notification_warning' """
In case this domain is shared, it won't be deleted, you'll just remove it from your domains.
"""
] ]
shared_domain_row domain = HH.tr_ domain_buttons domain
[ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ] = [ Bulma.alert_btn "delete" (DeleteDomainModal domain)
, HH.td_ [ HH.text $ fromMaybe "" domain.share_key ] , Bulma.btn domain (EnterDomain domain)
, if A.length domain.owners == 1 ]
then HH.td_ [ Bulma.alert_btn "Unshare" (UnShareDomain domain.name) ]
else HH.td_ [ Bulma.btn_ro (C.is_warning) "Cannot unshare it" ]
, HH.td_ [ Bulma.alert_btn "Delete" (DeleteDomainModal domain.name) ]
]
owned_domain_row domain = HH.tr_
[ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ]
, case domain.transfer_key of
Just key -> HH.td_ [ Bulma.p key ]
Nothing -> HH.td_ [ Bulma.btn "Transfer" (TransferDomain domain.name) ]
, HH.td_ [ Bulma.btn "Share" (ShareDomain domain.name) ]
, HH.td_ [ Bulma.alert_btn "Delete" (DeleteDomainModal domain.name) ]
]
render_add_domain_form = HH.form render_add_domain_form = HH.form
[ HE.onSubmit NewDomainAttempt ] [ HE.onSubmit NewDomainAttempt ]
@ -302,17 +196,6 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del
else HH.div_ [ ] else HH.div_ [ ]
] ]
render_ask_domain_transfer_form = HH.form
[ HE.onSubmit AskDomainTransferAttempt ]
[ Bulma.box_input "idTransferToken" "Token" "UUID of the domain"
AskDomainTransferUUIDInput
askDomainTransferForm.uuid
, Bulma.btn_validation_ "ask for a domain transfer"
, if A.length askDomainTransferForm._errors > 0
then HH.div_ $ map error_to_paragraph_label askDomainTransferForm._errors
else HH.div_ [ ]
]
domain_choice :: Int -> Action domain_choice :: Int -> Action
domain_choice i domain_choice i
= HandleNewDomainInput <<< UpdateSelectedDomain $ maybe default_domain (\x -> x) $ accepted_domains A.!! i = HandleNewDomainInput <<< UpdateSelectedDomain $ maybe default_domain (\x -> x) $ accepted_domains A.!! i
@ -327,7 +210,7 @@ handleAction = case _ of
H.raise $ StoreState state H.raise $ StoreState state
CancelModal -> do CancelModal -> do
H.modify_ _ { deletion_modal = Nothing } H.modify_ _ { active_modal = Nothing }
UpdateAcceptedDomains domains -> do UpdateAcceptedDomains domains -> do
H.modify_ _ { accepted_domains = domains } H.modify_ _ { accepted_domains = domains }
@ -346,35 +229,17 @@ handleAction = case _ of
Right _ -> H.modify_ _ { newDomainForm { _errors = [] } } Right _ -> H.modify_ _ { newDomainForm { _errors = [] } }
UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } } UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
AskDomainTransferUUIDInput str -> do
H.modify_ _ { askDomainTransferForm { uuid = toLower str } }
EnterDomain domain -> do EnterDomain domain -> do
H.raise $ ChangePageZoneInterface domain H.raise $ ChangePageZoneInterface domain
ShareDomain domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskShareToken { domain: domain }
H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "Ask a \"share token\" for domain " <> domain <> "."
TransferDomain domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskTransferToken { domain: domain }
H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "Ask a \"transfer token\" for domain " <> domain <> "."
UnShareDomain domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskUnShareDomain { domain: domain }
H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "Ask for exclusive ownership for domain " <> domain <> "."
DeleteDomainModal domain -> do DeleteDomainModal domain -> do
H.modify_ _ { deletion_modal = Just domain } H.modify_ _ { active_modal = Just domain }
RemoveDomain domain -> do RemoveDomain domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain } message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
H.raise $ MessageToSend message H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "Remove domain: " <> domain H.raise $ Log $ SystemLog $ "Remove domain: " <> domain
H.modify_ _ { deletion_modal = Nothing } H.modify_ _ { active_modal = Nothing }
NewDomainAttempt ev -> do NewDomainAttempt ev -> do
H.liftEffect $ Event.preventDefault ev H.liftEffect $ Event.preventDefault ev
@ -384,7 +249,7 @@ handleAction = case _ of
case newDomainForm.new_domain, newDomainForm._errors, new_domain of case newDomainForm.new_domain, newDomainForm._errors, new_domain of
"", _, _ -> "", _, _ ->
H.raise $ Log $ UnableToSend "You didn't enter the new domain." H.raise $ Log $ UnableToSend "You didn't enter the new domain!"
_, [], _ -> do _, [], _ -> do
message <- H.liftEffect message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
@ -395,23 +260,6 @@ handleAction = case _ of
_, _, _ -> _, _, _ ->
H.raise $ Log $ UnableToSend $ "The new domain name is invalid." H.raise $ Log $ UnableToSend $ "The new domain name is invalid."
AskDomainTransferAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
{ askDomainTransferForm } <- H.get
case askDomainTransferForm.uuid, askDomainTransferForm._errors of
"", _ ->
H.raise $ Log $ UnableToSend "You didn't enter the UUID of the transfer."
uuid, [] -> do
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkGainOwnership { uuid: uuid }
H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "Gain ownership of a domain (" <> uuid <> ")."
handleAction $ AskDomainTransferUUIDInput ""
_, _ ->
H.raise $ Log $ UnableToSend $ "The UUID is invalid."
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of handleQuery = case _ of
@ -432,17 +280,10 @@ handleQuery = case _ of
handleAction $ UpdateMyDomains response.my_domains handleAction $ UpdateMyDomains response.my_domains
(DNSManager.MkDomainAdded response) -> do (DNSManager.MkDomainAdded response) -> do
{ my_domains } <- H.get { my_domains } <- H.get
handleAction $ UpdateMyDomains (my_domains <> [ emptyDomainInfo { name = response.domain } ]) handleAction $ UpdateMyDomains (my_domains <> [response.domain])
(DNSManager.MkDomainChanged response) -> do
{ my_domains } <- H.get
let replaced_domains = map (\d -> if d.name == response.domain.name then response.domain else d) my_domains
new_domains = if A.elem response.domain replaced_domains
then replaced_domains
else replaced_domains <> [response.domain]
handleAction $ UpdateMyDomains new_domains
(DNSManager.MkDomainDeleted response) -> do (DNSManager.MkDomainDeleted response) -> do
{ my_domains } <- H.get { my_domains } <- H.get
handleAction $ UpdateMyDomains $ A.filter (\d -> d.name /= response.domain) my_domains handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface." _ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
pure (Just a) pure (Just a)

View File

@ -55,9 +55,9 @@ render _ = HH.div_
] ]
where where
title = Bulma.h3 title = Bulma.h3
expl content = Bulma.div_content [] [ Bulma.explanation content ] expl content = Bulma.div_content [ Bulma.explanation content ]
p = Bulma.p p = Bulma.p
b x = Bulma.column_ [ Bulma.box [ Bulma.div_content [] x ] ] b x = Bulma.column_ [ Bulma.box [ Bulma.div_content x ] ]
render_description = Bulma.columns_ [ render_basics, render_no_expert, render_no_housing ] render_description = Bulma.columns_ [ render_basics, render_no_expert, render_no_housing ]
render_update_why_and_contact = Bulma.columns_ [ render_updates, render_why, render_contact ] render_update_why_and_contact = Bulma.columns_ [ render_updates, render_why, render_contact ]

View File

@ -2,14 +2,12 @@
-- | -- |
-- | This interface enables to: -- | This interface enables to:
-- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV) -- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
-- | - provide dedicated interfaces for SPF, DKIM and DMARC -- | - provide dedicated interfaces for SPF and DKIM (TODO: DMARC)
-- | - add, modify, remove resource records -- | - add, modify, remove resource records
-- | -- |
-- | **WIP**: Display relevant information for each record type in the (add/mod) modal. -- | **WIP**: Display relevant information for each record type in the (add/mod) modal.
-- | This includes explaining use cases and displaying an appropriate interface for the task at hand. -- | This includes explaining use cases and displaying an appropriate interface for the task at hand.
-- | -- |
-- | TODO: CAA records.
-- |
-- | TODO: display errors not only for a record but for the whole zone. -- | TODO: display errors not only for a record but for the whole zone.
-- | A DNS zone is bound by a set of rules, the whole zone must be consistent. -- | A DNS zone is bound by a set of rules, the whole zone must be consistent.
-- | For example, a CNAME `target` has to point to the `name` of an existing record. -- | For example, a CNAME `target` has to point to the `name` of an existing record.
@ -57,7 +55,7 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR
, show_qualifier, show_qualifier_char , show_qualifier, show_qualifier_char
, show_mechanism_type, show_mechanism, to_mechanism , show_mechanism_type, show_mechanism, to_mechanism
, show_modifier_type, show_modifier, to_modifier , show_modifier_type, show_modifier, to_modifier
, qualifiers , all_qualifiers
, mechanism_types, qualifier_types, modifier_types) , mechanism_types, qualifier_types, modifier_types)
import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
import App.Type.DKIM as DKIM import App.Type.DKIM as DKIM
@ -296,7 +294,7 @@ default_domain :: String
default_domain = "netlib.re" default_domain = "netlib.re"
default_rr_A :: ResourceRecord default_rr_A :: ResourceRecord
default_rr_A = emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" } default_rr_A = emptyRR { rrtype = "A", name = "www", target = "192.0.2.1" }
default_empty_rr :: ResourceRecord default_empty_rr :: ResourceRecord
default_empty_rr = default_rr_A default_empty_rr = default_rr_A
@ -389,11 +387,11 @@ render state
render_current_rr_modal :: forall w. HH.HTML w Action render_current_rr_modal :: forall w. HH.HTML w Action
render_current_rr_modal = render_current_rr_modal =
case state._currentRR.rrtype of case state._currentRR.rrtype of
"A" -> template (modal_content_simple A) (foot_content A) "A" -> template modal_content_simple (foot_content A)
"AAAA" -> template (modal_content_simple AAAA) (foot_content AAAA) "AAAA" -> template modal_content_simple (foot_content AAAA)
"TXT" -> template (modal_content_simple TXT) (foot_content TXT) "TXT" -> template modal_content_simple (foot_content TXT)
"CNAME" -> template (modal_content_simple CNAME) (foot_content CNAME) "CNAME" -> template modal_content_simple (foot_content CNAME)
"NS" -> template (modal_content_simple NS) (foot_content NS) "NS" -> template modal_content_simple (foot_content NS)
"MX" -> template modal_content_mx (foot_content MX) "MX" -> template modal_content_mx (foot_content MX)
"SRV" -> template modal_content_srv (foot_content SRV) "SRV" -> template modal_content_srv (foot_content SRV)
"SPF" -> template modal_content_spf (foot_content SPF) "SPF" -> template modal_content_spf (foot_content SPF)
@ -406,10 +404,9 @@ render state
render_errors = if A.length state._currentRR_errors > 0 render_errors = if A.length state._currentRR_errors > 0
then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._currentRR_errors then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._currentRR_errors
else HH.div_ [ ] else HH.div_ [ ]
modal_content_simple :: AcceptedRRTypes -> Array (HH.HTML w Action) modal_content_simple :: Array (HH.HTML w Action)
modal_content_simple x = modal_content_simple =
[ render_errors [ render_errors
, render_introduction_text x
, Bulma.input_with_side_text ("domain" <> state._currentRR.rrtype) "Name" "www" , Bulma.input_with_side_text ("domain" <> state._currentRR.rrtype) "Name" "www"
(updateForm Field_Domain) (updateForm Field_Domain)
state._currentRR.name state._currentRR.name
@ -431,19 +428,9 @@ render state
] ]
else [] else []
_ -> [] _ -> []
render_introduction_text :: AcceptedRRTypes -> HH.HTML w Action
render_introduction_text = case _ of
A -> Bulma.div_content [] [Bulma.explanation Explanations.a_introduction]
AAAA -> Bulma.div_content [] [Bulma.explanation Explanations.aaaa_introduction]
TXT -> Bulma.div_content [] [Bulma.explanation Explanations.txt_introduction]
CNAME -> Bulma.div_content [] [Bulma.explanation Explanations.cname_introduction]
NS -> Bulma.div_content [] [Bulma.explanation Explanations.ns_introduction]
_ -> HH.p_ []
modal_content_mx :: Array (HH.HTML w Action) modal_content_mx :: Array (HH.HTML w Action)
modal_content_mx = modal_content_mx =
[ render_errors [ render_errors
, Bulma.div_content [] [Bulma.explanation Explanations.mx_introduction]
, Bulma.input_with_side_text "domainMX" "Name" "www" , Bulma.input_with_side_text "domainMX" "Name" "www"
(updateForm Field_Domain) (updateForm Field_Domain)
state._currentRR.name state._currentRR.name
@ -460,7 +447,7 @@ render state
] ]
modal_content_srv :: Array (HH.HTML w Action) modal_content_srv :: Array (HH.HTML w Action)
modal_content_srv = modal_content_srv =
[ Bulma.div_content [] [Bulma.explanation Explanations.srv_introduction] [ Bulma.div_content [Bulma.explanation Explanations.srv_introduction]
, render_errors , render_errors
, Bulma.box_input "domainSRV" "Service name" "service name" , Bulma.box_input "domainSRV" "Service name" "service name"
(updateForm Field_Domain) (updateForm Field_Domain)
@ -486,7 +473,7 @@ render state
] ]
modal_content_spf :: Array (HH.HTML w Action) modal_content_spf :: Array (HH.HTML w Action)
modal_content_spf = modal_content_spf =
[ Bulma.div_content [] [Bulma.explanation Explanations.spf_introduction] [ Bulma.div_content [Bulma.explanation Explanations.spf_introduction]
, render_errors , render_errors
, Bulma.input_with_side_text "domainSPF" "Name" "Let this alone." , Bulma.input_with_side_text "domainSPF" "Name" "Let this alone."
(updateForm Field_Domain) (updateForm Field_Domain)
@ -524,13 +511,13 @@ render state
, Bulma.hr , Bulma.hr
, Bulma.box , Bulma.box
[ Bulma.h3 "Default behavior" [ Bulma.h3 "Default behavior"
, Bulma.div_content [] [Bulma.explanation Explanations.spf_default_behavior] , Bulma.div_content [Bulma.explanation Explanations.spf_default_behavior]
, Bulma.selection SPF_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q) , Bulma.selection SPF_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q)
] ]
] ]
modal_content_dkim :: Array (HH.HTML w Action) modal_content_dkim :: Array (HH.HTML w Action)
modal_content_dkim = modal_content_dkim =
[ Bulma.div_content [] [Bulma.explanation Explanations.dkim_introduction] [ Bulma.div_content [Bulma.explanation Explanations.dkim_introduction]
, render_errors , render_errors
, Bulma.input_with_side_text "domainDKIM" "Name" "default._domainkey" , Bulma.input_with_side_text "domainDKIM" "Name" "default._domainkey"
(updateForm Field_Domain) (updateForm Field_Domain)
@ -540,7 +527,7 @@ render state
(updateForm Field_TTL) (updateForm Field_TTL)
(show state._currentRR.ttl) (show state._currentRR.ttl)
, Bulma.hr , Bulma.hr
, Bulma.div_content [] [Bulma.explanation Explanations.dkim_default_algorithms] , Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
, Bulma.selection_field "idDKIMSignature" "Signature algo" , Bulma.selection_field "idDKIMSignature" "Signature algo"
DKIM_sign_algo DKIM_sign_algo
(map show DKIM.sign_algos) (map show DKIM.sign_algos)
@ -555,7 +542,7 @@ render state
modal_content_dmarc :: Array (HH.HTML w Action) modal_content_dmarc :: Array (HH.HTML w Action)
modal_content_dmarc = modal_content_dmarc =
[ Bulma.div_content [] [Bulma.explanation Explanations.dmarc_introduction] [ Bulma.div_content [Bulma.explanation Explanations.dmarc_introduction]
, render_errors , render_errors
, Bulma.input_with_side_text "domainDMARC" "Name" "_dmarc" , Bulma.input_with_side_text "domainDMARC" "Name" "_dmarc"
(updateForm Field_Domain) (updateForm Field_Domain)
@ -564,27 +551,20 @@ render state
, Bulma.box_input "ttlDMARC" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) , Bulma.box_input "ttlDMARC" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl)
, Bulma.hr , Bulma.hr
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_policy] , Bulma.div_content [Bulma.explanation Explanations.dmarc_policy]
, Bulma.selection_field' "idDMARCPolicy" "Policy" DMARC_policy , Bulma.selection_field "idDMARCPolicy" "Policy" DMARC_policy (map show DMARC.policies) (show state.dmarc.p)
(A.zip DMARC.policies_txt DMARC.policies_raw) , Bulma.div_content [Bulma.explanation Explanations.dmarc_sp_policy]
(show state.dmarc.p) , Bulma.selection_field "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_sp_policy] (["do not provide policy advice"] <> map show DMARC.policies) (maybe "-" show state.dmarc.sp)
, Bulma.selection_field' "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
(zip_nullable DMARC.policies_txt_with_null DMARC.policies_raw)
(maybe "-" show state.dmarc.sp)
, Bulma.hr , Bulma.hr
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_adkim] , Bulma.div_content [Bulma.explanation Explanations.dmarc_adkim]
, Bulma.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim , Bulma.selection_field "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim DMARC.consistency_policies_txt (maybe "-" show state.dmarc.adkim)
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw) , Bulma.div_content [Bulma.explanation Explanations.dmarc_aspf]
(maybe "-" show state.dmarc.adkim) , Bulma.selection_field "idDMARCaspf" "Consistency Policy for SPF" DMARC_aspf DMARC.consistency_policies_txt (maybe "-" show state.dmarc.aspf)
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_aspf]
, Bulma.selection_field' "idDMARCaspf" "Consistency Policy for SPF" DMARC_aspf
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
(maybe "-" show state.dmarc.aspf)
, Bulma.hr , Bulma.hr
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_pct] , Bulma.div_content [Bulma.explanation Explanations.dmarc_pct]
, Bulma.box_input "idDMARCpct" "Sample rate [0..100]" "100" DMARC_pct (maybe "100" show state.dmarc.pct) , Bulma.box_input "idDMARCpct" "Sample rate [0..100]" "100" DMARC_pct (maybe "100" show state.dmarc.pct)
, Bulma.hr , Bulma.hr
@ -593,7 +573,7 @@ render state
(maybe "-" show state.dmarc.fo) (maybe "-" show state.dmarc.fo)
, Bulma.hr , Bulma.hr
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_contact] , Bulma.div_content [Bulma.explanation Explanations.dmarc_contact]
, maybe (Bulma.p "There is no address to send aggregated reports to.") , maybe (Bulma.p "There is no address to send aggregated reports to.")
(display_dmarc_mail_addresses "Addresses to contact for aggregated reports" DMARC_remove_rua) state.dmarc.rua (display_dmarc_mail_addresses "Addresses to contact for aggregated reports" DMARC_remove_rua) state.dmarc.rua
, maybe (Bulma.p "There is no address to send detailed reports to.") , maybe (Bulma.p "There is no address to send detailed reports to.")
@ -608,7 +588,7 @@ render state
] [] ] []
, Bulma.hr , Bulma.hr
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_ri] , Bulma.div_content [Bulma.explanation Explanations.dmarc_ri]
, Bulma.box_input "idDMARCri" "Report interval (in seconds)" "86400" DMARC_ri (maybe "0" show state.dmarc.ri) , Bulma.box_input "idDMARCri" "Report interval (in seconds)" "86400" DMARC_ri (maybe "0" show state.dmarc.ri)
] ]
@ -678,11 +658,11 @@ handleAction = case _ of
CreateNewRRModal t -> do CreateNewRRModal t -> do
state <- H.get state <- H.get
H.modify_ _ { rr_modal = NewRRModal t } H.modify_ _ { rr_modal = NewRRModal t }
let default_rr_AAAA = emptyRR { rrtype = "AAAA", name = "server1", target = "2001:db8::1" } let default_rr_AAAA = emptyRR { rrtype = "AAAA", name = "www", target = "2001:db8::1" }
default_rr_TXT = emptyRR { rrtype = "TXT", name = "txt", target = "some text" } default_rr_TXT = emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "www", target = "server1" } default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "blog", target = "www" }
default_rr_NS = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." } default_rr_NS = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." }
default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 } default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 }
default_rr_SRV = emptyRR { rrtype = "SRV", name = "voip", target = "server1" default_rr_SRV = emptyRR { rrtype = "SRV", name = "voip", target = "server1"
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" } , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" "" default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
@ -842,7 +822,7 @@ handleAction = case _ of
SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v } SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v }
SPF_Modifier_t v -> H.modify_ _ { spf_modifier_t = maybe "redirect" id $ modifier_types A.!! v } SPF_Modifier_t v -> H.modify_ _ { spf_modifier_t = maybe "redirect" id $ modifier_types A.!! v }
SPF_Modifier_v v -> H.modify_ _ { spf_modifier_v = v } SPF_Modifier_v v -> H.modify_ _ { spf_modifier_v = v }
SPF_Qualifier v -> H.modify_ _ { _currentRR { q = qualifiers A.!! v } } SPF_Qualifier v -> H.modify_ _ { _currentRR { q = all_qualifiers A.!! v } }
SPF_remove_mechanism i -> SPF_remove_mechanism i ->
H.modify_ \s -> s { _currentRR { mechanisms = case s._currentRR.mechanisms of H.modify_ \s -> s { _currentRR { mechanisms = case s._currentRR.mechanisms of
Just ms -> Just (remove_id i $ attach_id 0 ms) Just ms -> Just (remove_id i $ attach_id 0 ms)
@ -910,19 +890,29 @@ handleAction = case _ of
DMARC_remove_rua i -> do DMARC_remove_rua i -> do
state <- H.get state <- H.get
let current_ruas = fromMaybe [] state.dmarc.rua let current_ruas = case state._currentRR.dmarc of
Nothing -> []
Just dmarc -> fromMaybe [] dmarc.rua
new_value = case (remove_id i $ attach_id 0 current_ruas) of new_value = case (remove_id i $ attach_id 0 current_ruas) of
[] -> Nothing [] -> Nothing
v -> Just v v -> Just v
H.modify_ \s -> s { dmarc { rua = new_value } } new_dmarc = case state._currentRR.dmarc of
Nothing -> DMARC.emptyDMARCRR { rua = new_value }
Just dmarc -> dmarc { rua = new_value }
H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
DMARC_remove_ruf i -> do DMARC_remove_ruf i -> do
state <- H.get state <- H.get
let current_rufs = fromMaybe [] state.dmarc.ruf let current_rufs = case state._currentRR.dmarc of
Nothing -> []
Just dmarc -> fromMaybe [] dmarc.ruf
new_value = case (remove_id i $ attach_id 0 current_rufs) of new_value = case (remove_id i $ attach_id 0 current_rufs) of
[] -> Nothing [] -> Nothing
v -> Just v v -> Just v
H.modify_ \s -> s { dmarc { ruf = new_value } } new_dmarc = case state._currentRR.dmarc of
Nothing -> DMARC.emptyDMARCRR { ruf = new_value }
Just dmarc -> dmarc { ruf = new_value }
H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
DMARC_policy v -> H.modify_ _ { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } DMARC_policy v -> H.modify_ _ { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } }
DMARC_sp_policy v -> H.modify_ _ { dmarc { sp = DMARC.policies A.!! (v - 1) } } DMARC_sp_policy v -> H.modify_ _ { dmarc { sp = DMARC.policies A.!! (v - 1) } }
@ -1157,8 +1147,8 @@ render_resources records
show_token_or_btn rr = show_token_or_btn rr =
case rr.rrtype of case rr.rrtype of
"A" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token" (NewToken rr.rrid) "A" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token!" (NewToken rr.rrid)
"AAAA" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token" (NewToken rr.rrid) "AAAA" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token!" (NewToken rr.rrid)
_ -> HH.text "" _ -> HH.text ""
fancy_qualifier_display :: RR.Qualifier -> String fancy_qualifier_display :: RR.Qualifier -> String

View File

@ -6,7 +6,7 @@ import Bulma as Bulma
expl' :: forall w i. String -> HH.HTML w i expl' :: forall w i. String -> HH.HTML w i
expl' text = expl [Bulma.p text] expl' text = expl [Bulma.p text]
expl :: forall w i. Array (HH.HTML w i) -> HH.HTML w i expl :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
expl content = Bulma.div_content [] [ Bulma.explanation content ] expl content = Bulma.div_content [ Bulma.explanation content ]
expl_txt :: forall w i. String -> HH.HTML w i expl_txt :: forall w i. String -> HH.HTML w i
expl_txt content = Bulma.explanation [ Bulma.p content ] expl_txt content = Bulma.explanation [ Bulma.p content ]
@ -155,110 +155,6 @@ basics = HH.div_
, Bulma.p "Check out the \"Tokens? 🤨\" tab." , Bulma.p "Check out the \"Tokens? 🤨\" tab."
] ]
a_introduction :: forall w i. Array (HH.HTML w i)
a_introduction =
[ Bulma.p """
The A record enables to bind an IPv4 address to a domain.
"""
, HH.p []
[ HH.text "🚨 "
, HH.u_ [HH.text "Advice for beginners"]
, HH.text ":"
, HH.text """
the "Name" field is for the name of the record, which should be the name of the server owning this IP address, such as "server1".
The "Target" field is for the IP address.
The default TTL should be fine.
"""
]
]
aaaa_introduction :: forall w i. Array (HH.HTML w i)
aaaa_introduction =
[ Bulma.p """
The AAAA record enables to bind an IPv6 address to a domain.
"""
, HH.p []
[ HH.text "🚨 "
, HH.u_ [HH.text "Advice for beginners"]
, HH.text ":"
, HH.text """
the "Name" field is for the name of the record, which should be the name of the server owning this IP address, such as "server1".
The "Target" field is for the IP address.
The default TTL should be fine.
"""
]
]
cname_introduction :: forall w i. Array (HH.HTML w i)
cname_introduction =
[ Bulma.p """
The CNAME record enables to provide alternative names to records.
"""
, HH.p []
[ HH.text "🚨 "
, HH.u_ [HH.text "Advice for beginners"]
, HH.text ":"
, HH.text """
this resource record helps keeping your zone clean.
Let's say you have a server named "server1", you can register an A record for that server (since the server actually has an IP address).
Then, your hosted services will be registered in your zone as CNAMEs: "www", "blog" and "voip" will point to "server1", the actual server hosting these services.
"""
]
]
mx_introduction :: forall w i. Array (HH.HTML w i)
mx_introduction =
[ Bulma.p """
The MX record enables to add a mail server to your zone.
"""
, HH.p []
[ HH.text "🚨 "
, HH.u_ [HH.text "Advice for beginners"]
, HH.text ": handling a mail server is both complex and difficult."
, HH.text """
The tab "The basics 🧠" explains some parts of hosting a mail server, but keep in mind that this is time consuming to get it together.
This page talks about the DNS aspect of it, but doesn't cover all you need to know to actually host a mail server, by a long shot.
"""
]
, Bulma.p """
Anyway, the MX record itself is simple to understand.
Let's say you have a server named "server1" with your mail service.
The MX record can be named "mail" and it will target "server1".
Of course, "server1" needs a record for its IP address (A or AAAA).
"""
, Bulma.p """
The priority field is important only in case you have multiple mail servers; keep the default value.
"""
]
txt_introduction :: forall w i. Array (HH.HTML w i)
txt_introduction =
[ Bulma.p """
The TXT record enables to declare a small text.
"""
, HH.p []
[ HH.text "🚨 "
, HH.u_ [HH.text "Advice for beginners"]
, HH.text ":"
, HH.text """
do not use this record directly.
TXT records are used in several places, for example for mail security through SPF, DKIM and DMARC records.
"""
]
, Bulma.notification_danger' """
All of these specific records have a dedicated user interface on this website;
use them instead of writing these records by yourself.
"""
]
ns_introduction :: forall w i. Array (HH.HTML w i)
ns_introduction =
[ Bulma.p """
The NS record enables to declare a new Name Server, meaning a new server that would serve this zone.
"""
, Bulma.notification_danger' "🚨 Advice for beginners: do not use this resource record."
]
dkim_introduction :: forall w i. Array (HH.HTML w i) dkim_introduction :: forall w i. Array (HH.HTML w i)
dkim_introduction = dkim_introduction =
[ Bulma.p """ [ Bulma.p """

View File

@ -170,13 +170,10 @@ consistency_policies = [Strict, Relaxed]
consistency_policies_txt :: Array String consistency_policies_txt :: Array String
consistency_policies_txt consistency_policies_txt
= [ "Do not provide policy advice" = [ "Do not provide policy advice"
, "Strict: same domain" , "Strict"
, "Relaxed: same organizational domain" , "Relaxed"
] ]
consistency_policies_raw :: Array String
consistency_policies_raw = map show consistency_policies
-- | Codec for just encoding a single value of type `ConsistencyPolicy`. -- | Codec for just encoding a single value of type `ConsistencyPolicy`.
codecConsistencyPolicy :: CA.JsonCodec ConsistencyPolicy codecConsistencyPolicy :: CA.JsonCodec ConsistencyPolicy
codecConsistencyPolicy codecConsistencyPolicy
@ -238,19 +235,6 @@ data Policy
policies :: Array Policy policies :: Array Policy
policies = [None, Quarantine, Reject] policies = [None, Quarantine, Reject]
policies_raw :: Array String
policies_raw = map show policies
policies_txt :: Array String
policies_txt =
[ "None (let the receiver decide)"
, "Quarantine (high spam score, flag, etc.)"
, "Reject"
]
policies_txt_with_null :: Array String
policies_txt_with_null = [ "Do not provide policy advice" ] <> policies_txt
-- | Codec for just encoding a single value of type `Policy`. -- | Codec for just encoding a single value of type `Policy`.
codecPolicy :: CA.JsonCodec Policy codecPolicy :: CA.JsonCodec Policy
codecPolicy = CA.prismaticCodec "Policy" str_to_policy generic_serialization CA.string codecPolicy = CA.prismaticCodec "Policy" str_to_policy generic_serialization CA.string

View File

@ -1,33 +0,0 @@
module App.Type.DomainInfo where
import Prelude ((<>), map, bind, pure)
import Data.Maybe (Maybe(..), maybe)
import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR
type DomainInfo
= { name :: String
, share_key :: Maybe String
, transfer_key :: Maybe String
, owners :: Array Int
}
codec :: JsonCodec DomainInfo
codec = CA.object "DomainInfo"
(CAR.record
{ name: CA.string
, share_key: CAR.optional CA.string
, transfer_key: CAR.optional CA.string
, owners: CA.array CA.int
})
emptyDomainInfo :: DomainInfo
emptyDomainInfo
= { name: ""
, share_key: Nothing
, transfer_key: Nothing
, owners: []
}

View File

@ -232,8 +232,8 @@ emptyRR
} }
data Qualifier = Pass | Neutral | SoftFail | HardFail data Qualifier = Pass | Neutral | SoftFail | HardFail
qualifiers :: Array Qualifier all_qualifiers :: Array Qualifier
qualifiers = [Pass, Neutral, SoftFail, HardFail] all_qualifiers = [Pass, Neutral, SoftFail, HardFail]
qualifier_types :: Array String qualifier_types :: Array String
qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"] qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]

View File

@ -61,24 +61,6 @@ table prop xs = HH.table ([ HP.classes $ C.table ] <> prop) xs
table_ :: forall w i. Array HH.ClassName -> HH.Node DHI.HTMLtable w i table_ :: forall w i. Array HH.ClassName -> HH.Node DHI.HTMLtable w i
table_ classes prop xs = HH.table ([ HP.classes $ C.table <> classes] <> prop) xs table_ classes prop xs = HH.table ([ HP.classes $ C.table <> classes] <> prop) xs
table_header_owned_domains :: forall w i. HH.HTML w i
table_header_owned_domains
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
, HH.th_ [ HH.text "" ]
, HH.th_ [ HH.text "" ]
, HH.th_ [ HH.text "" ]
]
]
table_header_shared_domains :: forall w i. HH.HTML w i
table_header_shared_domains
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
, HH.th_ [ HH.text "Share key" ]
, HH.th_ [ HH.text "" ]
, HH.th_ [ HH.text "" ]
]
]
mechanism_table_header :: forall w i. HH.HTML w i mechanism_table_header :: forall w i. HH.HTML w i
mechanism_table_header mechanism_table_header
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ] = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ]
@ -556,17 +538,12 @@ tag_light_info str = HH.span [HP.classes (C.tag <> C.is_info <> C.is_light)] [HH
div_large_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i div_large_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
div_large_content content = HH.div [HP.classes (C.is_large <> C.content)] content div_large_content content = HH.div [HP.classes (C.is_large <> C.content)] content
div_content :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i div_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
div_content classes content = HH.div [HP.classes (C.content <> classes)] content div_content content = HH.div [HP.classes (C.content)] content
explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
explanation content = HH.blockquote [HP.classes [HH.ClassName "justified"]] content explanation content = HH.blockquote [HP.classes [HH.ClassName "justified"]] content
quote :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
quote content = div_content [] [ explanation content ]
simple_quote :: forall w i. String -> HH.HTML w i
simple_quote content = quote [ p content ]
tabs :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i tabs :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
tabs classes tab_list = HH.div [HP.classes $ C.tabs <> classes] [HH.ul_ tab_list] tabs classes tab_list = HH.div [HP.classes $ C.tabs <> classes] [HH.ul_ tab_list]
@ -590,16 +567,13 @@ notification classes value deleteaction =
] ]
notification_primary :: forall w i. String -> i -> HH.HTML w i notification_primary :: forall w i. String -> i -> HH.HTML w i
notification_primary value action = notification C.is_primary value action notification_primary value deleteaction = notification C.is_primary value deleteaction
notification_success :: forall w i. String -> i -> HH.HTML w i notification_success :: forall w i. String -> i -> HH.HTML w i
notification_success value action = notification C.is_success value action notification_success value deleteaction = notification C.is_success value deleteaction
notification_warning :: forall w i. String -> i -> HH.HTML w i
notification_warning value action = notification C.is_warning value action
notification_danger :: forall w i. String -> i -> HH.HTML w i notification_danger :: forall w i. String -> i -> HH.HTML w i
notification_danger value action = notification C.is_danger value action notification_danger value deleteaction = notification C.is_danger value deleteaction
notification_block' :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i notification_block' :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
notification_block' classes content = notification_block' classes content =
@ -610,12 +584,6 @@ notification' classes value =
HH.div [HP.classes (C.notification <> classes)] HH.div [HP.classes (C.notification <> classes)]
[ HH.text value ] [ HH.text value ]
notification_primary' :: forall w i. String -> HH.HTML w i
notification_primary' value = notification' C.is_primary value
notification_warning' :: forall w i. String -> HH.HTML w i
notification_warning' value = notification' C.is_warning value
notification_danger' :: forall w i. String -> HH.HTML w i notification_danger' :: forall w i. String -> HH.HTML w i
notification_danger' value = notification' C.is_danger value notification_danger' value = notification' C.is_danger value