X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=NmcJson.hs;h=69e693ff000e7ea5aafb986e5c45f017a1c60d05;hp=f7733669e33b08f0ac8bd341d7702dee249d3699;hb=f2dbb98dde41abe69d0bc9c3ee70eda0eeb12670;hpb=7350de03fb105bb8f46e96160bcb32fc75f04d61

diff --git a/NmcJson.hs b/NmcJson.hs
index f773366..69e693f 100644
--- a/NmcJson.hs
+++ b/NmcJson.hs
@@ -7,6 +7,9 @@ module NmcJson  ( NmcRes(..)
                 ) where
 
 import Data.ByteString.Lazy (ByteString)
+import Data.Text as T (unpack)
+import Data.List.Split
+import Data.Char
 import Data.Map as M (Map, lookup)
 import Control.Applicative ((<$>), (<*>), empty)
 import Data.Aeson
@@ -65,6 +68,19 @@ data NmcDom = NmcDom    { domService     :: Maybe [[String]] -- [NmcRRService]
                         } deriving (Show, Eq)
 
 instance FromJSON NmcDom where
+        -- Wherever we expect a domain object, there may be a string
+        -- containing IPv4 address. Interpret it as such.
+        -- Question: shall we try to recognize IPv6 addresses too?
+        parseJSON (String s) =
+                 return $ if isIPv4 s'
+                            then emptyNmcDom { domIp = Just [s'] }
+                            else emptyNmcDom
+                          where
+                            s' = T.unpack s
+                            isIPv4 x = all isNibble $ splitOn "." x
+                            isNibble x =
+                              if all isDigit x then (read x :: Int) < 256
+                              else False
         parseJSON (Object o) = NmcDom
                 <$> o .:? "service"
                 <*> o .:? "ip"
@@ -107,7 +123,9 @@ instance FromJSON NmcRes where
 
 normalizeDom :: NmcDom -> NmcDom
 normalizeDom dom
-  | domNs        dom /= Nothing = emptyNmcDom { domNs = domNs dom }
+  | domNs        dom /= Nothing = emptyNmcDom { domNs    = domNs dom
+                                              , domEmail = domEmail dom
+                                              }
   | domDelegate  dom /= Nothing = emptyNmcDom -- FIXME
   | domTranslate dom /= Nothing = dom { domMap = Nothing }
   | otherwise                   = dom
@@ -133,26 +151,26 @@ descendNmc subdom rawdom =
 
 -- FIXME -- I hope there exists a better way to merge records!
 mergeNmc :: NmcDom -> NmcDom -> NmcDom
-mergeNmc sub dom = dom  { domService = choose dom domService sub
-                        , domIp = choose dom domIp sub
-                        , domIp6 = choose dom domIp6 sub
-                        , domTor = choose dom domTor sub
-                        , domI2p = choose dom domI2p sub
-                        , domFreenet = choose dom domFreenet sub
-                        , domAlias = choose dom domAlias sub
-                        , domTranslate = choose dom domTranslate sub
-                        , domEmail = choose dom domEmail sub
-                        , domLoc = choose dom domLoc sub
-                        , domInfo = choose dom domInfo sub
-                        , domNs = choose dom domNs sub
-                        , domDelegate = choose dom domDelegate sub
-                        , domImport = choose dom domImport sub
-                        , domFingerprint = choose dom domFingerprint sub
-                        , domTls = choose dom domTls sub
-                        , domDs = choose dom domDs sub
+mergeNmc sub dom = dom  { domService = choose domService
+                        , domIp =          choose domIp
+                        , domIp6 =         choose domIp6
+                        , domTor =         choose domTor
+                        , domI2p =         choose domI2p
+                        , domFreenet =     choose domFreenet
+                        , domAlias =       choose domAlias
+                        , domTranslate =   choose domTranslate
+                        , domEmail =       choose domEmail
+                        , domLoc =         choose domLoc
+                        , domInfo =        choose domInfo
+                        , domNs =          choose domNs
+                        , domDelegate =    choose domDelegate
+                        , domImport =      choose domImport
+                        , domFingerprint = choose domFingerprint
+                        , domTls =         choose domTls
+                        , domDs =          choose domDs
                         }
   where
-    choose :: NmcDom -> (NmcDom -> Maybe a) -> NmcDom -> Maybe a
-    choose sub t dom = case t dom of
-      Nothing -> t sub
+    choose :: (NmcDom -> Maybe a) -> Maybe a
+    choose field = case field dom of
+      Nothing -> field sub
       Just x  -> Just x