Style.

src/App/AuthenticationForm.purs

@@ -1,33 +1,26 @@
 module App.AuthenticationForm where
 
-import Prelude (Unit, Void, bind, discard, map, show, void, when, ($), (&&), (<$>), (<<<), (<>), (>>=), pure, unit)
+import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>))
 
-import Bulma as Bulma
 
-import Control.Monad.State (class MonadState)
+import Data.ArrayBuffer.Types (ArrayBuffer)
-import Data.Tuple (Tuple(..))
-import Data.Const (Const)
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
+import Data.Maybe (Maybe(..), maybe)
-import Data.String as String
+import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
-import Web.Event.Event (Event)
 import Web.Event.Event as Event
+import Web.Event.Event (Event)
 
-import Effect.Class (class MonadEffect)
+import Bulma as Bulma
 
-import App.IPC as IPC
 import App.Email as Email
 import App.LogMessage
-
 import App.Messages.AuthenticationDaemon as AuthD
 
-import Data.ArrayBuffer.Types (ArrayBuffer)
-
 data Output
   = AuthToken (Tuple Int String)
   | MessageToSend ArrayBuffer

src/App/Container.purs

@@ -59,14 +59,21 @@ initialState _ = { token: Nothing
 render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
 render state
   = HH.div_ $
-    [ render_auth_form
+    [ render_header
+    , render_auth_form
     , render_newdomain_interface
     , render_authd_admin_interface
     , Bulma.columns_ [ Bulma.column_ [ render_logs ], Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
     ]
   where
+
+    render_header :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
+    render_header = case state.token of
+      Nothing -> Bulma.hero "net libre" "free domains"
+      Just _ ->  Bulma.hero "net libre" "free domains"
+
     render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_logs = Bulma.box [ HH.slot_ _log unit Log.component unit ]
+    render_logs = Bulma.container [ HH.slot_ _log unit Log.component unit ]
 
     render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_auth_WS = HH.slot _ws_auth unit WS.component "ws://127.0.0.1:8080" AuthenticationDaemonEvent
@@ -84,16 +91,14 @@ render state
     render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_authd_admin_interface = case state.token of
       Just _ -> Bulma.box $
-        [ Bulma.h1 "Administrative interface for authd"
+        [ HH.slot _aai unit AAI.component unit AuthenticationDaemonAdminComponentEvent
-        , HH.slot _aai unit AAI.component unit AuthenticationDaemonAdminComponentEvent
         ]
       Nothing -> render_nothing
 
     render_newdomain_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_newdomain_interface = case state.token of
       Just token -> Bulma.box $
-        [ Bulma.h1 "New domain interface!"
+        [ HH.slot _dli unit DomainListInterface.component token DomainListComponentEvent
-        , HH.slot _dli unit DomainListInterface.component token DomainListComponentEvent
         ]
       Nothing -> render_nothing
 

src/App/DomainListInterface.purs

@@ -12,33 +12,27 @@ module App.DomainListInterface where
    Authentication is automatic with the token.
 -}
 
-import Prelude (Unit, Void, bind, discard, map, otherwise, show, void, when, ($), (&&), (<$>), (<<<), (<>), (>>=), (/=), pure)
+import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>))
 
-import Bulma as Bulma
-
-import Data.String.Utils (endsWith)
-import Halogen.HTML.Events as HHE
-import Control.Monad.State (class MonadState)
 import Data.Array as A
+import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
+import Data.Maybe (Maybe(..), maybe)
+import Data.String.Utils (endsWith)
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
+import Halogen.HTML.Events as HHE
 import Halogen.HTML.Properties as HP
-import Web.Event.Event (Event)
 import Web.Event.Event as Event
+import Web.Event.Event (Event)
 
-import Effect.Class (class MonadEffect)
+import Bulma as Bulma
 
 import App.LogMessage
-
-import App.IPC as IPC
 import App.Messages.DNSManagerDaemon as DNSManager
 
-import Data.ArrayBuffer.Types (ArrayBuffer)
-
 data Output
   = MessageToSend ArrayBuffer
   | Log LogMessage
@@ -148,26 +142,32 @@ render { accepted_domains, my_domains, newDomainForm, wsUp }
 
       render_adduser_form = HH.form
         [ HE.onSubmit NewDomainAttempt ]
-        [ Bulma.box_input "Your new domain" "awesomewebsite"   -- title, placeholder
+        [ Bulma.new_domain_field
-            (HandleNewDomainInput <<< INP_newdomain)           -- action
+            (HandleNewDomainInput <<< INP_newdomain)
-            newDomainForm.new_domain                           -- value
+            newDomainForm.new_domain
-            true                                               -- validity (TODO)
+            [ HHE.onSelectedIndexChange domain_choice ]
-            should_be_disabled                                 -- condition
+            accepted_domains
-        , domain_selection
-        , HH.div_
-            [ HH.button
-                [ HP.style "padding: 0.5rem 1.25rem;"
-                , HP.type_ HP.ButtonSubmit
-                , (if wsUp then (HP.enabled true) else (HP.disabled true))
-                ]
-                [ HH.text "Send Message to Server" ]
-            ]
         ]
+        --[ Bulma.box_input "Your new domain" "awesomewebsite"   -- title, placeholder
+        --    (HandleNewDomainInput <<< INP_newdomain)           -- action
+        --    newDomainForm.new_domain                           -- value
+        --    true                                               -- validity (TODO)
+        --    should_be_disabled                                 -- condition
+        --, domain_selection
+        --, HH.div_
+        --    [ HH.button
+        --        [ HP.style "padding: 0.5rem 1.25rem;"
+        --        , HP.type_ HP.ButtonSubmit
+        --        , (if wsUp then (HP.enabled true) else (HP.disabled true))
+        --        ]
+        --        [ HH.text "Send Message to Server" ]
+        --    ]
+        --]
 
       domain_selection = Bulma.select [ HHE.onSelectedIndexChange domain_choice ] $ map Bulma.option accepted_domains
       domain_choice :: Int -> Action
       domain_choice i
-        = HandleNewDomainInput <<< UpdateSelectedDomain $ maybe "netlib.re" (\x -> x) $ accepted_domains A.!! i
+        = HandleNewDomainInput <<< UpdateSelectedDomain $ maybe default_domain (\x -> x) $ accepted_domains A.!! i
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
@@ -197,7 +197,6 @@ handleAction = case _ of
 
   NewDomainAttempt ev -> do
     H.liftEffect $ Event.preventDefault ev
-    H.raise $ Log $ SimpleLog "[😇] Trying to add a new domain"
 
     { newDomainForm } <- H.get
     let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain
@@ -247,7 +246,7 @@ handleQuery = case _ of
               H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)."
 
             (DNSManager.MkAcceptedDomains response) -> do
-              H.raise $ Log $ SimpleLog $ "[😈] Received the list of accepted domains!"
+              H.raise $ Log $ SimpleLog $ "[🎉] Received the list of accepted domains!"
               handleAction $ UpdateAcceptedDomains response.domains
 
             (DNSManager.MkLogged response) -> do
@@ -257,7 +256,7 @@ handleQuery = case _ of
 
             (DNSManager.MkDomainAdded response) -> do
               { my_domains } <- H.get
-              H.raise $ Log $ SimpleLog $ "[😈] Domain added: " <> response.domain
+              H.raise $ Log $ SimpleLog $ "[🎉] Domain added: " <> response.domain
               handleAction $ UpdateMyDomains (my_domains <> [response.domain])
 
             (DNSManager.MkInvalidDomainName _) -> do
@@ -265,11 +264,11 @@ handleQuery = case _ of
 
             (DNSManager.MkDomainDeleted response) -> do
               { my_domains } <- H.get
-              H.raise $ Log $ SimpleLog $ "[😈] The domain '" <> response.domain <> "' has been deleted!"
+              H.raise $ Log $ SimpleLog $ "[🎉] The domain '" <> response.domain <> "' has been deleted!"
               handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
 
             (DNSManager.MkSuccess _) -> do
-              H.raise $ Log $ SimpleLog $ "[😈] Success!"
+              H.raise $ Log $ SimpleLog $ "[🎉] Success!"
             -- WTH?!
             _ -> do
               H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."

src/Bulma.purs

@@ -9,9 +9,9 @@ import Halogen.HTML.Properties as HP
 import Halogen.HTML.Events as HE
 
 -- HTML PropName used with HP.prop
-import Halogen.HTML.Core (PropName(..))
+--import Halogen.HTML.Core (PropName(..))
 -- import Web.Event.Event (type_, Event, EventType(..))
-import Web.UIEvent.MouseEvent (MouseEvent)
+--import Web.UIEvent.MouseEvent (MouseEvent)
 
 class_columns  :: Array (HH.ClassName)
 class_columns  = [HH.ClassName "columns"  ]
@@ -343,6 +343,59 @@ field_inner ispassword title placeholder action value validity cond
 box_input    = field_inner false
 box_password = field_inner true
 
+class_has_addons :: Array (HH.ClassName)
+class_has_addons = [HH.ClassName "has-addons"]
+
+field classes = HH.div [ HP.classes (class_field <> classes) ]
+
+class_input  :: Array (HH.ClassName)
+class_input  = [HH.ClassName "input"   ]
+
+new_domain_field inputaction text selectaction accepted_domains
+  = field class_has_addons
+      [ HH.p
+          [ HP.classes class_control ]
+          [ HH.input $
+              [ HE.onValueInput inputaction
+              , HP.placeholder "www"
+              , HP.value text
+              , HP.type_ HP.InputText
+              , HP.classes (class_primary <> class_input)
+              ]
+          ]
+      , HH.p
+          [ HP.classes class_control ]
+          [ select selectaction $ map option accepted_domains ]
+      , HH.p
+          [ HP.classes class_control ]
+          [ HH.button
+              [ HP.type_ HP.ButtonSubmit
+              , HP.classes class_primary
+              ]
+              [ HH.text "add a new domain!" ]
+          ]
+      ]
+
+--<div class="field has-addons">
+--  <p class="control">
+--    <span class="select">
+--      <select>
+--        <option>$</option>
+--        <option>£</option>
+--        <option>€</option>
+--      </select>
+--    </span>
+--  </p>
+--  <p class="control">
+--    <input class="input" type="text" placeholder="Amount of money">
+--  </p>
+--  <p class="control">
+--    <a class="button">
+--      Transfer
+--    </a>
+--  </p>
+--</div>
+
 --box_button action value validity cond
 --  = HH.label [ ]
 --      [ HH.label [HP.classes class_label ] [ HH.text title ]
@@ -363,3 +416,41 @@ select :: forall w i. HH.Node DHI.HTMLselect w i
 select action options
   = HH.div [ HP.classes (class_select <> class_primary) ]
            [ HH.select action options]
+
+class_hero  :: Array (HH.ClassName)
+class_hero  = [HH.ClassName "hero" ]
+class_hero_body  :: Array (HH.ClassName)
+class_hero_body  = [HH.ClassName "hero-body" ]
+class_is_info  :: Array (HH.ClassName)
+class_is_info  = [HH.ClassName "is-info" ]
+class_is_small  :: Array (HH.ClassName)
+class_is_small  = [HH.ClassName "is-small" ]
+
+hero :: forall w i. String -> String -> HH.HTML w i
+hero title subtitle
+  = HH.section [ HP.classes (class_hero <> class_is_info <> class_is_small) ]
+      [ HH.div [ HP.classes class_hero_body ]
+          [ HH.p [ HP.classes class_title ] [ HH.text title ]
+          , HH.p [ HP.classes class_subtitle ] [ HH.text subtitle ]
+          ]
+      ]
+
+header :: forall w i. String -> String -> HH.HTML w i
+header = hero
+
+--<section class="hero">
+--  <div class="hero-body">
+--    <p class="title">
+--      Hero title
+--    </p>
+--    <p class="subtitle">
+--      Hero subtitle
+--    </p>
+--  </div>
+--</section>
+
+class_container  :: Array (HH.ClassName)
+class_container  = [HH.ClassName "container" ]
+
+container :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+container = HH.div [HP.classes (class_container <> class_is_info)]