allow string where array of strings is expected
authorEugene Crosser <crosser@average.org>
Mon, 14 Apr 2014 12:56:11 +0000 (16:56 +0400)
committerEugene Crosser <crosser@average.org>
Mon, 14 Apr 2014 13:02:53 +0000 (17:02 +0400)
NmcDom.hs
d/nf [new file with mode: 0644]

index c94e8af8bdd50970f9428ce5fd8a2dc8da4bed95..adb378999a064e81ce759d9b3d3e7c61a0dd34a0 100644 (file)
--- a/NmcDom.hs
+++ b/NmcDom.hs
@@ -9,15 +9,31 @@ module NmcDom   ( NmcDom(..)
 
 import Prelude hiding (length)
 import Data.ByteString.Lazy (ByteString)
 
 import Prelude hiding (length)
 import Data.ByteString.Lazy (ByteString)
-import qualified Data.Text as T (unpack)
+import Data.Text (Text, unpack)
 import Data.List as L (union)
 import Data.List.Split
 import Data.Char
 import Data.Map as M (Map, lookup, delete, size, union)
 import Data.List as L (union)
 import Data.List.Split
 import Data.Char
 import Data.Map as M (Map, lookup, delete, size, union)
-import Data.Vector (toList,(!),length)
-import Control.Applicative ((<$>), (<*>), empty)
+import Data.Vector (toList,(!),length, singleton)
+import Control.Applicative ((<$>), (<*>), empty, pure)
 import Data.Aeson
 
 import Data.Aeson
 
+import qualified Data.HashMap.Strict as H
+import Data.Aeson.Types
+
+-- Variant of Aeson's `.:?` that interprets a String as a
+-- single-element list, so it is possible to have either
+--      "ip":["1.2.3.4"]
+-- or
+--      "ip":"1.2.3.4"
+-- with the same result.
+(.:/) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
+obj .:/ key = case H.lookup key obj of
+               Nothing -> pure Nothing
+               Just v  -> case v of
+                        String s -> parseJSON $ Array (singleton v)
+                        _        -> parseJSON v
+
 class Mergeable a where
         merge :: a -> a -> a -- bias towads second arg
 
 class Mergeable a where
         merge :: a -> a -> a -- bias towads second arg
 
@@ -91,7 +107,7 @@ data NmcDom = NmcDom    { domService     :: Maybe [NmcRRService]
                         , domLoc         :: Maybe String
                         , domInfo        :: Maybe Value
                         , domNs          :: Maybe [String]
                         , domLoc         :: Maybe String
                         , domInfo        :: Maybe Value
                         , domNs          :: Maybe [String]
-                        , domDelegate    :: Maybe [String]
+                        , domDelegate    :: Maybe String
                         , domImport      :: Maybe String
                         , domMap         :: Maybe (Map String NmcDom)
                         , domFingerprint :: Maybe [String]
                         , domImport      :: Maybe String
                         , domMap         :: Maybe (Map String NmcDom)
                         , domFingerprint :: Maybe [String]
@@ -110,15 +126,15 @@ instance FromJSON NmcDom where
                             then emptyNmcDom { domIp = Just [s'] }
                             else emptyNmcDom
                           where
                             then emptyNmcDom { domIp = Just [s'] }
                             else emptyNmcDom
                           where
-                            s' = T.unpack s
+                            s' = 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"
                             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"
-                <*> o .:? "ip6"
+                <*> o .:/ "ip"
+                <*> o .:/ "ip6"
                 <*> o .:? "tor"
                 <*> o .:? "i2p"
                 <*> o .:? "freenet"
                 <*> o .:? "tor"
                 <*> o .:? "i2p"
                 <*> o .:? "freenet"
@@ -127,11 +143,11 @@ instance FromJSON NmcDom where
                 <*> o .:? "email"
                 <*> o .:? "loc"
                 <*> o .:? "info"
                 <*> o .:? "email"
                 <*> o .:? "loc"
                 <*> o .:? "info"
-                <*> o .:? "ns"
+                <*> o .:/ "ns"
                 <*> o .:? "delegate"
                 <*> o .:? "import"
                 <*> o .:? "map"
                 <*> o .:? "delegate"
                 <*> o .:? "import"
                 <*> o .:? "map"
-                <*> o .:? "fingerprint"
+                <*> o .:/ "fingerprint"
                 <*> o .:? "tls"
                 <*> o .:? "ds"
                 <*> return Nothing -- domMx not parsed
                 <*> o .:? "tls"
                 <*> o .:? "ds"
                 <*> return Nothing -- domMx not parsed
diff --git a/d/nf b/d/nf
new file mode 100644 (file)
index 0000000..5ef3845
--- /dev/null
+++ b/d/nf
@@ -0,0 +1 @@
+{"map":{"":"94.23.252.190"},"fingerprint":["14:7D:31:8D:52:CD:43:61:32:91:F1:81:1B:C5:B9:CB:7B:25:4C:71"]}