allow "import" to me an array

diff --git a/NmcDom.hs b/NmcDom.hs
index 11b77ac4a01905140f19161f0451d9f6501f7ecc..e03f683bf2107166fe4bdca7ebfde45449f07888 100644 (file)
--- 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 aa8cea7b509031d95ace9297d907655b20a90b0a..92b9b81648f2c4b312387a9c2e7d31751c27e742 100644 (file)
--- 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 19bfa436f644c38f7b0206f3c4769f63aab269c9..a2a8a5d7343708106309498cc878634038a920f3 100644 (file)
--- 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 (file)
index 0000000..bfb32b9
--- /dev/null
+++ b/d/extra3
@@ -0,0 +1 @@
+{"ip":"9.8.7.6"}