1 {-# LANGUAGE OverloadedStrings #-}
3 module NmcJson ( NmcRes(..)
9 import Data.ByteString.Lazy (ByteString)
10 import Data.Map as M (Map, lookup)
11 import Control.Applicative ((<$>), (<*>), empty)
14 data NmcRRService = NmcRRService -- unused
23 instance FromJSON NmcRRService where
24 parseJSON (Object o) = NmcRRService
33 data NmcRRI2p = NmcRRI2p
34 { i2pDestination :: String
39 instance FromJSON NmcRRI2p where
40 parseJSON (Object o) = NmcRRI2p
41 <$> o .: "destination"
46 data NmcDom = NmcDom { domService :: Maybe [[String]] -- [NmcRRService]
47 , domIp :: Maybe [String]
48 , domIp6 :: Maybe [String]
49 , domTor :: Maybe String
50 , domI2p :: Maybe NmcRRI2p
51 , domFreenet :: Maybe String
52 , domAlias :: Maybe String
53 , domTranslate :: Maybe String
54 , domEmail :: Maybe String
55 , domLoc :: Maybe String
56 , domInfo :: Maybe Value
57 , domNs :: Maybe [String]
58 , domDelegate :: Maybe [String]
59 , domImport :: Maybe [[String]]
60 , domMap :: Maybe (Map String NmcDom)
61 , domFingerprint :: Maybe [String]
62 , domTls :: Maybe (Map String
63 (Map String [[String]]))
64 , domDs :: Maybe [[String]]
67 instance FromJSON NmcDom where
68 parseJSON (Object o) = NmcDom
84 <*> o .:? "fingerprint"
89 emptyNmcDom = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing
90 Nothing Nothing Nothing Nothing Nothing Nothing
91 Nothing Nothing Nothing Nothing Nothing Nothing
93 data NmcRes = NmcRes { resName :: String
94 , resValue :: ByteString -- string with NmcDom
96 , resAddress :: String
97 , resExpires_in :: Int
99 instance FromJSON NmcRes where
100 parseJSON (Object o) = NmcRes
105 <*> o .: "expires_in"
108 normalizeDom :: NmcDom -> NmcDom
110 | domNs dom /= Nothing = emptyNmcDom { domNs = domNs dom }
111 | domDelegate dom /= Nothing = emptyNmcDom -- FIXME
112 | domTranslate dom /= Nothing = dom { domMap = Nothing }
115 descendNmc :: [String] -> NmcDom -> NmcDom
116 descendNmc subdom rawdom =
117 let dom = normalizeDom rawdom
123 case M.lookup "" map of -- Stupid, but there are "" in the map
124 Nothing -> dom -- Try to merge it with the root data
125 Just sub -> mergeNmc sub dom -- Or maybe drop it altogether...
128 Nothing -> emptyNmcDom
130 case M.lookup d map of
131 Nothing -> emptyNmcDom
132 Just sub -> descendNmc ds sub
134 -- FIXME -- I hope there exists a better way to merge records!
135 mergeNmc :: NmcDom -> NmcDom -> NmcDom
136 mergeNmc sub dom = dom { domService = choose dom domService sub
137 , domIp = choose dom domIp sub
138 , domIp6 = choose dom domIp6 sub
139 , domTor = choose dom domTor sub
140 , domI2p = choose dom domI2p sub
141 , domFreenet = choose dom domFreenet sub
142 , domAlias = choose dom domAlias sub
143 , domTranslate = choose dom domTranslate sub
144 , domEmail = choose dom domEmail sub
145 , domLoc = choose dom domLoc sub
146 , domInfo = choose dom domInfo sub
147 , domNs = choose dom domNs sub
148 , domDelegate = choose dom domDelegate sub
149 , domImport = choose dom domImport sub
150 , domFingerprint = choose dom domFingerprint sub
151 , domTls = choose dom domTls sub
152 , domDs = choose dom domDs sub
155 choose :: NmcDom -> (NmcDom -> Maybe a) -> NmcDom -> Maybe a
156 choose sub t dom = case t dom of