ZoneInterface is now somewhat working again. Should remove useless log messages.
parent
5ac94bf0fe
commit
7c6cb46c12
|
|
@ -205,12 +205,11 @@ handleAction = case _ of
|
||||||
DomainListComponentEvent ev -> case ev of
|
DomainListComponentEvent ev -> case ev of
|
||||||
DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)
|
DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)
|
||||||
DomainListInterface.Log message -> H.tell _log unit (AppLog.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.StoreState s -> H.modify_ _ { store_DomainListInterface_state = Just s }
|
||||||
DomainListInterface.ChangePageZoneInterface domain -> do
|
DomainListInterface.ChangePageZoneInterface domain -> do
|
||||||
handleAction $ Routing $ Zone domain
|
handleAction $ Routing $ Zone domain
|
||||||
|
|
||||||
DomainListInterface.AskState -> do
|
DomainListInterface.AskState -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.tell _dli unit (DomainListInterface.ProvideState state.store_DomainListInterface_state)
|
H.tell _dli unit (DomainListInterface.ProvideState state.store_DomainListInterface_state)
|
||||||
|
|
||||||
|
|
@ -237,12 +236,12 @@ handleAction = case _ of
|
||||||
DNSManagerDaemonEvent ev -> case ev of
|
DNSManagerDaemonEvent ev -> case ev of
|
||||||
WS.MessageReceived (Tuple _ message) -> do
|
WS.MessageReceived (Tuple _ message) -> do
|
||||||
handleAction $ DNSRawMessageReceived message
|
handleAction $ DNSRawMessageReceived message
|
||||||
WS.WSJustConnected -> do
|
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
|
handleAction AuthenticateToDNSManager
|
||||||
H.tell _dli unit DomainListInterface.ConnectionIsUp
|
H.tell _dli unit DomainListInterface.ConnectionIsUp
|
||||||
WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown
|
WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown
|
||||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||||
|
|
||||||
DNSRawMessageReceived message -> do
|
DNSRawMessageReceived message -> do
|
||||||
receivedMessage <- H.liftEffect $ DNSManager.deserialize message
|
receivedMessage <- H.liftEffect $ DNSManager.deserialize message
|
||||||
|
|
@ -290,43 +289,59 @@ handleAction = case _ of
|
||||||
(DNSManager.MkDomainAlreadyExists _) -> do
|
(DNSManager.MkDomainAlreadyExists _) -> do
|
||||||
handleAction $ Log $ SimpleLog $ "Failed! The domain already exists."
|
handleAction $ Log $ SimpleLog $ "Failed! The domain already exists."
|
||||||
m@(DNSManager.MkUnacceptableDomain _) -> do
|
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
|
handleAction $ DispatchDNSMessage m
|
||||||
m@(DNSManager.MkAcceptedDomains _) -> do
|
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
|
||||||
|
m@(DNSManager.MkLogged _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog $ "[🎉] Authenticated to dnsmanagerd!"
|
||||||
|
handleAction $ DispatchDNSMessage m
|
||||||
|
m@(DNSManager.MkDomainAdded response) -> do
|
||||||
|
handleAction $ Log $ SimpleLog $ "[🎉] Domain added: " <> response.domain
|
||||||
handleAction $ DispatchDNSMessage m
|
handleAction $ DispatchDNSMessage m
|
||||||
(DNSManager.MkLogged _) -> do
|
|
||||||
handleAction $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
|
|
||||||
(DNSManager.MkDomainAdded response) -> do
|
|
||||||
handleAction $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
|
|
||||||
(DNSManager.MkRRReadOnly response) -> do
|
(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
|
<> "domain: " <> response.domain
|
||||||
<> "resource rrid: " <> show response.rr.rrid
|
<> "resource rrid: " <> show response.rr.rrid
|
||||||
(DNSManager.MkRRUpdated _) -> do
|
m@(DNSManager.MkRRUpdated _) -> do
|
||||||
handleAction $ Log $ SimpleLog $ "[🎉] Resource updated!"
|
handleAction $ Log $ SimpleLog $ "[🎉] Resource updated!"
|
||||||
(DNSManager.MkRRAdded response) -> do
|
handleAction $ DispatchDNSMessage m
|
||||||
|
m@(DNSManager.MkRRAdded response) -> do
|
||||||
handleAction $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype
|
handleAction $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype
|
||||||
|
handleAction $ DispatchDNSMessage m
|
||||||
(DNSManager.MkInvalidDomainName _) -> do
|
(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
|
m@(DNSManager.MkDomainDeleted response) -> do
|
||||||
handleAction $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
|
handleAction $ Log $ SimpleLog $ "[🎉] The domain '" <> response.domain <> "' has been deleted!"
|
||||||
(DNSManager.MkRRDeleted response) -> do
|
handleAction $ DispatchDNSMessage m
|
||||||
|
m@(DNSManager.MkRRDeleted response) -> do
|
||||||
handleAction $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
|
handleAction $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
|
||||||
(DNSManager.MkZone _) -> do
|
handleAction $ DispatchDNSMessage m
|
||||||
|
m@(DNSManager.MkZone _) -> do
|
||||||
handleAction $ Log $ SimpleLog $ "[🎉] Zone received!"
|
handleAction $ Log $ SimpleLog $ "[🎉] Zone received!"
|
||||||
|
handleAction $ DispatchDNSMessage m
|
||||||
(DNSManager.MkInvalidRR response) -> do
|
(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
|
(DNSManager.MkSuccess _) -> do
|
||||||
handleAction $ Log $ SimpleLog $ "[🎉] Success!"
|
handleAction $ Log $ SimpleLog $ "[🎉] Success!"
|
||||||
|
handleAction $ Log $ SimpleLog $ "LETS GOOOOOOOOOOOOO!"
|
||||||
pure unit
|
pure unit
|
||||||
|
|
||||||
-- Send a received DNS manager message to a component.
|
-- Send a received DNS manager message to a component.
|
||||||
DispatchDNSMessage _ -> do
|
DispatchDNSMessage message -> do
|
||||||
handleAction $ Log $ SimpleLog "should send a DNS message to a component"
|
handleAction $ Log $ SimpleLog "should send a DNS message to a component"
|
||||||
--{ current_page } <- H.get
|
{ current_page } <- H.get
|
||||||
--case current_page of
|
case current_page of
|
||||||
-- DomainList -> H.tell _dli unit (DomainListInterface.MessageReceived message)
|
DomainList -> H.tell _dli unit (DomainListInterface.MessageReceived message)
|
||||||
-- Zone _ -> H.tell _zi unit (ZoneInterface.MessageReceived message)
|
Zone _ -> H.tell _zi unit (ZoneInterface.MessageReceived message)
|
||||||
-- _ -> H.tell _log unit (AppLog.Log $ SystemLog "unexpected message from dnsmanagerd")
|
_ -> H.tell _log unit (AppLog.Log $ SystemLog "unexpected message from dnsmanagerd")
|
||||||
pure unit
|
pure unit
|
||||||
|
|
||||||
|
--print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
|
||||||
|
--print_json_string arraybuffer = do
|
||||||
|
-- -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
|
||||||
|
-- value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
|
||||||
|
-- H.raise $ Log $ SimpleLog $ case (value) of
|
||||||
|
-- Left _ -> "Cannot even fromTypedIPC the message."
|
||||||
|
-- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
|
||||||
|
|
|
||||||
|
|
@ -31,7 +31,6 @@ import CSSClasses as C
|
||||||
|
|
||||||
import Parsing (runParser)
|
import Parsing (runParser)
|
||||||
import DomainParser as DomainParser
|
import DomainParser as DomainParser
|
||||||
|
|
||||||
import App.LogMessage
|
import App.LogMessage
|
||||||
import App.Messages.DNSManagerDaemon as DNSManager
|
import App.Messages.DNSManagerDaemon as DNSManager
|
||||||
|
|
||||||
|
|
@ -51,7 +50,6 @@ import App.Messages.DNSManagerDaemon as DNSManager
|
||||||
data Output
|
data Output
|
||||||
= MessageToSend ArrayBuffer
|
= MessageToSend ArrayBuffer
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
| DNSManagerReconnect
|
|
||||||
| ChangePageZoneInterface String
|
| ChangePageZoneInterface String
|
||||||
| AskState
|
| AskState
|
||||||
| StoreState State
|
| StoreState State
|
||||||
|
|
@ -64,7 +62,7 @@ data Output
|
||||||
-- | See the explanation for the `Output` data type.
|
-- | See the explanation for the `Output` data type.
|
||||||
|
|
||||||
data Query a
|
data Query a
|
||||||
= MessageReceived ArrayBuffer a
|
= MessageReceived DNSManager.AnswerMessage a
|
||||||
| ConnectionIsDown a
|
| ConnectionIsDown a
|
||||||
| ConnectionIsUp a
|
| ConnectionIsUp a
|
||||||
| ProvideState (Maybe State) a
|
| ProvideState (Maybe State) a
|
||||||
|
|
@ -266,7 +264,7 @@ handleAction = case _ of
|
||||||
H.modify_ _ { newDomainForm { new_domain = v } }
|
H.modify_ _ { newDomainForm { new_domain = v } }
|
||||||
case v of
|
case v of
|
||||||
"" -> H.modify_ _ { newDomainForm { error_string = Nothing } }
|
"" -> H.modify_ _ { newDomainForm { error_string = Nothing } }
|
||||||
otherwise -> case runParser v DomainParser.domain of
|
_ -> case runParser v DomainParser.domain of
|
||||||
Left error_string -> H.modify_ _ { newDomainForm { error_string = Just $ show error_string } }
|
Left error_string -> H.modify_ _ { newDomainForm { error_string = Just $ show error_string } }
|
||||||
Right _ -> H.modify_ _ { newDomainForm { error_string = Nothing } }
|
Right _ -> H.modify_ _ { newDomainForm { error_string = Nothing } }
|
||||||
UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
|
UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
|
||||||
|
|
@ -313,63 +311,21 @@ handleQuery = case _ of
|
||||||
pure (Just a)
|
pure (Just a)
|
||||||
|
|
||||||
MessageReceived message a -> do
|
MessageReceived message a -> do
|
||||||
receivedMessage <- H.liftEffect $ DNSManager.deserialize message
|
case message of
|
||||||
case receivedMessage of
|
-- The authentication failed.
|
||||||
-- Cases where we didn't understand the message.
|
(DNSManager.MkAcceptedDomains response) -> do
|
||||||
Left _ -> do
|
handleAction $ UpdateAcceptedDomains response.domains
|
||||||
-- case err of
|
(DNSManager.MkLogged response) -> do
|
||||||
-- (DNSManager.JSONERROR jerr) -> do
|
handleAction $ UpdateAcceptedDomains response.accepted_domains
|
||||||
-- print_json_string message
|
handleAction $ UpdateMyDomains response.my_domains
|
||||||
-- handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr)
|
(DNSManager.MkDomainAdded response) -> do
|
||||||
-- (DNSManager.UnknownError unerr) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownError" <> (show unerr))
|
{ my_domains } <- H.get
|
||||||
-- (DNSManager.UnknownNumber ) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownNumber")
|
handleAction $ UpdateMyDomains (my_domains <> [response.domain])
|
||||||
pure Nothing
|
(DNSManager.MkDomainDeleted response) -> do
|
||||||
|
{ my_domains } <- H.get
|
||||||
-- Cases where we understood the message.
|
handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
|
||||||
Right received_msg -> do
|
_ -> H.raise $ Log $ SimpleLog $ "[😈] Message not handled in DomainListInterface."
|
||||||
case received_msg of
|
pure (Just a)
|
||||||
-- The authentication failed.
|
|
||||||
(DNSManager.MkError errmsg) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason
|
|
||||||
(DNSManager.MkErrorUserNotLogged _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!"
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..."
|
|
||||||
H.raise $ DNSManagerReconnect
|
|
||||||
(DNSManager.MkErrorInvalidToken _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed connection! Invalid token!"
|
|
||||||
(DNSManager.MkDomainAlreadyExists _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain already exists."
|
|
||||||
(DNSManager.MkUnacceptableDomain _) -> do
|
|
||||||
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!"
|
|
||||||
handleAction $ UpdateAcceptedDomains response.domains
|
|
||||||
|
|
||||||
(DNSManager.MkLogged response) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Authenticated to dnsmanagerd!"
|
|
||||||
handleAction $ UpdateAcceptedDomains response.accepted_domains
|
|
||||||
handleAction $ UpdateMyDomains response.my_domains
|
|
||||||
|
|
||||||
(DNSManager.MkDomainAdded response) -> do
|
|
||||||
{ my_domains } <- H.get
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Domain added: " <> response.domain
|
|
||||||
handleAction $ UpdateMyDomains (my_domains <> [response.domain])
|
|
||||||
|
|
||||||
(DNSManager.MkInvalidDomainName _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"
|
|
||||||
|
|
||||||
(DNSManager.MkDomainDeleted response) -> do
|
|
||||||
{ my_domains } <- H.get
|
|
||||||
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!"
|
|
||||||
-- WTH?!
|
|
||||||
_ -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."
|
|
||||||
pure (Just a)
|
|
||||||
|
|
||||||
ConnectionIsDown a -> do
|
ConnectionIsDown a -> do
|
||||||
H.modify_ _ { wsUp = false }
|
H.modify_ _ { wsUp = false }
|
||||||
|
|
@ -383,11 +339,3 @@ build_new_domain :: String -> String -> String
|
||||||
build_new_domain sub tld
|
build_new_domain sub tld
|
||||||
| endsWith "." sub = sub <> tld
|
| endsWith "." sub = sub <> tld
|
||||||
| otherwise = sub <> "." <> tld
|
| otherwise = sub <> "." <> tld
|
||||||
|
|
||||||
--print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
|
|
||||||
--print_json_string arraybuffer = do
|
|
||||||
-- -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
|
|
||||||
-- value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
|
|
||||||
-- H.raise $ Log $ SimpleLog $ case (value) of
|
|
||||||
-- Left _ -> "Cannot even fromTypedIPC the message."
|
|
||||||
-- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
|
|
||||||
|
|
|
||||||
|
|
@ -63,7 +63,7 @@ data Output
|
||||||
-- | The component is also informed when the connection is lost or up again.
|
-- | The component is also informed when the connection is lost or up again.
|
||||||
|
|
||||||
data Query a
|
data Query a
|
||||||
= MessageReceived ArrayBuffer a
|
= MessageReceived DNSManager.AnswerMessage a
|
||||||
| ConnectionIsDown a
|
| ConnectionIsDown a
|
||||||
| ConnectionIsUp a
|
| ConnectionIsUp a
|
||||||
|
|
||||||
|
|
@ -493,93 +493,66 @@ handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () O
|
||||||
handleQuery = case _ of
|
handleQuery = case _ of
|
||||||
|
|
||||||
MessageReceived message a -> do
|
MessageReceived message a -> do
|
||||||
receivedMessage <- H.liftEffect $ DNSManager.deserialize message
|
case message of
|
||||||
case receivedMessage of
|
-- The authentication failed.
|
||||||
-- Cases where we didn't understand the message.
|
(DNSManager.MkError errmsg) -> do
|
||||||
Left err -> do
|
H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason
|
||||||
--H.raise $ Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err
|
(DNSManager.MkErrorUserNotLogged _) -> do
|
||||||
case err of
|
H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!"
|
||||||
(DNSManager.JSONERROR jerr) -> do
|
H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..."
|
||||||
H.raise $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr
|
H.raise $ DNSManagerReconnect
|
||||||
(DNSManager.UnknownError unerr) ->
|
(DNSManager.MkErrorInvalidToken _) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr)
|
H.raise $ Log $ SimpleLog $ "[TODO] Failed connection! Invalid token!"
|
||||||
(DNSManager.UnknownNumber ) ->
|
(DNSManager.MkDomainAlreadyExists _) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownNumber"
|
H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain already exists."
|
||||||
pure Nothing
|
(DNSManager.MkUnacceptableDomain _) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)."
|
||||||
-- Cases where we understood the message.
|
(DNSManager.MkAcceptedDomains _) -> do
|
||||||
Right received_msg -> do
|
H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!"
|
||||||
case received_msg of
|
(DNSManager.MkLogged _) -> do
|
||||||
-- The authentication failed.
|
H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
|
||||||
(DNSManager.MkError errmsg) -> do
|
(DNSManager.MkDomainAdded response) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason
|
H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
|
||||||
(DNSManager.MkErrorUserNotLogged _) -> do
|
(DNSManager.MkRRReadOnly response) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!"
|
H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! "
|
||||||
H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..."
|
<> "domain: " <> response.domain
|
||||||
H.raise $ DNSManagerReconnect
|
<> "resource rrid: " <> show response.rr.rrid
|
||||||
(DNSManager.MkErrorInvalidToken _) -> do
|
(DNSManager.MkRRUpdated response) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[TODO] Failed connection! Invalid token!"
|
H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!"
|
||||||
(DNSManager.MkDomainAlreadyExists _) -> do
|
replace_entry response.rr
|
||||||
H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain already exists."
|
(DNSManager.MkRRAdded response) -> do
|
||||||
(DNSManager.MkUnacceptableDomain _) -> do
|
state <- H.get
|
||||||
H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)."
|
let new_rr = response.rr
|
||||||
|
H.raise $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> new_rr.rrtype
|
||||||
(DNSManager.MkAcceptedDomains _) -> do
|
case add_entry state new_rr of
|
||||||
H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!"
|
Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
|
||||||
|
Right new_state -> H.put new_state
|
||||||
(DNSManager.MkLogged _) -> do
|
(DNSManager.MkInvalidDomainName _) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
|
H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"
|
||||||
|
(DNSManager.MkDomainDeleted response) -> do
|
||||||
(DNSManager.MkDomainAdded response) -> do
|
H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
|
||||||
H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
|
(DNSManager.MkRRDeleted response) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
|
||||||
(DNSManager.MkRRReadOnly response) -> do
|
-- Remove the resource record.
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! "
|
state <- H.get
|
||||||
<> "domain: " <> response.domain
|
H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr
|
||||||
<> "resource rrid: " <> show response.rr.rrid
|
, _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr
|
||||||
|
, _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr
|
||||||
(DNSManager.MkRRUpdated response) -> do
|
}
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!"
|
-- Remove its possible errors.
|
||||||
replace_entry response.rr
|
let new_error_hash = Hash.delete response.rrid state._errors
|
||||||
|
H.modify_ _ { _errors = new_error_hash }
|
||||||
(DNSManager.MkRRAdded response) -> do
|
(DNSManager.MkZone response) -> do
|
||||||
state <- H.get
|
H.raise $ Log $ SimpleLog $ "[🎉] Zone received!"
|
||||||
let new_rr = response.rr
|
add_entries response.zone.resources
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> new_rr.rrtype
|
(DNSManager.MkInvalidRR response) -> do
|
||||||
case add_entry state new_rr of
|
H.raise $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors
|
||||||
Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
|
(DNSManager.MkSuccess _) -> do
|
||||||
Right new_state -> H.put new_state
|
H.raise $ Log $ SimpleLog $ "[🎉] Success!"
|
||||||
|
-- WTH?!
|
||||||
(DNSManager.MkInvalidDomainName _) -> do
|
_ -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"
|
H.raise $ Log $ SimpleLog $ "[😈] Failed! dnsmanager daemon didn't send a valid message."
|
||||||
|
pure (Just a)
|
||||||
(DNSManager.MkDomainDeleted response) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
|
|
||||||
(DNSManager.MkRRDeleted response) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
|
|
||||||
-- Remove the resource record.
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr
|
|
||||||
, _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr
|
|
||||||
, _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr
|
|
||||||
}
|
|
||||||
-- Remove its possible errors.
|
|
||||||
let new_error_hash = Hash.delete response.rrid state._errors
|
|
||||||
H.modify_ _ { _errors = new_error_hash }
|
|
||||||
|
|
||||||
(DNSManager.MkZone response) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Zone received!"
|
|
||||||
add_entries response.zone.resources
|
|
||||||
|
|
||||||
(DNSManager.MkInvalidRR response) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors
|
|
||||||
|
|
||||||
(DNSManager.MkSuccess _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Success!"
|
|
||||||
-- WTH?!
|
|
||||||
_ -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! dnsmanager daemon didn't send a valid message."
|
|
||||||
pure (Just a)
|
|
||||||
|
|
||||||
ConnectionIsDown a -> do
|
ConnectionIsDown a -> do
|
||||||
H.modify_ _ { wsUp = false }
|
H.modify_ _ { wsUp = false }
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue