Style.
parent
53fdefd790
commit
de52e40036
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue