- let l = "{\"name\":\"d/dot-bit\",\"value\":\"{\\\"info\\\":{\\\"description\\\":\\\"Dot-BIT Project - Official Website\\\",\\\"registrar\\\":\\\"http://register.dot-bit.org\\\"},\\\"fingerprint\\\":[\\\"30:B0:60:94:32:08:EC:F5:BE:DF:F4:BB:EE:52:90:2C:5D:47:62:46\\\"],\\\"ns\\\":[\\\"ns0.web-sweet-web.net\\\",\\\"ns1.web-sweet-web.net\\\"],\\\"map\\\":{\\\"\\\":{\\\"ns\\\":[\\\"ns0.web-sweet-web.net\\\",\\\"ns1.web-sweet-web.net\\\"]}},\\\"email\\\":\\\"register@dot-bit.org\\\"}\",\"txid\":\"7412603f2e6c3459be56accc6e1f3646b603f3d4a4188119a4072f125c1340d5\",\"address\":\"Mw3KCQcqC44nm75w7r79ZifZbEqT8RetWn\",\"expires_in\":18915}"
- let r = decode l :: Maybe NmcRes
- case r of
- Just resp -> do
- let value = (resValue resp)
- let dom = decode value :: Maybe NmcDom
- print dom
- Nothing ->
- print "Unparseable NMC response"
+normalizeDom :: NmcDom -> NmcDom
+normalizeDom dom
+ | domNs dom /= Nothing = emptyNmcDom { domNs = domNs 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 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
+ }
+ where
+ choose :: NmcDom -> (NmcDom -> Maybe a) -> NmcDom -> Maybe a