diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs
index e4da4f9..8145a8d 100644
--- a/src/App/AuthenticationForm.purs
+++ b/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.Tuple (Tuple(..))
-import Data.Const (Const)
+import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Either (Either(..))
-import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
-import Data.String as String
+import Data.Maybe (Maybe(..), maybe)
+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
diff --git a/src/App/Container.purs b/src/App/Container.purs
index 7f0bfcb..bd634de 100644
--- a/src/App/Container.purs
+++ b/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
diff --git a/src/App/DomainListInterface.purs b/src/App/DomainListInterface.purs
index ac205e2..ad7239d 100644
--- a/src/App/DomainListInterface.purs
+++ b/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
- (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" ]
- ]
+ [ Bulma.new_domain_field
+ (HandleNewDomainInput <<< INP_newdomain)
+ newDomainForm.new_domain
+ [ HHE.onSelectedIndexChange domain_choice ]
+ accepted_domains
]
+ --[ 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."
diff --git a/src/Bulma.purs b/src/Bulma.purs
index f947039..6a5637a 100644
--- a/src/Bulma.purs
+++ b/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!" ]
+ ]
+ ]
+
+--
+--
+--
+--
+--
+--
+--
+--
+--
+--
+--
+-- Transfer
+--
+--
+--
+--
+-- Hero title
+--
+--
+-- Hero subtitle
+--
+--