Baguette/dnsmanager-webclient
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove the last MessageToSend events from components.

Browse source
This commit is contained in:
Philippe Pittoli 2025-05-11 18:41:55 +02:00
parent 507588cd66
commit 6d6899d809
3 changed files with 52 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
src/App/Container.purs
View file

@ -616,9 +616,26 @@ handleAction = case _ of
H.tell _ws_dns unit (WS.ToSend message)
EventPageZone ev -> case ev of
PageZone.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)
PageZone.Log message -> handleAction $ Log message
PageZone.ToDomainList -> handleAction $ Routing DomainList
PageZone.AskZoneFile domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskGeneratedZoneFile { domain }
H.tell _ws_dns unit (WS.ToSend message)
PageZone.AskNewToken domain rrid -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkNewToken { domain, rrid }
H.tell _ws_dns unit (WS.ToSend message)
PageZone.AskDeleteRR domain rrid -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteRR { domain, rrid }
H.tell _ws_dns unit (WS.ToSend message)
PageZone.AskSaveRR domain rr -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkUpdateRR { domain, rr }
H.tell _ws_dns unit (WS.ToSend message)
PageZone.AskAddRR domain rr -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAddRR { domain, rr }
H.tell _ws_dns unit (WS.ToSend message)
PageZone.AskGetZone domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain }
H.tell _ws_dns unit (WS.ToSend message)
EventPageDomainList ev -> case ev of
PageDomainList.AskShareToken domain -> do
@ -832,7 +849,12 @@ handleAction = case _ of
pure unit
EventPageMigration ev -> case ev of
PageMigration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
PageMigration.AskNewEmailAddress email -> do
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddress { email }
H.tell _ws_auth unit (WS.ToSend message)
PageMigration.AskNewEmailAddressTokenAddress token -> do
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddressToken { token }
H.tell _ws_auth unit (WS.ToSend message)
PageMigration.Log message -> handleAction $ Log message
-- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.

17
src/App/Page/Migration.purs
View file

@ -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 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.
@ -181,12 +178,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

57
src/App/Page/Zone.purs
View file

@ -25,7 +25,6 @@ import Web.Storage.Storage as Storage
import Data.Eq (class Eq)
import Data.Array as A
import Data.Int (fromString)
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..))
import Data.String (toLower)
@ -62,10 +61,16 @@ import App.Type.RRForm (RRForm, RRUpdateValue(..), default_caa, default_rr, mkEm
-- | reconnect the websocket to `dnsmanagerd`.
data Output
= MessageToSend ArrayBuffer
| Log LogMessage
= Log LogMessage
| ToDomainList
| AskZoneFile String
| AskNewToken String Int
| AskDeleteRR String Int
| AskSaveRR String ResourceRecord
| AskAddRR String ResourceRecord
| AskGetZone String
-- | `App.Page.Zone` can receive messages from `dnsmanagerd`.
data Query a
@ -136,7 +141,7 @@ data Action
| RemoveRR RRId
-- | Ask `dnsmanagerd` for the generated zone file.
| AskZoneFile
| AskGeneratedZoneFile
-- | Modification of any attribute of the current RR.
| RRUpdate RRUpdateValue
@ -295,8 +300,7 @@ handleAction = case _ of
Initialize -> do
{ _domain } <- H.get
H.raise $ Log $ SystemLog $ "Asking the domain " <> _domain
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain }
H.raise $ MessageToSend message
H.raise $ AskGetZone _domain
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
old_tab <- H.liftEffect $ Storage.getItem "current-zone-tab" sessionstorage
@ -341,13 +345,10 @@ handleAction = case _ of
-- | Try to add a resource record to the zone.
-- | Can fail if the content of the form isn't valid.
AddRR t newrr -> do
state <- H.get
{ _domain } <- H.get
H.raise $ Log $ SystemLog $ "Add new " <> show t
H.modify_ _ { _rr_form { _zonefile = Nothing } }
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
H.raise $ MessageToSend message
H.raise $ AskAddRR _domain newrr
-- | Update the currently displayed RR form (new or update RR).
UpdateCurrentRR field -> do
@ -390,43 +391,29 @@ handleAction = case _ of
}
SaveRR rr -> do
state <- H.get
{ _domain } <- H.get
H.raise $ Log $ SystemLog $ "Updating resource record " <> show rr.rrid
H.modify_ _ { _rr_form { _zonefile = Nothing } }
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkUpdateRR { domain: state._domain, rr: rr }
H.raise $ MessageToSend message
H.raise $ AskSaveRR _domain rr
handleAction $ ResetTemporaryValues
RemoveRR rr_id -> do
{ _domain } <- H.get
H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
H.modify_ _ { _rr_form { _zonefile = Nothing } }
-- Send a removal message.
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id }
H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "Ask to remove a RR " <> show rr_id
H.raise $ AskDeleteRR _domain rr_id
-- Modal doesn't need to be active anymore.
handleAction CancelModal
NewToken rr_id -> do
{ _domain } <- H.get
H.raise $ Log $ SystemLog $ "Ask a token for rrid " <> show rr_id
-- Send a NewToken message.
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkNewToken { domain: _domain, rrid: rr_id }
H.raise $ MessageToSend message
H.raise $ AskNewToken _domain rr_id
AskZoneFile -> do
state <- H.get
H.raise $ Log $ SystemLog $ "Asking for the '" <> state._domain <> "' zonefile"
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkAskGeneratedZoneFile { domain: state._domain }
H.raise $ MessageToSend message
AskGeneratedZoneFile -> do
{ _domain } <- H.get
H.raise $ Log $ SystemLog $ "Asking for the '" <> _domain <> "' zonefile"
H.raise $ AskZoneFile _domain
RRUpdate value_to_update -> do
state <- H.get
@ -515,7 +502,7 @@ render_new_records _
] []
, Web.hr
, Web.level [
Web.btn "Get the final zone file" AskZoneFile
Web.btn "Get the final zone file" AskGeneratedZoneFile
] [HH.text "For debug purposes. ⚠"]
]