diff --git a/src/App/Container.purs b/src/App/Container.purs index 8acc300..00200e6 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -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. diff --git a/src/App/Page/Migration.purs b/src/App/Page/Migration.purs index 11569a0..ecf031d 100644 --- a/src/App/Page/Migration.purs +++ b/src/App/Page/Migration.purs @@ -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 diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index ac2f8f1..33fbd7f 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -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. ⚠"] ]