From ffecb63c8daa3f2ced44aa690a714de787151cd7 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 17 Jun 2023 18:07:24 +0200 Subject: [PATCH] DNSManager messages: mostly done. Build is okay. --- src/App/DNSZone.purs | 18 +++++++++ src/App/MaintenanceSubject.purs | 2 +- src/App/Messages/DNSManagerDaemon.purs | 54 ++++++++++++++------------ src/App/ResourceRecord.purs | 18 +++++++++ 4 files changed, 66 insertions(+), 26 deletions(-) create mode 100644 src/App/DNSZone.purs create mode 100644 src/App/ResourceRecord.purs diff --git a/src/App/DNSZone.purs b/src/App/DNSZone.purs new file mode 100644 index 0000000..7cf1f54 --- /dev/null +++ b/src/App/DNSZone.purs @@ -0,0 +1,18 @@ +module App.DNSZone where + +import Prelude + +import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut as CA +import Data.Newtype (class Newtype) +import Data.Profunctor (wrapIso) + +newtype DNSZone = DNSZone String + +derive instance newtypeDNSZone :: Newtype DNSZone _ +derive instance eqDNSZone :: Eq DNSZone +derive instance ordDNSZone :: Ord DNSZone + +-- | DNSZone.codec can be used to parse and encode email addresses. +codec :: JsonCodec DNSZone +codec = wrapIso DNSZone CA.string diff --git a/src/App/MaintenanceSubject.purs b/src/App/MaintenanceSubject.purs index 9eb1c33..0fc7c77 100644 --- a/src/App/MaintenanceSubject.purs +++ b/src/App/MaintenanceSubject.purs @@ -13,7 +13,7 @@ codec = where from :: String -> Maybe MaintenanceSubject from = case _ of - "verbosity" -> Just None + "verbosity" -> Just Verbosity _ -> Nothing to :: MaintenanceSubject -> String diff --git a/src/App/Messages/DNSManagerDaemon.purs b/src/App/Messages/DNSManagerDaemon.purs index 68f4595..46cba19 100644 --- a/src/App/Messages/DNSManagerDaemon.purs +++ b/src/App/Messages/DNSManagerDaemon.purs @@ -15,28 +15,35 @@ import Data.Tuple (Tuple(..)) import Data.ArrayBuffer.Types (ArrayBuffer) -- import App.PermissionLevel as PermissionLevel +import App.MaintenanceSubject as MaintenanceSubject import Effect.Class (liftEffect) import Data.Argonaut.Parser as JSONParser import Data.Bifunctor (lmap) import App.IPC as IPC +import App.DNSZone as DNSZone +import App.ResourceRecord as ResourceRecord {- UserID should be in a separate module with a dedicated codec. -} type UserID = Int -- UserID is either a login or an uid number {- 7 -} -data MaintenanceSubject = Verbosity -type Maintenance = { subject :: MaintenanceSubject, value :: Maybe Int } -codecMaintenance = CA.object "Maintenance" (CAR.record { subject: CA.string, value: CA.int }) +type Maintenance = { subject :: MaintenanceSubject.MaintenanceSubject, value :: Maybe Int } +codecMaintenance = CA.object "Maintenance" (CAR.record { subject: MaintenanceSubject.codec, value: CAR.optional CA.int }) {- 0 -} type Login = { token :: String } codecLogin = CA.object "Login" (CAR.record { token: CA.string }) +{- 9 -} +type NewDomain = { domain :: String } +codecNewDomain = CA.object "NewDomain" (CAR.record { domain: CA.string }) + {- 10 -} --- type AddOrUpdateZone = { zone :: DNSManager::Storage::Zone } +type AddOrUpdateZone = { zone :: DNSZone.DNSZone } +codecAddOrUpdateZone = CA.object "AddOrUpdateZone" (CAR.record { zone: DNSZone.codec }) {- 11 -} type DeleteZone = { domain :: String } @@ -51,12 +58,12 @@ type UserDomains = {} codecUserDomains = CA.object "UserDomains" (CAR.record {}) {- 14 -} --- type AddRR = { domain :: String, rr :: DNSManager::Storage::Zone::ResourceRecord } --- codecAddRR = CA.object "AddRR" (CAR.record { domain: CA.string, rr: ResourceRecord.codec }) +type AddRR = { domain :: String, rr :: ResourceRecord.ResourceRecord } +codecAddRR = CA.object "AddRR" (CAR.record { domain: CA.string, rr: ResourceRecord.codec }) {- 15 -} --- type UpdateRR = { domain :: String, rr :: DNSManager::Storage::Zone::ResourceRecord } --- codecUpdateRR = CA.object "UpdateRR" (CAR.record { domain: CA.string, rr: ResourceRecord.codec }) +type UpdateRR = { domain :: String, rr :: ResourceRecord.ResourceRecord } +codecUpdateRR = CA.object "UpdateRR" (CAR.record { domain: CA.string, rr: ResourceRecord.codec }) {- 16 -} type DeleteRR = { domain :: String, rrid :: Int } @@ -68,14 +75,11 @@ codecDeleteRR = CA.object "DeleteRR" (CAR.record { domain: CA.string, rrid: CA.i RESPONSES -} --- TODO: Zone actually is a complex data structure. -type DNSZone = String - {- 0 -} -- type Error = { reason :: String | Array(String) } type Error = { reason :: String } -codecGotError ∷ CA.JsonCodec Error -codecGotError = CA.object "Error" (CAR.record { reason: CA.string }) +codecError ∷ CA.JsonCodec Error +codecError = CA.object "Error" (CAR.record { reason: CA.string }) {- 1 -} type Success = { } @@ -106,9 +110,9 @@ codecDomainChanged = CA.object "DomainChanged" (CAR.record { }) {- 12 -} -- TODO -type Zone = { zone :: DNSZone } +type Zone = { zone :: DNSZone.DNSZone } codecZone ∷ CA.JsonCodec Zone -codecZone = CA.object "Zone" (CAR.record { zone: CA.string }) +codecZone = CA.object "Zone" (CAR.record { zone: DNSZone.codec }) {- 13 -} type UnknownZone = { } @@ -161,16 +165,16 @@ data AnswerMessage encode ∷ RequestMessage -> Tuple UInt String encode m = case m of - (MkLogin request) -> get_tuple 0 codecLogin request - (MkMaintenance request) -> get_tuple 7 codecMaintenance request - (MkNewDomain request) -> get_tuple 9 codecNewDomain request - (MkAddOrUpdateZone request) -> get_tuple 10 codecAddOrUpdateZone request - (MkDeleteZone request) -> get_tuple 11 codecDeleteZone request - (MkGetZone request) -> get_tuple 12 codecGetZone request - (MkUserDomains request) -> get_tuple 13 codecUserDomains request - (MkAddRR request) -> get_tuple 14 codecAddRR request - (MkUpdateRR request) -> get_tuple 15 codecUpdateRR request - (MkDeleteRR request) -> get_tuple 16 codecDeleteRR request + (MkLogin request) -> get_tuple 0 codecLogin request + (MkMaintenance request) -> get_tuple 7 codecMaintenance request + (MkNewDomain request) -> get_tuple 9 codecNewDomain request + (MkAddOrUpdateZone request) -> get_tuple 10 codecAddOrUpdateZone request + (MkDeleteZone request) -> get_tuple 11 codecDeleteZone request + (MkGetZone request) -> get_tuple 12 codecGetZone request + (MkUserDomains request) -> get_tuple 13 codecUserDomains request + (MkAddRR request) -> get_tuple 14 codecAddRR request + (MkUpdateRR request) -> get_tuple 15 codecUpdateRR request + (MkDeleteRR request) -> get_tuple 16 codecDeleteRR request where get_tuple :: forall a. Int -> CA.JsonCodec a -> a -> Tuple UInt String get_tuple num codec request = Tuple (fromInt num) (J.stringify $ CA.encode codec request) diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs new file mode 100644 index 0000000..d03dd34 --- /dev/null +++ b/src/App/ResourceRecord.purs @@ -0,0 +1,18 @@ +module App.ResourceRecord where + +import Prelude + +import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut as CA +import Data.Newtype (class Newtype) +import Data.Profunctor (wrapIso) + +newtype ResourceRecord = ResourceRecord String + +derive instance newtypeResourceRecord :: Newtype ResourceRecord _ +derive instance eqResourceRecord :: Eq ResourceRecord +derive instance ordResourceRecord :: Ord ResourceRecord + +-- | ResourceRecord.codec can be used to parse and encode email addresses. +codec :: JsonCodec ResourceRecord +codec = wrapIso ResourceRecord CA.string