module NmcJson ( NmcRes(..)
, NmcDom(..)
, emptyNmcDom
+ , descendNmc
) where
import Data.ByteString.Lazy (ByteString)
-import Data.Map (Map)
+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
, srvW2 :: Int
, srvPort :: Int
, srvHost :: [String]
- } deriving (Show)
+ } deriving (Show, Eq)
instance FromJSON NmcRRService where
parseJSON (Object o) = NmcRRService
{ i2pDestination :: String
, i2pName :: String
, i2pB32 :: String
- } deriving (Show)
+ } deriving (Show, Eq)
instance FromJSON NmcRRI2p where
parseJSON (Object o) = NmcRRI2p
, domTls :: Maybe (Map String
(Map String [[String]]))
, domDs :: Maybe [[String]]
- } deriving (Show)
+ } 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 .: "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