diff --git a/src/App/Messages/DNSManagerDaemon.purs b/src/App/Messages/DNSManagerDaemon.purs index 8118571..8130299 100644 --- a/src/App/Messages/DNSManagerDaemon.purs +++ b/src/App/Messages/DNSManagerDaemon.purs @@ -182,6 +182,12 @@ type RRDeleted = { rrid :: Int } codecRRDeleted ∷ CA.JsonCodec RRDeleted codecRRDeleted = CA.object "RRDeleted" (CAR.record { rrid: CA.int }) +{- 19 -} +type RRAdded = { domain :: String, rr :: ResourceRecord.ResourceRecord } +codecRRAdded ∷ CA.JsonCodec RRAdded +codecRRAdded = CA.object "RRAdded" (CAR.record { domain: CA.string, rr: ResourceRecord.codec }) + + {- 50 -} type UnknownUser = { } codecUnknownUser ∷ CA.JsonCodec UnknownUser @@ -227,6 +233,7 @@ data AnswerMessage | MkLogged Logged -- 16 | MkDomainAdded DomainAdded -- 17 | MkRRDeleted RRDeleted -- 18 + | MkRRAdded RRAdded -- 19 | MkUnknownUser UnknownUser -- 50 | MkNoOwnership NoOwnership -- 51 @@ -274,6 +281,7 @@ decode number string 16 -> error_management codecLogged MkLogged 17 -> error_management codecDomainAdded MkDomainAdded 18 -> error_management codecRRDeleted MkRRDeleted + 19 -> error_management codecRRAdded MkRRAdded 50 -> error_management codecUnknownUser MkUnknownUser 51 -> error_management codecNoOwnership MkNoOwnership _ -> Left UnknownNumber diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 2d8d208..4cb8564 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -32,6 +32,7 @@ import Bulma as Bulma import CSSClasses as C import App.RR +import App.ResourceRecord import App.LogMessage (LogMessage(..)) import App.Messages.DNSManagerDaemon as DNSManager @@ -300,32 +301,11 @@ handleAction = case _ of H.raise $ Log $ SimpleLog ("Add simple entry") state <- H.get H.raise $ Log $ SimpleLog ("Add simple entry: " <> show state._current_entry) - H.put $ add_new_entry state state._current_entry + -- H.put $ add_new_entry state state._current_entry AddMX -> do state <- H.get - let form = state._current_entry_mx - newttl = fromMaybe 3600 $ fromString form.ttl - newpriority = fromMaybe 10 $ fromString form.priority - newrr = { rrtype: form.t - , rrid: 0 -- garbage value anyway - , name: form.domain - , ttl: newttl - , target: form.value - , readonly: false - , priority: Just newpriority - , port: Nothing - , protocol: Nothing - , weight: Nothing - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } + let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx) - -- H.put $ add_new_mx state state._current_entry_mx message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } @@ -333,7 +313,7 @@ handleAction = case _ of AddSRV -> do state <- H.get H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv) - H.put $ add_new_srv state state._current_entry_srv + -- H.put $ add_new_srv state state._current_entry_srv UpdateLocalSRRForm rr_id rr_update -> case rr_update of Update_SRR_Type val -> do @@ -489,23 +469,33 @@ handleQuery = case _ of (DNSManager.MkAcceptedDomains _) -> do H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!" - -- handleAction $ UpdateAcceptedDomains response.domains (DNSManager.MkLogged _) -> do H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!" - -- handleAction $ UpdateAcceptedDomains response.accepted_domains - -- handleAction $ UpdateMyDomains response.my_domains (DNSManager.MkDomainAdded response) -> do H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain - -- handleAction $ UpdateMyDomains (my_domains <> [response.domain]) + + (DNSManager.MkRRAdded response) -> do + state <- H.get + let new_rr = response.rr + H.raise $ Log $ SimpleLog + $ "[TODO] Resource Record added: " <> response.domain + <> " rrid: " <> show new_rr.rrid + <> " rrtype: " <> new_rr.rrtype + <> " name: " <> new_rr.name + <> " ttl: " <> show new_rr.ttl + <> " target: " <> new_rr.target + <> " readonly: " <> show new_rr.readonly + case add_entry state new_rr of + Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message + Right new_state -> H.put new_state (DNSManager.MkInvalidDomainName _) -> do H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!" (DNSManager.MkDomainDeleted response) -> do H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!" - -- handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains (DNSManager.MkRRDeleted response) -> do H.raise $ Log $ SimpleLog $ "[🎉] RR (id: '" <> show response.rrid <> "') has been deleted!" state <- H.get @@ -543,6 +533,14 @@ handleQuery = case _ of Just { head: x, tail: xs } -> "(" <> x.rrtype <> ": " <> show x.rrid <> ") " <> resource_list xs Nothing -> "" + add_entry :: State -> ResourceRecord -> Either String State + add_entry state new_rr = do + case new_rr.rrtype, (A.elem new_rr.rrtype baseRecords) of + _, true -> Right $ add_new_entry state $ fromResourceRecordToLocalRepresentationSimpleRR new_rr + "MX", _ -> Right $ add_new_mx state $ fromResourceRecordToLocalRepresentationMXRR new_rr + "SRV", _ -> Right $ add_new_srv state $ fromResourceRecordToLocalRepresentationSRVRR new_rr + _, _ -> Left "TODO: CAN'T ADD THIS KIND OF RR RIGHT NOW" + -- Rendering class_title_size :: Array (HH.ClassName) class_title_size = [HH.ClassName "is-4"] @@ -767,28 +765,22 @@ render_new_record_colunm_srv rr -- ACTIONS -- add a new record and get a new placeholter -add_new_entry :: State -> (SimpleRR ()) -> State -add_new_entry state rr - = state { _srr = new_rr_list, _current_entry = new_placeholder } - where new_placeholder = defaultResourceA - new_rr_list = state._srr <> [ new_rr ] - new_rr = rr { id = getNewID state } +add_new_entry :: State -> Maybe (SimpleRR ()) -> State +add_new_entry state = case _ of + Nothing -> state + Just rr -> state { _srr = (state._srr <> [ rr ]), _current_entry = defaultResourceA } -- add a new record and get a new placeholter -add_new_mx :: State -> (MXRR ()) -> State -add_new_mx state rr - = state { _mxrr = new_rr_list, _current_entry_mx = new_placeholder } - where new_placeholder = defaultResourceMX - new_rr_list = state._mxrr <> [ new_rr ] - new_rr = rr { id = getNewID state } +add_new_mx :: State -> Maybe (MXRR ()) -> State +add_new_mx state = case _ of + Nothing -> state + Just rr -> state { _mxrr = (state._mxrr <> [ rr ]), _current_entry_mx = defaultResourceMX } -- add a new record and get a new placeholter -add_new_srv :: State -> (SRVRR ()) -> State -add_new_srv state rr - = state { _srvrr = new_rr_list, _current_entry_srv = new_placeholder } - where new_placeholder = defaultResourceSRV - new_rr_list = state._srvrr <> [ new_rr ] - new_rr = rr { id = getNewID state } +add_new_srv :: State -> Maybe (SRVRR ()) -> State +add_new_srv state = case _ of + Nothing -> state + Just rr -> state { _srvrr = (state._srvrr <> [ rr ]), _current_entry_srv = defaultResourceSRV } changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l) changeType rr Nothing = rr @@ -832,6 +824,72 @@ update f rr_id records = map doSmth records | rr_id == rr.id = f rr | otherwise = rr +fromResourceRecordToLocalRepresentationSimpleRR :: ResourceRecord -> Maybe (SimpleRR ()) +fromResourceRecordToLocalRepresentationSimpleRR new_rr = + Just { t: new_rr.rrtype + , id: new_rr.rrid + , modified: false + , valid: true + , ttl: show new_rr.ttl + , domain: new_rr.name + , value: new_rr.target + } + +fromResourceRecordToLocalRepresentationMXRR :: ResourceRecord -> Maybe (MXRR ()) +fromResourceRecordToLocalRepresentationMXRR new_rr = do + priority <- new_rr.priority + Just { t: new_rr.rrtype + , id: new_rr.rrid + , modified: false + , valid: true + , ttl: show new_rr.ttl + , domain: new_rr.name + , value: new_rr.target + , priority: show priority + } +-- TODO: would be nice to have a simpler implementation, something like this: +--fromResourceRecordToLocalRepresentationMXRR new_rr +-- = let simple_rr = fromResourceRecordToLocalRepresentationSimpleRR new_rr +-- simple_rr { priority = show new_rr.priority } + +fromResourceRecordToLocalRepresentationSRVRR :: ResourceRecord -> Maybe (SRVRR ()) +fromResourceRecordToLocalRepresentationSRVRR new_rr = do + case new_rr.priority, new_rr.weight, new_rr.port of + Just priority, Just weight, Just port -> + Just { t: new_rr.rrtype + , id: new_rr.rrid + , modified: false + , valid: true + , ttl: show new_rr.ttl + , domain: new_rr.name + , value: new_rr.target + , priority: show priority + , port: show port + , weight: show weight + -- , protocol: protocol + } + _, _, _ -> Nothing + +fromLocalMXRRRepresentationToResourceRecord :: MXRR () -> ResourceRecord +fromLocalMXRRRepresentationToResourceRecord form + = { rrtype: form.t + , rrid: form.id + , name: form.domain + , ttl: fromMaybe 3600 $ fromString form.ttl + , target: form.value + , readonly: false + , priority: Just $ fromMaybe 10 $ fromString form.priority + , port: Nothing + , protocol: Nothing + , weight: Nothing + , mname: Nothing + , rname: Nothing + , serial: Nothing + , refresh: Nothing + , retry: Nothing + , expire: Nothing + , minttl: Nothing + } getNewID :: State -> Int getNewID state = (_ + 1)