From: Eugene Crosser Date: Sat, 12 Apr 2014 11:58:31 +0000 (+0400) Subject: separate Namecoin RPC from domain data X-Git-Tag: 0.9.0.0~91 X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=commitdiff_plain;h=35cea210f8d3a22afd24848441b5d34702d83239;hp=f2dbb98dde41abe69d0bc9c3ee70eda0eeb12670 separate Namecoin RPC from domain data --- diff --git a/NmcDom.hs b/NmcDom.hs new file mode 100644 index 0000000..b975522 --- /dev/null +++ b/NmcDom.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE OverloadedStrings #-} + +module NmcDom ( NmcDom(..) + , emptyNmcDom + , descendNmc + ) 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 + +data NmcRRService = NmcRRService -- unused + { srvName :: String + , srvProto :: String + , srvW1 :: Int + , srvW2 :: Int + , srvPort :: Int + , srvHost :: [String] + } deriving (Show, Eq) + +instance FromJSON NmcRRService where + parseJSON (Object o) = NmcRRService + <$> o .: "name" + <*> o .: "proto" + <*> o .: "w1" + <*> o .: "w2" + <*> o .: "port" + <*> o .: "host" + parseJSON _ = empty + +data NmcRRI2p = NmcRRI2p + { i2pDestination :: String + , i2pName :: String + , i2pB32 :: String + } deriving (Show, Eq) + +instance FromJSON NmcRRI2p where + parseJSON (Object o) = NmcRRI2p + <$> o .: "destination" + <*> o .: "name" + <*> o .: "b32" + parseJSON _ = empty + +data NmcDom = NmcDom { domService :: Maybe [[String]] -- [NmcRRService] + , domIp :: Maybe [String] + , domIp6 :: Maybe [String] + , domTor :: Maybe String + , domI2p :: Maybe NmcRRI2p + , domFreenet :: Maybe String + , domAlias :: Maybe String + , domTranslate :: Maybe String + , domEmail :: Maybe String + , domLoc :: Maybe String + , domInfo :: Maybe Value + , domNs :: Maybe [String] + , domDelegate :: Maybe [String] + , domImport :: Maybe [[String]] + , domMap :: Maybe (Map String NmcDom) + , domFingerprint :: Maybe [String] + , domTls :: Maybe (Map String + (Map String [[String]])) + , domDs :: Maybe [[String]] + } 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" + <*> o .:? "ip6" + <*> o .:? "tor" + <*> o .:? "i2p" + <*> o .:? "freenet" + <*> o .:? "alias" + <*> o .:? "translate" + <*> o .:? "email" + <*> o .:? "loc" + <*> o .:? "info" + <*> o .:? "ns" + <*> o .:? "delegate" + <*> o .:? "import" + <*> o .:? "map" + <*> o .:? "fingerprint" + <*> o .:? "tls" + <*> o .:? "ds" + parseJSON _ = empty + +emptyNmcDom = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing + +normalizeDom :: NmcDom -> NmcDom +normalizeDom dom + | domNs dom /= Nothing = emptyNmcDom { domNs = domNs dom + , domEmail = domEmail dom + } + | domDelegate dom /= Nothing = emptyNmcDom -- FIXME + | domTranslate dom /= Nothing = dom { domMap = Nothing } + | otherwise = dom + +descendNmc :: [String] -> NmcDom -> NmcDom +descendNmc subdom rawdom = + let dom = normalizeDom rawdom + in case subdom of + [] -> + case domMap dom of + Nothing -> dom + Just map -> + case M.lookup "" map of -- Stupid, but there are "" in the map + Nothing -> dom -- Try to merge it with the root data + Just sub -> mergeNmc sub dom -- Or maybe drop it altogether... + d:ds -> + case domMap dom of + Nothing -> emptyNmcDom + Just map -> + case M.lookup d map of + Nothing -> emptyNmcDom + Just sub -> descendNmc ds sub + +-- FIXME -- I hope there exists a better way to merge records! +mergeNmc :: NmcDom -> NmcDom -> NmcDom +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 -> Maybe a) -> Maybe a + choose field = case field dom of + Nothing -> field sub + Just x -> Just x diff --git a/NmcJson.hs b/NmcJson.hs deleted file mode 100644 index 69e693f..0000000 --- a/NmcJson.hs +++ /dev/null @@ -1,176 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module NmcJson ( NmcRes(..) - , NmcDom(..) - , emptyNmcDom - , descendNmc - ) 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 - -data NmcRRService = NmcRRService -- unused - { srvName :: String - , srvProto :: String - , srvW1 :: Int - , srvW2 :: Int - , srvPort :: Int - , srvHost :: [String] - } deriving (Show, Eq) - -instance FromJSON NmcRRService where - parseJSON (Object o) = NmcRRService - <$> o .: "name" - <*> o .: "proto" - <*> o .: "w1" - <*> o .: "w2" - <*> o .: "port" - <*> o .: "host" - parseJSON _ = empty - -data NmcRRI2p = NmcRRI2p - { i2pDestination :: String - , i2pName :: String - , i2pB32 :: String - } deriving (Show, Eq) - -instance FromJSON NmcRRI2p where - parseJSON (Object o) = NmcRRI2p - <$> o .: "destination" - <*> o .: "name" - <*> o .: "b32" - parseJSON _ = empty - -data NmcDom = NmcDom { domService :: Maybe [[String]] -- [NmcRRService] - , domIp :: Maybe [String] - , domIp6 :: Maybe [String] - , domTor :: Maybe String - , domI2p :: Maybe NmcRRI2p - , domFreenet :: Maybe String - , domAlias :: Maybe String - , domTranslate :: Maybe String - , domEmail :: Maybe String - , domLoc :: Maybe String - , domInfo :: Maybe Value - , domNs :: Maybe [String] - , domDelegate :: Maybe [String] - , domImport :: Maybe [[String]] - , domMap :: Maybe (Map String NmcDom) - , domFingerprint :: Maybe [String] - , domTls :: Maybe (Map String - (Map String [[String]])) - , domDs :: Maybe [[String]] - } 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" - <*> o .:? "ip6" - <*> o .:? "tor" - <*> o .:? "i2p" - <*> o .:? "freenet" - <*> o .:? "alias" - <*> o .:? "translate" - <*> o .:? "email" - <*> o .:? "loc" - <*> o .:? "info" - <*> o .:? "ns" - <*> o .:? "delegate" - <*> o .:? "import" - <*> o .:? "map" - <*> o .:? "fingerprint" - <*> o .:? "tls" - <*> o .:? "ds" - parseJSON _ = empty - -emptyNmcDom = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing - -data NmcRes = NmcRes { resName :: String - , resValue :: ByteString -- string with NmcDom - , resTxid :: String - , resAddress :: String - , resExpires_in :: Int - } deriving (Show) -instance FromJSON NmcRes where - parseJSON (Object o) = NmcRes - <$> o .: "name" - <*> o .: "value" - <*> o .: "txid" - <*> o .: "address" - <*> o .: "expires_in" - parseJSON _ = empty - -normalizeDom :: NmcDom -> NmcDom -normalizeDom dom - | domNs dom /= Nothing = emptyNmcDom { domNs = domNs dom - , domEmail = domEmail dom - } - | domDelegate dom /= Nothing = emptyNmcDom -- FIXME - | domTranslate dom /= Nothing = dom { domMap = Nothing } - | otherwise = dom - -descendNmc :: [String] -> NmcDom -> NmcDom -descendNmc subdom rawdom = - let dom = normalizeDom rawdom - in case subdom of - [] -> - case domMap dom of - Nothing -> dom - Just map -> - case M.lookup "" map of -- Stupid, but there are "" in the map - Nothing -> dom -- Try to merge it with the root data - Just sub -> mergeNmc sub dom -- Or maybe drop it altogether... - d:ds -> - case domMap dom of - Nothing -> emptyNmcDom - Just map -> - case M.lookup d map of - Nothing -> emptyNmcDom - Just sub -> descendNmc ds sub - --- FIXME -- I hope there exists a better way to merge records! -mergeNmc :: NmcDom -> NmcDom -> NmcDom -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 -> Maybe a) -> Maybe a - choose field = case field dom of - Nothing -> field sub - Just x -> Just x diff --git a/NmcRpc.hs b/NmcRpc.hs new file mode 100644 index 0000000..1f73a73 --- /dev/null +++ b/NmcRpc.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} + +module NmcRpc ( 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 + +data NmcRes = NmcRes { resName :: String + , resValue :: ByteString -- string with NmcDom + , resTxid :: String + , resAddress :: String + , resExpires_in :: Int + } deriving (Show) +instance FromJSON NmcRes where + parseJSON (Object o) = NmcRes + <$> o .: "name" + <*> o .: "value" + <*> o .: "txid" + <*> o .: "address" + <*> o .: "expires_in" + parseJSON _ = empty diff --git a/PowerDns.hs b/PowerDns.hs index 696b9b5..e225b62 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -5,7 +5,7 @@ module PowerDns ( RRType(..) , pdnsOut ) where -import NmcJson +import NmcDom data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index 304e049..4d47e50 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -16,7 +16,8 @@ import Network.HTTP.Conduit import JsonRpcClient import Config import PowerDns -import NmcJson +import NmcRpc +import NmcDom confFile = "/etc/namecoin.conf"