Can build again
parent
ab654ddbe7
commit
5ac94bf0fe
|
|
@ -1,15 +1,17 @@
|
|||
module App.Container where
|
||||
|
||||
import Prelude (Unit, bind, discard, unit, ($))
|
||||
import Prelude (Unit, bind, discard, unit, ($), (<>), show, pure)
|
||||
|
||||
import Bulma as Bulma
|
||||
|
||||
import App.Nav as Nav
|
||||
|
||||
import Data.Array as A
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Either (Either(..))
|
||||
import Data.Tuple (Tuple(..))
|
||||
import App.AuthenticationForm as AF
|
||||
import App.Log as Log
|
||||
import App.Log as AppLog
|
||||
import App.WS as WS
|
||||
import App.AuthenticationDaemonAdminInterface as AAI
|
||||
import App.DomainListInterface as DomainListInterface
|
||||
|
|
@ -20,6 +22,7 @@ import Halogen as H
|
|||
import Halogen.HTML as HH
|
||||
import Type.Proxy (Proxy(..))
|
||||
import Effect.Aff.Class (class MonadAff)
|
||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
||||
|
||||
import App.LogMessage (LogMessage(..))
|
||||
|
||||
|
|
@ -51,6 +54,9 @@ data Action
|
|||
-- | Then, the message will be provided to the `DispatchDNSMessage` action.
|
||||
| DNSRawMessageReceived ArrayBuffer
|
||||
|
||||
-- | Log message (through the Log component).
|
||||
| Log LogMessage
|
||||
|
||||
type State = { token :: Maybe String
|
||||
, uid :: Maybe Int
|
||||
, current_page :: Page
|
||||
|
|
@ -59,7 +65,7 @@ type State = { token :: Maybe String
|
|||
}
|
||||
|
||||
type ChildSlots =
|
||||
( log :: Log.Slot Unit
|
||||
( log :: AppLog.Slot Unit
|
||||
, ho :: HomeInterface.Slot Unit
|
||||
, ws_auth :: WS.Slot Unit
|
||||
, ws_dns :: WS.Slot Unit
|
||||
|
|
@ -129,7 +135,7 @@ render state
|
|||
Just _ -> Bulma.hero "net libre" "free domains"
|
||||
|
||||
render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_logs = Bulma.container [ HH.slot_ _log unit Log.component unit ]
|
||||
render_logs = Bulma.container [ HH.slot_ _log unit AppLog.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
|
||||
|
|
@ -165,7 +171,7 @@ handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Act
|
|||
handleAction = case _ of
|
||||
Routing page -> H.modify_ _ { current_page = page }
|
||||
|
||||
Log message -> H.tell _log unit $ Log.Log message
|
||||
Log message -> H.tell _log unit $ AppLog.Log message
|
||||
|
||||
AuthenticateToDNSManager -> do
|
||||
state <- H.get
|
||||
|
|
@ -174,18 +180,18 @@ handleAction = case _ of
|
|||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: token }
|
||||
H.tell _ws_dns unit (WS.ToSend message)
|
||||
Nothing -> do
|
||||
H.tell _log unit (Log.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token")
|
||||
H.tell _log unit (AppLog.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token")
|
||||
|
||||
AuthenticationComponentEvent ev -> case ev of
|
||||
AF.AuthToken (Tuple uid token) -> do
|
||||
H.modify_ _ { uid = Just uid, token = Just token, current_page = DomainList }
|
||||
handleAction AuthenticateToDNSManager
|
||||
AF.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
AF.Log message -> H.tell _log unit (Log.Log message)
|
||||
AF.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
|
||||
AuthenticationDaemonAdminComponentEvent ev -> case ev of
|
||||
AAI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
AAI.Log message -> H.tell _log unit (Log.Log message)
|
||||
AAI.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
AAI.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
|
||||
AAI.AskState -> do
|
||||
state <- H.get
|
||||
|
|
@ -193,12 +199,12 @@ handleAction = case _ of
|
|||
|
||||
ZoneInterfaceEvent ev -> case ev of
|
||||
ZoneInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)
|
||||
ZoneInterface.Log message -> H.tell _log unit (Log.Log message)
|
||||
ZoneInterface.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
ZoneInterface.DNSManagerReconnect -> handleAction AuthenticateToDNSManager
|
||||
|
||||
DomainListComponentEvent ev -> case ev of
|
||||
DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)
|
||||
DomainListInterface.Log message -> H.tell _log unit (Log.Log message)
|
||||
DomainListInterface.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
DomainListInterface.DNSManagerReconnect -> handleAction AuthenticateToDNSManager
|
||||
DomainListInterface.StoreState s -> H.modify_ _ { store_DomainListInterface_state = Just s }
|
||||
DomainListInterface.ChangePageZoneInterface domain -> do
|
||||
|
|
@ -221,7 +227,7 @@ handleAction = case _ of
|
|||
WS.WSJustClosed -> do
|
||||
H.tell _af unit AF.ConnectionIsDown
|
||||
H.tell _aai unit AAI.ConnectionIsDown
|
||||
WS.Log message -> H.tell _log unit (Log.Log message)
|
||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
|
||||
Disconnection -> do
|
||||
H.put $ initialState unit
|
||||
|
|
@ -232,78 +238,95 @@ handleAction = case _ of
|
|||
WS.MessageReceived (Tuple _ message) -> do
|
||||
handleAction $ DNSRawMessageReceived message
|
||||
WS.WSJustConnected -> do
|
||||
handleAction Log $ SimpleLog "Connection with dnsmanagerd was closed, let's re-authenticate"
|
||||
handleAction $ Log $ SimpleLog "Connection with dnsmanagerd was closed, let's re-authenticate"
|
||||
handleAction AuthenticateToDNSManager
|
||||
H.tell _dli unit DomainListInterface.ConnectionIsUp
|
||||
WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown
|
||||
WS.Log message -> H.tell _log unit (Log.Log message)
|
||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
|
||||
DNSRawMessageReceived message -> do
|
||||
receivedMessage <- H.liftEffect $ DNSManager.deserialize message
|
||||
case receivedMessage of
|
||||
-- Cases where we didn't understand the message.
|
||||
Left err -> do
|
||||
-- handleAction Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err
|
||||
-- handleAction $ Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err
|
||||
case err of
|
||||
(DNSManager.JSONERROR jerr) -> do
|
||||
handleAction Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr
|
||||
handleAction $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr
|
||||
(DNSManager.UnknownError unerr) ->
|
||||
handleAction Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr)
|
||||
handleAction $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr)
|
||||
(DNSManager.UnknownNumber ) ->
|
||||
handleAction Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownNumber"
|
||||
pure Nothing
|
||||
handleAction $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownNumber"
|
||||
|
||||
-- Cases where we understood the message.
|
||||
Right received_msg -> do
|
||||
case received_msg of
|
||||
(DNSManager.MkDomainNotFound _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: DomainNotFound"
|
||||
(DNSManager.MkRRNotFound _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: RRNotFound"
|
||||
(DNSManager.MkInvalidZone _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: InvalidZone"
|
||||
(DNSManager.MkDomainChanged _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: DomainChanged"
|
||||
(DNSManager.MkUnknownZone _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: UnknownZone"
|
||||
(DNSManager.MkDomainList _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: MkDomainList"
|
||||
(DNSManager.MkUnknownUser _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: MkUnknownUser"
|
||||
(DNSManager.MkNoOwnership _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Fail: MkNoOwnership"
|
||||
-- The authentication failed.
|
||||
(DNSManager.MkError errmsg) -> do
|
||||
handleAction Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason
|
||||
(DNSManager.MkErrorUserNotLogged _) -> do
|
||||
handleAction Log $ SimpleLog $ "[😈] Failed! The user isn't connected!"
|
||||
handleAction Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..."
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!"
|
||||
handleAction $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..."
|
||||
handleAction AuthenticateToDNSManager
|
||||
(DNSManager.MkErrorInvalidToken _) -> do
|
||||
H.modify_ _ { token = Nothing, current_page = Home }
|
||||
handleAction Log $ SimpleLog $ "Failed connection! Invalid token! Try re-authenticate."
|
||||
handleAction $ Log $ SimpleLog $ "Failed connection! Invalid token! Try re-authenticate."
|
||||
(DNSManager.MkDomainAlreadyExists _) -> do
|
||||
handleAction Log $ SimpleLog $ "Failed! The domain already exists."
|
||||
handleAction $ Log $ SimpleLog $ "Failed! The domain already exists."
|
||||
m@(DNSManager.MkUnacceptableDomain _) -> do
|
||||
handleAction Log $ SimpleLog $ "Failed! The domain is not acceptable (not in the list of accepted domains)."
|
||||
handleAction $ Log $ SimpleLog $ "Failed! The domain is not acceptable (not in the list of accepted domains)."
|
||||
handleAction $ DispatchDNSMessage m
|
||||
m@(DNSManager.MkAcceptedDomains _) -> do
|
||||
handleAction Log $ SimpleLog $ "Received the list of accepted domains!"
|
||||
handleAction $ Log $ SimpleLog $ "Received the list of accepted domains!"
|
||||
handleAction $ DispatchDNSMessage m
|
||||
(DNSManager.MkLogged _) -> do
|
||||
handleAction Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
|
||||
handleAction $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
|
||||
(DNSManager.MkDomainAdded response) -> do
|
||||
handleAction Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
|
||||
handleAction $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
|
||||
(DNSManager.MkRRReadOnly response) -> do
|
||||
handleAction Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! "
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! "
|
||||
<> "domain: " <> response.domain
|
||||
<> "resource rrid: " <> show response.rr.rrid
|
||||
(DNSManager.MkRRUpdated response) -> do
|
||||
handleAction Log $ SimpleLog $ "[🎉] Resource updated!"
|
||||
(DNSManager.MkRRUpdated _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[🎉] Resource updated!"
|
||||
(DNSManager.MkRRAdded response) -> do
|
||||
handleAction Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype
|
||||
handleAction $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype
|
||||
(DNSManager.MkInvalidDomainName _) -> do
|
||||
handleAction Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"
|
||||
(DNSManager.MkDomainDeleted response) -> do
|
||||
handleAction Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
|
||||
handleAction $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
|
||||
(DNSManager.MkRRDeleted response) -> do
|
||||
handleAction Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
|
||||
(DNSManager.MkZone response) -> do
|
||||
handleAction Log $ SimpleLog $ "[🎉] Zone received!"
|
||||
handleAction $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
|
||||
(DNSManager.MkZone _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[🎉] Zone received!"
|
||||
(DNSManager.MkInvalidRR response) -> do
|
||||
handleAction Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors
|
||||
(DNSManager.MkSuccess _) -> do
|
||||
handleAction Log $ SimpleLog $ "[🎉] Success!"
|
||||
handleAction $ Log $ SimpleLog $ "[🎉] Success!"
|
||||
pure unit
|
||||
|
||||
-- Send a received DNS manager message to a component.
|
||||
DispatchDNSMessage message -> do
|
||||
handleAction Log $ SimpleLog "should send a DNS message to a component"
|
||||
DispatchDNSMessage _ -> do
|
||||
handleAction $ Log $ SimpleLog "should send a DNS message to a component"
|
||||
--{ current_page } <- H.get
|
||||
--case current_page of
|
||||
-- DomainList -> H.tell _dli unit (DomainListInterface.MessageReceived message)
|
||||
-- Zone _ -> H.tell _zi unit (ZoneInterface.MessageReceived message)
|
||||
-- _ -> H.tell _log unit (Log.Log $ SystemLog "unexpected message from dnsmanagerd")
|
||||
-- _ -> H.tell _log unit (AppLog.Log $ SystemLog "unexpected message from dnsmanagerd")
|
||||
pure unit
|
||||
|
|
|
|||
Loading…
Reference in New Issue