From 936facf5d3c482bdd9b95ef9fd38f3595f9eb0f2 Mon Sep 17 00:00:00 2001 From: Eugene Crosser Date: Wed, 16 Apr 2014 02:26:51 +0400 Subject: [PATCH] allow "import" to me an array --- NmcDom.hs | 23 ++++++++++++++--------- SPEC.md | 13 +++++++------ d/extra1 | 2 +- d/extra3 | 1 + 4 files changed, 23 insertions(+), 16 deletions(-) create mode 100644 d/extra3 diff --git a/NmcDom.hs b/NmcDom.hs index 11b77ac..e03f683 100644 --- a/NmcDom.hs +++ b/NmcDom.hs @@ -15,6 +15,7 @@ import Data.List.Split import Data.Char import Data.Map as M (Map, lookup, delete, size, unionWith) import Data.Vector (toList,(!),length, singleton) +import Control.Monad (foldM) import Control.Applicative ((<$>), (<*>), empty, pure) import Data.Aeson @@ -40,6 +41,7 @@ class Mergeable a where instance (Ord k, Mergeable a) => Mergeable (Map k a) where merge mx my = M.unionWith merge my mx +-- Alas, the following is not possible in Haskell :-( -- instance Mergeable String where -- merge _ b = b @@ -146,7 +148,7 @@ data NmcDom = NmcDom { domService :: Maybe [NmcRRService] , domInfo :: Maybe Value , domNs :: Maybe [String] , domDelegate :: Maybe String - , domImport :: Maybe String + , domImport :: Maybe [String] , domMap :: Maybe (Map String NmcDom) , domFingerprint :: Maybe [String] , domTls :: Maybe (Map String @@ -183,7 +185,7 @@ instance FromJSON NmcDom where <*> o .:? "info" <*> o .:/ "ns" <*> o .:? "delegate" - <*> o .:? "import" + <*> o .:/ "import" <*> o .:? "map" <*> o .:/ "fingerprint" <*> o .:? "tls" @@ -205,7 +207,7 @@ instance Mergeable NmcDom where , domInfo = mergelm domInfo , domNs = mergelm domNs , domDelegate = mergelm domDelegate - , domImport = choose domImport + , domImport = mergelm domImport , domMap = mergelm domMap , domFingerprint = mergelm domFingerprint , domTls = mergelm domTls @@ -256,11 +258,14 @@ mergeImport queryOp depth base = do if depth <= 0 then return $ Left "Nesting of imports is too deep" else case domImport mbase of Nothing -> return $ Right base' - Just key -> do - sub <- queryNmcDom queryOp key - case sub of - Left e -> return $ Left e - Right sub' -> mergeImport queryOp (depth - 1) $ sub' `merge` base' + Just keys -> foldM mergeImport1 (Right base') keys + where + mergeImport1 (Left err) _ = return $ Left err + mergeImport1 (Right acc) key = do + sub <- queryNmcDom queryOp key + case sub of + Left err -> return $ Left err + Right sub' -> mergeImport queryOp (depth - 1) $ sub' `merge` acc -- | If there is an element in the map with key "", merge the contents -- and remove this element. Do this recursively. @@ -339,4 +344,4 @@ descendNmcDom queryOp subdom base = do seedNmcDom :: String -- ^ domain key (without namespace prefix) -> NmcDom -- ^ resulting seed domain -seedNmcDom dn = emptyNmcDom { domImport = Just ("d/" ++ dn)} +seedNmcDom dn = emptyNmcDom { domImport = Just (["d/" ++ dn])} diff --git a/SPEC.md b/SPEC.md index aa8cea7..92b9b81 100644 --- a/SPEC.md +++ b/SPEC.md @@ -22,7 +22,7 @@ or a JSON `Map`, with the following attributes, all optional: | info | JsonObj | Currently unspecified | | ns | Array(String) | Domain names as in `NS` | | delegate | String | Replaces current object | -| import | String | "Deep" merges into current obj. | +| import | Array(String) | "Deep" merges into current obj. | | map | Map(String:DomObj) | Tree of subdomain objects | | fingerprint | Array(String) | | | tls | Map(String:Map(String:Array(TlsObj))) | Outer `Map` by `Protocol`, inner by `Port` | @@ -88,9 +88,10 @@ or a JSON `Map`, with the following attributes, all optional: Assuming a query is performed for `sdN`++"."++{...}++"."++`sd2`++"."++`sd1`++"."++`dom`++".bit" (`sdX` list possibly being empty), the lookup process starts by -populating a "seed" DomObj with a single attribute `"import"` -the value of which corresponds to the `dom` name in the -Namecoin namespace, currently `"d/" ++ dom`. +querying the database for the object corresponding to `dom`. +Technically, it is easiest to populate a "seed" DomObj with a +single attribute `"import"` the value of which corresponds to the +`dom` name in the Namecoin namespace, which is `"d/" ++ dom`. This domain object is then transformed by the following recursive sequece: @@ -100,8 +101,8 @@ recursive sequece: 2. If attribute `"import"` does not exist in the resulting object, recursion stops, and step 3 is performed on the result If attribute `"import"` exists in the resulting object, lookup is - is performed for the value of this attribute, and fetched object - is recursively merged into the base domain. The `"import"` attribute + is performed for the values of this attribute, and fetched objects + are recursively merged into the base domain. The `"import"` attribute is removed from the result. Then the result is passed as base domain to step 1. 3. If subdomain chain is empty, recursion stops, and step 4 is diff --git a/d/extra1 b/d/extra1 index 19bfa43..a2a8a5d 100644 --- a/d/extra1 +++ b/d/extra1 @@ -1 +1 @@ -{"service":[["smtp", "tcp", 0, 0, 25, "mail.host.com."]],"import":"d/extra2","ip":["1.2.3.4"],"alias":"extra1alias","map":{"mail":"1.1.1.1","www":"1.1.1.1"}} +{"service":[["smtp", "tcp", 0, 0, 25, "mail.host.com."]],"import":["d/extra2","d/extra3"],"ip":["1.2.3.4"],"alias":"extra1alias","map":{"mail":"1.1.1.1","www":"1.1.1.1"}} diff --git a/d/extra3 b/d/extra3 new file mode 100644 index 0000000..bfb32b9 --- /dev/null +++ b/d/extra3 @@ -0,0 +1 @@ +{"ip":"9.8.7.6"} -- 2.43.0