Local addresses.

TODO.md

@@ -1,37 +1,25 @@
-# Code structure
+# Code structure and general note
 
-The Bulma module should be removed.
-The actual Bulma-related code should be in the package [purescript-bulma][psbulma], which currently lacks some features.
-The general style of the website should be in a module.
+Right now, the code is still in a somewhat early stage and **multiple** refactoring should take place.
 
-Modules should have their own specific API.
-When a module currently requires to send messages, the API should reflect semantics instead of providing the module a way to just carry raw messages.
-For example, there are currently modules able to send messages (with a very simple `MessageToSend message` API), but instead of dealing with raw messages that need to be built inside the module, the API should be more semantic such as `ChangePassword new-password`.
+The code should be reviewed and a decent documentation should be provided.
 
-Once modules will have specific APIs, the entire state of the application could be moved into a single module (or *component*).
+Some code should be pushed in the [bulma purescript module][psbulma].
+
+The entire state of the application *could* be moved into a single module (or *component*).
 Thus, every state modification can be handled in a single place.
 
-Minor modifications:
-
-- split `App.Zone` to improve compilation times
-- explanations and static content in general should be written using some kind of templates, not directly in Halogen
+Explanations and static content in general could be written using some kind of templates, not directly in Halogen.
 
 # Features
 
-Delegation:
-
-- new RR record: the "delegation record", effectively removing all other RRs
-  => requires 2 nameservers
-- also enable to change NS records (but after a accepting the consequences)?
+- new RR record: the "delegation record", effectively removing all other RRs, which should require 2 nameservers
+- **MAYBE**: also enable to change NS records (but after a accepting the consequences)? (could be unnecessary due to delegation)
+- zone-wise indications to help people configure their zone for specific uses (web, mail)
 
 About the admin interface:
 
-- enable administrators to ask for users' info and show zones
-- perform a few more administrative operations (*TBD*)
-
-Slightly more complex features to implement:
-
-- zone-wise indications to help people configure their zone for specific uses (web, mail)
+- display details about users
 
 # Tests
 
@@ -43,30 +31,17 @@ Check for common errors:
 More specialized tests or debug options:
 
 - verify the length of received messages in `App.Message.IPC`
-- MAYBE: run `named-checkzone` on the genetared zone and provide the result in case of an error
+- MAYBE: run `named-checkzone` on the generated zone and provide the result in case of an error
 
 # Display
 
 - say that there is no IPv6 on the server at the moment, so there is no point doing IPv6 address updates
-- admin interface: basically just rewrite the whole thing, it's a mess
-
-Details:
-
-- *maybe* notifications should disappear after a few seconds
 - hide logs by default?
 
-# General note
-
-The code should be reviewed and a decent documentation should be provided.
-
-Right now, the code is still in a somewhat early stage and **multiple** refactoring should take place.
-For example, modules have a very generic API; they can provide or receive messages from (respectively *to*) authd or dnsmanagerd.
-Instead, modules should have a more specific API and not deal with message encoding at all.
-Furthermore, *maybe* the state of the entire application should be stored in a single module, with a single function handling all state modifications when a message is received, enabling a simpler data management.
-
 # TODO in authd and dnsmanagerd
 
-- enable users to change their NS
+- implement proper delegation
+- **MAYBE**: enable users to modify their *protected-by-read-only* NS entries (could be unnecessary due to delegation)
 - MIGRATION-related: remove migrated accounts with no connection in over 6 months
 
 [psbulma]: https://github.com/KaneRoot/purescript-bulma

src/App/DisplayErrors.purs

@@ -7,101 +7,116 @@ import Prelude (show, ($), (<>), (==))
 import Data.Maybe (Maybe(..), maybe)
 import Halogen.HTML as HH
 
-import App.Validation.DNS as ValidationDNS
+import App.Type.ResourceRecord as RR
 import App.Validation.Login as L
 import App.Validation.Email as E
 import App.Validation.Password as P
+import App.Type.Delegation as Delegation
 import App.Validation.Label as ValidationLabel
 import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
 import GenericParser.IPAddress as IPAddress
 
-import Bulma as Bulma
-
-error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i
-error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
+import Web as Web
+delegation_error_to_paragraph :: forall w i. Delegation.Error -> HH.HTML w i
+delegation_error_to_paragraph v = Web.error_message (Web.p $ show_delegation_error_title v)
   (case v of
-      ValidationDNS.UNKNOWN              -> Bulma.p "An internal error happened."
-      ValidationDNS.VEIPv4     err       -> maybe default_error show_error_ip4 err.error
-      ValidationDNS.VEIPv6     err       -> maybe default_error show_error_ip6 err.error
-      ValidationDNS.VEName     err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VETTL min max n ->
-        Bulma.p $ "TTL should have a value between "
+      Delegation.VENameServer1 err -> maybe default_error show_error_domain err.error
+      Delegation.VENameServer2 err -> maybe default_error show_error_domain err.error
+  )
+  where default_error = Web.p ""
+
+error_to_paragraph :: forall w i. RR.Error -> HH.HTML w i
+error_to_paragraph v = Web.error_message (Web.p $ show_error_title v)
+  (case v of
+      RR.UNKNOWN       -> Web.p "An internal error happened."
+      RR.VEIPv4   err  -> maybe default_error show_error_ip4 err.error
+      RR.VEIPv6   err  -> maybe default_error show_error_ip6 err.error
+      RR.VEName   err  -> maybe default_error show_error_domain err.error
+      RR.VETTL min max n ->
+        Web.p $ "TTL should have a value between "
           <> show min <> " and " <> show max <> ", current value: " <> show n <> "."
-      ValidationDNS.VEDMARCpct min max n ->
-        Bulma.p $ "DMARC sample rate should have a value between "
+      RR.VEDMARCpct min max n ->
+        Web.p $ "DMARC sample rate should have a value between "
           <> show min <> " and " <> show max <> ", current value: " <> show n <> "."
-      ValidationDNS.VEDMARCri  min max n ->
-        Bulma.p $ "DMARC report interval should have a value between "
+      RR.VEDMARCri  min max n ->
+        Web.p $ "DMARC report interval should have a value between "
           <> show min <> " and " <> show max <> ", current value: " <> show n <> "."
-      ValidationDNS.VETXT      err       -> maybe default_error show_error_txt err.error
-      ValidationDNS.VECNAME    err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VENS       err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VEMX       err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VEPriority min max n -> Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max
+      RR.VETXT      err       -> maybe default_error show_error_txt err.error
+      RR.VECNAME    err       -> maybe default_error show_error_domain err.error
+      RR.VENS       err       -> maybe default_error show_error_domain err.error
+      RR.VEMX       err       -> maybe default_error show_error_domain err.error
+      RR.VEPriority min max n -> Web.p $ "Priority should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
-      ValidationDNS.VESRV      err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VEPort min max n     -> Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max
+      RR.VESRV      err       -> maybe default_error show_error_domain err.error
+      RR.VEPort min max n     -> Web.p $ "Port should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
-      ValidationDNS.VEWeight min max n   -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
+      RR.VEWeight min max n   -> Web.p $ "Weight should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
 
-      ValidationDNS.VECAAflag min max n  -> Bulma.p $ "CAA flag should have a value between " <> show min <> " and " <> show max
+      RR.VECAAflag min max n  -> Web.p $ "CAA flag should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
 
       -- SPF dedicated RR
-      ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
-      ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
-      ValidationDNS.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 err.error
-      ValidationDNS.VESPFModifierName  err -> maybe default_error show_error_domain err.error
+      RR.VESPFMechanismName err -> maybe default_error show_error_domain err.error
+      RR.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
+      RR.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 err.error
+      RR.VESPFModifierName  err -> maybe default_error show_error_domain err.error
 
-      ValidationDNS.DKIMInvalidKeySize min max -> show_error_key_sizes min max
+      RR.DKIMInvalidKeySize min max -> show_error_key_sizes min max
   )
-  where default_error = Bulma.p ""
+  where default_error = Web.p ""
 
 show_error_key_sizes :: forall w i. Int -> Int -> HH.HTML w i
 show_error_key_sizes min max
   = if min == max
-    then Bulma.p $ "Chosen signature algorithm only accepts public key input of " <> show min <> " characters."
-    else Bulma.p $ "Chosen signature algorithm only accepts public key input between "
+    then Web.p $ "Chosen signature algorithm only accepts public key input of " <> show min <> " characters."
+    else Web.p $ "Chosen signature algorithm only accepts public key input between "
               <> show min <> " and " <> show max <> " characters."
 
+-- | `show_delegation_error_title` provide a simple title string to display to the user
+-- | in case of an error with an entry in the delegation form.
+show_delegation_error_title :: Delegation.Error -> String
+show_delegation_error_title v = case v of
+  Delegation.VENameServer1 _ -> "Invalid domain for name server 1"
+  Delegation.VENameServer2 _ -> "Invalid domain for name server 2"
+
 -- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry.
-show_error_title :: ValidationDNS.Error -> String
+show_error_title :: RR.Error -> String
 show_error_title v = case v of
-  ValidationDNS.UNKNOWN          -> "Unknown"
-  ValidationDNS.VEIPv4     _     -> "Invalid IPv4 address"
-  ValidationDNS.VEIPv6     _     -> "Invalid IPv6 address"
-  ValidationDNS.VEName     _     -> "Invalid Name (domain label)"
-  ValidationDNS.VETTL _ _ _      -> "Invalid TTL"
-  ValidationDNS.VEDMARCpct _ _ _ -> "Invalid DMARC sample rate"
-  ValidationDNS.VEDMARCri  _ _ _ -> "Invalid DMARC report interval"
-  ValidationDNS.VETXT      _     -> "Invalid TXT"
-  ValidationDNS.VECNAME    _     -> "Invalid CNAME"
-  ValidationDNS.VENS       _     -> "Invalid NS Target"
-  ValidationDNS.VEMX       _     -> "Invalid MX Target"
-  ValidationDNS.VEPriority _ _ _ -> "Invalid Priority"
-  ValidationDNS.VESRV      _     -> "Invalid SRV Target"
-  ValidationDNS.VEPort _ _ _     -> "Invalid Port"
-  ValidationDNS.VEWeight _ _ _   -> "Invalid Weight"
-  ValidationDNS.VECAAflag _ _ _  -> "Invalid CAA Flag"
+  RR.UNKNOWN          -> "Unknown"
+  RR.VEIPv4     _     -> "Invalid IPv4 address"
+  RR.VEIPv6     _     -> "Invalid IPv6 address"
+  RR.VEName     _     -> "Invalid Name (domain label)"
+  RR.VETTL _ _ _      -> "Invalid TTL"
+  RR.VEDMARCpct _ _ _ -> "Invalid DMARC sample rate"
+  RR.VEDMARCri  _ _ _ -> "Invalid DMARC report interval"
+  RR.VETXT      _     -> "Invalid TXT"
+  RR.VECNAME    _     -> "Invalid CNAME"
+  RR.VENS       _     -> "Invalid NS Target"
+  RR.VEMX       _     -> "Invalid MX Target"
+  RR.VEPriority _ _ _ -> "Invalid Priority"
+  RR.VESRV      _     -> "Invalid SRV Target"
+  RR.VEPort _ _ _     -> "Invalid Port"
+  RR.VEWeight _ _ _   -> "Invalid Weight"
+  RR.VECAAflag _ _ _  -> "Invalid CAA Flag"
 
   -- SPF dedicated RR
-  ValidationDNS.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"
-  ValidationDNS.VESPFMechanismIPv4 _ -> "The IPv4 address in a SPF mechanism is wrong"
-  ValidationDNS.VESPFMechanismIPv6 _ -> "The IPv6 address in a SPF mechanism is wrong"
+  RR.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"
+  RR.VESPFMechanismIPv4 _ -> "The IPv4 address in a SPF mechanism is wrong"
+  RR.VESPFMechanismIPv6 _ -> "The IPv6 address in a SPF mechanism is wrong"
 
-  ValidationDNS.VESPFModifierName _    -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong"
-  ValidationDNS.DKIMInvalidKeySize _ _ -> "Public key has an invalid length"
+  RR.VESPFModifierName _    -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong"
+  RR.DKIMInvalidKeySize _ _ -> "Public key has an invalid length"
 
 show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
 show_error_domain e = case e of
   DomainParser.LabelTooLarge size ->
-    Bulma.p $ "The label contains too many characters (" <> show size <> ")."
+    Web.p $ "The label contains too many characters (" <> show size <> ")."
   DomainParser.DomainTooLarge size ->
-    Bulma.p $ "The domain contains too many characters (" <> show size <> ")."
+    Web.p $ "The domain contains too many characters (" <> show size <> ")."
   -- DomainParser.InvalidCharacter
   -- DomainParser.EOFExpected
-  _ -> Bulma.p """
+  _ -> Web.p """
            The domain (or label) contains invalid characters.
            A domain label should start with a letter,
            then possibly a series of letters, digits and hyphenations ("-"),
@@ -111,31 +126,31 @@ show_error_domain e = case e of
 show_error_ip6 :: forall w i. IPAddress.IPv6Error -> HH.HTML w i
 show_error_ip6 e = case e of
   IPAddress.IP6TooManyHexaDecimalCharacters ->
-    Bulma.p "IP6TooManyHexaDecimalCharacters"
+    Web.p "IP6TooManyHexaDecimalCharacters"
   IPAddress.IP6NotEnoughChunks ->
-    Bulma.p """
+    Web.p """
       The IPv6 representation is erroneous, it should contain 8 groups of hexadecimal characters or
       being shortened with a double ':' character, such as "2000::1".
       """
   IPAddress.IP6TooManyChunks ->
-    Bulma.p "The IPv6 representation is erroneous. It should contain only up to 8 groups of hexadecimal characters."
+    Web.p "The IPv6 representation is erroneous. It should contain only up to 8 groups of hexadecimal characters."
   IPAddress.IP6IrrelevantShortRepresentation ->
-    Bulma.p "IPv6 address has been unnecessarily shortened (with two ':')."
-  IPAddress.IP6InvalidRange -> Bulma.p "IPv6 address or range isn't valid."
+    Web.p "IPv6 address has been unnecessarily shortened (with two ':')."
+  IPAddress.IP6InvalidRange -> Web.p "IPv6 address or range isn't valid."
 
 show_error_ip4 :: forall w i. IPAddress.IPv4Error -> HH.HTML w i
 show_error_ip4 e = case e of
   IPAddress.IP4NumberTooBig n ->
-    Bulma.p $ "IPv4 address contains a number too big (should be between 0 and 255). Current entered number: " <> show n
+    Web.p $ "IPv4 address contains a number too big (should be between 0 and 255). Current entered number: " <> show n
   IPAddress.IP4IrrelevantShortRepresentation ->
-    Bulma.p "IPv4 address has been unnecessarily shortened (with two '.')."
-  IPAddress.IP4InvalidRange -> Bulma.p "IPv4 address or range isn't valid."
+    Web.p "IPv4 address has been unnecessarily shortened (with two '.')."
+  IPAddress.IP4InvalidRange -> Web.p "IPv4 address or range isn't valid."
 
-show_error_txt :: forall w i. ValidationDNS.TXTError -> HH.HTML w i
+show_error_txt :: forall w i. RR.TXTError -> HH.HTML w i
 show_error_txt e = case e of
-  ValidationDNS.TXTInvalidCharacter -> Bulma.p "The TXT field contains some invalid characters."
-  ValidationDNS.TXTTooLong max n ->
-    Bulma.p $ "An TXT field is limited to " <> show max <> " characters (currently there are "
+  RR.TXTInvalidCharacter -> Web.p "The TXT field contains some invalid characters."
+  RR.TXTTooLong max n ->
+    Web.p $ "An TXT field is limited to " <> show max <> " characters (currently there are "
               <> show n <> " characters)."
 
 domainerror_string :: DomainParser.DomainError -> String
@@ -146,14 +161,14 @@ domainerror_string (DomainParser.EOFExpected)         = "EOFExpected"
 
 -- | This `error_to_paragraph` is designed to go along the `Validation.Label` module.
 error_to_paragraph_label :: forall w i. ValidationLabel.Error -> HH.HTML w i
-error_to_paragraph_label v = Bulma.error_message (Bulma.p $ show_error_title_label v)
+error_to_paragraph_label v = Web.error_message (Web.p $ show_error_title_label v)
   (case v of
     ValidationLabel.ParsingError x -> case x.error of
-      Nothing -> Bulma.p ""
+      Nothing -> Web.p ""
       Just (ValidationLabel.CannotParse err) -> show_error_domain err
-      Just (ValidationLabel.CannotEntirelyParse) -> Bulma.p "Cannot entirely parse the label."
+      Just (ValidationLabel.CannotEntirelyParse) -> Web.p "Cannot entirely parse the label."
       Just (ValidationLabel.Size min max n) ->
-        Bulma.p $ "Label size should be between " <> show min <> " and " <> show max
+        Web.p $ "Label size should be between " <> show min <> " and " <> show max
                   <> " (current size: " <> show n <> ")."
   )
 

src/App/Log.purs

@@ -1,7 +1,7 @@
+-- | `App.Log` is a simple log component, showing a list of messages.
+-- | The list has a fixed size, the older messages are removed.
 module App.Log where
 
-{- Simple log component, showing the current events. -}
-
 import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (-), (<), (<>))
 
 import Control.Monad.State (class MonadState)
@@ -9,7 +9,8 @@ import Data.Array as A
 import Data.Maybe (Maybe(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
-import Halogen.HTML as HH
+
+import Web as Web
 
 import App.Type.LogMessage
 
@@ -44,9 +45,9 @@ initialState _ =
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render { messages }
-    = HH.div_ [ render_messages ]
+    = Web.div [ render_messages ]
     where
-      render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
+      render_messages = Web.ul $ map (\msg -> Web.li msg) messages
 
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of

src/App/Message/DNSManagerDaemon.purs

@@ -128,6 +128,18 @@ type GainOwnership = { uuid :: String }
 codecGainOwnership ∷ CA.JsonCodec GainOwnership
 codecGainOwnership = CA.object "GainOwnership" (CAR.record { uuid: CA.string })
 
+{- 24  -}
+type SearchDomain = { domain :: String, offset :: Maybe Int }
+codecSearchDomain ∷ CA.JsonCodec SearchDomain
+codecSearchDomain = CA.object "SearchDomain" (CAR.record { domain: CA.string, offset: CAR.optional CA.int })
+
+{- 25  -}
+type DelegateDomain = { domain :: String, nameserver1 :: String, nameserver2 :: String }
+codecDelegateDomain ∷ CA.JsonCodec DelegateDomain
+codecDelegateDomain = CA.object "DelegateDomain" (CAR.record { domain: CA.string
+                                                             , nameserver1: CA.string
+                                                             , nameserver2: CA.string })
+
 {- 100 -}
 type GenerateAllZoneFiles = {}
 codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles
@@ -280,6 +292,15 @@ type OrphanDomainList = { domains :: Array String }
 codecOrphanDomainList ∷ CA.JsonCodec OrphanDomainList
 codecOrphanDomainList = CA.object "OrphanDomainList" (CAR.record { domains: CA.array CA.string })
 
+{- 25 same as 14  -}
+
+{- 26  -}
+type DomainDelegated = { domain :: String, nameserver1 :: String, nameserver2 :: String }
+codecDomainDelegated ∷ CA.JsonCodec DomainDelegated
+codecDomainDelegated = CA.object "DomainDelegated" (CAR.record { domain: CA.string
+                                                               , nameserver1: CA.string
+                                                               , nameserver2: CA.string })
+
 {- 50  -}
 type UnknownUser = { }
 codecUnknownUser ∷ CA.JsonCodec UnknownUser
@@ -322,6 +343,8 @@ data RequestMessage
   | MkAskTransferToken     AskTransferToken     -- 21
   | MkAskUnShareDomain     AskUnShareDomain     -- 22
   | MkGainOwnership        GainOwnership        -- 23
+  | MkSearchDomain         SearchDomain         -- 24
+  | MkDelegateDomain       DelegateDomain       -- 25
   | MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100
   | MkGenerateZoneFile     GenerateZoneFile     -- 101
   | MkKeepAlive            KeepAlive            -- 250
@@ -353,6 +376,8 @@ data AnswerMessage
   | MkRRReadOnly          RRReadOnly          -- 22
   | MkGeneratedZoneFile   GeneratedZoneFile   -- 23
   | MkOrphanDomainList    OrphanDomainList    -- 24
+  | MkFoundDomains        DomainList          -- 25
+  | MkDomainDelegated     DomainDelegated     -- 26
   | MkUnknownUser         UnknownUser         -- 50
   | MkNoOwnership         NoOwnership         -- 51
   | MkInsufficientRights  InsufficientRights  -- 52
@@ -379,6 +404,8 @@ encode m = case m of
     (MkAskTransferToken     request) -> get_tuple 21  codecAskTransferToken     request
     (MkAskUnShareDomain     request) -> get_tuple 22  codecAskUnShareDomain     request
     (MkGainOwnership        request) -> get_tuple 23  codecGainOwnership        request
+    (MkSearchDomain         request) -> get_tuple 24  codecSearchDomain         request
+    (MkDelegateDomain       request) -> get_tuple 25  codecDelegateDomain       request
     (MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request
     (MkGenerateZoneFile     request) -> get_tuple 101 codecGenerateZoneFile     request
     (MkKeepAlive            request) -> get_tuple 250 codecKeepAlive            request
@@ -419,6 +446,8 @@ decode number string
     22  -> error_management codecRRReadOnly          MkRRReadOnly
     23  -> error_management codecGeneratedZoneFile   MkGeneratedZoneFile
     24  -> error_management codecOrphanDomainList    MkOrphanDomainList
+    25  -> error_management codecDomainList          MkFoundDomains
+    26  -> error_management codecDomainDelegated     MkDomainDelegated
     50  -> error_management codecUnknownUser         MkUnknownUser
     51  -> error_management codecNoOwnership         MkNoOwnership
     52  -> error_management codecInsufficientRights  MkInsufficientRights

src/App/Notification.purs

@@ -0,0 +1,75 @@
+-- | Handle a notification subsystem.
+module App.Notification where
+
+import Prelude
+
+import Data.Int (toNumber)
+import Data.Maybe (Maybe(..))
+import Effect.Aff as Aff
+import Effect.Aff (Milliseconds(..))
+import Effect.Aff.Class (class MonadAff)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.Subscription as HS
+
+import App.Type.Notification (Notification (..))
+
+import Web as Web
+
+-- | Input = delay.
+type Input = Int
+
+-- | No output.
+data Output = Unit
+
+type Slot = H.Slot Query Output
+
+-- | `timer` triggers an action after `tick_delay` ms.
+timer :: forall m a. MonadAff m => Number -> a -> m (HS.Emitter a)
+timer tick_delay action = do
+  { emitter, listener } <- H.liftEffect HS.create
+  _ <- H.liftAff $ Aff.forkAff do
+    Aff.delay $ Milliseconds tick_delay
+    H.liftEffect $ HS.notify listener action
+  pure emitter
+
+data Action = CloseNotif
+
+type State = { delay :: Int, notification :: Notification }
+
+data Query a = Set Notification a
+
+component :: forall m. MonadAff m => H.Component Query Input Output m
+component =
+  H.mkComponent
+    { initialState
+    , render
+    , eval: H.mkEval $ H.defaultEval
+        { initialize = Nothing
+        , handleAction = handleAction
+        , handleQuery  = handleQuery
+        }
+    }
+
+handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
+handleQuery = case _ of
+  Set notif a -> do
+    H.modify_ _ { notification = notif }
+    state <- H.get
+    _ <- H.subscribe =<< timer (toNumber state.delay) CloseNotif
+    pure (Just a)
+
+initialState :: Input -> State
+initialState delay = { delay: delay, notification: NoNotification }
+
+render :: forall m. State -> H.ComponentHTML Action () m
+render state = do
+  case state.notification of
+    NoNotification -> HH.div_ []
+    GoodNotification v -> Web.box [Web.notification_success v CloseNotif]
+    BadNotification  v -> Web.box [Web.notification_danger  v CloseNotif]
+
+handleAction :: forall m.
+  MonadAff m => Action -> H.HalogenM State Action () Output m Unit
+handleAction action = case action of
+  CloseNotif -> H.modify_ _ { notification = NoNotification }

src/App/Page/Administration.purs

@@ -1,9 +1,10 @@
 {- Administration interface.
    Enables to:
-     - add, remove, search users
+     - add, remove, search for users
      - TODO: validate users
      - TODO: change user password
      - TODO: show user details (list of owned domains)
+     - TODO: search for domains
      - TODO: show user domain details (zone content) and to modify users' zone
      - TODO: raise a user to admin (and vice versa)
      - TODO: list users (getting them slowly, otherwise it will cause problems with thousands of logins)
@@ -13,7 +14,9 @@ module App.Page.Administration where
 import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=), (==), unit)
 import Data.Eq (class Eq)
 
-import Bulma as Bulma
+import Utils (not_empty_string)
+import Web as Web
+import App.Templates.Table as Templates
 
 import Data.Maybe (Maybe(..))
 import Data.Array as A
@@ -31,29 +34,31 @@ import Web.HTML.Window (sessionStorage) as Window
 import Web.Storage.Storage as Storage
 
 import App.Type.UserPublic (UserPublic)
-import Data.ArrayBuffer.Types (ArrayBuffer)
 
 import App.Type.LogMessage
--- import App.IPC as IPC
 import App.Type.Email as Email
 
--- import App.Message.DNSManagerDaemon as DNSManager
 import App.Message.AuthenticationDaemon as AuthD
 
 data Output
-  = MessageToSend ArrayBuffer
-  | Log LogMessage
-  | AskState
-  | StoreState State
+  = AddUser String Boolean (Maybe Email.Email) String
+  | SearchUser (Maybe String) (Maybe Int)
   | DeleteUserAccount Int
+
   | GetOrphanDomains
 
-  --| DeleteDomain String
-  --| RequestDomain String
+  | DeleteDomain String
+  | SearchDomain String
+  | ShowZone String
+
+  | Log LogMessage
+  | StoreState State
+  | AskState
 
 data Query a
   = MessageReceived AuthD.AnswerMessage a
   | GotOrphanDomainList (Array String) a
+  | GotFoundDomains (Array String) a
   | ProvideState (Maybe State) a
 
 type Slot = H.Slot Query Output
@@ -65,23 +70,33 @@ data AddUserInput
   | ADDUSER_INP_email       String
   | ADDUSER_toggle_admin
   | ADDUSER_INP_pass        String
-  | SEARCHUSER_INP_regex    String
-  --| SEARCHUSER_INP_domain String
+
+data SearchUserInput
+  = SEARCHUSER_INP_regex    String
+  --| SEARCHUSER_toggle_admin Boolean
+
+data SearchDomainInput
+  = SEARCHDOMAIN_INP_domain String
 
 data Action
-  = HandleAddUserInput AddUserInput
+  = ActionOnAddUserForm AddUserInput
+  | ActionOnSearchUserForm SearchUserInput
+  | ActionOnSearchDomainForm SearchDomainInput
 
   | AddUserAttempt
   | SearchUserAttempt
+  | SearchDomainAttempt
   | PreventSubmit Event
 
+  -- Users.
   | ShowUser Int
-  | RemoveUser Int
+  | DeleteUser Int
 
   -- Domains.
-  | ShowOrphanDomains
   | RemoveDomain String
-  | ShowDomain String
+  | EnterDomain String
+
+  | ShowOrphanDomains
 
   -- | Change the displayed tab.
   | ChangeTab Tab
@@ -91,17 +106,20 @@ data Action
 
 -- | There are different tabs in the administration page.
 -- | For example, users can be searched (`authd`) and a list is provided.
-data Tab = Home | Search | Add | OrphanDomains
+data Tab = TabHome | TabSearchUser | TabSearchDomain | TabAddUser | TabOrphanDomains
 derive instance eqTab :: Eq Tab
 
 type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
-type StateSearchUserForm = { regex :: String {-, admin :: Boolean, domain :: String -} }
+type StateSearchUserForm = { regex :: String {- , admin :: Boolean -} }
+type StateSearchDomainForm = { domain :: String }
 
 type State =
   { addUserForm    :: StateAddUserForm
   , searchUserForm :: StateSearchUserForm
+  , searchDomainForm :: StateSearchDomainForm
   , current_tab    :: Tab
   , matching_users :: Array UserPublic
+  , matching_domains :: Array String
   , orphan_domains :: Array String
   }
 
@@ -120,72 +138,83 @@ component =
 
 initialState :: Input -> State
 initialState _ = { addUserForm:    { login: "", admin: false, email: "", pass: "" }
-                 , searchUserForm: { regex: "" {-, admin: false, domain: "" -} }
+                 , searchUserForm: { regex: "" {- , admin: false -} }
+                 , searchDomainForm: { domain: "" }
                  , matching_users: []
+                 , matching_domains: []
                  , orphan_domains: []
-                 , current_tab: Home
+                 , current_tab: TabHome
                  }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains }
-  = Bulma.section_small
+render { addUserForm, searchUserForm, searchDomainForm
+       , matching_users, matching_domains
+       , current_tab, orphan_domains }
+  = Web.section_small
       [ fancy_tab_bar
       , case current_tab of
-          Home -> Bulma.h3 "Select an action"
-          Search -> Bulma.columns_
-            [ Bulma.column [C.is 3] [Bulma.article (Bulma.p "Search users") render_searchuser_form]
-            , Bulma.column_ [ Bulma.h3 "Result", show_found_users ]
+          TabHome -> Web.h3 "Select an action"
+          TabSearchUser -> Web.columns_
+            [ Web.column [C.is 3] [Web.article (Web.p "Search users") render_searchuser_form]
+            , Web.column_ [ Templates.found_users ShowUser DeleteUser matching_users ]
             ]
-          Add -> Bulma.columns_
-            [ Bulma.column [C.is 5] [Bulma.article (Bulma.p "Add a new user") render_adduser_form] ]
-          OrphanDomains -> HH.div_
-            [ Bulma.btn_ [C.is_small] "Get orphan domains" ShowOrphanDomains
+          TabSearchDomain -> Web.columns_
+            [ Web.column [C.is 3] [Web.article (Web.p "Search domains") render_searchdomain_form]
+            , Web.column_ [ Templates.found_domains EnterDomain RemoveDomain matching_domains ]
+            ]
+          TabAddUser -> Web.columns_
+            [ Web.column [C.is 5] [Web.article (Web.p "Add a new user") render_adduser_form] ]
+          TabOrphanDomains -> HH.div_
+            [ Web.btn_ [C.is_small] "Get orphan domains" ShowOrphanDomains
             , show_orphan_domains
             ]
       ]
     where
     fancy_tab_bar =
-      Bulma.fancy_tabs
-        [ Bulma.tab_entry (is_tab_active Home)          "Home"             (ChangeTab Home)
-        , Bulma.tab_entry (is_tab_active Search)        "Search"           (ChangeTab Search)
-        , Bulma.tab_entry (is_tab_active Add)           "Add"              (ChangeTab Add)
-        , Bulma.tab_entry (is_tab_active OrphanDomains) "OrphanDomains"    (ChangeTab OrphanDomains)
+      Web.fancy_tabs
+        [ Web.tab_entry (is_tab_active TabHome)          "Home"             (ChangeTab TabHome)
+        , Web.tab_entry (is_tab_active TabSearchUser)    "SearchUser"       (ChangeTab TabSearchUser)
+        , Web.tab_entry (is_tab_active TabSearchDomain)  "SearchDomain"     (ChangeTab TabSearchDomain)
+        , Web.tab_entry (is_tab_active TabAddUser)       "AddUser"          (ChangeTab TabAddUser)
+        , Web.tab_entry (is_tab_active TabOrphanDomains) "OrphanDomains"    (ChangeTab TabOrphanDomains)
         ]
     is_tab_active tab = current_tab == tab
 
-    show_found_users = Bulma.box [ HH.ul_ $ map user_card matching_users ]
-    user_card user = HH.li_ [ Bulma.btn_delete (RemoveUser user.uid)
-                            , Bulma.btn_ [C.is_small] user.login (ShowUser user.uid)
-                            ]
-    show_orphan_domains = Bulma.box [ HH.ul_ $ map domain_entry orphan_domains ]
-    domain_entry domain = HH.li_ [ Bulma.btn_delete (RemoveDomain domain)
-                                 , Bulma.btn_ [C.is_small] domain (ShowDomain domain)
+    show_orphan_domains = Web.box [ HH.ul_ $ map domain_entry orphan_domains ]
+    domain_entry domain = HH.li_ [ Web.btn_delete (RemoveDomain domain)
+                                 , Web.btn_ [C.is_small] domain (EnterDomain domain)
                                  ]
-    up x = HandleAddUserInput <<< x
 
     render_adduser_form =
       HH.form
         [ HE.onSubmit PreventSubmit ]
-        [ Bulma.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login
-        , Bulma.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (HandleAddUserInput ADDUSER_toggle_admin)
-        , Bulma.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email
-        , Bulma.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass
-        , Bulma.btn "Send" AddUserAttempt
+        [ Web.box_input "login" "User login" "login" (ActionOnAddUserForm <<< ADDUSER_INP_login) addUserForm.login
+        , Web.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (ActionOnAddUserForm ADDUSER_toggle_admin)
+        , Web.box_input "email" "User email" "email" (ActionOnAddUserForm <<< ADDUSER_INP_email) addUserForm.email
+        , Web.box_password "password" "User password" "password" (ActionOnAddUserForm <<< ADDUSER_INP_pass) addUserForm.pass
+        , Web.btn "Send" AddUserAttempt
         ]
 
     render_searchuser_form =
       HH.form
         [ HE.onSubmit PreventSubmit ]
-        [ Bulma.p """
+        [ Web.p """
                   Following input accepts any regex.
                   This is used to search for a user based on their login, full name or email address.
                   """
-        , Bulma.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex
-        --, Bulma.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin)
-        --    (HandleAddUserInput SEARCHUSER_toggle_admin)
-        --, Bulma.box_input "domain" "Domain owned" "blah.netlib.re."
-        --    (up SEARCHUSER_INP_domain) searchUserForm.domain
-        , Bulma.btn "Send" SearchUserAttempt
+        , Web.box_input "regex" "Regex" "regex" (ActionOnSearchUserForm <<< SEARCHUSER_INP_regex) searchUserForm.regex
+        --, Web.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin)
+        --    (ActionOnSearchUserForm <<< SEARCHUSER_toggle_admin)
+        , Web.btn "Send" SearchUserAttempt
+        ]
+
+    render_searchdomain_form =
+      HH.form
+        [ HE.onSubmit PreventSubmit ]
+        [ Web.p "Following input accepts any regex to search for a domain."
+        , Web.box_input "domain" "Domain owned" "blah.netlib.re."
+            (ActionOnSearchDomainForm <<< SEARCHDOMAIN_INP_domain) searchDomainForm.domain
+        , Web.btn "Send" SearchDomainAttempt
         ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
@@ -197,24 +226,32 @@ handleAction = case _ of
     case old_tab of
       Nothing -> pure unit
       Just current_tab -> case current_tab of
-        "Home"          -> handleAction $ ChangeTab Home
-        "Search"        -> handleAction $ ChangeTab Search
-        "Add"           -> handleAction $ ChangeTab Add
-        "OrphanDomains" -> handleAction $ ChangeTab OrphanDomains
+        "TabHome"          -> handleAction $ ChangeTab TabHome
+        "TabSearchUser"    -> handleAction $ ChangeTab TabSearchUser
+        "TabSearchDomain"  -> handleAction $ ChangeTab TabSearchDomain
+        "TabAddUser"       -> handleAction $ ChangeTab TabAddUser
+        "TabOrphanDomains" -> handleAction $ ChangeTab TabOrphanDomains
         _               -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab
 
   Finalize -> do
     state <- H.get
     H.raise $ StoreState state
 
-  HandleAddUserInput adduserinp -> do
+  ActionOnAddUserForm adduserinp -> do
     { addUserForm } <- H.get
     case adduserinp of
-      ADDUSER_INP_login  v    -> H.modify_ _ { addUserForm    { login = v                     } }
-      ADDUSER_INP_email  v    -> H.modify_ _ { addUserForm    { email = v                     } }
-      ADDUSER_toggle_admin    -> H.modify_ _ { addUserForm    { admin = not addUserForm.admin } }
-      ADDUSER_INP_pass   v    -> H.modify_ _ { addUserForm    { pass  = v                     } }
-      SEARCHUSER_INP_regex  v -> H.modify_ _ { searchUserForm { regex = v                     } }
+      ADDUSER_INP_login  v  -> H.modify_ _ { addUserForm { login  = v                     } }
+      ADDUSER_INP_email  v  -> H.modify_ _ { addUserForm { email  = v                     } }
+      ADDUSER_toggle_admin  -> H.modify_ _ { addUserForm { admin  = not addUserForm.admin } }
+      ADDUSER_INP_pass   v  -> H.modify_ _ { addUserForm { pass   = v                     } }
+
+  ActionOnSearchUserForm searchuserinp -> do
+    case searchuserinp of
+      SEARCHUSER_INP_regex v -> H.modify_ _ { searchUserForm { regex  = v } }
+
+  ActionOnSearchDomainForm searchdomaininp -> do
+    case searchdomaininp of
+      SEARCHDOMAIN_INP_domain v -> H.modify_ _ { searchDomainForm { domain = v } }
 
   PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev
 
@@ -225,17 +262,17 @@ handleAction = case _ of
     H.raise $ Log $ SystemLog $ "Get orphan domains"
     H.raise $ GetOrphanDomains
 
-  RemoveUser uid -> do
+  DeleteUser uid -> do
     H.raise $ Log $ SystemLog $ "Remove user " <> show uid
     H.raise $ DeleteUserAccount uid
 
   RemoveDomain domain -> do
-    H.raise $ Log $ SystemLog $ "TODO: remove domain " <> domain
-    --H.raise $ DeleteDomain domain
+    H.raise $ Log $ SystemLog $ "Remove domain " <> domain
+    H.raise $ DeleteDomain domain
 
-  ShowDomain domain -> do
-    H.raise $ Log $ SystemLog $ "TODO: show domain " <> domain
-    -- H.raise $ RequestDomain domain
+  EnterDomain domain -> do
+    H.raise $ Log $ SystemLog $ "Show zone " <> domain
+    H.raise $ ShowZone domain
 
   AddUserAttempt -> do
     { addUserForm } <- H.get
@@ -249,37 +286,32 @@ handleAction = case _ of
       _, _, "" -> H.raise $ Log $ UnableToSend "Write the user's password."
 
       _, _, _ -> do
-        ab <- H.liftEffect $ AuthD.serialize $
-          AuthD.MkAddUser { login: login
-                          , admin: addUserForm.admin
-                          , email: Just (Email.Email email)
-                          , password: pass }
-        H.raise $ MessageToSend ab
         H.raise $ Log $ SystemLog "Add a user"
+        H.raise $ AddUser login addUserForm.admin (Just (Email.Email email)) pass
 
   ChangeTab current_tab -> do
     -- Store the current tab we are on and restore it when we reload.
     sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
     _ <- case current_tab of
-      Home           -> H.liftEffect $ Storage.setItem "current-ada-tab" "Home"          sessionstorage
-      Search         -> H.liftEffect $ Storage.setItem "current-ada-tab" "Search"        sessionstorage
-      Add            -> H.liftEffect $ Storage.setItem "current-ada-tab" "Add"           sessionstorage
-      OrphanDomains  -> H.liftEffect $ Storage.setItem "current-ada-tab" "OrphanDomains" sessionstorage
+      TabHome           -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabHome"          sessionstorage
+      TabSearchUser     -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabSearchUser"    sessionstorage
+      TabSearchDomain   -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabSearchDomain"  sessionstorage
+      TabAddUser        -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabAddUser"       sessionstorage
+      TabOrphanDomains  -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabOrphanDomains" sessionstorage
     H.modify_ _ { current_tab = current_tab }
 
   SearchUserAttempt -> do
     { searchUserForm } <- H.get
     let regex  = searchUserForm.regex
-        -- domain = searchUserForm.domain
-        -- admin  = searchUserForm.admin
-    ab <- H.liftEffect $ AuthD.serialize $
-      AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 }
-    H.raise $ MessageToSend ab
+    H.raise $ SearchUser (not_empty_string regex) (Just 0)
     H.modify_ _ { matching_users = [] }
 
-not_empty_string :: String -> Maybe String
-not_empty_string "" = Nothing
-not_empty_string v = Just v
+  SearchDomainAttempt -> do
+    { searchDomainForm } <- H.get
+    let domain  = searchDomainForm.domain
+    H.raise $ Log $ SystemLog $ "Search for this domain: " <> domain
+    H.raise $ SearchDomain domain
+    H.modify_ _ { matching_domains = [] }
 
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
@@ -312,3 +344,7 @@ handleQuery = case _ of
   GotOrphanDomainList domains a -> do
     H.modify_ _ { orphan_domains = domains }
     pure (Just a)
+
+  GotFoundDomains domains a -> do
+    H.modify_ _ { matching_domains = domains }
+    pure (Just a)

src/App/Page/Authentication.purs

@@ -5,7 +5,6 @@ module App.Page.Authentication where
 import Prelude (Unit, bind, discard, pure, ($), (<<<), (=<<), (<>), (>), (==), map, show, unit)
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Either (Either(..))
 import Data.Eq (class Eq)
 import Data.Maybe (Maybe(..), maybe)
@@ -17,7 +16,7 @@ import Halogen.HTML.Events as HE
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
-import Bulma as Bulma
+import Web as Web
 
 import Web.HTML (window) as HTML
 import Web.HTML.Window (sessionStorage) as Window
@@ -48,8 +47,7 @@ data Error
 -- |
 -- | TODO: authentication is performed in `App.Container`.
 data Output
-  = MessageToSend ArrayBuffer
-  | AuthenticateToAuthd (Tuple Login Password)
+  = AuthenticateToAuthd (Tuple Login Password)
   | Log LogMessage
   | UserLogin String
   | PasswordRecovery Login PasswordRecoveryToken Password
@@ -135,24 +133,24 @@ component =
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
-  Bulma.section_small
+  Web.section_small
     [ fancy_tab_bar
     , if A.length errors > 0
-      -- then HH.div_ [ Bulma.box [ HH.text (A.fold $ map show_error errors) ] ]
-      then HH.div_ [ Bulma.box [Bulma.notification_danger (A.fold $ map show_error errors) CloseErrorStuff]]
+      -- then HH.div_ [ Web.box [ HH.text (A.fold $ map show_error errors) ] ]
+      then HH.div_ [ Web.box [Web.notification_danger (A.fold $ map show_error errors) CloseErrorStuff]]
       else HH.div_ []
     , case current_tab of
-        Auth            -> Bulma.box auth_form
-        ILostMyPassword -> Bulma.box passrecovery_form
-        Recovery        -> Bulma.box newpass_form
+        Auth            -> Web.box auth_form
+        ILostMyPassword -> Web.box passrecovery_form
+        Recovery        -> Web.box newpass_form
     ]
 
   where
     fancy_tab_bar =
-      Bulma.fancy_tabs
-        [ Bulma.tab_entry (is_tab_active Auth) "Authentication" (ChangeTab Auth)
-        , Bulma.tab_entry (is_tab_active ILostMyPassword) "I lost my password! 😟" (ChangeTab ILostMyPassword)
-        , Bulma.tab_entry (is_tab_active Recovery) "Recover with a token" (ChangeTab Recovery)
+      Web.fancy_tabs
+        [ Web.tab_entry (is_tab_active Auth) "Authentication" (ChangeTab Auth)
+        , Web.tab_entry (is_tab_active ILostMyPassword) "I lost my password! 😟" (ChangeTab ILostMyPassword)
+        , Web.tab_entry (is_tab_active Recovery) "Recover with a token" (ChangeTab Recovery)
         ]
     is_tab_active tab = current_tab == tab
 
@@ -203,45 +201,41 @@ render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm,
                                <> show min <> " and " <> show max
                                <> " (currently: " <> show n <> ")"
 
-    auth_form = [ Bulma.h3 "Authentication", render_auth_form ]
+    auth_form = [ Web.h3 "Authentication", render_auth_form ]
     passrecovery_form =
-      [ Bulma.h3 "You forgot your password (or your login)"
-      , Bulma.div_content []
-        [ Bulma.p "Enter either your login or email and you'll receive a recovery token."
-        ]
+      [ Web.h3 "You forgot your password (or your login)"
+      , Web.quote [ Web.p "Enter either your login or email and you'll receive a recovery token." ]
       , render_password_recovery_form
       ]
     newpass_form =
-      [ Bulma.h3 "You got the password recovery mail"
-      , Bulma.div_content []
-        [ Bulma.p "Nice! You get to choose your new password."
-        ]
+      [ Web.h3 "You got the password recovery mail"
+      , Web.quote [ Web.p "Nice! You get to choose your new password." ]
       , render_new_password_form
       ]
 
     render_auth_form = HH.form
       [ HE.onSubmit AuthenticationAttempt ]
-      [ Bulma.username_input "Username" authenticationForm.login (HandleAuthenticationInput <<< AUTH_INP_login)
-      , Bulma.password_input "Password" authenticationForm.pass  (HandleAuthenticationInput <<< AUTH_INP_pass)
-      , Bulma.btn_validation
+      [ Web.username_input "Username" authenticationForm.login (HandleAuthenticationInput <<< AUTH_INP_login)
+      , Web.password_input "Password" authenticationForm.pass  (HandleAuthenticationInput <<< AUTH_INP_pass)
+      , Web.btn_validation
       ]
 
     render_password_recovery_form = HH.form
       [ HE.onSubmit PasswordRecoveryAttempt ]
-      [ Bulma.username_input "Username" passwordRecoveryForm.login (HandlePasswordRecovery <<< PASSR_INP_login)
-      , Bulma.email_input "Email"       passwordRecoveryForm.email (HandlePasswordRecovery <<< PASSR_INP_email)
-      , Bulma.btn_validation
+      [ Web.username_input "Username" passwordRecoveryForm.login (HandlePasswordRecovery <<< PASSR_INP_login)
+      , Web.email_input "Email"       passwordRecoveryForm.email (HandlePasswordRecovery <<< PASSR_INP_email)
+      , Web.btn_validation
       ]
 
     render_new_password_form = HH.form
       [ HE.onSubmit NewPasswordAttempt ]
-      [ Bulma.username_input "Username"     newPasswordForm.login    (HandleNewPassword <<< NEWPASS_INP_login)
-      , Bulma.token_input "Token"           newPasswordForm.token    (HandleNewPassword <<< NEWPASS_INP_token)
-      , Bulma.password_input_new "Password" newPasswordForm.password (HandleNewPassword <<< NEWPASS_INP_password)
+      [ Web.username_input "Username"     newPasswordForm.login    (HandleNewPassword <<< NEWPASS_INP_login)
+      , Web.token_input "Token"           newPasswordForm.token    (HandleNewPassword <<< NEWPASS_INP_token)
+      , Web.password_input_new "Password" newPasswordForm.password (HandleNewPassword <<< NEWPASS_INP_password)
 
-      , Bulma.password_input_confirmation "Confirmation" newPasswordForm.confirmation
+      , Web.password_input_confirmation "Confirmation" newPasswordForm.confirmation
         (HandleNewPassword <<< NEWPASS_INP_confirmation)
-      , Bulma.btn_validation
+      , Web.btn_validation
       ]
 
 

src/App/Page/DomainList.purs

@@ -15,10 +15,9 @@ module App.Page.DomainList where
 import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==))
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Either (Either(..))
 import Data.String (toLower)
-import Data.Maybe (Maybe(..), maybe, fromMaybe)
+import Data.Maybe (Maybe(..), maybe)
 import Data.String.Utils (endsWith)
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
@@ -27,13 +26,13 @@ import Halogen.HTML.Events as HE
 import Halogen.HTML.Events as HHE
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
-import Bulma as Bulma
+import Web as Web
+import App.Templates.Table (owned_domains, shared_domains) as Table
 
 import App.DisplayErrors (error_to_paragraph_label)
 
 import App.Validation.Label as Validation
 
-import CSSClasses as C
 import App.Type.DomainInfo
 import App.Type.LogMessage (LogMessage(..))
 import App.Message.DNSManagerDaemon as DNSManager
@@ -52,7 +51,12 @@ import App.Message.DNSManagerDaemon as DNSManager
 -- | component is removed. This way, the data is conserved.
 
 data Output
-  = MessageToSend ArrayBuffer
+  = AskShareToken String
+  | AskTransferToken String
+  | AskUnShareDomain String
+  | AskDeleteDomain String
+  | AskNewDomain String
+  | AskGainOwnership String
   | Log LogMessage
   | ChangePageZoneInterface String
   | AskState
@@ -179,49 +183,41 @@ initialState _ =
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, deletion_modal }
-  = Bulma.section_small
+  = Web.section_small
       [ case deletion_modal of
-          Nothing -> HH.div_ [ Bulma.columns_ domain_line
-                             , Bulma.hr
-                             , Bulma.columns_ new_domain_line
-                             , Bulma.hr
-                             , Bulma.columns_ explanations_line
+          Nothing -> HH.div_ [ Web.columns_ domain_line
+                             , Web.hr
+                             , Web.columns_ new_domain_line
+                             , Web.hr
+                             , Web.columns_ explanations_line
                              ]
-          Just domain -> Bulma.modal "Deleting a domain"
+          Just domain -> Web.modal "Deleting a domain"
             [warning_message domain] [modal_delete_button domain, modal_cancel_button]
       ]
   where
-    c = Bulma.column_
+    c = Web.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."
+      [ Web.h3 "My domains"
+      , Web.simple_quote "You are the exclusive owner of the following domains."
+      , Table.owned_domains domains_i_exclusively_own EnterDomain TransferDomain ShareDomain DeleteDomainModal
       ]
     render_my_shared_domains =
-      [ Bulma.h3 "Shared domains"
-      , Bulma.simple_quote """
+      [ Web.h3 "Shared domains"
+      , Web.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."
+      , Table.shared_domains domains_i_share EnterDomain UnShareDomain DeleteDomainModal
       ]
     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."
+      [ Web.h3 "New domain"
+      , Web.quote [ Web.p "The heart of dnsmanager! 🎉"
+                    , Web.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.
                         """
@@ -230,16 +226,16 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del
       ]
 
     render_gain_ownership =
-      [ Bulma.h3 "Get the ownership of a domain"
-      , Bulma.simple_quote """
+      [ Web.h3 "Get the ownership of a domain"
+      , Web.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 """
+      [ Web.h3 "Share the ownership of a domain"
+      , Web.simple_quote """
           Ask for a "share token" for your domain and give it to other users.
           All the owners can make modifications to the domain.
           Don't let the administration of a domain be the burden of a single person!
@@ -247,14 +243,14 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del
       ]
 
     render_transfer_ownership_explanation =
-      [ Bulma.h3 "Transfer the ownership of a domain"
-      , Bulma.simple_quote """
+      [ Web.h3 "Transfer the ownership of a domain"
+      , Web.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_cancel_button = Bulma.cancel_button CancelModal
+    modal_delete_button domain = Web.alert_btn "Delete the domain" (RemoveDomain domain)
+    modal_cancel_button = Web.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
@@ -267,37 +263,19 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del
                             <> "\". Are you sure you want to do this? This is "
                 , HH.strong_ [ HH.text "irreversible" ]
                 , HH.text "."
-                , Bulma.notification_warning' """
+                , Web.notification_warning' """
                 In case this domain is shared, it will just be removed from your domains.
                 """
                 ]
 
-    shared_domain_row domain = HH.tr_
-      [ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ]
-      , HH.td_ [ HH.text $ fromMaybe "" domain.share_key ]
-      , if A.length domain.owners == 1
-        then HH.td_ [ Bulma.alert_btn_abbr "Unshare the domain by removing the \"share\" token." "Unshare" (UnShareDomain domain.name) ]
-        else HH.td_ [ Bulma.btn_ro [C.is_warning] "Cannot unshare it" ]
-      , HH.td_ [ Bulma.alert_btn_abbr "Delete the domain from your list of owned domains. In case you are the only owner, this will also remove all zone data and the domain won't be served anymore." "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 "Token key:", Bulma.p key ]
-          Nothing  -> HH.td_ [ Bulma.btn_abbr "Generate a token to transfer the ownership of a domain." "Transfer" (TransferDomain domain.name) ]
-      , HH.td_ [ Bulma.btn_abbr "Generate a token to share the ownership of a domain." "Share" (ShareDomain domain.name) ]
-      , HH.td_ [ Bulma.alert_btn_abbr "Delete the domain. This will remove all zone data and the domain won't be served anymore." "Delete" (DeleteDomainModal domain.name) ]
-      ]
-
     render_add_domain_form = HH.form
       [ HE.onSubmit NewDomainAttempt ]
-      [ Bulma.new_domain_field
+      [ Web.new_domain_field
           (HandleNewDomainInput <<< INP_newdomain)
           newDomainForm.new_domain
           [ HHE.onSelectedIndexChange domain_choice ]
           (map (\v -> "." <> v) accepted_domains)
-      , Bulma.btn_validation_ "add a new domain"
+      , Web.btn_validation_ "add a new domain"
       , if A.length newDomainForm._errors > 0
         then HH.div_ $ map error_to_paragraph_label newDomainForm._errors
         else HH.div_ [ ]
@@ -305,10 +283,10 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del
 
     render_ask_domain_transfer_form = HH.form
       [ HE.onSubmit AskDomainTransferAttempt ]
-      [ Bulma.box_input "idTransferToken" "Token" "UUID of the domain"
+      [ Web.box_input "idTransferToken" "Token" "UUID of the domain"
           AskDomainTransferUUIDInput
           askDomainTransferForm.uuid
-      , Bulma.btn_validation_ "ask for a domain transfer"
+      , Web.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_ [ ]
@@ -354,27 +332,23 @@ handleAction = case _ of
     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 <> "."
+    H.raise $ AskShareToken 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 <> "."
+    H.raise $ AskTransferToken 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 <> "."
+    H.raise $ AskUnShareDomain domain
 
   DeleteDomainModal domain -> do
     H.modify_ _ { deletion_modal = Just domain }
 
   RemoveDomain domain -> do
-    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
-    H.raise $ MessageToSend message
     H.raise $ Log $ SystemLog $ "Remove domain: " <> domain
+    H.raise $ AskDeleteDomain domain
     H.modify_ _ { deletion_modal = Nothing }
 
   NewDomainAttempt ev -> do
@@ -387,10 +361,7 @@ handleAction = case _ of
       "", _, _ ->
         H.raise $ Log $ UnableToSend "Please enter the new domain."
       _, [], _ -> do
-        message <- H.liftEffect
-          $ DNSManager.serialize
-          $ DNSManager.MkNewDomain { domain: new_domain }
-        H.raise $ MessageToSend message
+        H.raise $ AskNewDomain new_domain
         H.raise $ Log $ SystemLog $ "Add a new domain (" <> new_domain <> ")"
         handleAction $ HandleNewDomainInput $ INP_newdomain ""
       _, _, _ ->
@@ -400,14 +371,12 @@ handleAction = case _ of
     H.liftEffect $ Event.preventDefault ev
 
     { askDomainTransferForm } <- H.get
-    case askDomainTransferForm.uuid, askDomainTransferForm._errors of
+    let { uuid, _errors } = askDomainTransferForm
+    case uuid, _errors of
       "", _ ->
         H.raise $ Log $ UnableToSend "Please enter the UUID of the transfer."
       uuid, [] -> do
-        message <- H.liftEffect
-          $ DNSManager.serialize
-          $ DNSManager.MkGainOwnership { uuid: uuid }
-        H.raise $ MessageToSend message
+        H.raise $ AskGainOwnership uuid
         H.raise $ Log $ SystemLog $ "Gain ownership of a domain (" <> uuid <> ")."
         handleAction $ AskDomainTransferUUIDInput ""
       _, _ ->

src/App/Page/Home.purs

@@ -13,7 +13,7 @@ import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
 
 import CSSClasses as C
-import Bulma as Bulma
+import Web as Web
 
 type Input = Unit
 type Action = Unit
@@ -41,53 +41,51 @@ initialState _ = unit
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render _ = HH.div_
-             [ Bulma.hero_danger
+             [ Web.hero_danger
                  -- "THIS IS A BETA RELEASE"
                  -- "You can register, login and play a bit with the tool. Feel free to report errors and suggestions."
                  [ HH.text "MESSAGE DE MIGRATION" ]
-                 [ Bulma.p "En bref : le site a été refait à neuf, en anglais (une traduction arrivera… un jour), et les comptes ont été migrés."
-                 , Bulma.p "Les utilisateurs peuvent se connecter avec leurs identifiants habituels et leurs domaines sont toujours attribués, mais le contenu n'a pas été préservé (il faut re-configurer les zones)."
-                 , Bulma.p """
+                 [ Web.p "En bref : le site a été refait à neuf, en anglais (une traduction arrivera… un jour), et les comptes ont été migrés."
+                 , Web.p "Les utilisateurs peuvent se connecter avec leurs identifiants habituels et leurs domaines sont toujours attribués, mais le contenu n'a pas été préservé (il faut re-configurer les zones)."
+                 , Web.p """
                  Les comptes migrés sont conservés 6 mois, puis supprimés si aucune connexion n'est faite,
                  afin de purger un certain nombre de vieux comptes de robots.
                  """
                  , HH.p [ HP.classes [C.margin_top 3] ]
-                   [ Bulma.outside_link [C.button, C.is_info] url_linuxfr "Article linuxfr.org présentant la nouvelle version de netlibre" ]
+                   [ Web.outside_link [C.button, C.is_info] url_linuxfr "Article linuxfr.org présentant la nouvelle version de netlibre" ]
                  ]
-             , Bulma.section_small
-                 [ Bulma.h1 "Welcome to netlib.re"
-                 , Bulma.subtitle "Free domain names for the common folks"
-                 , Bulma.hr
+             , Web.section_small
+                 [ Web.h1 "Welcome to netlib.re"
+                 , Web.subtitle "Free domain names for the common folks"
+                 , Web.hr
                  , render_description
                  , render_update_why_and_contact
-                 , Bulma.hr
+                 , Web.hr
                  , render_how_and_code
                  ]
              ]
   where
     url_linuxfr = "https://linuxfr.org/news/netlibre-un-service-libre-et-un-nom-de-domaine-gratuit"
-    title = Bulma.h3
-    expl content = Bulma.div_content [] [ Bulma.explanation content ]
-    p = Bulma.p
-    b x = Bulma.column_ [ Bulma.box [ Bulma.div_content [] x ] ]
+    title = Web.h4
+    b x = Web.column_ [ Web.box x ]
 
-    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_description = Web.columns_ [ render_basics, render_no_expert, render_no_housing ]
+    render_update_why_and_contact = Web.columns_ [ render_updates, render_why, render_contact ]
 
     render_basics
       = b [ title "What is provided?"
-          , p "Reserve a domain name in <something>.netlib.re for free."
-          , p "Manage your own DNS zone."
+          , Web.p "Reserve a domain name in <something>.netlib.re for free."
+          , Web.p "Manage your own DNS zone."
           ]
     render_no_expert
       = b [ title "No need to be an expert"
-          , p """
+          , Web.p """
               This website will help you through your configuration, as much as we can.
               """
           ]
     render_no_housing
       = b [ title "No housing, just a name"
-          , p """
+          , Web.p """
               We don't host your services or websites.
               We just provide a name.
               You can host your websites anywhere you want: at home for example.
@@ -95,32 +93,32 @@ render _ = HH.div_
           ]
     render_updates
       = b [ title "Automatic updates"
-          , p "Update your records with a single, stupidly simple command. For example:"
-          , expl [ Bulma.strong "wget https://www.netlib.re/token-update/<token>" ]
-          , p "Every A and AAAA records have tokens for easy updates."
+          , Web.p "Update your records with a single, stupidly simple command. For example:"
+          , Web.quote [ Web.strong "wget https://www.netlib.re/token-update/<token>" ]
+          , Web.p "Every A and AAAA records have tokens for easy updates."
           ]
 
     render_why
       = b [ title "Why?"
-          , p "Because everyone should be able to have a place on the Internet."
-          , p "We provide a name, build something meaningful with it."
+          , Web.p "Because everyone should be able to have a place on the Internet."
+          , Web.p "We provide a name, build something meaningful with it."
           ]
     render_contact
       = b [ title "Contact"
-          , p "You have a question, you have seen a bug, you have suggestions or you just want to chat?"
-          , p "You can contact me: philippe@netlib.re"
-          , p "For legal matter: abuse@netlib.re"
+          , Web.p "You have a question, you have seen a bug, you have suggestions or you just want to chat?"
+          , Web.p "You can contact me: philippe@netlib.re"
+          , Web.p "For legal matter: abuse@netlib.re"
           ]
 
-    render_how_and_code = Bulma.columns_ [ render_how, render_code ]
+    render_how_and_code = Web.columns_ [ render_how, render_code ]
     render_how
       = b [ title "How does this work?"
-          , p "We pay for the domain names (netlib.re and codelib.re) and let you have a subdomain."
-          , p "This service helps you manage your domain (a subdomain of netlib.re or codelib.re)."
+          , Web.p "We pay for the domain names (netlib.re and codelib.re) and let you have a subdomain."
+          , Web.p "This service helps you manage your domain (a subdomain of netlib.re or codelib.re)."
           ]
     render_code
       = b [ title "I want to see the code! 🤓​"
-          , p "The project is fully open-source (ISC licence)."
+          , Web.p "The project is fully open-source (ISC licence)."
           , HH.text "There are a few parts:"
           , HH.ul_
             [ link "https://git.baguette.netlib.re/Baguette/authd" "authentication daemon"
@@ -137,8 +135,8 @@ render _ = HH.div_
                    this user-friendly website, so you can manage your zones. 🥰
                    """
             ]
-          , Bulma.hr
-          , Bulma.p "But of course, there are a few more technical parts:"
+          , Web.hr
+          , Web.p "But of course, there are a few more technical parts:"
           , HH.ul_
             [ link "https://git.baguette.netlib.re/Baguette/libipc" "libIPC"
                    """
@@ -154,4 +152,4 @@ render _ = HH.div_
             ]
           ]
     link url link_title content
-      = HH.li_ [ Bulma.outside_link [] url link_title, HH.text ", ", HH.text content ]
+      = HH.li_ [ Web.outside_link [] url link_title, HH.text ", ", HH.text content ]

src/App/Page/MailValidation.purs

@@ -6,7 +6,6 @@ module App.Page.MailValidation where
 import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, show)
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Maybe (maybe)
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
@@ -16,16 +15,15 @@ import Halogen.HTML.Events as HE
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
-import Bulma as Bulma
+import Web as Web
 
 import App.Type.LogMessage
-import App.Message.AuthenticationDaemon as AuthD
 
 import App.Validation.Login as L
 import App.Validation.Token as T
 
 data Output
-  = MessageToSend ArrayBuffer
+  = AskValidateUser String String
   | Log LogMessage
 
 -- | The component is informed when the connection went up or down.
@@ -82,21 +80,21 @@ initialState _ =
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render { mailValidationForm }
-  = Bulma.section_small [ Bulma.columns_ [ b mail_validation_form ] ]
+  = Web.section_small [ Web.columns_ [ b mail_validation_form ] ]
 
   where
-    b e = Bulma.column_ [ Bulma.box e ]
+    b e = Web.column_ [ Web.box e ]
     mail_validation_form
-      = [ Bulma.h3 "Verify your account"
-        , Bulma.div_content [] [Bulma.explanation [Bulma.p "Email addresses must be validated within 30 minutes."]]
+      = [ Web.h3 "Verify your account"
+        , Web.quote [Web.p "Email addresses must be validated within 30 minutes."]
         , render_register_form
         ]
 
     render_register_form = HH.form
       [ HE.onSubmit ValidateInputs ]
-      [ Bulma.username_input "Username" mailValidationForm.login (HandleValidationInput <<< VALIDATION_INP_login)
-      , Bulma.token_input "Token"       mailValidationForm.token (HandleValidationInput <<< VALIDATION_INP_token)
-      , Bulma.btn_validation
+      [ Web.username_input "Username" mailValidationForm.login (HandleValidationInput <<< VALIDATION_INP_login)
+      , Web.token_input "Token"       mailValidationForm.token (HandleValidationInput <<< VALIDATION_INP_token)
+      , Web.btn_validation
       ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
@@ -127,8 +125,7 @@ handleAction = case _ of
   SendMailValidationToken -> do
     { mailValidationForm } <- H.get
     let { login, token } = mailValidationForm
-    message <- H.liftEffect $ AuthD.serialize $ AuthD.MkValidateUser { user: login, activation_key: token }
-    H.raise $ MessageToSend message
+    H.raise $ AskValidateUser login token
     H.raise $ Log $ SystemLog $ "Trying to validate email address of user \"" <> login <> "\""
 
 show_error :: Error -> String

src/App/Page/Migration.purs

@@ -22,9 +22,7 @@ module App.Page.Migration where
 import Prelude (Unit, between, bind, discard, map, ($), (<>))
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Either (Either(..))
--- import Data.Maybe (Maybe(..))
 import Data.String as S
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
@@ -33,18 +31,17 @@ import Halogen.HTML.Events as HE
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
--- import Data.Generic.Rep (class Generic)
--- import Data.Show.Generic (genericShow)
-
-import Bulma as Bulma
+import Web as Web
 import Scroll (scrollToTop)
 
 import App.Type.LogMessage
-import App.Message.AuthenticationDaemon as AuthD
 import App.DisplayErrors (show_error_email)
 import App.Validation.Email as E
 
-data Output = MessageToSend ArrayBuffer | Log LogMessage
+data Output
+  = Log LogMessage
+  | AskNewEmailAddress String
+  | AskNewEmailAddressTokenAddress String
 
 -- | Once the new email address has been accepted by `authd` as "pending",
 -- | this page automatically switches to a second tab.
@@ -57,11 +54,6 @@ type Input = Unit
 -- | Both value types to validate before sending the appropriate messages to `authd`.
 data Subject = EmailAddress | Token
 
---derive instance eqSubject :: Eq Subject
---derive instance genericSubject :: Generic Subject _
---instance showSubject :: Show Subject where
---  show = genericShow
-
 data Action
   -- | Copy user input in the different HTML inputs.
   = UserInput Subject String
@@ -72,28 +64,15 @@ data Action
   -- | Send either the new email address or the token to `authd`.
   | ContactAuthd Subject
 
-  -- | Change the current tab.
-  -- | ChangeTab Subject
-
 -- | The possible errors from the email format.
 -- | TODO: check the token.
 data Error = Email (Array E.Error)
 
 -- | State is composed of the new email address, the token and the possible errors.
-type State
-  = { email :: String
-    , token :: String
-    , errors :: Array Error
-    -- , current_tab :: Subject
-    }
+type State = { email :: String, token :: String, errors :: Array Error }
 
 initialState :: Input -> State
-initialState _
-  = { email: ""
-    , token: ""
-    , errors: []
-    -- , current_tab: EmailAddress
-    }
+initialState _ = { email: "", token: "", errors: [] }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
 component =
@@ -102,50 +81,39 @@ component =
     , render
     , eval: H.mkEval $ H.defaultEval
         { handleAction = handleAction
-        --, handleQuery  = handleQuery
         }
     }
 
--- TODO: this will be useful in case there is a tab mechanism on this page.
---handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
---handleQuery = case _ of
---  WaitingForToken a -> pure (Just a)
-
 render :: forall m. State -> H.ComponentHTML Action () m
-render state
-  = Bulma.section_small [Bulma.columns_
-      [ b email_form
-      , b token_form
-      ]]
-
+render state = Web.section_small [ Web.columns_ [ b email_form, b token_form ]]
   where
-    b e = Bulma.column_ [ Bulma.box e ]
+    b e = Web.column_ [ Web.box e ]
 
     email_form
-      = [ Bulma.h3 "New Email address"
-        -- TODO: put some text here
+      = [ Web.h3 "New Email address"
+        , Web.content [ Web.p "First, tell what is your new email address to use." ]
         , HH.form
             [ HE.onSubmit (Verify EmailAddress) ]
-            [ email_input, email_error, Bulma.btn_validation ]
+            [ email_input, email_error, Web.btn_validation ]
         ]
 
-    email_input = Bulma.email_input "Email" state.email (UserInput EmailAddress)
+    email_input = Web.email_input "Email" state.email (UserInput EmailAddress)
 
     email_error
       = case between 0 5 (S.length state.email), E.email state.email of
           true, _        -> HH.text ""
-          _, Left errors -> Bulma.error_box "newAddress" "Email error" (show_error $ Email errors)
+          _, Left errors -> Web.error_box "newAddress" "Email error" (show_error $ Email errors)
           _, Right _     -> HH.text ""
 
     token_form
-      = [ Bulma.h3 "Email validation token"
-        -- TODO: put some text here
+      = [ Web.h3 "Email validation token"
+        , Web.content [ Web.p "Then, verify your new email address with the provided token." ]
         , HH.form
             [ HE.onSubmit (Verify Token) ]
-            [ token_input {-, token_error -}, Bulma.btn_validation ]
+            [ token_input {-, token_error -}, Web.btn_validation ]
         ]
 
-    token_input = Bulma.token_input "Token" state.token (UserInput Token)
+    token_input = Web.token_input "Token" state.token (UserInput Token)
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
@@ -181,12 +149,10 @@ handleAction = case _ of
     state <- H.get
     case subject of
       EmailAddress -> do
-        message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddress { email: state.email }
-        H.raise $ MessageToSend message
+        H.raise $ AskNewEmailAddress state.email
         H.raise $ Log $ SystemLog $ "Sending a new email address."
       Token -> do
-        message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddressToken { token: state.token }
-        H.raise $ MessageToSend message
+        H.raise $ AskNewEmailAddressTokenAddress state.token
         H.raise $ Log $ SystemLog $ "Sending a validation token."
 
 show_error :: Error -> String

src/App/Page/Navigation.purs

@@ -18,7 +18,7 @@ import Halogen.HTML.Properties as HP
 import Halogen.HTML.Properties.ARIA as ARIA
 
 import CSSClasses as C
-import Bulma as Bulma
+import Web as Web
 
 import App.Type.Pages (Page(..))
 import App.Type.LogMessage (LogMessage)
@@ -142,7 +142,7 @@ render { logged, active, admin, login } =
     HH.a [ HP.classes $ [C.navbar_burger] <> if active then [C.is_active] else []
          , ARIA.label "menu"
          , ARIA.expanded "false"
-         , Bulma.data_target "navbar-netlibre"
+         , Web.data_target "navbar-netlibre"
          , HE.onClick (\_ -> ToggleMenu)
          ] [ HH.span [ARIA.hidden "true"] []
            , HH.span [ARIA.hidden "true"] []
@@ -192,7 +192,7 @@ render { logged, active, admin, login } =
          , HE.onClick (\_ -> action)
          ] [ (HH.text str) ]
 
-  dropdown_element classes link str = Bulma.outside_link ([C.navbar_item] <> classes) link str
+  dropdown_element classes link str = Web.outside_link ([C.navbar_item] <> classes) link str
   dropdown_element_primary link str   = dropdown_element [C.has_background_info_light] link str
   dropdown_element_secondary link str = dropdown_element [C.has_background_warning_light] link str
 

src/App/Page/Registration.purs

@@ -5,7 +5,6 @@ module App.Page.Registration where
 import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between, not)
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Maybe (Maybe(..))
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
@@ -18,13 +17,12 @@ import Web.Event.Event (Event)
 
 import App.Text.Explanations as Explanations
 
-import Bulma as Bulma
+import Web as Web
 import CSSClasses as C
 
 import Data.String as S
 import App.Type.Email as Email
 import App.Type.LogMessage
-import App.Message.AuthenticationDaemon as AuthD
 
 import App.DisplayErrors (show_error_login, show_error_email, show_error_password)
 
@@ -35,7 +33,7 @@ import App.Validation.Email as E
 import App.Validation.Password as P
 
 data Output
-  = MessageToSend ArrayBuffer
+  = AskRegister String (Maybe Email.Email) String
   | Log LogMessage
 
 data Query a = DoNothing a
@@ -96,11 +94,11 @@ component =
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render { registrationForm }
-  = Bulma.section_small [Bulma.columns_ [ b registration_form ]]
+  = Web.section_small [Web.columns_ [ b registration_form ]]
 
   where
-    b e = Bulma.column_ [ Bulma.box e ]
-    registration_form = [ Bulma.h3 "Register", render_register_form ]
+    b e = Web.column_ [ Web.box e ]
+    registration_form = [ Web.h3 "Register", render_register_form ]
 
     render_register_form = HH.form
       [ HE.onSubmit ValidateInputs ]
@@ -109,39 +107,39 @@ render { registrationForm }
        password_input <> password_error <>
        legal_mentions <> validation_btn)
 
-    username_input = [ Bulma.username_input "Username" registrationForm.login (HandleRegisterInput <<< REG_INP_login) ]
+    username_input = [ Web.username_input "Username" registrationForm.login (HandleRegisterInput <<< REG_INP_login) ]
 
     username_error
       = case between 0 1 (S.length registrationForm.login), L.login registrationForm.login of
           true, _        -> []
-          _, Left errors -> [ Bulma.error_box "loginREGISTER" "Login error" (show_error $ Login errors) ]
+          _, Left errors -> [ Web.error_box "loginREGISTER" "Login error" (show_error $ Login errors) ]
           _, Right _     -> []
 
-    email_input = [ Bulma.email_input "Email" registrationForm.email (HandleRegisterInput <<< REG_INP_email) ]
+    email_input = [ Web.email_input "Email" registrationForm.email (HandleRegisterInput <<< REG_INP_email) ]
 
     email_error
       = case between 0 5 (S.length registrationForm.email), E.email registrationForm.email of
           true, _        -> []
-          _, Left errors -> [ Bulma.error_box "emailREGISTER" "Email error" (show_error $ Email errors) ]
+          _, Left errors -> [ Web.error_box "emailREGISTER" "Email error" (show_error $ Email errors) ]
           _, Right _     -> []
 
-    password_input = [ Bulma.password_input "Password" registrationForm.pass (HandleRegisterInput <<< REG_INP_pass) ]
+    password_input = [ Web.password_input "Password" registrationForm.pass (HandleRegisterInput <<< REG_INP_pass) ]
 
     password_error
       = case between 0 15 (S.length registrationForm.pass), P.password registrationForm.pass of
           true, _        -> []
-          _, Left errors -> [ Bulma.error_box "passwordREGISTER" "Password error" (show_error $ Password errors) ]
+          _, Left errors -> [ Web.error_box "passwordREGISTER" "Password error" (show_error $ Password errors) ]
           _, Right _     -> []
 
     legal_mentions = [ Explanations.legal_notice
                      , HH.div [HP.classes [C.margin_top 3, C.margin_bottom 3]]
-                       [ Bulma.checkbox
+                       [ Web.checkbox
                            [HH.span [HP.classes [C.margin_left 3]] [HH.text "I have read and accept the terms of service and privacy policy."]]
                            LegalCheckboxToggle
                        ]
                      ]
 
-    validation_btn = [ Bulma.btn_validation ]
+    validation_btn = [ Web.btn_validation ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
@@ -193,9 +191,7 @@ handleAction = case _ of
   SendRegistrationRequest -> do
     { registrationForm } <- H.get
     let { login, email, pass } = registrationForm
-    message <- H.liftEffect $ AuthD.serialize $
-      AuthD.MkRegister { login, email: Just (Email.Email email), password: pass }
-    H.raise $ MessageToSend message
+    H.raise $ AskRegister login (Just (Email.Email email)) pass
     H.raise $ Log $ SystemLog $ "Trying to register (login: " <> login <> ")"
 
 show_error :: Error -> String

src/App/Page/Setup.purs

@@ -15,7 +15,7 @@ import Halogen.HTML.Events as HE
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
-import Bulma as Bulma
+import Web as Web
 import CSSClasses as C
 
 import App.Type.Email as Email
@@ -89,50 +89,50 @@ initialState emails =
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render { modal, newPasswordForm, emails } =
-  Bulma.section_small
+  Web.section_small
     [ render_emails emails
-    , Bulma.hr
+    , Web.hr
     , case modal of
         DeleteAccountModal -> render_delete_account_modal
-        NoModal -> Bulma.columns_
-          [ b [ Bulma.btn_ [C.is_large, C.is_info] "Change email address" RouteChangeEmailAddressPage ]
-          , b [ Bulma.h3 "Change password", render_new_password_form ]
-          , b [ Bulma.h3 "Delete account", render_delete_account ]
+        NoModal -> Web.columns_
+          [ b [ Web.btn_ [C.is_large, C.is_info] "Change email address" RouteChangeEmailAddressPage ]
+          , b [ Web.h3 "Change password", render_new_password_form ]
+          , b [ Web.h3 "Delete account", render_delete_account ]
           ]
     ]
 
   where
-  b e = Bulma.column_ e
+  b e = Web.column_ e
 
   render_emails (Tuple current pending) = HH.div [] $ render_current current <> render_pending pending
     where
-    render_current (Just (Email.Email e)) = [ Bulma.p $ "Current email address: " ] <>
-                                            [ Bulma.btn_ro [C.is_small, C.is_warning] e]
-    render_current Nothing                = [ Bulma.p   "You do not currently have a validated email address." ]
+    render_current (Just (Email.Email e)) = [ Web.p $ "Current email address: " ] <>
+                                            [ Web.btn_ro [C.is_small, C.is_warning] e]
+    render_current Nothing                = [ Web.p   "You do not currently have a validated email address." ]
 
-    render_pending (Just (Email.Email e)) = [ Bulma.p $ "Pending email address: " ] <>
-                                            [ Bulma.btn_ro [C.is_small, C.is_warning] e]
+    render_pending (Just (Email.Email e)) = [ Web.p $ "Pending email address: " ] <>
+                                            [ Web.btn_ro [C.is_small, C.is_warning] e]
     render_pending Nothing                = []
 
-  render_delete_account = Bulma.alert_btn "Delete my account" DeleteAccountPopup
+  render_delete_account = Web.alert_btn "Delete my account" DeleteAccountPopup
 
   render_new_password_form = HH.form
     [ HE.onSubmit ChangePasswordAttempt ]
-    [ Bulma.box_password "passwordNEWPASS" "New Password" "password"
+    [ Web.box_password "passwordNEWPASS" "New Password" "password"
         (HandleNewPassword <<< NEWPASS_INP_password)
         newPasswordForm.password
-    , Bulma.box_password "confirmationNEWPASS" "Confirmation" "confirmation"
+    , Web.box_password "confirmationNEWPASS" "Confirmation" "confirmation"
         (HandleNewPassword <<< NEWPASS_INP_confirmation)
         newPasswordForm.confirmation
-    , Bulma.btn_validation
+    , Web.btn_validation
     ]
 
-  render_delete_account_modal = Bulma.modal "Delete your account"
-    [ Bulma.p "Your account and domains will be removed."
-    , Bulma.strong "⚠ You won't be able to recover your data."
+  render_delete_account_modal = Web.modal "Delete your account"
+    [ Web.p "Your account and domains will be removed."
+    , Web.strong "⚠ You won't be able to recover your data."
     ]
-    [ Bulma.alert_btn "GO AHEAD LOL" DeleteAccount
-    , Bulma.cancel_button CancelModal
+    [ Web.alert_btn "GO AHEAD LOL" DeleteAccount
+    , Web.cancel_button CancelModal
     ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit

src/App/Templates/Modal.purs

@@ -0,0 +1,405 @@
+-- | `App.Templates.Modal` gathers all the website's modals, providing
+-- | an easy way to duplicate modals in different pages and to display
+-- | content in a consistent manner.
+module App.Templates.Modal where
+
+import Prelude (map, show, ($), (<<<), (<>), (==), (>))
+
+import CSSClasses as C
+
+import Data.Array as A
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+
+import Data.Tuple (Tuple)
+
+import App.Type.CAA as CAA
+import App.Text.Explanations as Explanations
+import Web as Web
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import App.Type.RRId (RRId)
+import App.Type.DMARC as DMARC
+import App.Type.DKIM as DKIM
+import App.Type.Delegation as Delegation
+import App.Templates.Table as Table
+import Data.String (toLower)
+
+import App.Type.RRModal (RRModal(..))
+
+import App.Type.ResourceRecord.SPF (mechanism_types, modifier_types, qualifier_types, show_qualifier) as SPF
+import App.Type.ResourceRecord as RR
+
+import App.DisplayErrors (error_to_paragraph, delegation_error_to_paragraph, show_error_email)
+
+type ActionCancelModal :: forall k. k -> k
+type ActionCancelModal i = i
+modal_rr_delete :: forall w i. Int -> (Int -> i) -> ActionCancelModal i -> HH.HTML w i
+modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting a resource record"
+  [warning_message] [modal_delete_button, Web.cancel_button action_cancel_modal]
+  where
+  modal_delete_button = Web.alert_btn "Delete the resource record" (action_remove_rr rr_id)
+  warning_message
+    = HH.p [] [ HH.text "You are about to delete a resource record, this action is "
+              , Web.strong "irreversible"
+              , HH.text "."
+              ]
+
+zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String)
+zip_nullable txt raw = A.zip txt ([""] <> raw)
+
+type ActionValidate :: forall i. i -> i
+type ActionValidate i = i
+type ActionUpdateDelegationForm  i = (Delegation.Field -> i)
+delegation_modal :: forall w i.
+  Domain -> Delegation.Form -> ActionUpdateDelegationForm i -> ActionValidate i -> ActionCancelModal i -> HH.HTML w i
+delegation_modal selected_domain form action_update_form action_validate action_cancel_modal =
+    Web.modal modal_title modal_content modal_foot
+    where
+    modal_title = "Delegation for " <> selected_domain
+    modal_content :: Array (HH.HTML w i)
+    modal_content =
+      [ HH.div [HP.classes [C.notification, C.is_warning]]
+          [ Web.p "⚠️​  You are about to delegate your domain to another server, you won't be able to manage entries from netlibre."
+          ]
+      , render_errors
+      , Web.box_input "nameserver1" "name server 1" "ns0.example.com"
+          (action_update_form <<< Delegation.NameServer1)
+          form.nameserver1
+      , Web.box_input "nameserver2" "name server 2" "ns1.example.com"
+          (action_update_form <<< Delegation.NameServer2)
+          form.nameserver2
+      ]
+    modal_foot :: Array (HH.HTML w i)
+    modal_foot =
+        [ Web.info_btn "Delegate the domain" action_validate
+        , Web.cancel_button action_cancel_modal
+        ]
+    render_errors = if A.length form.errors > 0
+                    then HH.div_ $ [ Web.h3 "Errors: " ] <> map delegation_error_to_paragraph form.errors
+                    else HH.div_ [ ]
+
+type Domain                  = String
+type ActionUpdateForm      i = (RR.Field -> i)
+type ActionNewToken        i = (RRId -> i)
+type ActionUpdateRR        i = (RR.RRUpdateValue -> i)
+type ActionValidateNewRR   i = (RR.AcceptedRRTypes -> i)
+type ActionValidateLocalRR :: forall k. k -> k
+type ActionValidateLocalRR i = i
+current_rr_modal :: forall w i.
+  Domain -> RR.Form -> RRModal
+  -> ActionUpdateForm i -> ActionNewToken i
+  -> ActionUpdateRR i -> ActionValidateNewRR i -> ActionValidateLocalRR i -> ActionCancelModal i
+  -> HH.HTML w i
+current_rr_modal selected_domain form rr_modal
+    action_update_form action_new_token
+    action_update_rr action_validate_rr action_validate_local_rr action_cancel_modal =
+  case form._rr.rrtype of
+    "A"     -> template (modal_content_simple RR.A)     (foot_content RR.A)
+    "AAAA"  -> template (modal_content_simple RR.AAAA)  (foot_content RR.AAAA)
+    "TXT"   -> template (modal_content_simple RR.TXT)   (foot_content RR.TXT)
+    "CNAME" -> template (modal_content_simple RR.CNAME) (foot_content RR.CNAME)
+    "NS"    -> template (modal_content_simple RR.NS)    (foot_content RR.NS)
+    "MX"    -> template modal_content_mx                (foot_content RR.MX)
+    "CAA"   -> template modal_content_caa               (foot_content RR.CAA)
+    "SRV"   -> template modal_content_srv               (foot_content RR.SRV)
+    "SPF"   -> template modal_content_spf               (foot_content RR.SPF)
+    "DKIM"  -> template modal_content_dkim              (foot_content RR.DKIM)
+    "DMARC" -> template modal_content_dmarc             (foot_content RR.DMARC)
+    _       -> Web.p $ "Invalid type: " <> form._rr.rrtype
+  where
+    side_text_for_name_input name_id
+      = Web.side_text_above_input name_id "Name" (HH.text $ "Empty name = root domain (" <> selected_domain <> ".)")
+
+    -- DRY
+    render_errors = if A.length form._errors > 0
+                    then HH.div_ $ [ Web.h3 "Errors: " ] <> map error_to_paragraph form._errors
+                    else HH.div_ [ ]
+
+    modal_content_simple :: RR.AcceptedRRTypes -> Array (HH.HTML w i)
+    modal_content_simple x =
+      [ render_errors
+      , render_introduction_text x
+      , side_text_for_name_input ("domain" <> form._rr.rrtype)
+      , Web.input_with_side_text ("domain" <> form._rr.rrtype) "" "www"
+          (action_update_form <<< RR.Domain)
+          form._rr.name
+          display_domain_side
+      , Web.box_input ("ttl" <> form._rr.rrtype) "TTL" "1800"
+          (action_update_form <<< RR.TTL)
+          (show form._rr.ttl)
+      , case form._rr.rrtype of
+          "AAAA"  -> Web.box_input ("target" <> form._rr.rrtype) "Target"    "2001:db8::1"      (action_update_form <<< RR.Target) form._rr.target
+          "TXT"   -> Web.box_input ("target" <> form._rr.rrtype) "Your text" "blah blah"        (action_update_form <<< RR.Target) form._rr.target
+          "CNAME" -> Web.box_input ("target" <> form._rr.rrtype) "Target"    "www"              (action_update_form <<< RR.Target) form._rr.target
+          "NS"    -> Web.box_input ("target" <> form._rr.rrtype) "Target"    "ns0.example.com." (action_update_form <<< RR.Target) form._rr.target
+          _       -> Web.box_input ("target" <> form._rr.rrtype) "Target"    "198.51.100.5"     (action_update_form <<< RR.Target) form._rr.target
+      ] <> case rr_modal of
+             UpdateRRModal ->
+               if A.elem form._rr.rrtype ["A", "AAAA"]
+               then [ Web.field_entry ("token" <> form._rr.rrtype) "Token"
+                        (maybe (Web.text "❌​") Web.p form._rr.token)
+                    ]
+               else []
+             _             -> []
+
+    render_introduction_text :: RR.AcceptedRRTypes -> HH.HTML w i
+    render_introduction_text = case _ of
+        RR.A     -> Web.quote Explanations.a_introduction
+        RR.AAAA  -> Web.quote Explanations.aaaa_introduction
+        RR.TXT   -> Web.quote Explanations.txt_introduction
+        RR.CNAME -> Web.quote Explanations.cname_introduction
+        RR.NS    -> Web.quote Explanations.ns_introduction
+        _        -> HH.p_ []
+
+    modal_content_mx :: Array (HH.HTML w i)
+    modal_content_mx =
+      [ render_errors
+      , Web.quote Explanations.mx_introduction
+      , side_text_for_name_input "domainMX"
+      , Web.input_with_side_text "domainMX" "" "www"
+          (action_update_form <<< RR.Domain)
+          form._rr.name
+          display_domain_side
+      , Web.box_input ("ttlMX") "TTL" "1800"
+          (action_update_form <<< RR.TTL)
+          (show form._rr.ttl)
+      , Web.box_input ("targetMX") "Target" "www"
+          (action_update_form <<< RR.Target)
+          form._rr.target
+      , Web.box_input ("priorityMX") "Priority" "10"
+          (action_update_form <<< RR.Priority)
+          (maybe "" show form._rr.priority)
+      ]
+
+    modal_content_caa :: Array (HH.HTML w i)
+    modal_content_caa =
+      [ render_errors
+      , Web.quote Explanations.caa_introduction
+      , side_text_for_name_input "domainCAA"
+      , Web.input_with_side_text "domainCAA" "" "www"
+          (action_update_form <<< RR.Domain)
+          form._rr.name
+          display_domain_side
+      , Web.box_input ("ttlCAA") "TTL" "1800"
+          (action_update_form <<< RR.TTL)
+          (show form._rr.ttl)
+      , Web.hr
+      , Web.box_input ("flagCAA") "Flag" ""
+          (action_update_form <<< RR.CAA_flag)
+          (show (fromMaybe RR.default_caa form._rr.caa).flag)
+      , Web.selection_field'' "tagCAA" "Tag" (action_update_rr <<< RR.CAA_tag) (A.zip CAA.tags_txt CAA.tags_raw)
+        CAA.Issue
+        (Just (fromMaybe RR.default_caa form._rr.caa).tag)
+      , HH.div [HP.classes [C.notification, C.is_warning]]
+          [ Web.p "⚠️​  CAA entries aren't thoroughly verified, yet. Also, do not put quotes."
+          ]
+      , Web.box_input "valueCAA" "Value" "" (action_update_form <<< RR.CAA_value)
+        (fromMaybe RR.default_caa form._rr.caa).value
+      ]
+
+    modal_content_srv :: Array (HH.HTML w i)
+    modal_content_srv =
+      [ Web.quote Explanations.srv_introduction
+      , render_errors
+      , Web.box_input ("ttlSRV") "TTL" "1800"
+          (action_update_form <<< RR.TTL)
+          (show form._rr.ttl)
+      , Web.box_input "domainSRV" "Service name" "service name"
+          (action_update_form <<< RR.Domain)
+          form._rr.name
+      , Web.selection_field "protocolSRV" "Protocol" (action_update_rr <<< RR.SRV_Protocol) RR.srv_protocols_txt
+          (maybe "udp" (toLower <<< show) form._rr.protocol)
+      , Web.box_input ("targetSRV") "Where the server is" "www"
+          (action_update_form <<< RR.Target)
+          form._rr.target
+      , Web.box_input ("portSRV") "Port of the service" "5061"
+          (action_update_form <<< RR.Port)
+          (maybe "" show form._rr.port)
+      , Web.quote [Web.p "The priority field is a numeric value that indicates the preference of the server (lower values indicate higher priority)."]
+      , Web.box_input ("prioritySRV") "Priority" "10"
+          (action_update_form <<< RR.Priority)
+          (maybe "" show form._rr.priority)
+      -- Web.quote Explanations.spf_introduction, Web.p "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain."
+      , Web.quote [Web.p "The weight field is a relative weight used when multiple servers have the same priority, determining how often they should be used."]
+      , Web.box_input ("weightSRV") "Weight" "100"
+          (action_update_form <<< RR.Weight)
+          (maybe "" show form._rr.weight)
+      ]
+
+    modal_content_spf :: Array (HH.HTML w i)
+    modal_content_spf =
+      [ Web.quote Explanations.spf_introduction
+      , render_errors
+      , side_text_for_name_input "domainSPF"
+      , Web.input_with_side_text "domainSPF" "" "Let this alone."
+          (action_update_form <<< RR.Domain)
+          form._rr.name
+          display_domain_side
+      , Web.box_input "ttlSPF" "TTL" "1800"
+          (action_update_form <<< RR.TTL)
+          (show form._rr.ttl)
+      --, case form._rr.v of
+      --  Nothing -> Web.p "default value for the version (spf1)"
+      --  Just v  -> Web.box_input "vSPF" "Version" "spf1" (action_update_form <<< RR.SPF_v) v
+      , Web.hr
+      , Web.box_with_tag [C.has_background_info_light] tag_mechanisms
+        [ Web.quote [Web.p "Mechanisms specify which mail servers are allowed to send mail for the domain and how to evaluate the sending mail server’s IP address."] 
+        , maybe (Web.p "You don't have any mechanism.") (Table.display_mechanisms (action_update_rr <<< RR.SPF_remove_mechanism)) form._rr.mechanisms
+        , Web.hr
+        , Web.h4 "New mechanism"
+        , Web.selection_field "idMechanismQ" "Policy" (action_update_rr <<< RR.SPF_Mechanism_q) SPF.qualifier_types form.tmp.spf.mechanism_q
+        , Web.selection_field "idMechanismT" "Type"   (action_update_rr <<< RR.SPF_Mechanism_t) SPF.mechanism_types form.tmp.spf.mechanism_t
+        , Web.box_input "valueNewMechanismSPF" "Value" ""
+            (action_update_rr <<< RR.SPF_Mechanism_v)
+            form.tmp.spf.mechanism_v
+        , Web.btn "Add a mechanism" (action_update_rr RR.SPF_Mechanism_Add)
+        ]
+      , Web.hr
+      , Web.box_with_tag [C.has_background_success_light] tag_modifiers
+        [ Web.quote [Web.p "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain."] 
+        , maybe (Web.p "You don't have any modifier.") (Table.display_modifiers (action_update_rr <<< RR.SPF_remove_modifier)) form._rr.modifiers
+        , Web.hr
+        , Web.h4 "New modifier"
+        , Web.selection_field "idModifierT" "Modifier" (action_update_rr <<< RR.SPF_Modifier_t) SPF.modifier_types form.tmp.spf.modifier_t
+        , Web.box_input "valueNewModifierSPF" "Value" ""
+            (action_update_rr <<< RR.SPF_Modifier_v)
+            form.tmp.spf.modifier_v
+        , Web.btn "Add a modifier" (action_update_rr RR.SPF_Modifier_Add)
+        ]
+      , Web.hr
+      , Web.box
+        [ Web.h3 "Default behavior"
+        , Web.quote Explanations.spf_default_behavior
+        , Web.selection (action_update_rr <<< RR.SPF_Qualifier) SPF.qualifier_types (maybe RR.default_qualifier_str SPF.show_qualifier form._rr.q)
+        ]
+      ]
+
+    tag_mechanisms = Web.tags [Web.tag "Mechanisms"]
+    tag_modifiers  = Web.tags [Web.tag "Modifiers"]
+
+    tag_aggregated_reports = Web.tags [Web.tag "Addresses to contact for aggregated reports"]
+    tag_detailed_reports   = Web.tags [Web.tag "Addresses to contact for detailed reports"]
+
+    modal_content_dkim :: Array (HH.HTML w i)
+    modal_content_dkim =
+      [ Web.quote Explanations.dkim_introduction
+      , render_errors
+      , side_text_for_name_input "domainDKIM"
+      , Web.input_with_side_text "domainDKIM" "" "default._domainkey"
+          (action_update_form <<< RR.Domain)
+          form._rr.name
+          display_domain_side
+      , Web.box_input "ttlDKIM" "TTL" "1800"
+          (action_update_form <<< RR.TTL)
+          (show form._rr.ttl)
+      , Web.hr
+      , Web.quote Explanations.dkim_default_algorithms
+      , Web.selection_field "idDKIMSignature" "Signature algo"
+          (action_update_rr <<< RR.DKIM_sign_algo)
+          (map show DKIM.sign_algos)
+          (show $ fromMaybe DKIM.RSA form.tmp.dkim.k)
+      , Web.selection_field "idDKIMHash"      "Hash algo"
+          (action_update_rr <<< RR.DKIM_hash_algo)
+          (map show DKIM.hash_algos)
+          (show $ fromMaybe DKIM.SHA256 form.tmp.dkim.h)
+      , Web.box_input "pkDKIM" "Public Key" "Your public key, such as \"MIIBIjANBgqh...\"" (action_update_rr <<< RR.DKIM_pubkey) form.tmp.dkim.p
+      , Web.box_input "noteDKIM" "Note" "Note for fellow administrators." (action_update_rr <<< RR.DKIM_note) (fromMaybe "" form.tmp.dkim.n)
+      ]
+
+    modal_content_dmarc :: Array (HH.HTML w i)
+    modal_content_dmarc =
+      [ Web.quote Explanations.dmarc_introduction
+      , render_errors
+      , side_text_for_name_input "domainDMARC"
+      , Web.input_with_side_text "domainDMARC" "" "_dmarc"
+          (action_update_form <<< RR.Domain)
+          form._rr.name
+          display_domain_side
+      , Web.box_input "ttlDMARC" "TTL" "1800" (action_update_form <<< RR.TTL) (show form._rr.ttl)
+
+      , Web.hr
+      , Web.quote Explanations.dmarc_policy
+      , Web.selection_field' "idDMARCPolicy" "Policy" (action_update_rr <<< RR.DMARC_policy)
+          (A.zip DMARC.policies_txt DMARC.policies_raw)
+          (show form.tmp.dmarc.p)
+      , Web.quote Explanations.dmarc_sp_policy
+      , Web.selection_field' "idDMARCPolicy_sp" "Policy for subdomains" (action_update_rr <<< RR.DMARC_sp_policy)
+          (zip_nullable DMARC.policies_txt_with_null DMARC.policies_raw)
+          (maybe "-" show form.tmp.dmarc.sp)
+
+      , Web.hr
+      , Web.quote Explanations.dmarc_adkim
+      , Web.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" (action_update_rr <<< RR.DMARC_adkim)
+          (zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
+          (maybe "-" show form.tmp.dmarc.adkim)
+      , Web.quote Explanations.dmarc_aspf
+      , Web.selection_field' "idDMARCaspf" "Consistency Policy for SPF"   (action_update_rr <<< RR.DMARC_aspf)
+          (zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
+          (maybe "-" show form.tmp.dmarc.aspf)
+
+      , Web.hr
+      , Web.quote Explanations.dmarc_pct
+      , Web.box_input "idDMARCpct" "Sample rate (between 0 and 100)" "100" (action_update_rr <<< RR.DMARC_pct) (maybe "100" show form.tmp.dmarc.pct)
+
+      , Web.hr
+      , Web.selection_field' "idDMARCfo" "When to send a report" (action_update_rr <<< RR.DMARC_fo)
+          (zip_nullable DMARC.report_occasions_txt DMARC.report_occasions_raw)
+          (maybe "-" show form.tmp.dmarc.fo)
+
+      , Web.hr
+      , Web.quote Explanations.dmarc_contact
+      , Web.box_with_tag [C.has_background_info_light] tag_aggregated_reports
+        [ maybe (Web.p "There is no address to send aggregated reports to.")
+          (Table.display_dmarc_mail_addresses (action_update_rr <<< RR.DMARC_remove_rua))
+          form.tmp.dmarc.rua
+        ]
+      , Web.box_with_tag [C.has_background_success_light] tag_detailed_reports
+        [ maybe (Web.p "There is no address to send detailed reports to.")
+          (Table.display_dmarc_mail_addresses  (action_update_rr <<< RR.DMARC_remove_ruf))
+          form.tmp.dmarc.ruf
+        ]
+
+      , Web.hr
+      , render_dmarc_mail_errors
+      , Web.box_input "idDMARCmail"      "Address to contact" "admin@example.com" (action_update_rr <<< RR.DMARC_mail) form.tmp.dmarc_mail
+      , Web.box_input "idDMARCmaillimit" "Report size limit (in KB)" "2000" (action_update_rr <<< RR.DMARC_mail_limit) (maybe "0" show form.tmp.dmarc_mail_limit)
+      , Web.level [ Web.btn_ [C.has_background_info_light] "New address for aggregated report" (action_update_rr RR.DMARC_rua_Add)
+                  , Web.btn_ [C.has_background_success_light] "New address for specific report" (action_update_rr RR.DMARC_ruf_Add)
+                  ] []
+
+      , Web.hr
+      , Web.quote Explanations.dmarc_ri
+      , Web.box_input "idDMARCri" "Report interval (in seconds)" "86400" (action_update_rr <<< RR.DMARC_ri) (maybe "0" show form.tmp.dmarc.ri)
+      ]
+
+    render_dmarc_mail_errors
+      = if A.length form._dmarc_mail_errors > 0
+        then Web.notification_danger_block'
+               $ [ Web.h3 "Invalid mail 😥" ] <> map (Web.p <<< show_error_email) form._dmarc_mail_errors
+        else HH.div_ [ ]
+
+    display_domain_side = (if form._rr.name == (selected_domain <> ".") then "" else "." <> selected_domain)
+
+    newtokenbtn :: HH.HTML w i
+    newtokenbtn = Web.btn (maybe "🏁​ Ask for a token" (\_ -> "🏁​ Ask for a new token") form._rr.token) (action_new_token form._rr.rrid)
+
+    foot_content :: RR.AcceptedRRTypes -> Array (HH.HTML w i)
+    foot_content x =
+      case rr_modal of
+        NewRRModal _  -> [Web.btn_add (action_validate_rr x)]
+        UpdateRRModal -> [Web.btn_save action_validate_local_rr ] <> case x of
+          RR.A    -> [newtokenbtn]
+          RR.AAAA -> [newtokenbtn]
+          _    -> []
+        _             -> [Web.p "rr_modal should either be NewRRModal or UpdateRRModal."]
+
+    template :: Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
+    template content foot_ = Web.modal title content foot
+      where
+      title = case rr_modal of
+        NoModal             -> "Error: no modal should be displayed"
+        DelegationModal     -> "Error: the delegation modal should be displayed"
+        NewRRModal t_       -> "New " <> show t_ <> " resource record"
+        UpdateRRModal       -> "Update " <> form._rr.rrtype <> " Resource Record"
+        RemoveRRModal rr_id -> "Error: should display removal modal instead (for resource record " <> show rr_id <> ")"
+      foot = foot_ <> [Web.cancel_button action_cancel_modal]

src/App/Templates/Table.purs

@@ -0,0 +1,612 @@
+-- | `App.Templates.Table` gathers all the website's tables, providing
+-- | an easy way to duplicate tables in different pages and to display
+-- | content in a consistent manner.
+module App.Templates.Table
+  ( owned_domains
+  , shared_domains
+  , resource_records
+  , display_dmarc_mail_addresses
+  , display_modifiers
+  , display_mechanisms
+  , found_users
+  , found_domains
+  ) where
+
+import Prelude (comparing, map, not, show, (#), ($), (&&), (<<<), (<>), (==), (>))
+
+import CSSClasses as C
+
+import App.Type.UserPublic (UserPublic)
+import Data.Array.NonEmpty as NonEmpty
+import Data.Array as A
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+
+import Data.Tuple (Tuple(..))
+
+import Web as Web
+import Web.Button as Button
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Data.String.CodePoints as CP
+import Utils (id, attach_id)
+import App.Type.DMARC as DMARC
+
+import App.Type.ResourceRecord (ResourceRecord)
+import App.Type.ResourceRecord.SPF ( show_mechanism, show_mechanism_type
+                                   , show_modifier, show_modifier_type
+                                   , show_qualifier, show_qualifier_char
+                                   , Mechanism, Modifier, Qualifier) as SPF
+
+import App.Type.DomainInfo (DomainInfo)
+
+txt_name :: forall w i. String -> HH.HTML w i
+txt_name t
+  = HH.td  [ rr_name_style ] [ rr_name_text ]
+  where
+    rr_name_style = HP.style "width: 80px;"
+    rr_name_text  = HH.text t
+
+owned_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i
+owned_domains domains_i_exclusively_own action_enter_domain action_transfer_domain action_share_domain action_delete_domain
+  = if A.length domains_i_exclusively_own > 0
+    then Web.table [] [ owned_domains_table_header
+                      , HH.tbody_ $ map owned_domain_row domains_i_exclusively_own
+                      ]
+    else Web.p "No domain yet."
+  where
+    owned_domains_table_header :: HH.HTML w i
+    owned_domains_table_header
+      = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
+                           , HH.th_ [ HH.text "" ]
+                           , HH.th_ [ HH.text "" ]
+                           , HH.th_ [ HH.text "" ]
+                           ]
+                  ]
+    owned_domain_row domain = HH.tr_
+      [ HH.td_ [ Button.btn domain.name (action_enter_domain domain.name) ]
+      , case domain.transfer_key of
+          Just key -> HH.td_ [ Web.p "Token key:", Web.p key ]
+          Nothing  -> HH.td_ [ Button.btn_abbr "Generate a token to transfer the ownership of a domain." "Transfer" (action_transfer_domain domain.name) ]
+      , HH.td_ [ Button.btn_abbr "Generate a token to share the ownership of a domain." "Share" (action_share_domain domain.name) ]
+      , HH.td_ [ Button.alert_btn_abbr "Delete the domain. This will remove all zone data and the domain won't be served anymore." "Delete" (action_delete_domain domain.name) ]
+      ]
+
+shared_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i
+shared_domains domains_i_share action_enter_domain action_unshare_domain action_delete_domain
+  = if A.length domains_i_share > 0
+    then Web.table [] [ shared_domains_table_header
+                      , HH.tbody_ $ map shared_domain_row domains_i_share
+                      ]
+    else Web.p "No domain yet."
+  where
+    shared_domains_table_header :: HH.HTML w i
+    shared_domains_table_header
+      = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
+                           , HH.th_ [ HH.text "Share key" ]
+                           , HH.th_ [ HH.text "" ]
+                           , HH.th_ [ HH.text "" ]
+                           ]
+                  ]
+    shared_domain_row domain = HH.tr_
+      [ HH.td_ [ Button.btn domain.name (action_enter_domain domain.name) ]
+      , HH.td_ [ HH.text $ fromMaybe "" domain.share_key ]
+      , if A.length domain.owners == 1
+        then HH.td_ [ Button.alert_btn_abbr "Unshare the domain by removing the \"share\" token." "Unshare" (action_unshare_domain domain.name) ]
+        else HH.td_ [ Button.btn_ro [C.is_warning] "Cannot unshare it" ]
+      , HH.td_ [ Button.alert_btn_abbr "Delete the domain from your list of owned domains. In case you are the only owner, this will also remove all zone data and the domain won't be served anymore." "Delete" (action_delete_domain domain.name) ]
+      ]
+
+-- | Render all Resource Records.
+resource_records :: forall w i. Array ResourceRecord -> (Int -> i) -> (Int -> i) -> (Int -> i) -> HH.HTML w i
+resource_records [] _ _ _ = Web.box [Web.title "Resource records", Web.subtitle "No records for now"]
+resource_records records action_create_or_update_rr action_delete_rr action_new_token
+  = HH.div_ $
+         (rr_box [bg_color_ro] tag_soa      soa_table_header       table_content        all_soa_rr)
+      <> (rr_box []            tag_basic    simple_table_header    table_content_w_seps all_basic_rr)
+      <> (rr_box []            tag_mx       mx_table_header        table_content        all_mx_rr)
+      <> (rr_box []            tag_caa      caa_table_header       table_content        all_caa_rr)
+      <> (rr_box []            tag_srv      srv_table_header       table_content        all_srv_rr)
+      <> (rr_box []            tag_spf      spf_table_header       table_content        all_spf_rr)
+      <> (rr_box []            tag_dkim     dkim_table_header      table_content        all_dkim_rr)
+      <> (rr_box []            tag_dmarc    dmarc_table_header     table_content        all_dmarc_rr)
+      <> (rr_box [bg_color_ro] tag_basic_ro simple_table_header_ro table_content_w_seps all_basic_ro_rr)
+  where
+  bg_color_ro = C.has_background_warning_light :: HH.ClassName
+
+  baseRecords :: Array String
+  baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]
+
+  all_basic_rr    = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records
+  all_basic_ro_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && rr.readonly)     records
+  all_XX_rr str   = A.filter (\rr -> rr.rrtype == str) records
+  all_soa_rr      = all_XX_rr "SOA"
+  all_mx_rr       = all_XX_rr "MX"
+  all_caa_rr      = all_XX_rr "CAA"
+  all_srv_rr      = all_XX_rr "SRV"
+  all_spf_rr      = all_XX_rr "SPF"
+  all_dkim_rr     = all_XX_rr "DKIM"
+  all_dmarc_rr    = all_XX_rr "DMARC"
+
+  tag_soa      = Web.tags [Web.tag_ro "SOA", Web.tag_ro "read only"]
+  tag_basic    = Web.tags [Web.tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"]
+  tag_mx       = Web.tags [Web.tag "MX"]
+  tag_caa      = Web.tags [Web.tag "CAA"]
+  tag_srv      = Web.tags [Web.tag "SRV"]
+  tag_spf      = Web.tags [Web.tag "SPF"]
+  tag_dkim     = Web.tags [Web.tag "DKIM"]
+  tag_dmarc    = Web.tags [Web.tag "DMARC"]
+  tag_basic_ro = Web.tags [Web.tag_ro "Basic Resource Records", Web.tag_ro "read only"]
+
+  rr_box :: Array HH.ClassName -- css classes (such as colors)
+         -> HH.HTML w i        -- box title (type of data)
+         -> HH.HTML w i        -- table title
+         -> (Array ResourceRecord -> HH.HTML w i)
+         -> Array ResourceRecord
+         -> Array (HH.HTML w i)
+  rr_box colors title header dp rrs =
+    if A.length rrs > 0
+    then [ Web.box_with_tag colors title [Web.table_ [C.margin_left 3] [] [header, dp rrs]] ]
+    else []
+  --title_col_props = C.is 1
+
+  table_content_w_seps records_ = HH.tbody_ $
+    A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]]
+    # map NonEmpty.toArray                       -- -> [[xx], [yy], [z]]
+    # map (map rows)                             -- -> [[hh], [hh], [h]] ('h' means 'html')
+    # A.intersperse [emptyline]                  -- -> [[hh], [line], [hh], [line], [h]]
+    # A.concat                                   -- -> [h h line h h line h]
+
+  emptyline = HH.tr_ [ txt_name "", HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [] ]
+
+  table_content records_ = HH.tbody_ $ map rows records_
+  rows rr = if rr.readonly
+            then HH.tr [ HP.classes [C.has_background_warning_light] ] $ render_row rr
+            else HH.tr_ $ render_row rr
+
+  render_row :: ResourceRecord -> Array (HH.HTML w i)
+  render_row rr =
+    case rr.rrtype of
+      "SOA" ->
+        [ HH.td_ [ HH.text rr.name ]
+        , HH.td_ [ HH.text $ show rr.ttl ]
+        , HH.td_ [ HH.text $ maybe "" id rr.mname   ]
+        , HH.td_ [ HH.text $ maybe "" id rr.rname   ]
+        , HH.td_ [ HH.text $ maybe "" show rr.serial  ]
+        , HH.td_ [ HH.text $ maybe "" show rr.refresh ]
+        , HH.td_ [ HH.text $ maybe "" show rr.retry   ]
+        , HH.td_ [ HH.text $ maybe "" show rr.expire  ]
+        , HH.td_ [ HH.text $ maybe "" show rr.minttl  ]
+        ]
+      "SRV" ->
+        [ HH.td_ [ Web.p rr.name ]
+        , HH.td_ [ Web.p $ maybe "tcp" show rr.protocol ]
+        , HH.td_ [ Web.p rr.target ]
+        , HH.td_ [ Web.p $ maybe "" show rr.port ]
+        , HH.td_ [ Web.p $ show rr.ttl ]
+        , HH.td_ [ Web.p $ maybe "" show rr.priority ]
+        , HH.td_ [ Web.p $ maybe "" show rr.weight ]
+        , if rr.readonly
+          then HH.td_ [ Button.btn_readonly ]
+          else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
+        ]
+      "CAA"  ->
+        [ HH.td_ [ Web.p rr.name ]
+        , HH.td_ [ Web.p $ show rr.ttl ]
+        ] <> case rr.caa of
+          Just caa ->
+            [ HH.td_ [ Web.p $ show caa.flag ]
+            , HH.td_ [ Web.p $ show caa.tag ]
+            , HH.td_ [ Web.p caa.value ]
+            , if rr.readonly
+              then HH.td_ [ Button.btn_readonly ]
+              else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
+            ]
+          Nothing -> [Web.p "Problem: there is no CAA data." ]
+      "SPF"  ->
+        [ HH.td_ [ Web.p rr.name ]
+        , HH.td_ [ Web.p $ show rr.ttl ]
+        -- , HH.td_ [ Web.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed.
+        , HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map SPF.show_mechanism) rr.mechanisms ]
+        , HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map SPF.show_modifier)  rr.modifiers ]
+        , HH.td_ [ Web.p $ maybe "" fancy_qualifier_display rr.q ]
+        , if rr.readonly
+          then HH.td_ [ Button.btn_readonly ]
+          else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
+        ]
+      "DKIM"  ->
+        [ HH.td_ [ Web.p rr.name ]
+        , HH.td_ [ Web.p $ show rr.ttl ]
+        ] <> case rr.dkim of
+          Just dkim ->
+            [
+            -- , HH.td_ [ Web.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DKIM1.
+              HH.td_ [ Web.p $ maybe "" show dkim.h ]
+            , HH.td_ [ Web.p $ maybe "" show dkim.k ]
+            , HH.td_ [ Web.p $ CP.take 20    dkim.p ]
+            , HH.td_ [ Web.p $ fromMaybe ""  dkim.n ]
+            , if rr.readonly
+              then HH.td_ [ Button.btn_readonly ]
+              else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
+            ]
+          Nothing -> [Web.p "Problem: there is no DKIM data." ]
+      "DMARC"  ->
+        [ HH.td_ [ Web.p rr.name ]
+        , HH.td_ [ Web.p $ show rr.ttl ]
+        ] <> case rr.dmarc of
+          Just dmarc ->
+            [
+            -- , HH.td_ [ Web.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DMARC1.
+              HH.td_ [ Web.p $ show dmarc.p               ]
+            , HH.td_ [ Web.p $ maybe "" show dmarc.sp     ]
+            , HH.td_ [ Web.p $ maybe "" show dmarc.adkim  ]
+            , HH.td_ [ Web.p $ maybe "" show dmarc.aspf   ]
+            , HH.td_ [ Web.p $ maybe "" show dmarc.pct    ]
+            , HH.td_ [ Web.p $ maybe "" show dmarc.fo     ]
+            , HH.td_ [ Web.p $ maybe "" show dmarc.ri     ]
+            -- TODO? rua & ruf
+            -- , HH.td_ [ ] -- For now, assume AFRF.
+            , if rr.readonly
+              then HH.td_ [ Button.btn_readonly ]
+              else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
+            ]
+          Nothing -> [Web.p "Problem: there is no DMARC data." ]
+      "MX"  ->
+        [ HH.td_ [ Web.p rr.name ]
+        , HH.td_ [ Web.p $ show rr.ttl ]
+        , HH.td_ [ Web.p $ maybe "" show rr.priority ]
+        , HH.td_ [ Web.p rr.target ]
+        , if rr.readonly
+          then HH.td_ [ Button.btn_readonly ]
+          else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
+        ]
+      _     ->
+        [ txt_name rr.rrtype
+        , HH.td_ [ Web.p rr.name ]
+        , HH.td_ [ Web.p $ show rr.ttl ]
+        , HH.td_ [ Web.p rr.target ]
+        ] <> if rr.readonly
+          then [ HH.td_ [ Button.btn_readonly ] ]
+          else [ HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
+               , HH.td_ [ maybe (show_token_or_btn rr) Web.p rr.token ]
+               ]
+
+  show_token_or_btn rr =
+    case rr.rrtype of
+      "A"    -> Button.btn_ [C.is_small] "🏁​ Ask for a token" (action_new_token rr.rrid)
+      "AAAA" -> Button.btn_ [C.is_small] "🏁​ Ask for a token" (action_new_token rr.rrid)
+      _      -> HH.text ""
+
+  fancy_qualifier_display :: SPF.Qualifier -> String
+  fancy_qualifier_display qualifier = "(" <> SPF.show_qualifier_char qualifier <> ") " <> SPF.show_qualifier qualifier
+
+simple_table_header :: forall w i. HH.HTML w i
+simple_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ]
+                       , HH.th_ [ name_header ]
+                       , HH.th_ [ ttl_header ]
+                       , HH.th_ [ target_header ]
+                       , HH.th_ [ HH.text "" ]
+                       , HH.th_ [ token_header ]
+                       ]
+              ]
+  where
+    token_header :: HH.HTML w i
+    token_header = HH.abbr
+      [ HP.title "Tokens are used to update the entry, see the tab: \"Tokens? 🤨\"" ]
+      [ HH.text "Token" ]
+
+simple_table_header_ro :: forall w i. HH.HTML w i
+simple_table_header_ro
+  = HH.thead_ [ HH.tr [ HP.classes [C.has_background_warning_light] ]
+                       [ HH.th  [ HP.style "width: 50px;" ] [ HH.text "Type"  ]
+                       , HH.th_ [ name_header ]
+                       , HH.th_ [ ttl_header ]
+                       , HH.th_ [ target_header ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
+mx_table_header :: forall w i. HH.HTML w i
+mx_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
+                       , HH.th_ [ ttl_header ]
+                       , HH.th_ [ priority_header ]
+                       , HH.th_ [ target_header ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
+caa_table_header :: forall w i. HH.HTML w i
+caa_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
+                       , HH.th_ [ ttl_header ]
+                       , HH.th_ [ HH.text "Flag" ]
+                       , HH.th_ [ HH.text "Tag" ]
+                       , HH.th_ [ HH.text "Value" ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
+srv_table_header :: forall w i. HH.HTML w i
+srv_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
+                       , HH.th_ [ protocol_header ]
+                       , HH.th_ [ target_header ]
+                       , HH.th_ [ port_header ]
+                       , HH.th_ [ ttl_header ]
+                       , HH.th_ [ priority_header ]
+                       , HH.th_ [ weight_header ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+  where
+    weight_header :: HH.HTML w i
+    weight_header = HH.abbr
+      [ HP.title "A relative weight used when multiple servers have the same priority, determining how often they should be used" ]
+      [ HH.text "Weight" ]
+
+spf_table_header :: forall w i. HH.HTML w i
+spf_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
+                       , HH.th_ [ ttl_header ]
+                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed.
+                       , HH.th_ [ srv_mechanisms_header ]
+                       , HH.th_ [ srv_modifiers_header ]
+                       , HH.th_ [ srv_default_policy_header ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+  where
+    srv_mechanisms_header :: HH.HTML w i
+    srv_mechanisms_header = HH.abbr
+      [ HP.title "Mechanisms specify which mail servers are allowed to send mail for the domain and how to evaluate the sending mail server’s IP address" ]
+      [ HH.text "Mechanisms" ]
+    srv_modifiers_header :: HH.HTML w i
+    srv_modifiers_header = HH.abbr
+      [ HP.title "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain" ]
+      [ HH.text "Modifiers" ]
+    srv_default_policy_header :: HH.HTML w i
+    srv_default_policy_header = HH.abbr
+      [ HP.title "" ]
+      [ HH.text "Default Policy" ]
+
+dkim_table_header :: forall w i. HH.HTML w i
+dkim_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
+                       , HH.th_ [ ttl_header ]
+                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DKIM1.
+                       , HH.th_ [ HH.text "Hash algo" ]
+                       , HH.th_ [ HH.text "Signature algo" ]
+                       , HH.th_ [ HH.text "Public Key" ]
+                       , HH.th_ [ dkim_notes_header ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+  where
+    dkim_notes_header :: HH.HTML w i
+    dkim_notes_header = HH.abbr
+      [ HP.title "Arbitrary string related to this cryptographic material" ]
+      [ HH.text "Notes" ]
+
+dmarc_table_header :: forall w i. HH.HTML w i
+dmarc_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
+                       , HH.th_ [ ttl_header ]
+                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DMARC1.
+                       , HH.th_ [ dmarc_policy_header ]          -- p
+                       , HH.th_ [ dmarc_subdom_policy_header ]   -- sp
+                       , HH.th_ [ dmarc_dkim_policy_header ]     -- adkim
+                       , HH.th_ [ dmarc_spf_policy_header ]      -- aspf
+                       , HH.th_ [ dmarc_sample_rate_header ]     -- pct
+                       , HH.th_ [ dmarc_report_on_header ]       -- fo
+                       , HH.th_ [ dmarc_report_interval_header ] -- ri
+                       -- TODO? rua & ruf
+                       -- , HH.th_ [ HH.text "Accepted report formats" ] -- For now, assume AFRF.
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+  where
+    dmarc_policy_header :: HH.HTML w i
+    dmarc_policy_header = HH.abbr
+      [ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
+      [ HH.text "Policy" ]
+    dmarc_subdom_policy_header :: HH.HTML w i
+    dmarc_subdom_policy_header = HH.abbr
+      [ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
+      [ HH.text "Subdomain Policy" ]
+    dmarc_dkim_policy_header :: HH.HTML w i
+    dmarc_dkim_policy_header = HH.abbr
+      [ HP.title "What should be considered acceptable to do with an email not conforming with DKIM" ]
+      [ HH.text "DKIM Policy" ]
+    dmarc_spf_policy_header :: HH.HTML w i
+    dmarc_spf_policy_header = HH.abbr
+      [ HP.title "What should be considered acceptable to do with an email not conforming with SPF" ]
+      [ HH.text "SPF Policy" ]
+    dmarc_sample_rate_header :: HH.HTML w i
+    dmarc_sample_rate_header = HH.abbr
+      [ HP.title "Percentage of messages subjected to the requested policy [0-100]" ]
+      [ HH.text "Sample Rate" ]
+    dmarc_report_on_header :: HH.HTML w i
+    dmarc_report_on_header = HH.abbr
+      [ HP.title "What error should be reported? DKIM, SPF, Both, Any or None?" ]
+      [ HH.text "Report on" ]
+    dmarc_report_interval_header :: HH.HTML w i
+    dmarc_report_interval_header = HH.abbr
+      [ HP.title "Minimal duration between two DMARC reports (in seconds)" ]
+      [ HH.text "Report interval" ]
+
+soa_table_header :: forall w i. HH.HTML w i
+soa_table_header
+  = HH.thead_ [ HH.tr [ HP.classes [C.has_background_warning_light] ]
+                      [ HH.th_ [ name_soa_header ]
+                      , HH.th_ [ ttl_header ]
+                      , HH.th_ [ mname_soa_header ]
+                      , HH.th_ [ rname_soa_header ]
+                      , HH.th_ [ serial_soa_header ]
+                      , HH.th_ [ refresh_soa_header ]
+                      , HH.th_ [ retry_soa_header ]
+                      , HH.th_ [ expire_soa_header ]
+                      , HH.th_ [ minttl_soa_header ]
+                      ]
+              ]
+  where
+    name_soa_header :: HH.HTML w i
+    name_soa_header = HH.abbr
+      [ HP.title "Your actual domain name (technical term: \"fully qualified domain name\")." ]
+      [ HH.text "Name" ]
+    mname_soa_header :: HH.HTML w i
+    mname_soa_header = HH.abbr
+      [ HP.title "Domain name of the primary authoritative DNS server for the zone (SOA \"MNAME\" field)." ]
+      [ HH.text "Primary NS" ]
+    rname_soa_header :: HH.HTML w i
+    rname_soa_header = HH.abbr
+      [ HP.title "The email address of the person responsible for managing the zone (the \"@\" is replaced by \".\" for some reason). This is the SOA \"RNAME\" field." ]
+      [ HH.text "Contact" ]
+    serial_soa_header :: HH.HTML w i
+    serial_soa_header = HH.abbr
+      [ HP.title "A number that is incremented every time the zone is updated. Secondary DNS servers use this number to check for updates." ]
+      [ HH.text "Serial" ]
+    refresh_soa_header :: HH.HTML w i
+    refresh_soa_header = HH.abbr
+      [ HP.title "The interval (in seconds) at which secondary DNS servers should check the primary server for changes to the zone." ]
+      [ HH.text "Refresh" ]
+    expire_soa_header :: HH.HTML w i
+    expire_soa_header = HH.abbr
+      [ HP.title "The time in seconds that secondary DNS servers will keep the zone data before discarding it if they cannot contact the primary server." ]
+      [ HH.text "Expire" ]
+    minttl_soa_header :: HH.HTML w i
+    minttl_soa_header = HH.abbr
+      [ HP.title "The minimum time (in seconds) that other DNS servers should cache negative responses (e.g., for non-existent domain names)." ]
+      [ HH.text "Minimum TTL" ]
+    retry_soa_header :: HH.HTML w i
+    retry_soa_header = HH.abbr
+      [ HP.title "The time in seconds that secondary servers should wait before retrying a failed attempt to contact the primary DNS server." ]
+      [ HH.text "Retry" ]
+
+name_header :: forall w i. HH.HTML w i
+name_header = HH.abbr
+  [ HP.title "Name of the DNS entry, the fully-qualified-domain-name is <name>.<domain>." ]
+  [ HH.text "Name" ]
+
+ttl_header :: forall w i. HH.HTML w i
+ttl_header = HH.abbr
+  [ HP.title "Time-to-Live, nb seconds before being considered invalid" ]
+  [ HH.text "TTL" ]
+
+target_header :: forall w i. HH.HTML w i
+target_header = HH.abbr
+  [ HP.title "In the DNS jargon, the target means the most important value associated with the entry, for an A entry it would be an IPv4 address, for example" ]
+  [ HH.text "Target" ]
+
+priority_header :: forall w i. HH.HTML w i
+priority_header = HH.abbr
+  [ HP.title "A numeric value that indicates the preference of the server (lower values indicate higher priority)" ]
+  [ HH.text "Priority" ]
+
+protocol_header :: forall w i. HH.HTML w i
+protocol_header = HH.abbr
+  [ HP.title "The related communication protocol, either TCP or UDP (want more? Just ask me)" ]
+  [ HH.text "Protocol" ]
+
+port_header :: forall w i. HH.HTML w i
+port_header = HH.abbr
+  [ HP.title "Related connection port" ]
+  [ HH.text "Port" ]
+
+display_mechanisms :: forall w i. (Int -> i) -> Array SPF.Mechanism -> HH.HTML w i
+display_mechanisms _ [] = Web.p "You don't have any mechanism."
+display_mechanisms action_remove_mechanism ms =
+    Web.table [] [ mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms]
+  where
+  render_mechanism_row :: (Tuple Int SPF.Mechanism) -> HH.HTML w i
+  render_mechanism_row (Tuple i m) = HH.tr_
+    [ txt_name $ maybe "" SPF.show_qualifier m.q
+    , HH.td_ [ Web.p $ SPF.show_mechanism_type m.t ]
+    , HH.td_ [ Web.p m.v ]
+    , HH.td_ [ Button.alert_btn "x" (action_remove_mechanism i) ]
+    ]
+  mechanism_table_header :: HH.HTML w i
+  mechanism_table_header
+    = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ]
+                         , HH.th_ [ HH.text "Type" ]
+                         , HH.th_ [ HH.text "Value" ]
+                         , HH.th_ [ HH.text "" ]
+                         ]
+                ]
+
+display_modifiers :: forall w i. (Int -> i) -> Array SPF.Modifier -> HH.HTML w i
+display_modifiers _ [] = Web.p "You don't have any modifier."
+display_modifiers action_remove_modifier ms =
+    Web.table [] [ modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms]
+  where
+  render_modifier_row :: (Tuple Int SPF.Modifier) -> HH.HTML w i
+  render_modifier_row (Tuple i m) = HH.tr_
+    [ HH.td_ [ Web.p $ SPF.show_modifier_type m.t ]
+    , HH.td_ [ Web.p m.v ]
+    , HH.td_ [ Button.alert_btn "x" (action_remove_modifier i) ]
+    ]
+  modifier_table_header :: HH.HTML w i
+  modifier_table_header
+    = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type"  ]
+                         , HH.th_ [ HH.text "Value"   ]
+                         , HH.th_ [ HH.text "" ]
+                         ]
+                ]
+
+display_dmarc_mail_addresses :: forall w i. (Int -> i) -> Array DMARC.DMARCURI -> HH.HTML w i
+display_dmarc_mail_addresses f ms = Web.table [] [ header, HH.tbody_ $ map row $ attach_id 0 ms]
+  where
+  header :: HH.HTML w i
+  header
+    = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ]
+                         , HH.th_ [ HH.text "Report size limit" ]
+                         , HH.th_ [ HH.text "" ]
+                         ]
+                ]
+  row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w i
+  row (Tuple i m) = HH.tr_
+    [ HH.td_ [ Web.p m.mail ]
+    , HH.td_ [ Web.p $ maybe "(no size limit)" show m.limit ]
+    , HH.td_ [ Button.alert_btn "x" (f i) ]
+    ]
+
+type ActionShowUser i = (Int -> i)
+type ActionDeleteUser i = (Int -> i)
+found_users :: forall w i. ActionShowUser i -> ActionDeleteUser i -> Array UserPublic -> HH.HTML w i
+found_users action_show_user action_delete_user users = Web.table [] [ header, HH.tbody_ $ map row users ]
+  where
+  header :: HH.HTML w i
+  header
+    = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Username" ]
+                         , HH.th_ [ HH.text "UID" ]
+                         , HH.th_ [ HH.text "Date of registration" ]
+                         , HH.th_ [ HH.text "" ]
+                         ]
+                ]
+  row :: UserPublic -> HH.HTML w i
+  row user = HH.tr_
+    [ HH.td_ [ Button.btn user.login (action_show_user user.uid) ]
+    , HH.td_ [ Web.p $ show user.uid ]
+    , HH.td_ [ Web.p $ fromMaybe "" user.date_registration ]
+    , HH.td_ [ Button.alert_btn "x" (action_delete_user user.uid) ]
+    ]
+
+type ActionEnterDomain i = (String -> i)
+type ActionDeleteDomain i = (String -> i)
+found_domains :: forall w i.
+  ActionEnterDomain i -> ActionDeleteDomain i -> Array String -> HH.HTML w i
+found_domains action_enter_domain action_delete_domain domains = Web.table [] [ header, HH.tbody_ $ map row domains ]
+  where
+  row :: String -> HH.HTML w i
+  row dom = HH.tr_
+    [ HH.td_ [ Button.btn dom (action_enter_domain dom) ]
+    , HH.td_ [ Web.p "" ]
+    , HH.td_ [ Button.alert_btn "x" (action_delete_domain dom) ]
+    ]
+  header :: HH.HTML w i
+  header
+    = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain name" ]
+                         , HH.th_ [ HH.text "" ]
+                         , HH.th_ [ HH.text "" ]
+                         ]
+                ]

src/App/Text/Explanations.purs

@@ -1,90 +1,90 @@
 module App.Text.Explanations where
 import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
-import Bulma as Bulma
+import Web as Web
 import CSSClasses as C
 
-expl' :: forall w i. String -> HH.HTML w i
-expl' text = expl [Bulma.p text]
-expl :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-expl content = Bulma.div_content [] [ Bulma.explanation content ]
+expl :: forall w i. String -> HH.HTML w i
+expl text = Web.quote [Web.p text]
 expl_txt :: forall w i. String -> HH.HTML w i
-expl_txt content = Bulma.explanation [ Bulma.p content ]
+expl_txt content = Web.explanation [ Web.p content ]
 
 col :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-col arr = Bulma.column_ [ Bulma.box arr ]
+col arr = Web.column_ [ Web.box arr ]
 
 tokens :: forall w i. HH.HTML w i
 tokens = HH.div_
-  [ Bulma.h3 "What are tokens?"
-  , expl' """
-          Tokens are a simple way to update a resource record (A or AAAA) with your current IP address.
-          """
+  [ Web.h3 "What are tokens?"
+  , expl """
+         Tokens are a simple way to update a resource record (A or AAAA) with your current IP address.
+         """
   , HH.p_ [ HH.text "Let's take an example: you have an A record (IPv4) pointing to your web server at home, "
           , HH.text "but your ISP changes your IP address from time to time. "
           , HH.text "You can ask for a token (which looks like "
           , HH.u_ [HH.text "53be0c45-61c4-4d29-8ae9-c2cc8767603d"]
           , HH.text ") for this specific entry, then make your server regularly visit the following website."
           ]
-  , expl [ HH.p_ [ HH.text "https://www.netlib.re/token-update/"
-                 , HH.u_ [HH.text "<your-token>"]
-                 ]
-         ]
-  , Bulma.p "For example: https://www.netlib.re/token-update/53be0c45-61c4-4d29-8ae9-c2cc8767603d"
-  , Bulma.hr
-  , Bulma.h3 "How to automate the update of my IP address?"
-  , Bulma.p "On Linux, you can make your computer access the update link with the following command."
-  , expl [ Bulma.strong "wget https://www.netlib.re/token-update/<your-token>" ]
-  , Bulma.p """
+  , Web.quote
+    [ HH.p_ [ HH.text "https://www.netlib.re/token-update/"
+            , HH.u_ [HH.text "<your-token>"]
+            ]
+    ]
+  , Web.p "For example: https://www.netlib.re/token-update/53be0c45-61c4-4d29-8ae9-c2cc8767603d"
+  , Web.hr
+  , Web.h3 "How to automate the update of my IP address?"
+  , Web.p "On Linux, you can make your computer access the update link with the following command."
+  , Web.quote [ Web.strong "wget https://www.netlib.re/token-update/<your-token>" ]
+  , Web.p """
     No need for a more complex program. This works just fine.
     And you can run this command every hour.
     For example, in your crontab (Linux and Unix related):
     """
-  , expl [ Bulma.strong "0 * * * * wget <url>" ]
-  , Bulma.p """
+  , Web.quote [ Web.strong "0 * * * * wget <url>" ]
+  , Web.p """
     Commands for other operating systems may differ, but you get the idea.
     """
-  , Bulma.hr
-  , Bulma.h3 "The obvious trap ⚠"
-  , Bulma.p """
+  , Web.hr
+  , Web.h3 "The obvious trap ⚠"
+  , Web.p """
     Make sure to access the website using the related IP address.
     To update an IPv6 address (AAAA), force your application to access the URL using an IPv6 address.
     """
-  , expl [ HH.p_ [ Bulma.strong "wget -6 <url>" ]
-         , HH.p_ [ HH.text "To force the use of an IPv6 address." ]
-         , HH.p_ [ Bulma.strong "wget -4 <url>" ]
-         , HH.p_ [ HH.text "To force the use of an IPv4 address." ]
-         ]
+  , Web.quote
+    [ HH.p_ [ Web.strong "wget -6 <url>" ]
+    , HH.p_ [ HH.text "To force the use of an IPv6 address." ]
+    , HH.p_ [ Web.strong "wget -4 <url>" ]
+    , HH.p_ [ HH.text "To force the use of an IPv4 address." ]
+    ]
   ]
 
 basics :: forall w i. HH.HTML w i
 basics = HH.div_
-  [ Bulma.h3 "Basics of DNS"
-  , Bulma.p """
+  [ Web.h3 "Basics of DNS"
+  , Web.p """
           The domain name system (DNS) enables people share a name instead of an address to find a website or service.
           """
-  , Bulma.p """
+  , Web.p """
           To configure a zone, the first steps are trivial.
           """
 
-  , Bulma.hr
-  , Bulma.h3 "I have something to host (A and AAAA records)."
-  , expl' "Let's assume you have a web server and you host your website somewhere."
-  , Bulma.p """
+  , Web.hr
+  , Web.h3 "I have something to host (A and AAAA records)."
+  , expl "Let's assume you have a web server and you host your website somewhere."
+  , Web.p """
     You want an A (IPv4) or AAAA (IPv6) record pointing to your server, named "enigma" for example.
     """
 
-  , Bulma.hr
-  , Bulma.h3 "You need other names pointing to your server (CNAME records)."
-  , Bulma.p """
+  , Web.hr
+  , Web.h3 "You need other names pointing to your server (CNAME records)."
+  , Web.p """
     You may not want to use the name of your server "enigma" directly.
     Instead, you may want the usual names for your services, such as "www" or "blog".
     CNAME records are basically aliases, exactly to that end.
     """
 
-  , Bulma.hr
-  , Bulma.h3 "If you have other servers, just add more A or AAAA records."
-  , Bulma.p """
+  , Web.hr
+  , Web.h3 "If you have other servers, just add more A or AAAA records."
+  , Web.p """
     Tip: choose relevant names for your servers then add CNAME records.
     For example, you can have an A record named "server1" and a CNAME "www" pointing to it.
     The service isn't pointing to an actual IP address directly,
@@ -92,36 +92,36 @@ basics = HH.div_
     You don't need to remember the IP address of each of your servers.
     """
 
-  , Bulma.hr
-  , Bulma.h3 "I want an email server."
-  , expl' """
-           Hosting a mail server is quite complex.
-           This section will focus on the main parts regarding the DNS.
-           """
-  , Bulma.notification_danger' """
+  , Web.hr
+  , Web.h3 "I want an email server."
+  , expl """
+         Hosting a mail server is quite complex.
+         This section will focus on the main parts regarding the DNS.
+         """
+  , Web.notification_danger' """
     The actual configuration of your mail server is complex and depends on your choice of software.
     This won't be covered here.
     """
-  , Bulma.p """
+  , Web.p """
     You need an MX record pointing to your "www" A (or AAAA) record.
     """
-  , Bulma.p """
+  , Web.p """
     Having an MX record isn't enough to handle a mail server.
     You need to use a few spam mitigation mechanisms.
     """
-  , Bulma.columns_
+  , Web.columns_
       [ col
-        [ expl' """
-                Spam mitigation 1: tell what are the right mail servers for your domain with Sender Policy Framework (SPF).
-                """
+        [ expl """
+               Spam mitigation 1: tell what are the right mail servers for your domain with Sender Policy Framework (SPF).
+               """
         , expl_txt """
           You need a SPF record to tell other mail servers what are the acceptable mail servers for your domain.
           """
         ]
       , col
-        [ expl' """
-                Spam mitigation 2: prove that the mails come from your mail server with DomainKeys Identified Mail (DKIM).
-                """
+        [ expl """
+               Spam mitigation 2: prove that the mails come from your mail server with DomainKeys Identified Mail (DKIM).
+               """
         , expl_txt """
           You will have to configure your mail server to sign the emails you send.
           This involves creating a pair of keys (public and private).
@@ -131,34 +131,34 @@ basics = HH.div_
           """
         ]
       , col
-        [ expl' """
-                Spam mitigation 3: mitigate fraud (impersonators) with Domain-based Message Authentication Reporting and Conformance (DMARC).
-                Tell other mail servers to only accept emails from your domain which actually are coming from your domain (SPF) and sent by your mail server (DKIM).
-                """
+        [ expl """
+               Spam mitigation 3: mitigate fraud (impersonators) with Domain-based Message Authentication Reporting and Conformance (DMARC).
+               Tell other mail servers to only accept emails from your domain which actually are coming from your domain (SPF) and sent by your mail server (DKIM).
+               """
         , expl_txt """
           Last but not least, DMARC.
           """
-        , Bulma.hr
-        , Bulma.p """
+        , Web.hr
+        , Web.p """
           DMARC enables to check the "From:" field of a mail, based on the SPF and DKIM mechanisms.
           Thus, domains with a DMARC record enable to only allow verified mails.
           Valid emails come from an authorized IP address (SPF), are signed by the verified email server (DKIM) and have an email address coming from a verified domain (DMARC) related to the two previous spam mitigation mechanisms.
           """
-        , Bulma.hr
-        , Bulma.p """
+        , Web.hr
+        , Web.p """
           With DMARC, you won't accept an email from "hacker@example.com" because it was sent by another domain with a valid SPF and DKIM.
           """
         ]
       ]
 
-  , Bulma.hr
-  , Bulma.h3 "How to automate the update of my IP address?"
-  , Bulma.p "Check out the \"Tokens? 🤨\" tab."
+  , Web.hr
+  , Web.h3 "How to automate the update of my IP address?"
+  , Web.p "Check out the \"Tokens? 🤨\" tab."
   ]
 
 a_introduction :: forall w i. Array (HH.HTML w i)
 a_introduction =
-  [ Bulma.p """
+  [ Web.p """
     The A record enables to bind an IPv4 address to a domain.
     """
   , HH.p []
@@ -175,7 +175,7 @@ a_introduction =
 
 aaaa_introduction :: forall w i. Array (HH.HTML w i)
 aaaa_introduction =
-  [ Bulma.p """
+  [ Web.p """
     The AAAA record enables to bind an IPv6 address to a domain.
     """
   , HH.p []
@@ -192,7 +192,7 @@ aaaa_introduction =
 
 cname_introduction :: forall w i. Array (HH.HTML w i)
 cname_introduction =
-  [ Bulma.p """
+  [ Web.p """
     The CNAME record enables to provide alternative names to records.
     """
   , HH.p []
@@ -209,7 +209,7 @@ cname_introduction =
 
 mx_introduction :: forall w i. Array (HH.HTML w i)
 mx_introduction =
-  [ Bulma.p """
+  [ Web.p """
     The MX record enables to add a mail server to your zone.
     """
   , HH.p []
@@ -221,20 +221,20 @@ mx_introduction =
         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 """
+  , Web.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 """
+  , Web.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 """
+  [ Web.p """
     The TXT record enables to declare a small text.
     """
   , HH.p []
@@ -246,7 +246,7 @@ txt_introduction =
         TXT records are used in several places, for example for mail security through SPF, DKIM and DMARC records.
       """
     ]
-  , Bulma.notification_danger' """
+  , Web.notification_danger' """
       All of these specific records have a dedicated user interface on this website;
       use them instead of writing these records by yourself.
     """
@@ -254,19 +254,19 @@ txt_introduction =
 
 ns_introduction :: forall w i. Array (HH.HTML w i)
 ns_introduction =
-  [ Bulma.p """
+  [ Web.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."
+  , Web.notification_danger' "🚨 Advice for beginners: do not use this resource record."
   ]
 
 caa_introduction :: forall w i. Array (HH.HTML w i)
 caa_introduction =
-  [ Bulma.p """
+  [ Web.p """
     The CAA record enables to specify a certification authority that is authorized to issue certificates for the domain.
     The idea is to reduce the risk of unintended certificate mis-issue.
     """
-  , Bulma.p """
+  , Web.p """
     Certification authorities (CA) may issue certificates for any domain.
     Thus, any CA may provide certificates for a domain (let's say google.com) to any hacker that can now impersonate the domain.
     The CAA record allows to say what is the authorized CA for the domain, preventing this kind of attacks.
@@ -282,7 +282,7 @@ caa_introduction =
 
 dkim_introduction :: forall w i. Array (HH.HTML w i)
 dkim_introduction =
-  [ Bulma.p """
+  [ Web.p """
     DKIM is a way to share a public signature key for the domain.
     This enables emails to be signed by the sender and for the receiver to verify the origin of the mail.
     """
@@ -293,14 +293,14 @@ dkim_introduction =
       """
     , HH.u_ [HH.text "selector"]
     , HH.text " is "
-    , Bulma.strong "default"
+    , Web.strong "default"
     , HH.text "."
     ]
   ]
 
 dmarc_introduction :: forall w i. Array (HH.HTML w i)
 dmarc_introduction =
-  [ Bulma.p """
+  [ Web.p """
     DMARC is a spam mitigation mechanism on top of SPF and DKIM.
     Upon receiving a mail, the server checks whether the "From:" field of the mail is consistent with the SPF and DKIM
     records of the sender's domain.
@@ -311,11 +311,11 @@ dmarc_introduction =
 
 dmarc_policy :: forall w i. Array (HH.HTML w i)
 dmarc_policy =
-  [ Bulma.p """
+  [ Web.p """
     DMARC record enables to tell receivers what to do with a non-conforming message,
     i.e. a message that wasn't properly secured with SPF and DKIM.
     """
-  , Bulma.p """
+  , Web.p """
     This message can either be accepted ("None") or rejected, or even quarantined, meaning to be considered as suspicious.
     This can take different forms, such as being flagged, marked as spam or have a high "spam score", it's up to the receiver.
     """
@@ -323,34 +323,34 @@ dmarc_policy =
 
 dmarc_sp_policy :: forall w i. Array (HH.HTML w i)
 dmarc_sp_policy =
-  [ Bulma.p """
+  [ Web.p """
     Same as the previous entry, but for sub-domains.
     """
   ]
 
 dmarc_adkim :: forall w i. Array (HH.HTML w i)
 dmarc_adkim =
-  [ Bulma.p """
+  [ Web.p """
     Consistency policy for DKIM. Tell what should be considered acceptable.
     """
-  , Bulma.p """
+  , Web.p """
     This is about the relation between the email "From:" field and the domain field of the DKIM signature ("d:").
     """
-  , Bulma.p """
+  , Web.p """
     The policy can be either strict (both should be identical) or relaxed (both in the same Organizational Domain).
     """
   ]
 
 dmarc_aspf :: forall w i. Array (HH.HTML w i)
 dmarc_aspf =
-  [ Bulma.p """
+  [ Web.p """
     Consistency policy for SPF. Tell what should be considered acceptable.
     """
-  , Bulma.p """
+  , Web.p """
     First, SPF should produce a passing result.
     Then, the "From:" and the "MailFrom:" fields of the received email are checked.
     """
-  , Bulma.p """
+  , Web.p """
     In strict mode, both fields should be identical.
     In relaxed mode, they can be different, but in the same Organizational Domain.
     """
@@ -367,28 +367,28 @@ dmarc_aspf =
           ]
   , HH.p_
     [ HH.text "See "
-    , Bulma.outside_link [] "https://publicsuffix.org/" "publicsuffix.org"
+    , Web.outside_link [] "https://publicsuffix.org/" "publicsuffix.org"
     , HH.text " for a list of Organizational Domains."
     ]
   ]
 
 dmarc_contact :: forall w i. Array (HH.HTML w i)
 dmarc_contact =
-  [ Bulma.p """
+  [ Web.p """
     In case you want to receive error reports, enter email addresses that should receive either an aggregated report or a detailed report of the occurring errors.
     """
   ]
 
 dmarc_ri :: forall w i. Array (HH.HTML w i)
 dmarc_ri =
-  [ Bulma.p """
+  [ Web.p """
     Requested report interval. Default is 86400.
     """
   ]
 
 dmarc_pct :: forall w i. Array (HH.HTML w i)
 dmarc_pct =
-  [ Bulma.p """
+  [ Web.p """
     Sampling rate.
     Percentage of messages subjected to the requested policy.
     """
@@ -397,7 +397,7 @@ dmarc_pct =
 
 dkim_default_algorithms :: forall w i. Array (HH.HTML w i)
 dkim_default_algorithms =
-  [ Bulma.p """
+  [ Web.p """
     Default values should be fine (RSA + SHA256), change them only if you know what you are doing.
     Just enter your public key.
   """
@@ -435,7 +435,7 @@ spf_introduction =
 
 spf_default_behavior :: forall w i. Array (HH.HTML w i)
 spf_default_behavior = [
-    Bulma.p """
+    Web.p """
     What should someone do when receiving a mail from your email address but not from a listed domain or IP address?
     """
   , HH.p_ [ HH.text """
@@ -464,7 +464,7 @@ spf_default_behavior = [
 
 srv_introduction :: forall w i. Array (HH.HTML w i)
 srv_introduction =
-  [ Bulma.p "The SRV record is a DNS resource record for specifying the location of services."
+  [ Web.p "The SRV record is a DNS resource record for specifying the location of services."
   , HH.p_ [ HH.text "Given a specific "
           , HH.u_ [HH.text "service name"]
           , HH.text " (which may be arbitrary) and a "
@@ -487,78 +487,80 @@ website_abuse_address = "abuse AT netlib.re" :: String
 
 legal_notice :: forall w i. HH.HTML w i
 legal_notice = HH.div_
-  [ Bulma.h3 "Legal Notice"
+  [ Web.h3 "Legal Notice"
 
-  , Bulma.strong "Website Publisher"
-  , expl [ HH.p_ [ HH.text "You can contact this website's owner and publisher at: "
-                 , Bulma.strong website_owner_address
-                 ]
-         , HH.p_ [ HH.text "For legal matter: "
-                 , Bulma.strong website_abuse_address
-                 ]
-         ]
+  , Web.strong "Website Publisher"
+  , Web.quote
+    [ HH.p_ [ HH.text "You can contact this website's owner and publisher at: "
+            , Web.strong website_owner_address
+            ]
+    , HH.p_ [ HH.text "For legal matter: "
+            , Web.strong website_abuse_address
+            ]
+    ]
 
-  , Bulma.strong "Website Hosting"
-  , expl [ HH.p_ [ HH.text "This website is hosted by "
-                 , Bulma.strong "Alsace Réseau Neutre"
-                 , HH.text "."
-                 , HH.br_
-                 , HH.text "Website: "
-                 , Bulma.outside_link [] "https://arn-fai.net" "arn-fai.net"
-                 , HH.br_
-                 , HH.text "Address & contact: "
-                 , Bulma.outside_link [] "https://arn-fai.net/fr/mentions" "Legal Notice of ARN"
-                 ]
-         ]
+  , Web.strong "Website Hosting"
+  , Web.quote
+    [ HH.p_ [ HH.text "This website is hosted by "
+            , Web.strong "Alsace Réseau Neutre"
+            , HH.text "."
+            , HH.br_
+            , HH.text "Website: "
+            , Web.outside_link [] "https://arn-fai.net" "arn-fai.net"
+            , HH.br_
+            , HH.text "Address & contact: "
+            , Web.outside_link [] "https://arn-fai.net/fr/mentions" "Legal Notice of ARN"
+            ]
+    ]
 
-  , Bulma.strong "Intellectual Property"
-  , expl' """
-          The code of this website is released under the ISC License. You
-          are free to copy, modify, and distribute the code, provided
-          that you comply with the terms of the ISC License.
-          """
+  , Web.strong "Intellectual Property"
+  , expl """
+         The code of this website is released under the ISC License. You
+         are free to copy, modify, and distribute the code, provided
+         that you comply with the terms of the ISC License.
+         """
 
-  , Bulma.strong "Personal Data Collection"
-  , expl' """
-          This website collects only the personal data necessary for its proper functioning.
-          This includes data such as: a login (arbitrary set of
-          characters), a password (that is stored encrypted), an email
-          to contact the owner of the domain, domain names and zone data.
-          """
+  , Web.strong "Personal Data Collection"
+  , expl """
+         This website collects only the personal data necessary for its proper functioning.
+         This includes data such as: a login (arbitrary set of
+         characters), a password (that is stored encrypted), an email
+         to contact the owner of the domain, domain names and zone data.
+         """
 
-  , Bulma.strong "Data Sharing"
-  , expl' """
-          None of the collected data will be shared to third parties.
-          """
+  , Web.strong "Data Sharing"
+  , expl """
+         None of the collected data will be shared to third parties.
+         """
 
-  , Bulma.strong "Data Retention"
-  , expl' """
-          The personal data collected on this website will be retained
-          for as long as necessary to fulfill the purposes for which it
-          was collected, including the management of user accounts.
+  , Web.strong "Data Retention"
+  , expl """
+         The personal data collected on this website will be retained
+         for as long as necessary to fulfill the purposes for which it
+         was collected, including the management of user accounts.
 
-          However, please note that even after the deletion of your
-          account, your data may be retained for up to 6 months due
-          to technical constraints, such as backups made for disaster
-          recovery purposes in the event of a hardware failure.
+         However, please note that even after the deletion of your
+         account, your data may be retained for up to 6 months due
+         to technical constraints, such as backups made for disaster
+         recovery purposes in the event of a hardware failure.
 
-          This retention period is necessary to ensure the security and
-          integrity of our system and to allow for the restoration of
-          data in case of any unforeseen issues.
+         This retention period is necessary to ensure the security and
+         integrity of our system and to allow for the restoration of
+         data in case of any unforeseen issues.
 
-          After this period, all data will be securely deleted.
-          """
+         After this period, all data will be securely deleted.
+         """
 
-  , Bulma.strong "Liability"
-  , expl
-    [ Bulma.p
+  , Web.strong "Liability"
+  , Web.quote
+    [ Web.p
           """
           The publisher of this website makes every effort to ensure that
           the website functions properly and that all data is protected
           to the best of their ability.
           """
 
-    , Bulma.p
+    , Web.p
           """
           However, despite all reasonable precautions, the publisher
           cannot guarantee that the website will always be free of errors,
@@ -576,7 +578,7 @@ legal_notice = HH.div_
               ]
             ]
 
-    , Bulma.p
+    , Web.p
           """
           By using this website, users acknowledge that they accept the
           inherent risks associated with the use of online services. The
@@ -585,13 +587,14 @@ legal_notice = HH.div_
           """
     ]
 
-  , Bulma.strong "GDPR compliance"
-  , expl [ HH.p_ [ HH.text """
-                           You have the right to access, correct and delete your personal
-                           data at any time via this website or by contacting us at the
-                           following email address:
-                           """
-                 , Bulma.strong website_owner_address
-                 ]
-         ]
+  , Web.strong "GDPR compliance"
+  , Web.quote
+    [ HH.p_ [ HH.text """
+                      You have the right to access, correct and delete your personal
+                      data at any time via this website or by contacting us at the
+                      following email address:
+                      """
+            , Web.strong website_owner_address
+            ]
+    ]
   ]

src/App/Type/AcceptedRRTypes.purs

@@ -1,26 +0,0 @@
--- | The application accepts to add a few new entry types in a DNS zone.
--- | Each resource record has a specific form, with dedicated inputs and
--- | dedicated validation.
-module App.Type.AcceptedRRTypes where
-
-import Prelude
-import Data.Generic.Rep (class Generic)
-import Data.Show.Generic (genericShow)
-
-data AcceptedRRTypes
-  = A
-  | AAAA
-  | TXT
-  | CNAME
-  | NS
-  | MX
-  | CAA
-  | SRV
-  | SPF
-  | DKIM
-  | DMARC
-
-derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
-
-instance showAcceptedRRTypes :: Show AcceptedRRTypes where
-  show = genericShow

src/App/Type/DNSZone.purs

@@ -4,6 +4,19 @@ import Data.Codec.Argonaut (JsonCodec)
 import Data.Codec.Argonaut as CA
 import Data.Codec.Argonaut.Record as CAR
 import App.Type.ResourceRecord as RR
+import Data.Maybe (Maybe)
+
+type Delegation
+  = { nameserver1 :: String
+    , nameserver2 :: String
+    }
+
+codecDelegation :: JsonCodec Delegation
+codecDelegation = CA.object "Delegation"
+  (CAR.record
+    { nameserver1: CA.string
+    , nameserver2: CA.string
+    })
 
 type DNSZone
   = { domain        :: String
@@ -13,6 +26,9 @@ type DNSZone
 
     -- Each resource record has a number, this is the ID to give to a new RR.
     , current_rrid  :: Int
+
+    -- In case the zone is delegated, it should have two recorded name servers.
+    , delegation  :: Maybe Delegation
     }
 
 codec :: JsonCodec DNSZone
@@ -21,4 +37,5 @@ codec = CA.object "DNSZone"
     { domain:        CA.string
     , resources:     CA.array RR.codec
     , current_rrid:  CA.int
+    , delegation:    CAR.optional codecDelegation
     })

src/App/Type/Delegation.purs

@@ -0,0 +1,45 @@
+module App.Type.Delegation where
+
+import GenericParser.Parser as G
+import GenericParser.DomainParser.Common (DomainError) as DomainParser
+
+-- | The required data needed to properly delegate a domain: two name servers.
+-- | The type also includes potential errors found while validating the data.
+type Form
+  = { nameserver1 :: String
+    , nameserver2 :: String
+    , errors      :: Array Error
+    }
+
+-- | Empty delegation form, with default inputs.
+mkEmptyDelegationForm :: Form
+mkEmptyDelegationForm
+  = { nameserver1: "ns0.example.com"
+    , nameserver2: "ns1.example.com"
+    , errors: []
+    }
+
+-- | What are the **fields** of our delegation form?
+-- | This *Field* data type provides a way to update the form with `update`.
+data Field
+  = NameServer1 String
+  | NameServer2 String
+
+-- | Utility function to update a field of the form, based on the previous `Form` and `Field` types.
+-- |
+-- | RATIONALE: this utility function enables a generic way of handling field updates.
+-- | In Halogen, a single *Action* is required to update all fields:
+-- |```
+-- |  UpdateDelegationForm field -> do
+-- |    state <- H.get
+-- |    H.modify_ _ { delegation_form = Delegation.update state.delegation_form field }
+-- |```
+update :: Form -> Field -> Form
+update form updated_field = case updated_field of
+  NameServer1 val -> form { nameserver1 = val }
+  NameServer2 val -> form { nameserver2 = val }
+
+-- | Possible errors regarding the form (domain parsing errors).
+data Error
+  = VENameServer1 (G.Error DomainParser.DomainError)
+  | VENameServer2 (G.Error DomainParser.DomainError)

src/App/Type/Notification.purs

@@ -0,0 +1,3 @@
+module App.Type.Notification where
+
+data Notification = NoNotification | GoodNotification String | BadNotification String

src/App/Type/RRId.purs

@@ -0,0 +1,3 @@
+module App.Type.RRId where
+
+type RRId = Int

src/App/Type/RRModal.purs

@@ -0,0 +1,17 @@
+-- | `App.Type.RRModal.RRModal` provides the states of a modal related
+-- | to resource management: no modal because no RR is currently
+-- | selected, new RR because a new resource will be requested, update
+-- | and finally removal, to ask for confirmation.
+-- |
+-- | FIXME: TODO: WIP: should this be replaced by something like `CRUD`?
+module App.Type.RRModal where
+
+import App.Type.RRId
+import App.Type.ResourceRecord (AcceptedRRTypes)
+
+data RRModal
+  = NoModal
+  | NewRRModal AcceptedRRTypes
+  | UpdateRRModal
+  | RemoveRRModal RRId
+  | DelegationModal

src/App/Type/ResourceRecord.purs

@@ -1,19 +1,31 @@
 module App.Type.ResourceRecord where
 
-import Prelude ((<>), map, bind, pure, class Show)
+import Prelude (($), (-), (<>), map, bind, pure, class Show)
 -- import Data.String (toLower)
 import Data.Generic.Rep (class Generic)
 import App.Type.GenericSerialization (generic_serialization)
 import Data.Show.Generic (genericShow)
 
-import Data.Maybe (Maybe(..), maybe)
+import Data.Array as A
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Either (Either(..))
+
+import GenericParser.Parser as G
+import GenericParser.IPAddress as IPAddress
+import GenericParser.DomainParser.Common (DomainError) as DomainParser
+
+import Utils (id, attach_id, remove_id)
+
+import App.Validation.Email as Email
 
 import Data.Codec.Argonaut (JsonCodec)
 import Data.Codec.Argonaut as CA
 import Data.Codec.Argonaut.Record as CAR
+import Data.Int (fromString)
 
 import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
+import App.Type.ResourceRecord.SPF as SPF
 import App.Type.CAA as CAA
 
 type ResourceRecord
@@ -45,9 +57,9 @@ type ResourceRecord
 
     -- SPF specific entries.
     , v :: Maybe String -- Default: spf1
-    , mechanisms :: Maybe (Array Mechanism)
-    , modifiers  :: Maybe (Array Modifier)
-    , q          :: Maybe Qualifier  -- Qualifier for default mechanism (`all`).
+    , mechanisms :: Maybe (Array SPF.Mechanism)
+    , modifiers  :: Maybe (Array SPF.Modifier)
+    , q          :: Maybe SPF.Qualifier  -- Qualifier for default mechanism (`all`).
 
     , dkim :: Maybe DKIM.DKIM
     , dmarc :: Maybe DMARC.DMARC
@@ -85,119 +97,15 @@ codec = CA.object "ResourceRecord"
 
     -- SPF specific entries.
     , v:          CAR.optional CA.string
-    , mechanisms: CAR.optional (CA.array codecMechanism)
-    , modifiers:  CAR.optional (CA.array codecModifier)
-    , q:          CAR.optional codecQualifier
+    , mechanisms: CAR.optional (CA.array SPF.codecMechanism)
+    , modifiers:  CAR.optional (CA.array SPF.codecModifier)
+    , q:          CAR.optional SPF.codecQualifier
 
     , dkim:       CAR.optional DKIM.codec
     , dmarc:      CAR.optional DMARC.codec
     , caa:        CAR.optional CAA.codec
     })
 
-type Mechanism
-  = { q :: Maybe Qualifier
-    , t :: MechanismType
-    , v :: String    -- Value (IP addresses or ranges, or domains).
-    }
-
-codecMechanism :: JsonCodec Mechanism
-codecMechanism = CA.object "Mechanism"
-  (CAR.record
-    { q: CAR.optional codecQualifier
-    , t: codecMechanismType
-    , v: CA.string
-    })
-
--- TODO: this is debug code, before actual validation.
-to_mechanism :: String -> String -> String -> Maybe Mechanism
-to_mechanism q t v = do
-  mechanism_type <- str_to_mechanism_type t
-  pure { q: str_to_qualifier q, t: mechanism_type, v }
-to_modifier :: String -> String -> Maybe Modifier
-to_modifier t v = do
-  modifier_type <- str_to_modifier_type t
-  pure { t: modifier_type, v }
-
--- | `show_modifier` acts like `show_mechanism` regarding the value (meaning: it can be discarded).
--- | But this probably shouldn't since both values of modifiers actually NEED a value.
-show_modifier :: Modifier -> String
-show_modifier m =
-  let mtype = show_modifier_type m.t
-      value = case m.v of
-               "" -> ""
-               _  -> "=" <> m.v
-  in mtype <> value
-
-show_mechanism :: Mechanism -> String
-show_mechanism m =
-  let qualifier = case maybe "" show_qualifier_char m.q of
-                    "+" -> ""
-                    v      -> v
-      mtype = show_mechanism_type m.t
-      value = case m.v of
-               "" -> ""
-               _  -> "=" <> m.v
-  in qualifier <> mtype <> value
-
-show_qualifier_char :: Qualifier -> String
-show_qualifier_char = case _ of
-  Pass      -> "+"
-  Neutral   -> "?"
-  SoftFail  -> "~"
-  HardFail  -> "-"
-
-data MechanismType = A | IP4 | IP6 | MX | PTR | EXISTS | INCLUDE
-mechanism_types :: Array String
-mechanism_types = map show_mechanism_type [ A, IP4, IP6, MX, PTR, EXISTS, INCLUDE ]
-
--- | Codec for just encoding a single value of type `MechanismType`.
-codecMechanismType :: CA.JsonCodec MechanismType
-codecMechanismType = CA.prismaticCodec "MechanismType" str_to_mechanism_type show_mechanism_type CA.string
-
-str_to_mechanism_type :: String -> Maybe MechanismType
-str_to_mechanism_type = case _ of
-  "a"         -> Just A
-  "ip4"       -> Just IP4
-  "ip6"       -> Just IP6
-  "mx"        -> Just MX
-  "ptr"       -> Just PTR
-  "exists"    -> Just EXISTS
-  "include"   -> Just INCLUDE
-  _ -> Nothing
-
-show_mechanism_type :: MechanismType -> String
-show_mechanism_type = case _ of
-  A       -> "a"
-  IP4     -> "ip4"
-  IP6     -> "ip6"
-  MX      -> "mx"
-  PTR     -> "ptr"
-  EXISTS  -> "exists"
-  INCLUDE -> "include"
-
-data ModifierType = EXP | REDIRECT
-modifier_types :: Array String
-modifier_types = ["exp", "redirect"]
-
-show_modifier_type :: ModifierType -> String
-show_modifier_type = case _ of
-  EXP      -> "exp"
-  REDIRECT -> "redirect"
-
--- | Codec for just encoding a single value of type `ModifierType`.
-codecModifierType :: CA.JsonCodec ModifierType
-codecModifierType = CA.prismaticCodec "ModifierType" str_to_modifier_type show_modifier_type CA.string
-
-str_to_modifier_type :: String -> Maybe ModifierType
-str_to_modifier_type = case _ of
-  "exp"      -> Just EXP
-  "redirect" -> Just REDIRECT
-  _          -> Nothing
-
-type Modifier = { t :: ModifierType, v :: String  {- Value (domain). -} }
-codecModifier :: JsonCodec Modifier
-codecModifier = CA.object "Modifier" (CAR.record { t: codecModifierType, v: CA.string })
-
 emptyRR :: ResourceRecord
 emptyRR
   = { rrid:         0
@@ -237,31 +145,6 @@ emptyRR
     , caa:          Nothing
     }
 
-data Qualifier = Pass | Neutral | SoftFail | HardFail
-qualifiers :: Array Qualifier
-qualifiers = [Pass, Neutral, SoftFail, HardFail]
-qualifier_types :: Array String
-qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
-
--- | Codec for just encoding a single value of type `Qualifier`.
-codecQualifier :: CA.JsonCodec Qualifier
-codecQualifier = CA.prismaticCodec "Qualifier" str_to_qualifier show_qualifier CA.string
-
-str_to_qualifier :: String -> Maybe Qualifier
-str_to_qualifier = case _ of
-  "pass"      -> Just Pass      -- +
-  "neutral"   -> Just Neutral   -- ?
-  "soft_fail" -> Just SoftFail  -- ~
-  "hard_fail" -> Just HardFail  -- -
-  _ -> Nothing
-
-show_qualifier :: Qualifier -> String
-show_qualifier = case _ of
-  Pass      -> "pass"
-  Neutral   -> "neutral"
-  SoftFail  -> "soft_fail"
-  HardFail  -> "hard_fail"
-
 data SRVProtocol = TCP | UDP
 srv_protocols :: Array SRVProtocol
 srv_protocols = [TCP, UDP]
@@ -281,3 +164,313 @@ str_to_srv_protocol = case _ of
   "tcp" -> Just TCP
   "udp" -> Just UDP
   _ -> Nothing
+
+data Field
+  = Domain    String
+  | TTL       String
+  | Target    String
+  | Priority  String
+  | Weight    String
+  | Port      String
+  | SPF_v          String
+  | SPF_mechanisms (Array SPF.Mechanism)
+  | SPF_modifiers  (Array SPF.Modifier)
+  | SPF_q          SPF.Qualifier
+
+  | CAA_flag  String
+  | CAA_value String
+
+-- | TMP: temporary stored values regarding specific records such as SPF,
+-- | DKIM and DMARC.
+type TMP =
+  {
+    -- SPF details.
+    spf :: { mechanism_q :: String
+           , mechanism_t :: String
+           , mechanism_v :: String
+           , modifier_t  :: String
+           , modifier_v  :: String
+           }
+
+    -- DMARC details.
+  , dmarc_mail       :: String
+  , dmarc_mail_limit :: Maybe Int
+  , dmarc            :: DMARC.DMARC
+
+    -- DKIM details.
+  , dkim :: DKIM.DKIM
+  }
+
+-- | `Form` is the necessary state to modify a resource record.
+-- | It contains the currently manipulated record, detected errors, along with some temporary values.
+-- | FIXME: this form is messy AF and should be replaced.
+type Form =
+  { _rr                :: ResourceRecord
+  , _errors            :: Array Error
+  , _dmarc_mail_errors :: Array Email.Error
+  , _zonefile          :: Maybe String
+  , tmp                :: TMP
+  }
+
+default_qualifier_str = "hard_fail" :: String
+default_caa = { flag: 0, tag: CAA.Issue, value: "letsencrypt.org" } :: CAA.CAA
+
+default_rr :: AcceptedRRTypes -> String -> ResourceRecord
+default_rr t domain =
+  case t of
+    A     -> emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
+    AAAA  -> emptyRR { rrtype = "AAAA",  name = "server1",        target = "2001:db8::1" }
+    TXT   -> emptyRR { rrtype = "TXT",   name = "txt",            target = "some text" }
+    CNAME -> emptyRR { rrtype = "CNAME", name = "www",            target = "server1" }
+    NS    -> emptyRR { rrtype = "NS",    name = (domain <> "."),  target = "ns0.example.com." }
+    MX    -> emptyRR { rrtype = "MX",    name = "mail",           target = "server1", priority = Just 10 }
+    CAA   -> emptyRR { rrtype = "CAA",   name = "",               target = "",        caa = Just default_caa }
+    SRV   -> emptyRR { rrtype = "SRV",   name = "voip",           target = "server1"
+                     , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just TCP }
+    SPF   -> emptyRR { rrtype = "SPF",   name = "",               target = ""
+                     , mechanisms = Just default_mechanisms, q = Just SPF.HardFail }
+    DKIM  -> emptyRR { rrtype = "DKIM",  name = "default._domainkey", target = "" }
+    DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc",             target = "" }
+  where
+  default_mechanisms = maybe [] (\x -> [x]) $ SPF.to_mechanism "pass" "mx" ""
+
+mkEmptyRRForm :: Form
+mkEmptyRRForm =
+  {
+  -- This is the state for the new RR modal.
+    _rr: default_rr A ""
+  -- List of errors within the form in new RR modal.
+  , _errors: []
+  , _dmarc_mail_errors: []
+  , _zonefile: Nothing
+  , tmp: { spf: { mechanism_q: "pass"
+                , mechanism_t: "a"
+                , mechanism_v: ""
+                , modifier_t:  "redirect"
+                , modifier_v:  ""
+                }
+         , dkim:  DKIM.emptyDKIMRR
+         , dmarc: DMARC.emptyDMARCRR
+         , dmarc_mail: ""
+         , dmarc_mail_limit: Nothing
+         }
+  }
+
+data RRUpdateValue
+  = CAA_tag Int
+  | SRV_Protocol Int
+  | SPF_Mechanism_q Int
+  | SPF_Mechanism_t Int
+  | SPF_Mechanism_v String
+  | SPF_Modifier_t  Int
+  | SPF_Modifier_v  String
+  | SPF_Qualifier   Int
+
+  -- | Remove a SPF mechanism of the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_remove_mechanism Int
+  -- | Remove a SPF modifier of the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_remove_modifier Int
+
+  -- | Add a SPF mechanism to the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_Mechanism_Add
+  -- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`).
+  | SPF_Modifier_Add
+
+  -- | Change the temporary mail address for DMARC.
+  | DMARC_mail String
+
+  -- | Change the temporary report size limit for DMARC.
+  | DMARC_mail_limit String
+
+  -- | Change the requested report interval.
+  | DMARC_ri String
+
+  -- | Add a new mail address to the DMARC rua list.
+  | DMARC_rua_Add
+
+  -- | Add a new mail address to the DMARC ruf list.
+  | DMARC_ruf_Add
+
+  -- | Remove a mail address of the DMARC rua list.
+  | DMARC_remove_rua Int
+
+  -- | Remove a mail address of the DMARC ruf list.
+  | DMARC_remove_ruf Int
+
+  | DMARC_policy Int
+  | DMARC_sp_policy Int
+  | DMARC_adkim Int
+  | DMARC_aspf Int
+  | DMARC_pct  String
+  | DMARC_fo Int
+
+  | DKIM_hash_algo Int
+  | DKIM_sign_algo Int
+  | DKIM_pubkey    String
+  | DKIM_note      String
+
+update_form :: Form -> RRUpdateValue -> Form
+update_form form new_field_value =
+  case new_field_value of
+  CAA_tag         v ->
+    let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v
+        new_value = case new_tag of
+          CAA.Issue -> "letsencrypt.org"
+          CAA.ContactEmail -> "contact@example.com"
+          CAA.ContactPhone -> "0203040506"
+          _                -> ""
+        new_caa = (fromMaybe default_caa form._rr.caa) { tag = new_tag, value = new_value }
+    in form { _rr { caa = Just new_caa } }
+
+  SRV_Protocol v    -> form { _rr { protocol = srv_protocols A.!! v } }
+  SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass"     id $ SPF.qualifier_types A.!! v  }}}
+  SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a"        id $ SPF.mechanism_types A.!! v  }}}
+  SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v                                                 }}}
+  SPF_Modifier_t v  -> form { tmp { spf { modifier_t  = maybe "redirect" id $ SPF.modifier_types  A.!! v  }}}
+  SPF_Modifier_v v  -> form { tmp { spf { modifier_v  = v                                                 }}}
+  SPF_Qualifier v   -> form { _rr { q  = SPF.qualifiers A.!! v                                             }}
+  SPF_remove_mechanism i ->
+    form { _rr { mechanisms = case form._rr.mechanisms of
+                   Just ms -> Just (remove_id i $ attach_id 0 ms)
+                   Nothing -> Nothing
+               } }
+  SPF_remove_modifier i ->
+    form { _rr { modifiers = case form._rr.modifiers of
+                   Just ms -> Just (remove_id i $ attach_id 0 ms)
+                   Nothing -> Nothing
+               } }
+
+  SPF_Mechanism_Add ->
+    let m = form._rr.mechanisms
+        m_q = form.tmp.spf.mechanism_q
+        m_t = form.tmp.spf.mechanism_t
+        m_v = form.tmp.spf.mechanism_v
+        new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_mechanism m_q m_t m_v)
+        new_value = case new_list_of_mechanisms of
+          [] -> Nothing
+          v  -> Just v
+    in form { _rr { mechanisms = new_value }}
+
+  SPF_Modifier_Add ->
+    let m = form._rr.modifiers
+        m_t = form.tmp.spf.modifier_t
+        m_v = form.tmp.spf.modifier_v
+        new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_modifier m_t m_v)
+        new_value = case new_list_of_modifiers of
+          [] -> Nothing
+          v  -> Just v
+    in form { _rr { modifiers = new_value }}
+
+  DMARC_mail       v -> form { tmp { dmarc_mail = v } }
+  DMARC_mail_limit v -> form { tmp { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } }
+  DMARC_ri         v -> form { tmp { dmarc { ri = fromString v } } }
+  DMARC_rua_Add ->
+    case Email.email form.tmp.dmarc_mail of
+      Left errors -> form { _dmarc_mail_errors = errors }
+      Right _     ->
+        let current_ruas = fromMaybe [] form.tmp.dmarc.rua
+            new_list = current_ruas <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
+        in form { tmp { dmarc { rua = Just new_list }}}
+
+  DMARC_ruf_Add ->
+    case Email.email form.tmp.dmarc_mail of
+      Left errors -> form { _dmarc_mail_errors = errors }
+      Right _     ->
+        let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
+            new_list = current_rufs <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
+        in form { tmp { dmarc { ruf = Just new_list }}}
+
+  DMARC_remove_rua i ->
+    let current_ruas = fromMaybe [] form.tmp.dmarc.rua
+        new_value = case (remove_id i $ attach_id 0 current_ruas) of
+          [] -> Nothing
+          v -> Just v
+    in form { tmp { dmarc { rua = new_value } } }
+
+  DMARC_remove_ruf i ->
+    let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
+        new_value = case (remove_id i $ attach_id 0 current_rufs) of
+          [] -> Nothing
+          v -> Just v
+    in form { tmp { dmarc { ruf = new_value } } }
+
+  DMARC_policy    v -> form { tmp { dmarc { p     = fromMaybe DMARC.None $ DMARC.policies A.!! v       } } }
+  DMARC_sp_policy v -> form { tmp { dmarc { sp    =                        DMARC.policies A.!! (v - 1) } } }
+  DMARC_adkim     v -> form { tmp { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1)            } } }
+  DMARC_aspf      v -> form { tmp { dmarc { aspf  = DMARC.consistency_policies A.!! (v - 1)            } } }
+  DMARC_pct       v -> form { tmp { dmarc { pct   = Just $ fromMaybe 100 (fromString v)                } } }
+  DMARC_fo        v -> form { tmp { dmarc { fo    = DMARC.report_occasions A.!! (v - 1)                } } }
+  DKIM_hash_algo  v -> form { tmp { dkim  { h     = DKIM.hash_algos A.!! v                             } } }
+  DKIM_sign_algo  v -> form { tmp { dkim  { k     = DKIM.sign_algos A.!! v                             } } }
+  DKIM_pubkey     v -> form { tmp { dkim  { p     =                      v                             } } }
+  DKIM_note       v -> form { tmp { dkim  { n     = Just                 v                             } } }
+
+-- | Errors that might be catched in for the form upon validation (`App.Validation.DNS`).
+-- |
+-- | **History:**
+-- | The module once used dedicated types for each type of RR.
+-- | That comes with several advantages.
+-- | First, type verification was a thing, and function were dedicated to a certain type of record.
+-- | Second, these dedicated types used strings for their fields,
+-- | which simplifies the typing when dealing with forms.
+-- | Finally, the validation was a way to convert dedicated types (used in forms)
+-- | to the general type (used for network serialization).
+-- | This ensures each resource record is verified before being sent to `dnsmanagerd`.
+-- |
+-- | The problem is that, with dedicated types, you are then required to have dedicated functions.
+-- | Conversion functions are also required.
+-- |
+-- | Maybe the code will change again in the future, but for now it will be enough.
+
+data Error
+  = UNKNOWN
+  | VEIPv4 (G.Error IPAddress.IPv4Error)
+  | VEIPv6 (G.Error IPAddress.IPv6Error)
+  | VEName (G.Error DomainParser.DomainError)
+  | VETTL Int Int Int
+  | VETXT (G.Error TXTError)
+  | VECNAME (G.Error DomainParser.DomainError)
+  | VENS (G.Error DomainParser.DomainError)
+  | VEMX (G.Error DomainParser.DomainError)
+  | VEPriority Int Int Int
+  | VESRV (G.Error DomainParser.DomainError)
+  | VEPort Int Int Int
+  | VEWeight Int Int Int
+  | VEDMARCpct Int Int Int
+  | VEDMARCri  Int Int Int
+
+  | VECAAflag  Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
+
+  -- SPF
+  | VESPFMechanismName (G.Error DomainParser.DomainError)
+  | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
+  | VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
+
+  | VESPFModifierName (G.Error DomainParser.DomainError)
+
+  | DKIMInvalidKeySize Int Int
+
+-- | The application accepts to add a few new entry types in a DNS zone.
+-- | Each resource record has a specific form, with dedicated inputs and
+-- | dedicated validation.
+data AcceptedRRTypes
+  = A
+  | AAAA
+  | TXT
+  | CNAME
+  | NS
+  | MX
+  | CAA
+  | SRV
+  | SPF
+  | DKIM
+  | DMARC
+
+derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
+
+instance showAcceptedRRTypes :: Show AcceptedRRTypes where
+  show = genericShow
+
+data TXTError
+  = TXTInvalidCharacter
+  | TXTTooLong Int Int -- max current

src/App/Type/ResourceRecord/SPF.purs

@@ -0,0 +1,145 @@
+module App.Type.ResourceRecord.SPF where
+
+import Prelude (($), (-), (<>), map, bind, pure, class Show)
+-- import Data.String (toLower)
+import Data.Generic.Rep (class Generic)
+import App.Type.GenericSerialization (generic_serialization)
+import Data.Show.Generic (genericShow)
+
+import Data.Array as A
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Either (Either(..))
+
+import Data.Codec.Argonaut (JsonCodec)
+import Data.Codec.Argonaut as CA
+import Data.Codec.Argonaut.Record as CAR
+import Data.Int (fromString)
+
+data Qualifier = Pass | Neutral | SoftFail | HardFail
+qualifiers :: Array Qualifier
+qualifiers = [Pass, Neutral, SoftFail, HardFail]
+qualifier_types :: Array String
+qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
+
+-- | Codec for just encoding a single value of type `Qualifier`.
+codecQualifier :: CA.JsonCodec Qualifier
+codecQualifier = CA.prismaticCodec "Qualifier" str_to_qualifier show_qualifier CA.string
+
+str_to_qualifier :: String -> Maybe Qualifier
+str_to_qualifier = case _ of
+  "pass"      -> Just Pass      -- +
+  "neutral"   -> Just Neutral   -- ?
+  "soft_fail" -> Just SoftFail  -- ~
+  "hard_fail" -> Just HardFail  -- -
+  _ -> Nothing
+
+show_qualifier :: Qualifier -> String
+show_qualifier = case _ of
+  Pass      -> "pass"
+  Neutral   -> "neutral"
+  SoftFail  -> "soft_fail"
+  HardFail  -> "hard_fail"
+
+type Mechanism
+  = { q :: Maybe Qualifier
+    , t :: MechanismType
+    , v :: String    -- Value (IP addresses or ranges, or domains).
+    }
+
+codecMechanism :: JsonCodec Mechanism
+codecMechanism = CA.object "Mechanism"
+  (CAR.record
+    { q: CAR.optional codecQualifier
+    , t: codecMechanismType
+    , v: CA.string
+    })
+
+-- TODO: this is debug code, before actual validation.
+to_mechanism :: String -> String -> String -> Maybe Mechanism
+to_mechanism q t v = do
+  mechanism_type <- str_to_mechanism_type t
+  pure { q: str_to_qualifier q, t: mechanism_type, v }
+to_modifier :: String -> String -> Maybe Modifier
+to_modifier t v = do
+  modifier_type <- str_to_modifier_type t
+  pure { t: modifier_type, v }
+
+-- | `show_modifier` acts like `show_mechanism` regarding the value (meaning: it can be discarded).
+-- | But this probably shouldn't since both values of modifiers actually NEED a value.
+show_modifier :: Modifier -> String
+show_modifier m =
+  let mtype = show_modifier_type m.t
+      value = case m.v of
+               "" -> ""
+               _  -> "=" <> m.v
+  in mtype <> value
+
+show_mechanism :: Mechanism -> String
+show_mechanism m =
+  let qualifier = case maybe "" show_qualifier_char m.q of
+                    "+" -> ""
+                    v      -> v
+      mtype = show_mechanism_type m.t
+      value = case m.v of
+               "" -> ""
+               _  -> "=" <> m.v
+  in qualifier <> mtype <> value
+
+show_qualifier_char :: Qualifier -> String
+show_qualifier_char = case _ of
+  Pass      -> "+"
+  Neutral   -> "?"
+  SoftFail  -> "~"
+  HardFail  -> "-"
+
+data MechanismType = A | IP4 | IP6 | MX | PTR | EXISTS | INCLUDE
+mechanism_types :: Array String
+mechanism_types = map show_mechanism_type [ A, IP4, IP6, MX, PTR, EXISTS, INCLUDE ]
+
+-- | Codec for just encoding a single value of type `MechanismType`.
+codecMechanismType :: CA.JsonCodec MechanismType
+codecMechanismType = CA.prismaticCodec "MechanismType" str_to_mechanism_type show_mechanism_type CA.string
+
+str_to_mechanism_type :: String -> Maybe MechanismType
+str_to_mechanism_type = case _ of
+  "a"         -> Just A
+  "ip4"       -> Just IP4
+  "ip6"       -> Just IP6
+  "mx"        -> Just MX
+  "ptr"       -> Just PTR
+  "exists"    -> Just EXISTS
+  "include"   -> Just INCLUDE
+  _ -> Nothing
+
+show_mechanism_type :: MechanismType -> String
+show_mechanism_type = case _ of
+  A       -> "a"
+  IP4     -> "ip4"
+  IP6     -> "ip6"
+  MX      -> "mx"
+  PTR     -> "ptr"
+  EXISTS  -> "exists"
+  INCLUDE -> "include"
+
+data ModifierType = EXP | REDIRECT
+modifier_types :: Array String
+modifier_types = ["exp", "redirect"]
+
+show_modifier_type :: ModifierType -> String
+show_modifier_type = case _ of
+  EXP      -> "exp"
+  REDIRECT -> "redirect"
+
+-- | Codec for just encoding a single value of type `ModifierType`.
+codecModifierType :: CA.JsonCodec ModifierType
+codecModifierType = CA.prismaticCodec "ModifierType" str_to_modifier_type show_modifier_type CA.string
+
+str_to_modifier_type :: String -> Maybe ModifierType
+str_to_modifier_type = case _ of
+  "exp"      -> Just EXP
+  "redirect" -> Just REDIRECT
+  _          -> Nothing
+
+type Modifier = { t :: ModifierType, v :: String  {- Value (domain). -} }
+codecModifier :: JsonCodec Modifier
+codecModifier = CA.object "Modifier" (CAR.record { t: codecModifierType, v: CA.string })

src/App/Validation/DNS.purs

@@ -10,11 +10,10 @@ import Data.String.CodeUnits as CU
 import Data.String as S
 import Data.Validation.Semigroup (V, invalid, toEither)
 
-import App.Type.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier)
-import App.Type.ResourceRecord (MechanismType(..), ModifierType(..)) as RR
+import App.Type.ResourceRecord as RR
+import App.Type.ResourceRecord.SPF as SPF
 import GenericParser.SomeParsers as SomeParsers
 import GenericParser.Parser as G
-import GenericParser.DomainParser.Common (DomainError) as DomainParser
 import GenericParser.DomainParser (name, sub_eof) as DomainParser
 import GenericParser.IPAddress as IPAddress
 import GenericParser.RFC5234 as RFC5234
@@ -23,50 +22,9 @@ import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
 import App.Type.CAA as CAA
 
--- | **History:**
--- | The module once used dedicated types for each type of RR.
--- | That comes with several advantages.
--- | First, type verification was a thing, and function were dedicated to a certain type of record.
--- | Second, these dedicated types used strings for their fields,
--- | which simplifies the typing when dealing with forms.
--- | Finally, the validation was a way to convert dedicated types (used in forms)
--- | to the general type (used for network serialization).
--- | This ensures each resource record is verified before being sent to `dnsmanagerd`.
--- |
--- | The problem is that, with dedicated types, you are then required to have dedicated functions.
--- | Conversion functions are also required.
--- |
--- | Maybe the code will change again in the future, but for now it will be enough.
+import Utils (id)
 
-data Error
-  = UNKNOWN
-  | VEIPv4 (G.Error IPAddress.IPv4Error)
-  | VEIPv6 (G.Error IPAddress.IPv6Error)
-  | VEName (G.Error DomainParser.DomainError)
-  | VETTL Int Int Int
-  | VETXT (G.Error TXTError)
-  | VECNAME (G.Error DomainParser.DomainError)
-  | VENS (G.Error DomainParser.DomainError)
-  | VEMX (G.Error DomainParser.DomainError)
-  | VEPriority Int Int Int
-  | VESRV (G.Error DomainParser.DomainError)
-  | VEPort Int Int Int
-  | VEWeight Int Int Int
-  | VEDMARCpct Int Int Int
-  | VEDMARCri  Int Int Int
-
-  | VECAAflag  Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
-
-  -- SPF
-  | VESPFMechanismName (G.Error DomainParser.DomainError)
-  | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
-  | VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
-
-  | VESPFModifierName (G.Error DomainParser.DomainError)
-
-  | DKIMInvalidKeySize Int Int
-
-type AVErrors = Array Error
+type AVErrors = Array RR.Error
 
 -- | Current default values.
 min_ttl      =     30 :: Int
@@ -92,93 +50,93 @@ type RRRetry    = Maybe Int
 type RRExpire   = Maybe Int
 type RRMinttl   = Maybe Int
 
-data TXTError
-  = TXTInvalidCharacter
-  | TXTTooLong Int Int -- max current
 -- | TODO: `txt_parser` is currently accepting any printable character (`vchar + sp`).
-txt_parser :: G.Parser TXTError String
+txt_parser :: G.Parser RR.TXTError String
 txt_parser = do pos <- G.current_position
                 v <- A.many (RFC5234.vchar <|> RFC5234.sp)
                 e <- G.tryMaybe SomeParsers.eof
                 pos2 <- G.current_position
                 case e of
-                  Nothing -> G.errorParser $ Just TXTInvalidCharacter
+                  Nothing -> G.errorParser $ Just RR.TXTInvalidCharacter
                   Just _ -> do
                     let nbchar = pos2 - pos
                     if nbchar < max_txt
                     then pure $ CU.fromCharArray v
-                    else G.Parser \_ -> G.failureError pos (Just $ TXTTooLong max_txt nbchar)
+                    else G.Parser \_ -> G.failureError pos (Just $ RR.TXTTooLong max_txt nbchar)
 
 -- | `parse` enables to run any parser based on `GenericParser` and provide a validation error.
 -- | The actual validation error contains the parser's error including the position.
-parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v
+parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> RR.Error) -> V (Array RR.Error) v
 parse (G.Parser p) str c = case p { string: str, position: 0 } of
   Left x  -> invalid $ [c x]
   Right x -> pure x.result
 
-validationA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationA :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationA form = ado
-  name   <- parse DomainParser.name form.name   VEName
-  ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
-  target <- parse IPAddress.ipv4       form.target VEIPv4
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target
-             , token = form.token }
+  name   <- parse DomainParser.name form.name      RR.VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl    RR.VETTL
+  target <- parse IPAddress.ipv4       form.target RR.VEIPv4
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A"
+                , name = name, ttl = ttl, target = target, token = form.token }
 
-validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationAAAA :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationAAAA form = ado
-  name   <- parse DomainParser.name form.name VEName
-  ttl    <- is_between min_ttl max_ttl form.ttl  VETTL
+  name   <- parse DomainParser.name form.name    RR.VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl  RR.VETTL
   -- use read_input to get unaltered input (the IPv6 parser expands the input)
-  target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target
-             , token = form.token }
+  target <- parse (G.read_input IPAddress.ipv6) form.target RR.VEIPv6
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA"
+                , name = name, ttl = ttl, target = target, token = form.token }
 
-validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord
+validationTXT :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationTXT form = ado
-  name   <- parse DomainParser.name form.name   VEName
-  ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
-  target <- parse txt_parser           form.target VETXT
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target }
+  name   <- parse DomainParser.name form.name      RR.VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl    RR.VETTL
+  target <- parse txt_parser           form.target RR.VETXT
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT"
+                , name = name, ttl = ttl, target = target }
 
-validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord
+validationCNAME :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationCNAME form = ado
-  name   <- parse DomainParser.name form.name VEName
-  ttl    <- is_between min_ttl max_ttl form.ttl      VETTL
-  target <- parse DomainParser.sub_eof form.target VECNAME
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target }
+  name   <- parse DomainParser.name form.name      RR.VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl    RR.VETTL
+  target <- parse DomainParser.sub_eof form.target RR.VECNAME
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME"
+                , name = name, ttl = ttl, target = target }
 
-validationNS :: ResourceRecord -> V (Array Error) ResourceRecord
+validationNS :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationNS form = ado
-  name   <- parse DomainParser.name form.name   VEName
-  ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
-  target <- parse DomainParser.sub_eof form.target VENS
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target }
+  name   <- parse DomainParser.name form.name      RR.VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl    RR.VETTL
+  target <- parse DomainParser.sub_eof form.target RR.VENS
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS"
+                , name = name, ttl = ttl, target = target }
 
-is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int
+is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> RR.Error) -> V (Array RR.Error) Int
 is_between min max n ve = if between min max n
                           then pure n
                           else invalid [ve min max n]
 
-validationMX :: ResourceRecord -> V (Array Error) ResourceRecord
+validationMX :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationMX form = ado
-  name     <- parse DomainParser.name form.name     VEName
-  ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
-  target   <- parse DomainParser.sub_eof form.target   VEMX
-  priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
-             , name = name, ttl = ttl, target = target, priority = Just priority }
+  name     <- parse DomainParser.name form.name        RR.VEName
+  ttl      <- is_between min_ttl max_ttl form.ttl      RR.VETTL
+  target   <- parse DomainParser.sub_eof form.target   RR.VEMX
+  priority <- is_between min_priority max_priority (maybe 0 id form.priority) RR.VEPriority
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
+                , name = name, ttl = ttl, target = target, priority = Just priority }
 
-validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord
+validationSRV :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationSRV form = ado
-  name     <- parse DomainParser.name form.name     VEName
-  ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
-  target   <- parse DomainParser.sub_eof form.target   VESRV
-  priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
-  port     <- is_between min_port max_port (maybe 0 id form.port)       VEPort
-  weight   <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
-             , name = name, ttl = ttl, target = target
-             , priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
+  name     <- parse DomainParser.name form.name        RR.VEName
+  ttl      <- is_between min_ttl max_ttl form.ttl      RR.VETTL
+  target   <- parse DomainParser.sub_eof form.target   RR.VESRV
+  priority <- is_between min_priority max_priority (maybe 0 id form.priority) RR.VEPriority
+  port     <- is_between min_port max_port (maybe 0 id form.port)       RR.VEPort
+  weight   <- is_between min_weight max_weight (maybe 0 id form.weight) RR.VEWeight
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
+                , name = name, ttl = ttl, target = target
+                , priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
 
 -- My version of "map" lol.
 verification_loop :: forall a e. (a -> V (Array e) a) -> Array a -> V (Array e) (Array a)
@@ -212,53 +170,53 @@ or_nothing p = do v <- G.tryMaybe p
 -- | Also, some of them should accept a CIDR, which currently isn't a thing.
 -- |
 -- | TODO: I don't intend to implement the full RFC7208, but accepting CIDR can be done.
-validate_SPF_mechanism :: Mechanism -> V (Array Error) Mechanism
+validate_SPF_mechanism :: SPF.Mechanism -> V (Array RR.Error) SPF.Mechanism
 validate_SPF_mechanism m = case m.t of
   -- RFC: `a         = "a"      [ ":" domain-spec ] [ dual-cidr-length ]`
-  RR.A       -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+  SPF.A       -> test (or_nothing DomainParser.sub_eof)          RR.VESPFMechanismName
 
   -- RFC: `mx        = "mx"     [ ":" domain-spec ] [ dual-cidr-length ]`
-  RR.MX      -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+  SPF.MX      -> test (or_nothing DomainParser.sub_eof)          RR.VESPFMechanismName
 
   -- RFC: `exists    = "exists"   ":" domain-spec`
-  RR.EXISTS  -> test DomainParser.sub_eof                       VESPFMechanismName
+  SPF.EXISTS  -> test DomainParser.sub_eof                       RR.VESPFMechanismName
 
   -- RFC: `ptr       = "ptr"    [ ":" domain-spec ]`
-  RR.PTR     -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+  SPF.PTR     -> test (or_nothing DomainParser.sub_eof)          RR.VESPFMechanismName
 
   -- RFC: `ip4       = "ip4"      ":" ip4-network   [ ip4-cidr-length ]`
-  RR.IP4     -> test (IPAddress.ipv4_range <|> IPAddress.ipv4)  VESPFMechanismIPv4
+  SPF.IP4     -> test (IPAddress.ipv4_range <|> IPAddress.ipv4)  RR.VESPFMechanismIPv4
 
   -- RFC: `ip6       = "ip6"      ":" ip6-network   [ ip6-cidr-length ]`
-  RR.IP6     -> test (IPAddress.ipv6_range <|> IPAddress.ipv6)  VESPFMechanismIPv6
+  SPF.IP6     -> test (IPAddress.ipv6_range <|> IPAddress.ipv6)  RR.VESPFMechanismIPv6
 
   -- RFC: `include   = "include"  ":" domain-spec`
-  RR.INCLUDE -> test DomainParser.sub_eof                       VESPFMechanismName
+  SPF.INCLUDE -> test DomainParser.sub_eof                       RR.VESPFMechanismName
 
   where
-  test :: forall e. G.Parser e String -> ((G.Error e) -> Error) -> V (Array Error) Mechanism
+  test :: forall e. G.Parser e String -> ((G.Error e) -> RR.Error) -> V (Array RR.Error) SPF.Mechanism
   test p e = ado
     name <- parse p m.v e
     in first m name -- name is discarded
 
-validate_SPF_modifier :: Modifier -> V (Array Error) Modifier
+validate_SPF_modifier :: SPF.Modifier -> V (Array RR.Error) SPF.Modifier
 validate_SPF_modifier m = case m.t of
-  RR.EXP -> ado
-    name <- parse DomainParser.sub_eof m.v VESPFModifierName
+  SPF.EXP -> ado
+    name <- parse DomainParser.sub_eof m.v RR.VESPFModifierName
     in first m name -- name is discarded
-  RR.REDIRECT -> ado
-    name <- parse DomainParser.sub_eof m.v VESPFModifierName
+  SPF.REDIRECT -> ado
+    name <- parse DomainParser.sub_eof m.v RR.VESPFModifierName
     in first m name -- name is discarded
 
-validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
+validationSPF :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationSPF form = ado
-  name     <- parse DomainParser.name form.name     VEName
-  ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
+  name     <- parse DomainParser.name form.name   RR.VEName
+  ttl      <- is_between min_ttl max_ttl form.ttl RR.VETTL
   mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms)
   modifiers  <- verification_loop validate_SPF_modifier  (maybe [] id form.modifiers)
   -- No need to validate the target, actually, it will be completely discarded.
   -- The different specific entries replace `target` completely.
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
+  in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
              , name = name, ttl = ttl, target = "" -- `target` is discarded!
              , v = form.v, mechanisms = Just mechanisms
              , modifiers = Just modifiers, q = form.q }
@@ -278,64 +236,64 @@ rsa_max_key_size = 1000 :: Int
 -- | This key is converted directly in base64, leading to a simple 44-byte key representation.
 ed25519_key_size = 44 :: Int
 
-verify_public_key :: DKIM.SignatureAlgorithm -> DKIM.PublicKey -> V (Array Error) DKIM.PublicKey
+verify_public_key :: DKIM.SignatureAlgorithm -> DKIM.PublicKey -> V (Array RR.Error) DKIM.PublicKey
 verify_public_key signalgo key = case signalgo of
   DKIM.RSA -> ado
     k <- if between rsa_min_key_size rsa_max_key_size (S.length key)
          then pure key
-         else invalid [DKIMInvalidKeySize rsa_min_key_size rsa_max_key_size]
+         else invalid [RR.DKIMInvalidKeySize rsa_min_key_size rsa_max_key_size]
     in k
   DKIM.ED25519 -> ado
     k <- if S.length key == ed25519_key_size
          then pure key
-         else invalid [DKIMInvalidKeySize ed25519_key_size ed25519_key_size]
+         else invalid [RR.DKIMInvalidKeySize ed25519_key_size ed25519_key_size]
     in k
 
-validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord
+validationDKIM :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationDKIM form =
   let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim
   in ado
-    name     <- parse DomainParser.name form.name     VEName
-    ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
+    name     <- parse DomainParser.name form.name   RR.VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl RR.VETTL
     -- TODO: v n
     p        <- verify_public_key (fromMaybe DKIM.RSA dkim.k) dkim.p
     -- No need to validate the target, actually, it will be completely discarded.
     -- The different specific entries replace `target` completely.
-    in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DKIM"
+    in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DKIM"
                , name = name, ttl = ttl, target = "" -- `target` is discarded!
                , dkim = Just $ dkim { p = p } }
 
-validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord
+validationDMARC :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationDMARC form =
   let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc
   in ado
-    name     <- parse DomainParser.name form.name     VEName
-    ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
-    pct      <- is_between 0 100      (fromMaybe 100   dmarc.pct) VEDMARCpct
-    ri       <- is_between 0 1000000  (fromMaybe 86400 dmarc.ri)  VEDMARCri
+    name     <- parse DomainParser.name form.name   RR.VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl RR.VETTL
+    pct      <- is_between 0 100      (fromMaybe 100   dmarc.pct) RR.VEDMARCpct
+    ri       <- is_between 0 1000000  (fromMaybe 86400 dmarc.ri)  RR.VEDMARCri
     -- No need to validate the target, actually, it will be completely discarded.
     -- The different specific entries replace `target` completely.
-    in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DMARC"
+    in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DMARC"
                , name = name, ttl = ttl, target = "" -- `target` is discarded!
                , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
 
-validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationCAA :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
 validationCAA form =
   let caa = fromMaybe CAA.emptyCAARR form.caa
   in ado
-    name     <- parse DomainParser.name form.name  VEName
-    ttl      <- is_between min_ttl max_ttl form.ttl   VETTL
-    flag     <- is_between 0 255           caa.flag   VECAAflag
+    name     <- parse DomainParser.name form.name   RR.VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl RR.VETTL
+    flag     <- is_between 0 255           caa.flag RR.VECAAflag
     -- TODO: verify the `value` field.
     -- No need to validate the target, actually, it will be completely discarded.
     -- The different specific entries replace `target` completely.
-    in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CAA"
+    in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CAA"
                , name = name, ttl = ttl, target = "" -- `target` is discarded!
                , caa = Just $ caa { flag = flag } }
 
 
 -- | `validation` provides a way to validate the content of a RR.
-validation :: ResourceRecord -> Either (Array Error) ResourceRecord
+validation :: RR.ResourceRecord -> Either (Array RR.Error) RR.ResourceRecord
 validation entry = case entry.rrtype of
   "A"     -> toEither $ validationA     entry
   "AAAA"  -> toEither $ validationAAAA  entry
@@ -348,7 +306,4 @@ validation entry = case entry.rrtype of
   "SPF"   -> toEither $ validationSPF   entry
   "DKIM"  -> toEither $ validationDKIM  entry
   "DMARC" -> toEither $ validationDMARC entry
-  _       -> toEither $ invalid [UNKNOWN]
-
-id :: forall a. a -> a
-id x = x
+  _       -> toEither $ invalid [RR.UNKNOWN]

src/App/Validation/Delegation.purs

@@ -0,0 +1,28 @@
+module App.Validation.Delegation where
+
+import Prelude (apply, map, pure, ($))
+
+import Data.Either (Either(..))
+import Data.Validation.Semigroup (V, invalid, toEither)
+
+import GenericParser.Parser as G
+import GenericParser.DomainParser (name) as DomainParser
+
+import App.Type.Delegation (mkEmptyDelegationForm, Form, Error(..)) as Delegation
+
+-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error.
+-- | The actual validation error contains the parser's error including the position.
+parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Delegation.Error) -> V (Array Delegation.Error) v
+parse (G.Parser p) str c = case p { string: str, position: 0 } of
+  Left x  -> invalid $ [c x]
+  Right x -> pure x.result
+
+validation_nameservers :: Delegation.Form -> V (Array Delegation.Error) Delegation.Form
+validation_nameservers form = ado
+  nameserver1 <- parse DomainParser.name form.nameserver1 Delegation.VENameServer1
+  nameserver2 <- parse DomainParser.name form.nameserver2 Delegation.VENameServer2
+  in Delegation.mkEmptyDelegationForm { nameserver1 = nameserver1, nameserver2 = nameserver2 }
+
+-- | `validation` verifies the domain names of the provided name servers for the delegation.
+validation :: Delegation.Form -> Either (Array Delegation.Error) Delegation.Form
+validation entry = toEither $ validation_nameservers entry

src/Bulma.purs

@@ -1,979 +0,0 @@
--- | The `Bulma` module is a wrapper around the BULMA css framework.
-module Bulma where
-import Prelude (class Show, map, show, ($), (<>), (==))
-
-import Data.Maybe (Maybe, fromMaybe)
-import Data.Tuple (Tuple, fst, snd)
-import Halogen.HTML as HH
-import DOM.HTML.Indexed as DHI
-import Halogen.HTML.Properties as HP
-import Halogen.HTML.Events as HE
-
-import DOM.HTML.Indexed.AutocompleteType (AutocompleteType(..))
-import CSSClasses as C
-
-import Halogen.HTML.Core (AttrName(..))
--- import Web.Event.Event (type_, Event, EventType(..))
--- import Web.UIEvent.MouseEvent (MouseEvent) -- package web-uievents
-
-checkbox :: forall w i. Array (HH.HTML w i) -> i -> HH.HTML w i
-checkbox content_ action
-  = HH.label
-    [ HP.classes [C.label] ] $ [ HH.input [ HE.onValueInput \ _ -> action, HP.type_ HP.InputCheckbox ] ] <> content_
--- <label class="checkbox">
---   <input type="checkbox" />
---   I agree to the <a href="#">terms and conditions</a>
--- </label>
-
-outside_link :: forall w i. Array HH.ClassName -> String -> String -> HH.HTML w i
-outside_link classes url title = HH.a [ HP.classes classes, HP.target "_blank", HP.href url ] [ HH.text title ]
-
-columns :: forall (w :: Type) (i :: Type).
-  Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-columns classes = HH.div [ HP.classes ([C.columns] <> classes) ]
-
-columns_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
-columns_ = columns []
-
-column :: forall (w :: Type) (i :: Type).
-  Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-column classes = HH.div [ HP.classes ([C.column] <> classes) ]
-
-column_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
-column_ = column []
-
-h1 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
-h1 title = HH.h1 [ HP.classes [C.title] ] [ HH.text title ]
-
-h3 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
-h3 title = HH.h3 [ HP.classes [C.title, C.is5] ] [ HH.text title ]
-
-h4 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
-h4 title = HH.h4 [ HP.classes [C.title, C.is5] ] [ HH.text title ]
-
-zone_rr_title :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
-zone_rr_title title
-  = HH.h3 [ HP.classes [C.title, C.is5, C.has_text_light, C.has_background_dark] ]
-          [ HH.text title ]
-
-subtitle :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
-subtitle title = HH.h2 [ HP.classes [C.subtitle, C.is4] ] [ HH.text title ]
-
-hdiv :: forall (w :: Type) (a :: Type). Array (HH.HTML w a) -> HH.HTML w a
-hdiv = HH.div [ HP.classes [HH.ClassName "mt-5"] ]
-
---offcolumn :: forall (w :: Type) (a :: Type).
---  Int -> Int -> Array (HH.HTML w a) -> HH.HTML w a
---offcolumn 0      size = HH.div [ HP.classes [HH.ClassName ("mt-"<>show size)] ]
---offcolumn offset size
---  = column [ HH.ClassName ("is-offset-" <> (show offset) <> " is-" <> (show size)) ]
-
-input_classes :: Array HH.ClassName
-input_classes = [C.input, C.is_small, C.is_info]
-
-table :: forall w i. HH.Node DHI.HTMLtable w i
-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_ 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
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ]
-                       , HH.th_ [ HH.text "Type" ]
-                       , HH.th_ [ HH.text "Value" ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-modifier_table_header :: forall w i. HH.HTML w i
-modifier_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type"  ]
-                       , HH.th_ [ HH.text "Value"   ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-dmarc_dmarcuri_table_header :: forall w i. HH.HTML w i
-dmarc_dmarcuri_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ]
-                       , HH.th_ [ HH.text "Report size limit" ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-name_header :: forall w i. HH.HTML w i
-name_header = HH.abbr
-  [ HP.title "Name of the DNS entry, the fully-qualified-domain-name is <name>.<domain>." ]
-  [ HH.text "Name" ]
-
-ttl_header :: forall w i. HH.HTML w i
-ttl_header = HH.abbr
-  [ HP.title "Time-to-Live, nb seconds before being considered invalid" ]
-  [ HH.text "TTL" ]
-
-target_header :: forall w i. HH.HTML w i
-target_header = HH.abbr
-  [ HP.title "In the DNS jargon, the target means the most important value associated with the entry, for an A entry it would be an IPv4 address, for example" ]
-  [ HH.text "Target" ]
-
-token_header :: forall w i. HH.HTML w i
-token_header = HH.abbr
-  [ HP.title "Tokens are used to update the entry, see the tab: \"Tokens? 🤨\"" ]
-  [ HH.text "Token" ]
-
-priority_header :: forall w i. HH.HTML w i
-priority_header = HH.abbr
-  [ HP.title "A numeric value that indicates the preference of the server (lower values indicate higher priority)" ]
-  [ HH.text "Priority" ]
-
-weight_header :: forall w i. HH.HTML w i
-weight_header = HH.abbr
-  [ HP.title "A relative weight used when multiple servers have the same priority, determining how often they should be used" ]
-  [ HH.text "Weight" ]
-
-srv_mechanisms_header :: forall w i. HH.HTML w i
-srv_mechanisms_header = HH.abbr
-  [ HP.title "Mechanisms specify which mail servers are allowed to send mail for the domain and how to evaluate the sending mail server’s IP address" ]
-  [ HH.text "Mechanisms" ]
-
-srv_modifiers_header :: forall w i. HH.HTML w i
-srv_modifiers_header = HH.abbr
-  [ HP.title "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain" ]
-  [ HH.text "Modifiers" ]
-
-srv_default_policy_header :: forall w i. HH.HTML w i
-srv_default_policy_header = HH.abbr
-  [ HP.title "" ]
-  [ HH.text "Default Policy" ]
-
-protocol_header :: forall w i. HH.HTML w i
-protocol_header = HH.abbr
-  [ HP.title "The related communication protocol, either TCP or UDP (want more? Just ask me)" ]
-  [ HH.text "Protocol" ]
-
-port_header :: forall w i. HH.HTML w i
-port_header = HH.abbr
-  [ HP.title "Related connection port" ]
-  [ HH.text "Port" ]
-
-dkim_notes_header :: forall w i. HH.HTML w i
-dkim_notes_header = HH.abbr
-  [ HP.title "Arbitrary string related to this cryptographic material" ]
-  [ HH.text "Notes" ]
-
-dmarc_policy_header :: forall w i. HH.HTML w i
-dmarc_policy_header = HH.abbr
-  [ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
-  [ HH.text "Policy" ]
-
-dmarc_subdom_policy_header :: forall w i. HH.HTML w i
-dmarc_subdom_policy_header = HH.abbr
-  [ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
-  [ HH.text "Subdomain Policy" ]
-
-dmarc_dkim_policy_header :: forall w i. HH.HTML w i
-dmarc_dkim_policy_header = HH.abbr
-  [ HP.title "What should be considered acceptable to do with an email not conforming with DKIM" ]
-  [ HH.text "DKIM Policy" ]
-
-dmarc_spf_policy_header :: forall w i. HH.HTML w i
-dmarc_spf_policy_header = HH.abbr
-  [ HP.title "What should be considered acceptable to do with an email not conforming with SPF" ]
-  [ HH.text "SPF Policy" ]
-
-dmarc_sample_rate_header :: forall w i. HH.HTML w i
-dmarc_sample_rate_header = HH.abbr
-  [ HP.title "Percentage of messages subjected to the requested policy [0-100]" ]
-  [ HH.text "Sample Rate" ]
-
-dmarc_report_on_header :: forall w i. HH.HTML w i
-dmarc_report_on_header = HH.abbr
-  [ HP.title "What error should be reported? DKIM, SPF, Both, Any or None?" ]
-  [ HH.text "Report on" ]
-
-dmarc_report_interval_header :: forall w i. HH.HTML w i
-dmarc_report_interval_header = HH.abbr
-  [ HP.title "Minimal duration between two DMARC reports (in seconds)" ]
-  [ HH.text "Report interval" ]
-
-simple_table_header :: forall w i. HH.HTML w i
-simple_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ]
-                       , HH.th_ [ name_header ]
-                       , HH.th_ [ ttl_header ]
-                       , HH.th_ [ target_header ]
-                       , HH.th_ [ HH.text "" ]
-                       , HH.th_ [ token_header ]
-                       ]
-              ]
-
-simple_table_header_ro :: forall w i. HH.HTML w i
-simple_table_header_ro
-  = HH.thead_ [ HH.tr [ HP.classes [C.has_background_warning_light] ]
-                       [ HH.th  [ HP.style "width: 50px;" ] [ HH.text "Type"  ]
-                       , HH.th_ [ name_header ]
-                       , HH.th_ [ ttl_header ]
-                       , HH.th_ [ target_header ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-mx_table_header :: forall w i. HH.HTML w i
-mx_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
-                       , HH.th_ [ ttl_header ]
-                       , HH.th_ [ priority_header ]
-                       , HH.th_ [ target_header ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-caa_table_header :: forall w i. HH.HTML w i
-caa_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
-                       , HH.th_ [ ttl_header ]
-                       , HH.th_ [ HH.text "Flag" ]
-                       , HH.th_ [ HH.text "Tag" ]
-                       , HH.th_ [ HH.text "Value" ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-srv_table_header :: forall w i. HH.HTML w i
-srv_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
-                       , HH.th_ [ protocol_header ]
-                       , HH.th_ [ target_header ]
-                       , HH.th_ [ port_header ]
-                       , HH.th_ [ ttl_header ]
-                       , HH.th_ [ priority_header ]
-                       , HH.th_ [ weight_header ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-spf_table_header :: forall w i. HH.HTML w i
-spf_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
-                       , HH.th_ [ ttl_header ]
-                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed.
-                       , HH.th_ [ srv_mechanisms_header ]
-                       , HH.th_ [ srv_modifiers_header ]
-                       , HH.th_ [ srv_default_policy_header ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-dkim_table_header :: forall w i. HH.HTML w i
-dkim_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
-                       , HH.th_ [ ttl_header ]
-                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DKIM1.
-                       , HH.th_ [ HH.text "Hash algo" ]
-                       , HH.th_ [ HH.text "Signature algo" ]
-                       , HH.th_ [ HH.text "Public Key" ]
-                       , HH.th_ [ dkim_notes_header ]
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-dmarc_table_header :: forall w i. HH.HTML w i
-dmarc_table_header
-  = HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
-                       , HH.th_ [ ttl_header ]
-                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DMARC1.
-                       , HH.th_ [ dmarc_policy_header ]          -- p
-                       , HH.th_ [ dmarc_subdom_policy_header ]   -- sp
-                       , HH.th_ [ dmarc_dkim_policy_header ]     -- adkim
-                       , HH.th_ [ dmarc_spf_policy_header ]      -- aspf
-                       , HH.th_ [ dmarc_sample_rate_header ]     -- pct
-                       , HH.th_ [ dmarc_report_on_header ]       -- fo
-                       , HH.th_ [ dmarc_report_interval_header ] -- ri
-                       -- TODO? rua & ruf
-                       -- , HH.th_ [ HH.text "Accepted report formats" ] -- For now, assume AFRF.
-                       , HH.th_ [ HH.text "" ]
-                       ]
-              ]
-
-name_soa_header :: forall w i. HH.HTML w i
-name_soa_header = HH.abbr
-  [ HP.title "Your actual domain name (technical term: \"fully qualified domain name\")." ]
-  [ HH.text "Name" ]
-
-mname_soa_header :: forall w i. HH.HTML w i
-mname_soa_header = HH.abbr
-  [ HP.title "Domain name of the primary authoritative DNS server for the zone (SOA \"MNAME\" field)." ]
-  [ HH.text "Primary NS" ]
-
-rname_soa_header :: forall w i. HH.HTML w i
-rname_soa_header = HH.abbr
-  [ HP.title "The email address of the person responsible for managing the zone (the \"@\" is replaced by \".\" for some reason). This is the SOA \"RNAME\" field." ]
-  [ HH.text "Contact" ]
-
-serial_soa_header :: forall w i. HH.HTML w i
-serial_soa_header = HH.abbr
-  [ HP.title "A number that is incremented every time the zone is updated. Secondary DNS servers use this number to check for updates." ]
-  [ HH.text "Serial" ]
-
-refresh_soa_header :: forall w i. HH.HTML w i
-refresh_soa_header = HH.abbr
-  [ HP.title "The interval (in seconds) at which secondary DNS servers should check the primary server for changes to the zone." ]
-  [ HH.text "Refresh" ]
-
-retry_soa_header :: forall w i. HH.HTML w i
-retry_soa_header = HH.abbr
-  [ HP.title "The time in seconds that secondary servers should wait before retrying a failed attempt to contact the primary DNS server." ]
-  [ HH.text "Retry" ]
-
-expire_soa_header :: forall w i. HH.HTML w i
-expire_soa_header = HH.abbr
-  [ HP.title "The time in seconds that secondary DNS servers will keep the zone data before discarding it if they cannot contact the primary server." ]
-  [ HH.text "Expire" ]
-
-minttl_soa_header :: forall w i. HH.HTML w i
-minttl_soa_header = HH.abbr
-  [ HP.title "The minimum time (in seconds) that other DNS servers should cache negative responses (e.g., for non-existent domain names)." ]
-  [ HH.text "Minimum TTL" ]
-
-soa_table_header :: forall w i. HH.HTML w i
-soa_table_header
-  = HH.thead_ [ HH.tr [ HP.classes [C.has_background_warning_light] ]
-                      [ HH.th_ [ name_soa_header ]
-                      , HH.th_ [ ttl_header ]
-                      , HH.th_ [ mname_soa_header ]
-                      , HH.th_ [ rname_soa_header ]
-                      , HH.th_ [ serial_soa_header ]
-                      , HH.th_ [ refresh_soa_header ]
-                      , HH.th_ [ retry_soa_header ]
-                      , HH.th_ [ expire_soa_header ]
-                      , HH.th_ [ minttl_soa_header ]
-                      ]
-              ]
-
-txt_name :: forall w i. String -> HH.HTML w i
-txt_name t
-  = HH.td  [ rr_name_style ] [ rr_name_text ]
-  where
-    rr_name_style = HP.style "width: 80px;"
-    rr_name_text  = HH.text t
-
-textarea_ :: forall w i. Array HH.ClassName -> String -> String -> (String -> i) -> HH.HTML w i
-textarea_ classes placeholder value action
-  = HH.textarea
-      [ HE.onValueInput action
-      , HP.value value
-      , HP.placeholder placeholder
-      , HP.classes $ [C.textarea] <> classes
-      ]
-
-textarea :: forall w i. String ->  String -> (String -> i) -> HH.HTML w i
-textarea placeholder value action = textarea_ [] placeholder value action
-
-btn_abbr_ :: forall w action.
-     Array HH.ClassName -- button classes
-  -> Array HH.ClassName -- inner div classes
-  -> String
-  -> String
-  -> action
-  -> HH.HTML w action
-btn_abbr_ btnclasses divclasses explanation_ title action
-  = HH.button
-      [ HE.onClick \_ -> action
-      , HP.classes $ [C.button] <> btnclasses
-      ] [ HH.abbr [ HP.title explanation_ ] [ HH.div [ HP.classes divclasses ] [ HH.text title ] ] ]
-
-btn_abbr :: forall w action. String -> String -> action -> HH.HTML w action
-btn_abbr explanation_ title action = btn_abbr_ [] [] explanation_ title action
-
-alert_btn_abbr :: forall w action. String -> String -> action -> HH.HTML w action
-alert_btn_abbr explanation_ title action = btn_abbr_ [C.is_danger] [] explanation_ title action
-
-btn_modify :: forall w i. i -> HH.HTML w i
-btn_modify action = btn_abbr_ [C.is_small, C.is_info] [C.is_size 4] "Edit" "⚒" action
-
-btn_save :: forall w i. i -> HH.HTML w i
-btn_save action = btn_ [C.is_info] "Save" action
-
-btn_add :: forall w i. i -> HH.HTML w i
-btn_add action = btn_ [C.is_info] "Add" action
-
-btn_delete :: forall w i. i -> HH.HTML w i
-btn_delete action = btn_abbr_ [C.is_small, C.is_danger] [C.is_size 4] "Delete" "✖" action
-
-btn_modify_ro :: forall w i. HH.HTML w i
-btn_modify_ro = btn_ro [C.is_small, C.is_warning] "modify"
-
-btn_readonly :: forall w i. HH.HTML w i
-btn_readonly = btn_ro [C.is_small, C.is_warning] "read only"
-
-btn_delete_ro :: forall w i. HH.HTML w i
-btn_delete_ro = btn_ro [C.is_small, C.is_warning] "remove"
-
-btn_ro :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
-btn_ro classes title
-  = HH.button
-      [ HP.classes $ [C.button] <> classes
-      ] [ HH.text title ]
-
--- | Create a `level`, different components that should appear on the same horizontal line.
--- | First argument, elements that should appear on the left, second on the right.
-level :: forall w i. Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
-level left right = HH.nav [ HP.classes [C.level] ]
-                          [ HH.div [ HP.classes [C.level_left]  ] $ itemize left
-                          , HH.div [ HP.classes [C.level_right] ] $ itemize right
-                          ]
-   where itemize = map (\v -> HH.div [ HP.classes [C.level_item] ] [v])
-
-btn_ :: forall w action. Array HH.ClassName -> String -> action -> HH.HTML w action
-btn_ classes title action
-  = HH.button
-      [ HE.onClick \_ -> action
-      , HP.classes $ [C.button] <> classes
-      ] [ HH.text title ]
-
-btn :: forall w action. String -> action -> HH.HTML w action
-btn title action = btn_ [] title action
-
-alert_btn :: forall w action. String -> action -> HH.HTML w action
-alert_btn title action = btn_ [C.is_danger] title action
-
-render_input :: forall w i.
-  Boolean -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
-render_input password id placeholder action value cond
-  = HH.input $
-      [ HE.onValueInput action
-      , HP.value value
-      , HP.placeholder placeholder
-      , HP.classes $ input_classes
-      , HP.id id
-      , cond
-      ] <> case password of
-        false -> []
-        true -> [ HP.type_ HP.InputPassword ]
-
--- | Bulma's `field`, which contains an array of `Halogen.HTML` entries.
--- | Two entries are expected: a field label (`div_field_label`) and a field content (`div_field_content`).
-div_field :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-div_field classes = HH.div [HP.classes ([C.field, C.is_horizontal] <> classes)]
-
--- | Field label (id and title) for a Bulma `field`.
-div_field_label :: forall w i. String -> String -> HH.HTML w i
-div_field_label id title = HH.div [HP.classes [C.field_label, C.normal]]
-                                  [HH.label [ HP.classes [C.label], HP.for id ] [ HH.text title ]]
-
--- | Any `Halogen.HTML` data in Bulma `field-body > field > control` divs.
-div_field_content :: forall w i. HH.HTML w i -> HH.HTML w i
-div_field_content content
-  = HH.div [ HP.classes [C.field_body] ]
-           [ HH.div [HP.classes [C.field] ] [ HH.div [HP.classes [C.control] ] [ content ] ] ]
-
--- | Basic field entry with a title and a field content.
--- |
--- |```
--- |div [field is-horizontal]
--- |  div [field-label is-normal]
--- |    label [for-id]
--- |      text
--- |  div [field-body]
--- |    div [field]
--- |      div [control]
--- |```
-field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
-field_entry id title entry
-  = div_field []
-      [ div_field_label id title
-      , div_field_content entry
-      ]
-
--- | Error field entry with a title and a field content.
-error_field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
-error_field_entry id title entry
-  = div_field [C.has_background_danger_light]
-      [ div_field_label id title
-      , div_field_content entry
-      ]
-
-error_box :: forall w i. String -> String -> String -> HH.HTML w i
-error_box id title value = error_field_entry id title $ notification_danger' value
-
-field_inner :: forall w i.
-  Boolean -> (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-field_inner ispassword cond id title placeholder action value
-  = field_entry id title $ render_input ispassword id placeholder action value cond
-
-div_field_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-div_field_ classes = HH.div [ HP.classes ([C.field] <> classes) ]
-
-btn_labeled :: forall w i. String -> String -> String -> i -> HH.HTML w i
-btn_labeled id title button_text action
-  = field_entry id title $ HH.button
-      [ HE.onClick \_ -> action
-      , HP.classes [C.button, C.is_small, C.is_info]
-      , HP.id id
-      ] [ HH.text button_text ]
-
-box_input_ :: forall w i.
-  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-box_input_ = field_inner false
-
-box_password_ :: forall w i.
-  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-box_password_ = field_inner true
-
-box_input :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-box_input = box_input_ (HP.enabled true)
-
-username_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
-username_input title value action
-  = div_field []
-      [ div_field_label "username" title
-      , div_field_content $ HH.input
-        [ HE.onValueInput action
-        , HP.type_ HP.InputText
-        , HP.value value
-        , HP.name "username"
-        , HP.autocomplete AutocompleteUsername
-        , HP.placeholder "Username"
-        , HP.id "username"
-        , HP.classes input_classes
-        ]
-      ]
-
-email_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
-email_input title value action
-  = div_field []
-      [ div_field_label "email" title
-      , div_field_content $ HH.input
-        [ HE.onValueInput action
-        , HP.type_ HP.InputEmail
-        , HP.value value
-        , HP.name "email"
-        , HP.autocomplete AutocompleteEmail
-        , HP.placeholder "email@example.com"
-        , HP.id "email"
-        , HP.classes input_classes
-        ]
-      ]
-
-password_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
-password_input title value action
-  = div_field []
-      [ div_field_label "password" title
-      , div_field_content $ HH.input
-        [ HE.onValueInput action
-        , HP.type_ HP.InputPassword
-        , HP.value value
-        , HP.name "password"
-        , HP.autocomplete AutocompleteCurrentPassword
-        , HP.placeholder ""
-        , HP.id "password"
-        , HP.classes input_classes
-        ]
-      ]
-
-password_input_new :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
-password_input_new title value action
-  = div_field []
-      [ div_field_label "password" title
-      , div_field_content $ HH.input
-        [ HE.onValueInput action
-        , HP.type_ HP.InputPassword
-        , HP.value value
-        , HP.name "password"
-        , HP.autocomplete AutocompleteNewPassword
-        , HP.placeholder ""
-        , HP.id "password"
-        , HP.classes input_classes
-        ]
-      ]
-
-password_input_confirmation :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
-password_input_confirmation title value action
-  = div_field []
-      [ div_field_label "password_confirmation" title
-      , div_field_content $ HH.input
-        [ HE.onValueInput action
-        , HP.type_ HP.InputPassword
-        , HP.value value
-        , HP.name "password_confirmation"
-        , HP.autocomplete AutocompleteOff
-        , HP.placeholder ""
-        , HP.id "password_confirmation"
-        , HP.classes input_classes
-        ]
-      ]
-
-token_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
-token_input title value action
-  = div_field []
-      [ div_field_label "token" title
-      , div_field_content $ HH.input
-        [ HE.onValueInput action
-        , HP.type_ HP.InputText
-        , HP.value value
-        , HP.name "token"
-        , HP.autocomplete AutocompleteOff
-        , HP.placeholder ""
-        , HP.id "token"
-        , HP.classes input_classes
-        ]
-      ]
-
-box_password :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-box_password = box_password_ (HP.enabled true)
-
-section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-section_small = HH.section [ HP.classes [C.section, C.is_small] ]
-
-section_medium :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-section_medium = HH.section [ HP.classes [C.section, C.medium] ]
-
-new_domain_field :: forall w i.
-  (String -> i) -> String -> Array (HP.IProp DHI.HTMLselect i) -> Array String -> HH.HTML w i
-new_domain_field inputaction text_ selectaction accepted_domains
-  = div_field_ [C.has_addons]
-      [ HH.p
-          [ HP.classes [C.control] ]
-          [ HH.input $
-              [ HE.onValueInput inputaction
-              , HP.placeholder "www"
-              , HP.value text_
-              , HP.type_ HP.InputText
-              , HP.classes [C.is_primary, C.input]
-              ]
-          ]
-      , HH.p
-          [ HP.classes [C.control] ]
-          [ select selectaction $ map option accepted_domains ]
-      ]
-
-code :: forall w i. String -> HH.HTML w i
-code str = HH.code_ [ HH.text str ]
-
-text :: forall w i. String -> HH.HTML w i
-text = HH.text
-
-p :: forall w i. String -> HH.HTML w i
-p str = HH.p_ [ HH.text str ]
-
-p_ :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
-p_ classes str = HH.p [HP.classes classes] [ HH.text str ]
-
-box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-box = HH.div [HP.classes [C.box]]
-
-box_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-box_ classes = HH.div [HP.classes $ [C.box] <> classes]
-
-option :: forall w i. String -> HH.HTML w i
-option value = HH.option_ [HH.text value]
-
-select :: forall w i. HH.Node DHI.HTMLselect w i
-select action options
-  = HH.div [ HP.classes [C.select, C.is_primary] ]
-           [ HH.select action options]
-
-hero :: forall w i. String -> String -> HH.HTML w i
-hero _title _subtitle
-  = HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ]
-      [ HH.div [ HP.classes [C.hero_body] ]
-          [ HH.p [ HP.classes [C.title] ] [ HH.text _title ]
-          , HH.p [ HP.classes [C.subtitle] ] [ HH.text _subtitle ]
-          ]
-      ]
-
-small_hero :: forall w i. String -> String -> HH.HTML w i
-small_hero _title _subtitle =
-  HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ]
-    [ HH.div [ HP.classes [C.hero_body] ]
-        [ HH.div [ HP.classes [C.container, C.has_text_centered] ]
-            [ HH.p [ HP.classes [C.title] ]    [ HH.text _title ]
-            , HH.p [ HP.classes [C.subtitle] ] [ HH.text _subtitle ]
-            ]
-        ]
-    ]
-
-hero_danger_txt :: forall w i. String -> String -> HH.HTML w i
-hero_danger_txt _title _subtitle
-  = hero_danger [ HH.text _title ] [ HH.text _subtitle ]
-
-hero_danger :: forall w i. Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
-hero_danger _title _subtitle
-  = HH.section [ HP.classes [C.hero, C.is_danger, C.is_small] ]
-      [ HH.div [ HP.classes [C.hero_body] ]
-          [ HH.p [ HP.classes [C.title] ] _title
-          , HH.p [ HP.classes [C.subtitle] ] _subtitle
-          ]
-      ]
-
-header :: forall w i. String -> String -> HH.HTML w i
-header = hero
-
-container :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-container = HH.div [HP.classes [C.container, C.is_info]]
-
-data_target :: forall r i. String -> HP.IProp r i
-data_target = HP.attr (AttrName "data-target")
-
-modal_ :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-modal_ = HH.div [HP.classes [C.modal, C.is_active]]
-modal_background :: forall w i. HH.HTML w i
-modal_background = HH.div [HP.classes [C.modal_background]] []
-modal_card_large :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-modal_card_large = HH.div [HP.classes [C.modal_card, C.is_large]]
-modal_header :: forall w i. String -> HH.HTML w i
-modal_header title = HH.header [HP.classes [C.modal_card_head]]
-  [ HH.p [HP.classes [C.modal_card_title]] [HH.text title]
-  ]
-modal_body :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-modal_body = HH.section [HP.classes [C.modal_card_body]]
-modal_foot :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-modal_foot = HH.div [HP.classes [C.modal_card_foot]]
-
-cancel_button :: forall w i. i -> HH.HTML w i
-cancel_button action
-  = HH.button [ HP.classes [C.button]
-              , HE.onClick \_ -> action
-              ] [HH.text "Cancel"]
-
-strong :: forall w i. String -> HH.HTML w i
-strong str = HH.strong_ [ HH.text str ]
-
-hr :: forall w i. HH.HTML w i
-hr = HH.hr_
-
-tile :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-tile classes = HH.div [HP.classes ([C.tile] <> classes)]
-
-tile_ :: forall w i. Array (HH.HTML w i) ->  HH.HTML w i
-tile_ = tile []
-
-tile_danger :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-tile_danger classes = tile $ [C.is_danger, C.notification] <> classes
-
-tile_warning :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-tile_warning classes = tile $ [C.is_warning, C.notification] <> classes
-
-article_ :: forall w i. Array HH.ClassName -> HH.HTML w i -> HH.HTML w i -> HH.HTML w i
-article_ classes head body = HH.article [HP.classes $ [C.message] <> classes]
-  [ HH.div [HP.classes [C.message_header]] [head]
-  , HH.div [HP.classes [C.message_body]  ] [body]
-  ]
-
-article :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i
-article head body = article_ [] head body
-
-error_message :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i
-error_message head body = article_ [C.is_danger] head body
-
-
--- | Basic input field with a read-only side text.
--- |
--- |```
--- |div [field is-horizontal]
--- |  div [field-label normal]
--- |    label [label for-id]
--- |      text
--- |  div [field-body]
--- |    div [has-addons field]
--- |      p [control]
--- |        input
--- |      p [control]
--- |        a [button is-small is-static]
--- |          text
--- |```
-input_with_side_text :: forall w i.
-  String -> String -> String -> (String -> i) -> String -> String -> HH.HTML w i
-input_with_side_text id title placeholder action value sidetext
-  = HH.div [HP.classes [C.field, C.is_horizontal]]
-      [ HH.div [ HP.classes [C.field_label, C.normal] ]
-               [HH.label [ HP.classes [C.label], HP.for id ] [ HH.text title ]]
-      , HH.div [ HP.classes [C.field_body] ]
-          [ HH.div [ HP.classes [C.has_addons, C.field] ]
-              [ HH.p [HP.classes [C.control]]
-                  [ HH.input $
-                    [ HE.onValueInput action
-                    , HP.value value
-                    , HP.placeholder placeholder
-                    , HP.classes $ input_classes
-                    , HP.id id
-                    ]
-                  ]
-              , HH.p [HP.classes [C.control]]
-                  [ HH.a [HP.classes [C.button, C.is_small, C.is_static]]
-                         [HH.text sidetext] ]
-              ]
-          ]
-      ]
-
-side_text_above_input :: forall w i.
-  String -> String -> HH.HTML w i -> HH.HTML w i
-side_text_above_input id title sidetext
-  = HH.div [HP.classes [C.field, C.is_horizontal]]
-      [ HH.div [ HP.classes [C.field_label, C.normal] ]
-               [HH.label [ HP.classes [C.label], HP.for id ] [ HH.text title ]]
-      , HH.div [ HP.classes [C.field_body] ]
-          [ HH.div [ HP.classes [C.has_addons, C.field] ]
-              [ HH.p [HP.classes [C.control]] [ sidetext ] ]
-          ]
-      ]
-
--- | `modal`: create a modal by providing a few things:
--- | - a title (a simple String)
--- | - a body (`HTML` content)
--- | - a footer (`HTML` content)
-modal :: forall w i. String -> Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
-modal title body foot =
-  modal_
-    [ modal_background
-    , modal_card_large [modal_header title, modal_body body]
-    , modal_foot foot
-    ]
-
--- selection: create a "select" input.
--- Get the changes with "onSelectedIndexChange" which provides an index.
-selection :: forall w i. (Int -> i) -> Array String -> String -> HH.HTML w i
-selection action values selected = HH.div [HP.classes [C.select, C.is_normal]]
-  [ HH.select [ HE.onSelectedIndexChange action ]
-    $ map (\n -> HH.option [HP.value n, HP.selected (n == selected)] [HH.text n]) values
-  ]
-
-selection_field :: forall w i. String -> String -> (Int -> i) -> Array String -> String -> HH.HTML w i
-selection_field id title action values selected
-  = field_entry id title $ selection action values selected
-
-selection_field' :: forall w i.
-  String -> String -> (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
-selection_field' id title action values selected
-  = field_entry id title $ selection' action values selected
-
-selection_field'' :: forall w i t. Show t =>
-  String -> String -> (Int -> i) -> Array (Tuple String String) -> t -> Maybe t -> HH.HTML w i
-selection_field'' id title action values default_value selected
-  = field_entry id title $ selection' action values selected_value
-  where
-  selected_value = (show $ fromMaybe default_value selected)
-
--- | selection': as `selection` but takes an array of tuple as values.
--- | First value in the tuple is what to display, the second one is what to match on.
-selection' :: forall w i. (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
-selection' action values selected = HH.div [HP.classes [C.select, C.is_normal]]
-  [ HH.select [ HE.onSelectedIndexChange action ]
-    $ map (\n -> HH.option [HP.value (snd n), HP.selected ((snd n) == selected)] [HH.text (fst n)]) values
-  ]
-
-tag_light_info :: forall w i. String -> HH.HTML w i
-tag_light_info str = HH.span [HP.classes [C.tag, C.is_info, C.is_light]] [HH.text str]
-
-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_content :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
-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 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 classes tab_list = HH.div [HP.classes $ [C.tabs] <> classes] [HH.ul_ tab_list]
-
-fancy_tabs :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-fancy_tabs arr = tabs [C.is_medium, C.is_boxed, C.is_centered] arr
-
-tab_entry :: forall w i. Boolean -> String -> i -> HH.HTML w i
-tab_entry active name action =
-  HH.li (if active then [HP.classes [C.is_active]] else [])
-    [ HH.a [HE.onClick \_ -> action] [HH.text name] ]
-
-delete_btn :: forall w i. i -> HH.HTML w i
-delete_btn action = HH.button [HE.onClick \_ -> action, HP.classes [C.delete]] []
-
-notification :: forall w i. Array HH.ClassName -> String -> i -> HH.HTML w i
-notification classes value deleteaction =
-  HH.div [HP.classes $ [C.notification] <> classes]
-         [ delete_btn deleteaction
-         , HH.text value
-         ]
-
-notification_primary :: forall w i. String -> i -> HH.HTML w i
-notification_primary value action = notification [C.is_primary] value action
-
-notification_success :: forall w i. String -> i -> HH.HTML w i
-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 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' classes content =
-  HH.div [HP.classes ([C.notification] <> classes)] content
-
-notification' :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
-notification' classes value =
-  HH.div [HP.classes ([C.notification] <> classes)]
-         [ 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' value = notification' [C.is_danger] value
-
-notification_danger_block' :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-notification_danger_block' content = notification_block' [C.is_danger] content
-
-btn_validation_ :: forall w i. String -> HH.HTML w i
-btn_validation_ str = HH.button
-  -- [ HP.style "padding: 0.5rem 1.25rem;"
-  [ HP.type_ HP.ButtonSubmit
-  , HP.classes [C.button, C.is_primary]
-  ]
-  [ HH.text str ]
-
-btn_validation :: forall w i. HH.HTML w i
-btn_validation = btn_validation_ "Validate"
-
--- | Box with tags.
--- |```
--- |box_with_tag [C.has_background_danger_light] some_tag [Bulma.p "Hello"]
--- |```
-box_with_tag :: forall w action.
-  Array HH.ClassName            -- css classes (like the color)
-  -> HH.HTML w action           -- tag (title for the box)
-  -> Array (HH.HTML w action)   -- box content
-  -> HH.HTML w action
-box_with_tag colors tag xs
-  = box_
-    ([C.no_padding_left, C.no_padding_top] <> colors)
-    [tag, HH.div [HP.classes [C.restore_padding_left, C.restore_padding_top]] xs]

src/Bulma/Color.purs

@@ -0,0 +1,71 @@
+module Bulma.Color where
+
+import Prelude (show, class Show, (<<<), (<>), ($), (<))
+import Halogen.HTML as HH
+import Data.String (toLower)
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+
+type Inverted = Boolean
+
+data ColorSubject = Background | Text
+
+-- | As the documentation says, Bulma provides 7 colors: text primary successful link info warning danger.
+data PrimaryColor = ColorText | Success | Primary | Link | Info | Warning | Danger
+
+-- | Both text and background have additional colors: white black dark and light.
+data TypographyColor = White | Black | Dark | Light | PrimaryColor PrimaryColor
+
+-- | Bulma provides many shades of color: Light Dark Soft Bold OnScheme and a custom shade which
+-- | is represented by a number between 5 and 100 (by 5).
+data Shade = LightShade | DarkShade | BoldShade | SoftShade | Custom Int | OnScheme | NoShade
+
+-- | Bulma provides many shades of grey, too.
+data ShadeOfGrey
+  = BlackBis | BlackTer
+  | GreyDarker | GreyDark | Grey | GreyLight | GreyLighter
+  | WhiteTer | WhiteBis
+
+derive instance genericColorSubject :: Generic ColorSubject _
+instance showColorSubject :: Show ColorSubject where
+  show = toLower <<< genericShow
+
+derive instance genericColor :: Generic PrimaryColor _
+instance showColor :: Show PrimaryColor where
+  show = toLower <<< genericShow
+
+derive instance genericTypographyColor :: Generic TypographyColor _
+instance showTypographyColor :: Show TypographyColor where
+  show = case _ of
+    (PrimaryColor color) -> show color
+    color                -> (toLower <<< genericShow) color
+
+derive instance genericShade :: Generic Shade _
+instance showShade :: Show Shade where
+  show = toLower <<< genericShow
+
+derive instance genericShadeOfGrey :: Generic ShadeOfGrey _
+instance showShadeOfGrey :: Show ShadeOfGrey where
+  show = toLower <<< genericShow
+
+has_grey :: ColorSubject -> ShadeOfGrey -> Inverted -> HH.ClassName
+has_grey subject shade inverted = HH.ClassName $ "has-" <> show subject <> "-" <> show shade <> inverted_
+  where
+  inverted_ = if inverted then "-inverted" else ""
+
+has_color :: ColorSubject -> PrimaryColor -> Shade -> Inverted -> HH.ClassName
+has_color subject color shade inverted = HH.ClassName $ "has-" <> subject_ <> "-" <> color_ <> shade_ <> inverted_
+  where
+  subject_ = show subject
+  color_   = show color
+  shade_   = case shade of
+    NoShade    -> ""
+    Custom num -> "-" <> (if num < 10 then "0" <> show num else show num)
+    OnScheme   -> "-on-scheme"
+    _          -> "-" <> show shade
+  inverted_ = if inverted then "-inverted" else ""
+
+has_background_current = HH.ClassName "has-background-current" :: HH.ClassName
+has_background_inherit = HH.ClassName "has-background-inherit" :: HH.ClassName
+has_text_current = HH.ClassName "has-text-current" :: HH.ClassName
+has_text_inherit = HH.ClassName "has-text-inherit" :: HH.ClassName

src/Utils.purs

@@ -0,0 +1,27 @@
+module Utils where
+
+import Prelude (($), (+), (<>), (==))
+import Data.Array as A
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Tuple (Tuple(..))
+
+attach_id :: forall a. Int -> Array a -> Array (Tuple Int a)
+attach_id _ []  = []
+attach_id i arr = case A.head arr of
+  Just x -> [Tuple i x] <> attach_id (i + 1) (fromMaybe [] $ A.tail arr)
+  Nothing -> []
+
+remove_id :: forall a. Int -> Array (Tuple Int a) -> Array a
+remove_id _ []  = []
+remove_id i arr = case A.head arr of
+  Just (Tuple n x) -> if i == n
+                      then remove_id i (fromMaybe [] $ A.tail arr)
+                      else [x] <> remove_id i (fromMaybe [] $ A.tail arr)
+  Nothing -> []
+
+id :: forall a. a -> a
+id x = x
+
+not_empty_string :: String -> Maybe String
+not_empty_string "" = Nothing
+not_empty_string v = Just v

src/Web.purs

@@ -0,0 +1,43 @@
+-- | `Web` module is an abstraction over most HTML-related code in order
+-- | to have a consistent style through all the website.
+module Web
+  ( module Web.Basics
+  , module Web.Box
+  , module Web.Button
+  , module Web.Checkbox
+  , module Web.Column
+  , module Web.Data
+  , module Web.Field
+  , module Web.Header
+  , module Web.Hero
+  , module Web.Input
+  , module Web.Level
+  , module Web.Modal
+  , module Web.Notification
+  , module Web.Section
+  , module Web.Tab
+  , module Web.Table
+  , module Web.Tag
+  , module Web.Tile
+  , module Web.Warning
+  ) where
+
+import Web.Basics
+import Web.Box (box, box_, box_with_tag)
+import Web.Button (alert_btn, alert_btn_abbr, btn, btn_, btn_abbr, btn_abbr_, btn_add, btn_delete, btn_delete_ro, btn_modify, btn_modify_ro, btn_readonly, btn_ro, btn_save, btn_validation, btn_validation_, cancel_button, delete_btn, info_btn, info_btn_abbr)
+import Web.Checkbox (checkbox)
+import Web.Column (column, column_, columns, columns_)
+import Web.Data (data_target)
+import Web.Field (btn_labeled, div_field, div_field_, div_field_content, div_field_label, error_field_entry, field_entry, new_domain_field, option, select, selection, selection', selection_field, selection_field', selection_field'', side_text_above_input)
+import Web.Header (h1, h3, h4, title, subtitle)
+import Web.Hero (hero, hero_danger, hero_danger_txt, small_hero)
+import Web.Input (box_input, box_input_, box_password, box_password_, email_input, field_inner, input_classes, input_with_side_text, password_input, password_input_confirmation, password_input_new, render_input, token_input, username_input)
+import Web.Level (level)
+import Web.Modal (modal, modal_, modal_background, modal_body, modal_card_large, modal_foot, modal_header)
+import Web.Notification (error_box, notification, notification', notification_block', notification_danger, notification_danger', notification_danger_block', notification_primary, notification_primary', notification_success, notification_warning, notification_warning')
+import Web.Section (section_medium, section_small)
+import Web.Tab (fancy_tabs, tab_entry, tabs)
+import Web.Table (table, table_)
+import Web.Tag (tag, tag_ro, tags, tag_light_info)
+import Web.Tile (tile, tile_, tile_danger, tile_warning)
+import Web.Warning (big_website_warning)

src/Web/Basics.purs

@@ -0,0 +1,91 @@
+module Web.Basics where
+
+import Prelude (($), (<>))
+
+import DOM.HTML.Indexed as DHI
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+code :: forall w i. String -> HH.HTML w i
+code str = HH.code_ [ HH.text str ]
+
+text :: forall w i. String -> HH.HTML w i
+text = HH.text
+
+p :: forall w i. String -> HH.HTML w i
+p str = HH.p_ [ HH.text str ]
+
+p_ :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
+p_ classes str = HH.p [HP.classes classes] [ HH.text str ]
+
+ul :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+ul body = HH.ul_ body
+
+li :: forall w i. String -> HH.HTML w i
+li body = li_ [] body
+
+li_ :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
+li_ classes body = HH.li [HP.classes classes] [ HH.text body ]
+
+strong :: forall w i. String -> HH.HTML w i
+strong str = HH.strong_ [ HH.text str ]
+
+hr :: forall w i. HH.HTML w i
+hr = HH.hr_
+
+div :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+div body = HH.div_ body
+
+div_ :: forall w i. HH.Node DHI.HTMLdiv w i
+div_ = HH.div
+
+content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+content body = HH.div [HP.classes [C.content]] body
+
+content_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+content_ classes body = HH.div [HP.classes ([C.content] <> classes)] body
+
+explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+explanation body = HH.blockquote [HP.classes [HH.ClassName "justified"]] body
+
+quote :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+quote body = content [ explanation body ]
+
+simple_quote :: forall w i. String -> HH.HTML w i
+simple_quote string = quote [ p string ]
+
+article_ :: forall w i. Array HH.ClassName -> HH.HTML w i -> HH.HTML w i -> HH.HTML w i
+article_ classes head body = HH.article [HP.classes $ [C.message] <> classes]
+  [ HH.div [HP.classes [C.message_header]] [head]
+  , HH.div [HP.classes [C.message_body]  ] [body]
+  ]
+
+article :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i
+article head body = article_ [] head body
+
+container :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+container body = HH.div [HP.classes [C.container, C.is_info]] body
+
+hdiv :: forall (w :: Type) (a :: Type). Array (HH.HTML w a) -> HH.HTML w a
+hdiv = HH.div [ HP.classes [HH.ClassName "mt-5"] ]
+
+error_message :: forall w i. HH.HTML w i -> HH.HTML w i -> HH.HTML w i
+error_message head body = article_ [C.is_danger] head body
+
+textarea_ :: forall w i. Array HH.ClassName -> String -> String -> (String -> i) -> HH.HTML w i
+textarea_ classes placeholder value action
+  = HH.textarea
+      [ HE.onValueInput action
+      , HP.value value
+      , HP.placeholder placeholder
+      , HP.classes $ [C.textarea] <> classes
+      ]
+
+textarea :: forall w i. String ->  String -> (String -> i) -> HH.HTML w i
+textarea placeholder value action = textarea_ [] placeholder value action
+
+outside_link :: forall w a. Array HH.ClassName -> String -> String -> HH.HTML w a
+outside_link classes url str = HH.a [ HP.classes classes, HP.target "_blank", HP.href url ] [ HH.text str ]

src/Web/Box.purs

@@ -0,0 +1,28 @@
+module Web.Box where
+
+import Prelude
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+box = HH.div [HP.classes [C.box]]
+
+box_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+box_ classes = HH.div [HP.classes $ [C.box] <> classes]
+
+-- | Box with tags.
+-- |```
+-- |box_with_tag [C.has_background_danger_light] some_tag [Bulma.p "Hello"]
+-- |```
+box_with_tag :: forall w action.
+  Array HH.ClassName            -- css classes (like the color)
+  -> HH.HTML w action           -- tag (title for the box)
+  -> Array (HH.HTML w action)   -- box content
+  -> HH.HTML w action
+box_with_tag colors tag xs
+  = box_
+    ([C.no_padding_left, C.no_padding_top] <> colors)
+    [tag, HH.div [HP.classes [C.restore_padding_left, C.restore_padding_top]] xs]

src/Web/Button.purs

@@ -0,0 +1,114 @@
+module Web.Button
+  ( alert_btn
+  , alert_btn_abbr
+  , btn
+  , btn_
+  , btn_abbr
+  , btn_abbr_
+  , btn_add
+  , btn_delete
+  , btn_delete_ro
+  , btn_modify
+  , btn_modify_ro
+  , btn_readonly
+  , btn_ro
+  , btn_save
+  , btn_validation
+  , btn_validation_
+  , cancel_button
+  , delete_btn
+  , info_btn
+  , info_btn_abbr
+  ) where
+
+import Prelude (($), (<>))
+import CSSClasses as C
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Halogen.HTML.Events as HE
+
+btn_abbr_ :: forall w action.
+     Array HH.ClassName -- button classes
+  -> Array HH.ClassName -- inner div classes
+  -> String
+  -> String
+  -> action
+  -> HH.HTML w action
+btn_abbr_ btnclasses divclasses explanation_ title action
+  = HH.button
+      [ HE.onClick \_ -> action
+      , HP.classes $ [C.button] <> btnclasses
+      ] [ HH.abbr [ HP.title explanation_ ] [ HH.div [ HP.classes divclasses ] [ HH.text title ] ] ]
+
+btn_abbr :: forall w action. String -> String -> action -> HH.HTML w action
+btn_abbr explanation_ title action = btn_abbr_ [] [] explanation_ title action
+
+alert_btn_abbr :: forall w action. String -> String -> action -> HH.HTML w action
+alert_btn_abbr explanation_ title action = btn_abbr_ [C.is_danger] [] explanation_ title action
+
+btn_modify :: forall w i. i -> HH.HTML w i
+btn_modify action = btn_abbr_ [C.is_small, C.is_info] [C.is_size 4] "Edit" "⚒" action
+
+btn_save :: forall w i. i -> HH.HTML w i
+btn_save action = btn_ [C.is_info] "Save" action
+
+btn_add :: forall w i. i -> HH.HTML w i
+btn_add action = btn_ [C.is_info] "Add" action
+
+btn_delete :: forall w i. i -> HH.HTML w i
+btn_delete action = btn_abbr_ [C.is_small, C.is_danger] [C.is_size 4] "Delete" "✖" action
+
+btn_ro :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
+btn_ro classes title
+  = HH.button
+      [ HP.classes $ [C.button] <> classes
+      ] [ HH.text title ]
+
+btn_modify_ro :: forall w i. HH.HTML w i
+btn_modify_ro = btn_ro [C.is_small, C.is_warning] "modify"
+
+btn_readonly :: forall w i. HH.HTML w i
+btn_readonly = btn_ro [C.is_small, C.is_warning] "read only"
+
+btn_delete_ro :: forall w i. HH.HTML w i
+btn_delete_ro = btn_ro [C.is_small, C.is_warning] "remove"
+
+btn_validation_ :: forall w i. String -> HH.HTML w i
+btn_validation_ str = HH.button
+  -- [ HP.style "padding: 0.5rem 1.25rem;"
+  [ HP.type_ HP.ButtonSubmit
+  , HP.classes [C.button, C.is_primary]
+  ]
+  [ HH.text str ]
+
+btn_validation :: forall w i. HH.HTML w i
+btn_validation = btn_validation_ "Validate"
+
+btn_ :: forall w action. Array HH.ClassName -> String -> action -> HH.HTML w action
+btn_ classes title action
+  = HH.button
+      [ HE.onClick \_ -> action
+      , HP.classes $ [C.button] <> classes
+      ] [ HH.text title ]
+
+btn :: forall w action. String -> action -> HH.HTML w action
+btn title action = btn_ [] title action
+
+info_btn :: forall w action. String -> action -> HH.HTML w action
+info_btn title action = btn_ [C.is_info] title action
+
+info_btn_abbr :: forall w action. String -> String -> action -> HH.HTML w action
+info_btn_abbr explanation_ title action = btn_abbr_ [C.is_info] [] explanation_ title action
+
+alert_btn :: forall w action. String -> action -> HH.HTML w action
+alert_btn title action = btn_ [C.is_danger] title action
+
+delete_btn :: forall w i. i -> HH.HTML w i
+delete_btn action = HH.button [HE.onClick \_ -> action, HP.classes [C.delete]] []
+
+cancel_button :: forall w i. i -> HH.HTML w i
+cancel_button action
+  = HH.button [ HP.classes [C.button]
+              , HE.onClick \_ -> action
+              ] [HH.text "Cancel"]

src/Web/Checkbox.purs

@@ -0,0 +1,17 @@
+module Web.Checkbox where
+
+import Prelude (($), (<>))
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Halogen.HTML.Events as HE
+
+import CSSClasses as C
+
+checkbox :: forall w i. Array (HH.HTML w i) -> i -> HH.HTML w i
+checkbox content_ action
+  = HH.label
+    [ HP.classes [C.label] ] $ [ HH.input [ HE.onValueInput \ _ -> action, HP.type_ HP.InputCheckbox ] ] <> content_
+-- <label class="checkbox">
+--   <input type="checkbox" />
+--   I agree to the <a href="#">terms and conditions</a>
+-- </label>

src/Web/Column.purs

@@ -0,0 +1,28 @@
+module Web.Column where
+
+import Prelude ((<>))
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+columns :: forall (w :: Type) (i :: Type).
+  Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+columns classes = HH.div [ HP.classes ([C.columns] <> classes) ]
+
+columns_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
+columns_ = columns []
+
+column :: forall (w :: Type) (i :: Type).
+  Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+column classes = HH.div [ HP.classes ([C.column] <> classes) ]
+
+column_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
+column_ = column []
+
+--offcolumn :: forall (w :: Type) (a :: Type).
+--  Int -> Int -> Array (HH.HTML w a) -> HH.HTML w a
+--offcolumn 0      size = HH.div [ HP.classes [HH.ClassName ("mt-"<>show size)] ]
+--offcolumn offset size
+--  = column [ HH.ClassName ("is-offset-" <> (show offset) <> " is-" <> (show size)) ]

src/Web/Data.purs

@@ -0,0 +1,7 @@
+module Web.Data where
+
+import Halogen.HTML.Properties as HP
+import Halogen.HTML.Core (AttrName(..))
+
+data_target :: forall r i. String -> HP.IProp r i
+data_target = HP.attr (AttrName "data-target")

src/Web/Div.purs

@@ -0,0 +1,8 @@
+module Web.Div where
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+

src/Web/Field.purs

@@ -0,0 +1,136 @@
+module Web.Field where
+
+import Prelude (class Show, map, show, ($), (<>), (==))
+
+import Data.Maybe (Maybe, fromMaybe)
+import Data.Tuple (Tuple, fst, snd)
+import Halogen.HTML as HH
+import DOM.HTML.Indexed as DHI
+import Halogen.HTML.Properties as HP
+import Halogen.HTML.Events as HE
+
+import CSSClasses as C
+
+-- | Bulma's `field`, which contains an array of `Halogen.HTML` entries.
+-- | Two entries are expected: a field label (`div_field_label`) and a field content (`div_field_content`).
+div_field :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+div_field classes = HH.div [HP.classes ([C.field, C.is_horizontal] <> classes)]
+
+-- | Field label (id and title) for a Bulma `field`.
+div_field_label :: forall w i. String -> String -> HH.HTML w i
+div_field_label id title = HH.div [HP.classes [C.field_label, C.normal]]
+                                  [HH.label [ HP.classes [C.label], HP.for id ] [ HH.text title ]]
+
+-- | Any `Halogen.HTML` data in Bulma `field-body > field > control` divs.
+div_field_content :: forall w i. HH.HTML w i -> HH.HTML w i
+div_field_content content
+  = HH.div [ HP.classes [C.field_body] ]
+           [ HH.div [HP.classes [C.field] ] [ HH.div [HP.classes [C.control] ] [ content ] ] ]
+
+-- | Basic field entry with a title and a field content.
+-- |
+-- |```
+-- |div [field is-horizontal]
+-- |  div [field-label is-normal]
+-- |    label [for-id]
+-- |      text
+-- |  div [field-body]
+-- |    div [field]
+-- |      div [control]
+-- |```
+field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
+field_entry id title entry
+  = div_field []
+      [ div_field_label id title
+      , div_field_content entry
+      ]
+
+-- | Error field entry with a title and a field content.
+error_field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
+error_field_entry id title entry
+  = div_field [C.has_background_danger_light]
+      [ div_field_label id title
+      , div_field_content entry
+      ]
+
+div_field_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+div_field_ classes = HH.div [ HP.classes ([C.field] <> classes) ]
+
+btn_labeled :: forall w i. String -> String -> String -> i -> HH.HTML w i
+btn_labeled id title button_text action
+  = field_entry id title $ HH.button
+      [ HE.onClick \_ -> action
+      , HP.classes [C.button, C.is_small, C.is_info]
+      , HP.id id
+      ] [ HH.text button_text ]
+
+selection_field :: forall w i. String -> String -> (Int -> i) -> Array String -> String -> HH.HTML w i
+selection_field id title action values selected
+  = field_entry id title $ selection action values selected
+
+selection_field' :: forall w i.
+  String -> String -> (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
+selection_field' id title action values selected
+  = field_entry id title $ selection' action values selected
+
+selection_field'' :: forall w i t. Show t =>
+  String -> String -> (Int -> i) -> Array (Tuple String String) -> t -> Maybe t -> HH.HTML w i
+selection_field'' id title action values default_value selected
+  = field_entry id title $ selection' action values selected_value
+  where
+  selected_value = (show $ fromMaybe default_value selected)
+
+side_text_above_input :: forall w i.
+  String -> String -> HH.HTML w i -> HH.HTML w i
+side_text_above_input id title sidetext
+  = HH.div [HP.classes [C.field, C.is_horizontal]]
+      [ HH.div [ HP.classes [C.field_label, C.normal] ]
+               [HH.label [ HP.classes [C.label], HP.for id ] [ HH.text title ]]
+      , HH.div [ HP.classes [C.field_body] ]
+          [ HH.div [ HP.classes [C.has_addons, C.field] ]
+              [ HH.p [HP.classes [C.control]] [ sidetext ] ]
+          ]
+      ]
+
+new_domain_field :: forall w i.
+  (String -> i) -> String -> Array (HP.IProp DHI.HTMLselect i) -> Array String -> HH.HTML w i
+new_domain_field inputaction text_ selectaction accepted_domains
+  = div_field_ [C.has_addons]
+      [ HH.p
+          [ HP.classes [C.control] ]
+          [ HH.input $
+              [ HE.onValueInput inputaction
+              , HP.placeholder "www"
+              , HP.value text_
+              , HP.type_ HP.InputText
+              , HP.classes [C.is_primary, C.input]
+              ]
+          ]
+      , HH.p
+          [ HP.classes [C.control] ]
+          [ select selectaction $ map option accepted_domains ]
+      ]
+
+select :: forall w i. HH.Node DHI.HTMLselect w i
+select action options
+  = HH.div [ HP.classes [C.select, C.is_primary] ]
+           [ HH.select action options]
+
+-- selection: create a "select" input.
+-- Get the changes with "onSelectedIndexChange" which provides an index.
+selection :: forall w i. (Int -> i) -> Array String -> String -> HH.HTML w i
+selection action values selected = HH.div [HP.classes [C.select, C.is_normal]]
+  [ HH.select [ HE.onSelectedIndexChange action ]
+    $ map (\n -> HH.option [HP.value n, HP.selected (n == selected)] [HH.text n]) values
+  ]
+
+-- | selection': as `selection` but takes an array of tuple as values.
+-- | First value in the tuple is what to display, the second one is what to match on.
+selection' :: forall w i. (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
+selection' action values selected = HH.div [HP.classes [C.select, C.is_normal]]
+  [ HH.select [ HE.onSelectedIndexChange action ]
+    $ map (\n -> HH.option [HP.value (snd n), HP.selected ((snd n) == selected)] [HH.text (fst n)]) values
+  ]
+
+option :: forall w i. String -> HH.HTML w i
+option value = HH.option_ [HH.text value]

src/Web/Header.purs

@@ -0,0 +1,23 @@
+module Web.Header where
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+h1 :: forall w a. String -> HH.HTML w a
+h1 str = HH.h1 [ HP.classes [C.title] ] [ HH.text str ]
+
+h3 :: forall w a. String -> HH.HTML w a
+h3 str = HH.h3 [ HP.classes [C.title] ] [ HH.text str ]
+
+h4 :: forall w a. String -> HH.HTML w a
+h4 str = HH.h4 [ HP.classes [C.title] ] [ HH.text str ]
+
+title :: forall w a. String -> HH.HTML w a
+title title_str
+  = HH.h3 [ HP.classes [C.title, C.has_text_light, C.has_background_dark] ]
+          [ HH.text title_str ]
+
+subtitle :: forall w a. String -> HH.HTML w a
+subtitle str = HH.h2 [ HP.classes [C.subtitle, C.is4] ] [ HH.text str ]

src/Web/Hero.purs

@@ -0,0 +1,39 @@
+module Web.Hero where
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+hero :: forall w i. String -> String -> HH.HTML w i
+hero _title _subtitle
+  = HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ]
+      [ HH.div [ HP.classes [C.hero_body] ]
+          [ HH.p [ HP.classes [C.title] ] [ HH.text _title ]
+          , HH.p [ HP.classes [C.subtitle] ] [ HH.text _subtitle ]
+          ]
+      ]
+
+small_hero :: forall w i. String -> String -> HH.HTML w i
+small_hero _title _subtitle =
+  HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ]
+    [ HH.div [ HP.classes [C.hero_body] ]
+        [ HH.div [ HP.classes [C.container, C.has_text_centered] ]
+            [ HH.p [ HP.classes [C.title] ]    [ HH.text _title ]
+            , HH.p [ HP.classes [C.subtitle] ] [ HH.text _subtitle ]
+            ]
+        ]
+    ]
+
+hero_danger_txt :: forall w i. String -> String -> HH.HTML w i
+hero_danger_txt _title _subtitle
+  = hero_danger [ HH.text _title ] [ HH.text _subtitle ]
+
+hero_danger :: forall w i. Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
+hero_danger _title _subtitle
+  = HH.section [ HP.classes [C.hero, C.is_danger, C.is_small] ]
+      [ HH.div [ HP.classes [C.hero_body] ]
+          [ HH.p [ HP.classes [C.title] ] _title
+          , HH.p [ HP.classes [C.subtitle] ] _subtitle
+          ]
+      ]

src/Web/Input.purs

@@ -0,0 +1,184 @@
+module Web.Input where
+
+import Prelude (($), (<>))
+import Web.Field
+
+import DOM.HTML.Indexed.AutocompleteType (AutocompleteType(..))
+
+import DOM.HTML.Indexed as DHI
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Halogen.HTML.Events as HE
+
+import CSSClasses as C
+
+input_classes :: Array HH.ClassName
+input_classes = [C.input, C.is_small, C.is_info]
+
+username_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
+username_input title value action
+  = div_field []
+      [ div_field_label "username" title
+      , div_field_content $ HH.input
+        [ HE.onValueInput action
+        , HP.type_ HP.InputText
+        , HP.value value
+        , HP.name "username"
+        , HP.autocomplete AutocompleteUsername
+        , HP.placeholder "Username"
+        , HP.id "username"
+        , HP.classes input_classes
+        ]
+      ]
+
+email_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
+email_input title value action
+  = div_field []
+      [ div_field_label "email" title
+      , div_field_content $ HH.input
+        [ HE.onValueInput action
+        , HP.type_ HP.InputEmail
+        , HP.value value
+        , HP.name "email"
+        , HP.autocomplete AutocompleteEmail
+        , HP.placeholder "email@example.com"
+        , HP.id "email"
+        , HP.classes input_classes
+        ]
+      ]
+
+password_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
+password_input title value action
+  = div_field []
+      [ div_field_label "password" title
+      , div_field_content $ HH.input
+        [ HE.onValueInput action
+        , HP.type_ HP.InputPassword
+        , HP.value value
+        , HP.name "password"
+        , HP.autocomplete AutocompleteCurrentPassword
+        , HP.placeholder ""
+        , HP.id "password"
+        , HP.classes input_classes
+        ]
+      ]
+
+password_input_new :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
+password_input_new title value action
+  = div_field []
+      [ div_field_label "password" title
+      , div_field_content $ HH.input
+        [ HE.onValueInput action
+        , HP.type_ HP.InputPassword
+        , HP.value value
+        , HP.name "password"
+        , HP.autocomplete AutocompleteNewPassword
+        , HP.placeholder ""
+        , HP.id "password"
+        , HP.classes input_classes
+        ]
+      ]
+
+password_input_confirmation :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
+password_input_confirmation title value action
+  = div_field []
+      [ div_field_label "password_confirmation" title
+      , div_field_content $ HH.input
+        [ HE.onValueInput action
+        , HP.type_ HP.InputPassword
+        , HP.value value
+        , HP.name "password_confirmation"
+        , HP.autocomplete AutocompleteOff
+        , HP.placeholder ""
+        , HP.id "password_confirmation"
+        , HP.classes input_classes
+        ]
+      ]
+
+token_input :: forall w i. String -> String -> (String -> i) -> HH.HTML w i
+token_input title value action
+  = div_field []
+      [ div_field_label "token" title
+      , div_field_content $ HH.input
+        [ HE.onValueInput action
+        , HP.type_ HP.InputText
+        , HP.value value
+        , HP.name "token"
+        , HP.autocomplete AutocompleteOff
+        , HP.placeholder ""
+        , HP.id "token"
+        , HP.classes input_classes
+        ]
+      ]
+
+box_input_ :: forall w i.
+  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
+box_input_ = field_inner false
+
+box_password_ :: forall w i.
+  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
+box_password_ = field_inner true
+
+box_input :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
+box_input = box_input_ (HP.enabled true)
+
+box_password :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
+box_password = box_password_ (HP.enabled true)
+
+-- | Basic input field with a read-only side text.
+-- |
+-- |```
+-- |div [field is-horizontal]
+-- |  div [field-label normal]
+-- |    label [label for-id]
+-- |      text
+-- |  div [field-body]
+-- |    div [has-addons field]
+-- |      p [control]
+-- |        input
+-- |      p [control]
+-- |        a [button is-small is-static]
+-- |          text
+-- |```
+input_with_side_text :: forall w i.
+  String -> String -> String -> (String -> i) -> String -> String -> HH.HTML w i
+input_with_side_text id title placeholder action value sidetext
+  = HH.div [HP.classes [C.field, C.is_horizontal]]
+      [ HH.div [ HP.classes [C.field_label, C.normal] ]
+               [HH.label [ HP.classes [C.label], HP.for id ] [ HH.text title ]]
+      , HH.div [ HP.classes [C.field_body] ]
+          [ HH.div [ HP.classes [C.has_addons, C.field] ]
+              [ HH.p [HP.classes [C.control]]
+                  [ HH.input $
+                    [ HE.onValueInput action
+                    , HP.value value
+                    , HP.placeholder placeholder
+                    , HP.classes $ input_classes
+                    , HP.id id
+                    ]
+                  ]
+              , HH.p [HP.classes [C.control]]
+                  [ HH.a [HP.classes [C.button, C.is_small, C.is_static]]
+                         [HH.text sidetext] ]
+              ]
+          ]
+      ]
+
+render_input :: forall w i.
+  Boolean -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
+render_input password id placeholder action value cond
+  = HH.input $
+      [ HE.onValueInput action
+      , HP.value value
+      , HP.placeholder placeholder
+      , HP.classes $ input_classes
+      , HP.id id
+      , cond
+      ] <> case password of
+        false -> []
+        true -> [ HP.type_ HP.InputPassword ]
+
+field_inner :: forall w i.
+  Boolean -> (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
+field_inner ispassword cond id title placeholder action value
+  = field_entry id title $ render_input ispassword id placeholder action value cond

src/Web/Level.purs

@@ -0,0 +1,20 @@
+module Web.Level where
+
+import Prelude (map, ($))
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+-- import Web.Event.Event (type_, Event, EventType(..))
+-- import Web.UIEvent.MouseEvent (MouseEvent) -- package web-uievents
+
+-- | Create a `level`, different components that should appear on the same horizontal line.
+-- | First argument, elements that should appear on the left, second on the right.
+level :: forall w a. Array (HH.HTML w a) -> Array (HH.HTML w a) -> HH.HTML w a
+level left right = HH.nav [ HP.classes [C.level] ]
+                          [ HH.div [ HP.classes [C.level_left]  ] $ itemize left
+                          , HH.div [ HP.classes [C.level_right] ] $ itemize right
+                          ]
+   where itemize = map (\v -> HH.div [ HP.classes [C.level_item] ] [v])

src/Web/Modal.purs

@@ -0,0 +1,38 @@
+module Web.Modal where
+
+import CSSClasses as C
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+modal_background :: forall w i. HH.HTML w i
+modal_background = HH.div [HP.classes [C.modal_background]] []
+
+modal_card_large :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+modal_card_large = HH.div [HP.classes [C.modal_card, C.is_large]]
+
+modal_header :: forall w i. String -> HH.HTML w i
+modal_header title = HH.header [HP.classes [C.modal_card_head]]
+  [ HH.p [HP.classes [C.modal_card_title]] [HH.text title]
+  ]
+
+modal_body :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+modal_body = HH.section [HP.classes [C.modal_card_body]]
+
+modal_foot :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+modal_foot = HH.div [HP.classes [C.modal_card_foot]]
+
+-- | `modal`: create a modal by providing a few things:
+-- | - a title (a simple String)
+-- | - a body (`HTML` content)
+-- | - a footer (`HTML` content)
+modal :: forall w i. String -> Array (HH.HTML w i) -> Array (HH.HTML w i) -> HH.HTML w i
+modal title body foot =
+  modal_
+    [ modal_background
+    , modal_card_large [modal_header title, modal_body body]
+    , modal_foot foot
+    ]
+
+modal_ :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+modal_ = HH.div [HP.classes [C.modal, C.is_active]]

src/Web/Notification.purs

@@ -0,0 +1,53 @@
+module Web.Notification where
+
+import Prelude (($), (<>))
+import Web.Field
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+import Web.Button (delete_btn)
+
+notification :: forall w i. Array HH.ClassName -> String -> i -> HH.HTML w i
+notification classes value deleteaction =
+  HH.div [HP.classes $ [C.notification] <> classes]
+         [ delete_btn deleteaction
+         , HH.text value
+         ]
+
+notification_primary :: forall w i. String -> i -> HH.HTML w i
+notification_primary value action = notification [C.is_primary] value action
+
+notification_success :: forall w i. String -> i -> HH.HTML w i
+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 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' classes content =
+  HH.div [HP.classes ([C.notification] <> classes)] content
+
+notification' :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
+notification' classes value =
+  HH.div [HP.classes ([C.notification] <> classes)]
+         [ 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' value = notification' [C.is_danger] value
+
+notification_danger_block' :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+notification_danger_block' content = notification_block' [C.is_danger] content
+
+error_box :: forall w i. String -> String -> String -> HH.HTML w i
+error_box id title value = error_field_entry id title $ notification_danger' value

src/Web/Section.purs

@@ -0,0 +1,12 @@
+module Web.Section where
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+section_small = HH.section [ HP.classes [C.section, C.is_small] ]
+
+section_medium :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+section_medium = HH.section [ HP.classes [C.section, C.medium] ]

src/Web/Tab.purs

@@ -0,0 +1,21 @@
+module Web.Tab where
+
+import Prelude (($), (<>))
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Halogen.HTML.Events as HE
+
+import CSSClasses as C
+
+
+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]
+
+fancy_tabs :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+fancy_tabs arr = tabs [C.is_medium, C.is_boxed, C.is_centered] arr
+
+tab_entry :: forall w i. Boolean -> String -> i -> HH.HTML w i
+tab_entry active name action =
+  HH.li (if active then [HP.classes [C.is_active]] else [])
+    [ HH.a [HE.onClick \_ -> action] [HH.text name] ]

src/Web/Table.purs

@@ -0,0 +1,15 @@
+module Web.Table where
+
+import Prelude ((<>), ($))
+
+import Halogen.HTML as HH
+import DOM.HTML.Indexed as DHI
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+table :: forall w i. HH.Node DHI.HTMLtable w i
+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_ classes prop xs = HH.table ([ HP.classes $ [C.table] <> classes] <> prop) xs

src/Web/Tag.purs

@@ -0,0 +1,18 @@
+module Web.Tag where
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+tags :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+tags xs = HH.span [HP.classes [C.tags, C.no_margin_bottom, C.no_padding_bottom]] xs
+
+tag :: forall w i. String -> HH.HTML w i
+tag str = HH.span [HP.classes [C.tag, C.is_dark]] [HH.text str]
+
+tag_ro :: forall w i. String -> HH.HTML w i
+tag_ro str = HH.span [HP.classes [C.tag, C.is_warning]] [HH.text str]
+
+tag_light_info :: forall w i. String -> HH.HTML w i
+tag_light_info str = HH.span [HP.classes [C.tag, C.is_info, C.is_light]] [HH.text str]

src/Web/Tile.purs

@@ -0,0 +1,22 @@
+-- | `WARNING:` tiles are deprecated since Bulma 1.0.
+module Web.Tile where
+
+import Prelude (($), (<>))
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+tile :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+tile classes = HH.div [HP.classes ([C.tile] <> classes)]
+
+tile_ :: forall w i. Array (HH.HTML w i) ->  HH.HTML w i
+tile_ = tile []
+
+tile_danger :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+tile_danger classes = tile $ [C.is_danger, C.notification] <> classes
+
+tile_warning :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+tile_warning classes = tile $ [C.is_warning, C.notification] <> classes
+

src/Web/Warning.purs

@@ -0,0 +1,9 @@
+module Web.Warning where
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+import CSSClasses as C
+
+big_website_warning :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+big_website_warning content = HH.div [HP.classes [C.notification, C.is_warning]] content