Compare commits
18 Commits
103fb0d643
...
dcc587bd19
Author | SHA1 | Date | |
---|---|---|---|
dcc587bd19 | |||
2f75e29991 | |||
cfd1ecf265 | |||
a43884f98a | |||
06a52e6480 | |||
e1c069c497 | |||
108c78a206 | |||
67d0ca700f | |||
ea2160b857 | |||
04f9334f29 | |||
96f82adf6b | |||
9346e81861 | |||
c98de0e4f0 | |||
797f2ce248 | |||
b4a75feca0 | |||
d8c78e4370 | |||
0605cf1a05 | |||
4181c86c82 |
@ -573,42 +573,45 @@ 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 "GotErrorAlreadyUsersInDB"
|
handleAction $ Log $ ErrorLog "Login already taken."
|
||||||
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."
|
||||||
@ -684,8 +687,9 @@ 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."
|
||||||
(DNSManager.MkDomainChanged _) -> do
|
m@(DNSManager.MkDomainChanged response) -> do
|
||||||
handleAction $ Log $ ErrorLog $ "DomainChanged"
|
handleAction $ Log $ SystemLog $ "Domain \"" <> response.domain.name <> "\" has been updated."
|
||||||
|
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."
|
||||||
@ -701,7 +705,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 $ "reason is: " <> errmsg.reason
|
handleAction $ Log $ ErrorLog 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..."
|
||||||
|
@ -339,6 +339,11 @@ 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
|
||||||
@ -393,6 +398,7 @@ 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
|
||||||
@ -455,6 +461,7 @@ 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
|
||||||
|
@ -2,6 +2,8 @@ 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
|
||||||
@ -105,6 +107,27 @@ 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
|
||||||
@ -183,9 +206,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 = { }
|
type DomainChanged = { domain :: DomainInfo.DomainInfo }
|
||||||
codecDomainChanged ∷ CA.JsonCodec DomainChanged
|
codecDomainChanged ∷ CA.JsonCodec DomainChanged
|
||||||
codecDomainChanged = CA.object "DomainChanged" (CAR.record { })
|
codecDomainChanged = CA.object "DomainChanged" (CAR.record { domain: DomainInfo.codec })
|
||||||
|
|
||||||
{- 12 -}
|
{- 12 -}
|
||||||
type Zone = { zone :: DNSZone.DNSZone }
|
type Zone = { zone :: DNSZone.DNSZone }
|
||||||
@ -208,10 +231,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 String, admin :: Boolean }
|
type Logged = { accepted_domains :: Array String, my_domains :: Array DomainInfo.DomainInfo, 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 CA.string
|
, my_domains: CA.array DomainInfo.codec
|
||||||
, admin: CA.boolean
|
, admin: CA.boolean
|
||||||
})
|
})
|
||||||
|
|
||||||
@ -295,6 +318,10 @@ 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
|
||||||
@ -348,6 +375,10 @@ 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
|
||||||
|
@ -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
|
||||||
|
@ -8,16 +8,17 @@
|
|||||||
-- | - 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
|
||||||
-- | - TODO: validate the domain before sending a message to `dnsmanagerd`
|
-- | - 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)
|
import Data.Maybe (Maybe(..), maybe, fromMaybe)
|
||||||
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
|
||||||
@ -32,7 +33,9 @@ import App.DisplayErrors (error_to_paragraph_label)
|
|||||||
|
|
||||||
import App.Validation.Label as Validation
|
import App.Validation.Label as Validation
|
||||||
|
|
||||||
import App.Type.LogMessage
|
import CSSClasses as C
|
||||||
|
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
|
||||||
@ -84,18 +87,26 @@ 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
|
||||||
-- | - remove a domain
|
-- | - delete a domain you exclusively own
|
||||||
-- | - TODO: show the zone content (in another component)
|
-- | - share or transfer a domain (through dedicated tokens)
|
||||||
|
-- | - 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 String)
|
| UpdateMyDomains (Array DomainInfo)
|
||||||
|
|
||||||
| 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
|
||||||
@ -103,8 +114,9 @@ data Action
|
|||||||
| Initialize
|
| Initialize
|
||||||
| Finalize
|
| Finalize
|
||||||
|
|
||||||
-- | The form only has two elements:
|
-- | The form only has two visible 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
|
||||||
@ -112,15 +124,21 @@ 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 String
|
, my_domains :: Array DomainInfo
|
||||||
|
|
||||||
, active_modal :: Maybe String
|
, deletion_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
|
||||||
@ -141,47 +159,135 @@ 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: ""
|
{ newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain }
|
||||||
, _errors: []
|
, askDomainTransferForm: { uuid: "", _errors: [] }
|
||||||
, selected_domain: default_domain
|
|
||||||
}
|
|
||||||
, accepted_domains: [ default_domain ]
|
, accepted_domains: [ default_domain ]
|
||||||
, my_domains: [ ]
|
, my_domains: []
|
||||||
, active_modal: Nothing
|
, deletion_modal: Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
render :: forall m. State -> H.ComponentHTML Action () m
|
render :: forall m. State -> H.ComponentHTML Action () m
|
||||||
render { accepted_domains, my_domains, newDomainForm, active_modal }
|
render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, deletion_modal }
|
||||||
= Bulma.section_small
|
= Bulma.section_small
|
||||||
[ case active_modal of
|
[ case deletion_modal of
|
||||||
Nothing -> Bulma.columns_
|
Nothing -> HH.div_ [ Bulma.columns_ domain_line
|
||||||
[ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form]
|
, Bulma.hr
|
||||||
, Bulma.column_ [ Bulma.h3 "My domains"
|
, Bulma.columns_ new_domain_line
|
||||||
, if A.length my_domains > 0
|
, Bulma.hr
|
||||||
then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_domains
|
, Bulma.columns_ explanations_line
|
||||||
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.
|
||||||
|
"""
|
||||||
]
|
]
|
||||||
|
|
||||||
domain_buttons domain
|
shared_domain_row domain = HH.tr_
|
||||||
= [ Bulma.alert_btn "delete" (DeleteDomainModal domain)
|
[ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ]
|
||||||
, Bulma.btn domain (EnterDomain domain)
|
, HH.td_ [ HH.text $ fromMaybe "" domain.share_key ]
|
||||||
]
|
, 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 ]
|
||||||
@ -196,6 +302,17 @@ render { accepted_domains, my_domains, newDomainForm, active_modal }
|
|||||||
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
|
||||||
@ -210,7 +327,7 @@ handleAction = case _ of
|
|||||||
H.raise $ StoreState state
|
H.raise $ StoreState state
|
||||||
|
|
||||||
CancelModal -> do
|
CancelModal -> do
|
||||||
H.modify_ _ { active_modal = Nothing }
|
H.modify_ _ { deletion_modal = Nothing }
|
||||||
|
|
||||||
UpdateAcceptedDomains domains -> do
|
UpdateAcceptedDomains domains -> do
|
||||||
H.modify_ _ { accepted_domains = domains }
|
H.modify_ _ { accepted_domains = domains }
|
||||||
@ -229,17 +346,35 @@ 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_ _ { active_modal = Just domain }
|
H.modify_ _ { deletion_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_ _ { active_modal = Nothing }
|
H.modify_ _ { deletion_modal = Nothing }
|
||||||
|
|
||||||
NewDomainAttempt ev -> do
|
NewDomainAttempt ev -> do
|
||||||
H.liftEffect $ Event.preventDefault ev
|
H.liftEffect $ Event.preventDefault ev
|
||||||
@ -249,7 +384,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
|
||||||
@ -260,6 +395,23 @@ 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
|
||||||
|
|
||||||
@ -280,10 +432,17 @@ 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 <> [response.domain])
|
handleAction $ UpdateMyDomains (my_domains <> [ emptyDomainInfo { name = 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 ((/=) response.domain) my_domains
|
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 DomainListInterface."
|
||||||
pure (Just a)
|
pure (Just a)
|
||||||
|
|
||||||
|
@ -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 ]
|
||||||
|
@ -2,12 +2,14 @@
|
|||||||
-- |
|
-- |
|
||||||
-- | 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 and DKIM (TODO: DMARC)
|
-- | - provide dedicated interfaces for SPF, DKIM and 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.
|
||||||
@ -55,7 +57,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
|
||||||
, all_qualifiers
|
, 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
|
||||||
@ -294,7 +296,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 = "www", target = "192.0.2.1" }
|
default_rr_A = emptyRR { rrtype = "A", name = "server1", 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
|
||||||
@ -387,11 +389,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 (foot_content A)
|
"A" -> template (modal_content_simple A) (foot_content A)
|
||||||
"AAAA" -> template modal_content_simple (foot_content AAAA)
|
"AAAA" -> template (modal_content_simple AAAA) (foot_content AAAA)
|
||||||
"TXT" -> template modal_content_simple (foot_content TXT)
|
"TXT" -> template (modal_content_simple TXT) (foot_content TXT)
|
||||||
"CNAME" -> template modal_content_simple (foot_content CNAME)
|
"CNAME" -> template (modal_content_simple CNAME) (foot_content CNAME)
|
||||||
"NS" -> template modal_content_simple (foot_content NS)
|
"NS" -> template (modal_content_simple NS) (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)
|
||||||
@ -404,9 +406,10 @@ 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 :: Array (HH.HTML w Action)
|
modal_content_simple :: AcceptedRRTypes -> Array (HH.HTML w Action)
|
||||||
modal_content_simple =
|
modal_content_simple x =
|
||||||
[ 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
|
||||||
@ -428,9 +431,19 @@ 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
|
||||||
@ -447,7 +460,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)
|
||||||
@ -473,7 +486,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)
|
||||||
@ -511,13 +524,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)
|
||||||
@ -527,7 +540,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)
|
||||||
@ -542,7 +555,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)
|
||||||
@ -551,20 +564,27 @@ 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 (map show DMARC.policies) (show state.dmarc.p)
|
, Bulma.selection_field' "idDMARCPolicy" "Policy" DMARC_policy
|
||||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_sp_policy]
|
(A.zip DMARC.policies_txt DMARC.policies_raw)
|
||||||
, Bulma.selection_field "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
|
(show state.dmarc.p)
|
||||||
(["do not provide policy advice"] <> map show DMARC.policies) (maybe "-" show state.dmarc.sp)
|
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_sp_policy]
|
||||||
|
, 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 DMARC.consistency_policies_txt (maybe "-" show state.dmarc.adkim)
|
, Bulma.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim
|
||||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_aspf]
|
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
|
||||||
, Bulma.selection_field "idDMARCaspf" "Consistency Policy for SPF" DMARC_aspf DMARC.consistency_policies_txt (maybe "-" show state.dmarc.aspf)
|
(maybe "-" show state.dmarc.adkim)
|
||||||
|
, 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
|
||||||
@ -573,7 +593,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.")
|
||||||
@ -588,7 +608,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)
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -658,11 +678,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 = "www", target = "2001:db8::1" }
|
let default_rr_AAAA = emptyRR { rrtype = "AAAA", name = "server1", 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 = "blog", target = "www" }
|
default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
|
||||||
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 = "www", priority = Just 10 }
|
default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "server1", 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" ""
|
||||||
@ -822,7 +842,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 = all_qualifiers A.!! v } }
|
SPF_Qualifier v -> H.modify_ _ { _currentRR { q = 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)
|
||||||
@ -890,29 +910,19 @@ handleAction = case _ of
|
|||||||
|
|
||||||
DMARC_remove_rua i -> do
|
DMARC_remove_rua i -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
let current_ruas = case state._currentRR.dmarc of
|
let current_ruas = fromMaybe [] state.dmarc.rua
|
||||||
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
|
||||||
new_dmarc = case state._currentRR.dmarc of
|
H.modify_ \s -> s { dmarc { rua = new_value } }
|
||||||
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 = case state._currentRR.dmarc of
|
let current_rufs = fromMaybe [] state.dmarc.ruf
|
||||||
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
|
||||||
new_dmarc = case state._currentRR.dmarc of
|
H.modify_ \s -> s { dmarc { ruf = new_value } }
|
||||||
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) } }
|
||||||
@ -1147,8 +1157,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
|
||||||
|
@ -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,6 +155,110 @@ 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 """
|
||||||
|
@ -170,10 +170,13 @@ 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"
|
, "Strict: same domain"
|
||||||
, "Relaxed"
|
, "Relaxed: same organizational domain"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
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
|
||||||
@ -235,6 +238,19 @@ 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
|
||||||
|
33
src/App/Type/DomainInfo.purs
Normal file
33
src/App/Type/DomainInfo.purs
Normal file
@ -0,0 +1,33 @@
|
|||||||
|
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: []
|
||||||
|
}
|
@ -232,8 +232,8 @@ emptyRR
|
|||||||
}
|
}
|
||||||
|
|
||||||
data Qualifier = Pass | Neutral | SoftFail | HardFail
|
data Qualifier = Pass | Neutral | SoftFail | HardFail
|
||||||
all_qualifiers :: Array Qualifier
|
qualifiers :: Array Qualifier
|
||||||
all_qualifiers = [Pass, Neutral, SoftFail, HardFail]
|
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"]
|
||||||
|
|
||||||
|
@ -61,6 +61,24 @@ 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" ]
|
||||||
@ -538,12 +556,17 @@ 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.HTML w i) -> HH.HTML w i
|
div_content :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
|
||||||
div_content content = HH.div [HP.classes (C.content)] content
|
div_content classes content = HH.div [HP.classes (C.content <> classes)] 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]
|
||||||
@ -567,13 +590,16 @@ 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 deleteaction = notification C.is_primary value deleteaction
|
notification_primary value action = notification C.is_primary value action
|
||||||
|
|
||||||
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 deleteaction = notification C.is_success value deleteaction
|
notification_success value action = notification C.is_success value action
|
||||||
|
|
||||||
|
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 deleteaction = notification C.is_danger value deleteaction
|
notification_danger value action = notification C.is_danger value action
|
||||||
|
|
||||||
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 =
|
||||||
@ -584,6 +610,12 @@ 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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user