karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

DNSManager messages: mostly done. Build is okay.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-06-17 18:07:24 +02:00
parent 7f50ad1ffe
commit ffecb63c8d
4 changed files with 66 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/App/DNSZone.purs Normal file
View File

@ -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

2
src/App/MaintenanceSubject.purs
View File

@ -13,7 +13,7 @@ codec =
where
from :: String -> Maybe MaintenanceSubject
from = case _ of
"verbosity" -> Just None
"verbosity" -> Just Verbosity
_ -> Nothing
to :: MaintenanceSubject -> String

54
src/App/Messages/DNSManagerDaemon.purs
View File

@ -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)

18
src/App/ResourceRecord.purs Normal file
View File

@ -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