+takeTls o =
+ case H.lookup "tls" o of
+ Nothing -> pure Nothing
+ Just (Object t) ->
+ (parseJSON (Object t) :: Parser (Map String (Map String [NmcRRTlsa])))
+ >>= tmap2dmap
+ where
+ tmap2dmap :: Map String (Map String [NmcRRTlsa])
+ -> Parser (Maybe (Map String NmcDom))
+ -- FIXME return parse error on invalid proto or port
+ tmap2dmap m1 = return $ foldrWithKey addprotoelem (Just M.empty) m1
+ addprotoelem k1 m2 acc = protoelem k1 m2 `merge` acc
+ protoelem k1 m2 = Just (M.singleton ("_" ++ k1) (pmap2dmap m2))
+ pmap2dmap m2 = foldrWithKey addportelem def m2
+ addportelem k2 v acc = portelem k2 v `merge` acc
+ portelem k2 v =
+ def { domSubmap = Just (M.singleton ("_" ++ k2)
+ def { domTlsa = Just v }) }
+ Just _ -> empty