X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=NmcDom.hs;h=1ccf836b9049b8bfe15aebbefda18d67bea4f233;hp=3ab8c7fd40aa6213e8e47f63459a9fac296edeb1;hb=0288e756cf28a0229c03a946e54cda94252526c1;hpb=0c0ad44ac6376d9bfb2b84d5f2293d945130ab45 diff --git a/NmcDom.hs b/NmcDom.hs index 3ab8c7f..1ccf836 100644 --- a/NmcDom.hs +++ b/NmcDom.hs @@ -5,7 +5,6 @@ module NmcDom ( NmcDom(..) , NmcRRI2p(..) , NmcRRTls(..) , NmcRRDs(..) - , emptyNmcDom , mergeNmcDom ) where @@ -20,6 +19,7 @@ import Data.Map (Map, unionWith) import qualified Data.HashMap.Strict as H (lookup) import Data.Aeson import Data.Aeson.Types +import Data.Default.Class -- Variant of Aeson's `.:?` that interprets a String as a -- single-element list, so it is possible to have either @@ -155,16 +155,22 @@ data NmcDom = NmcDom { domService :: Maybe [NmcRRService] , domDs :: Maybe [NmcRRDs] , domMx :: Maybe [String] -- Synthetic , domSrv :: Maybe [String] -- Synthetic + , domTlsa :: Maybe [String] -- Synthetic } deriving (Show, Eq) +instance Default NmcDom where + def = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + 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 + then def { domIp = Just [s'] } + else def where s' = unpack s isIPv4 x = all isNibble $ splitOn "." x @@ -192,6 +198,7 @@ instance FromJSON NmcDom where <*> o .:? "ds" <*> return Nothing -- domMx not parsed <*> return Nothing -- domSrv not parsed + <*> return Nothing -- domTlsa not parsed parseJSON _ = empty instance Mergeable NmcDom where @@ -215,6 +222,7 @@ instance Mergeable NmcDom where , domDs = mergelm domDs , domMx = mergelm domMx , domSrv = mergelm domSrv + , domTlsa = mergelm domTlsa } where mergelm x = merge (x sub) (x dom) @@ -227,8 +235,3 @@ instance Mergeable NmcDom where mergeNmcDom :: NmcDom -> NmcDom -> NmcDom mergeNmcDom = merge - -emptyNmcDom = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing