From 92504303416dfc46f1a4e4ed45ddd3203919cf8f Mon Sep 17 00:00:00 2001
From: Eugene Crosser <crosser@average.org>
Date: Fri, 30 May 2014 18:27:42 +0400
Subject: [PATCH] wip on enforcing TLSA on subdoms

---
 NmcDom.hs       | 7 +++++--
 NmcTransform.hs | 5 ++++-
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/NmcDom.hs b/NmcDom.hs
index 2fdd6b9..dac614b 100644
--- a/NmcDom.hs
+++ b/NmcDom.hs
@@ -182,7 +182,7 @@ instance Mergeable NmcRRI2p where
 data NmcRRTlsa = NmcRRTlsa
                         { tlsMatchType  :: Int -- 0:exact 1:sha256 2:sha512
                         , tlsMatchValue :: String
-                        , tlsIncSubdoms :: Int -- 1:enforce on subdoms 0:no
+                        , tlsIncSubdoms :: Bool -- enforce on subdoms?
                         } deriving (Show, Eq)
 
 instance FromJSON NmcRRTlsa where
@@ -190,7 +190,10 @@ instance FromJSON NmcRRTlsa where
                 if length a == 3 then NmcRRTlsa
                         <$> parseJSON (a ! 0)
                         <*> parseJSON (a ! 1)
-                        <*> parseJSON (a ! 2)
+                        <*> case (a ! 2) of
+                              Number 0 -> return False
+                              Number 1 -> return True
+                              _        -> empty
                 else empty
         parseJSON _ = empty
 
diff --git a/NmcTransform.hs b/NmcTransform.hs
index c461274..23244a5 100644
--- a/NmcTransform.hs
+++ b/NmcTransform.hs
@@ -75,7 +75,10 @@ mergeSelf base =
 
 -- | transfer some elements of `base` into `sub`, notably TLSA
 propagate :: NmcDom -> NmcDom -> NmcDom
-propagate base sub = sub -- FIXME implement it
+propagate base sub = sub `merge` (pickglobals base)
+  where -- FIXME must do this on the map elements, not on the top level
+    pickglobals dom = def { domTlsa = fmap pickforcedtls (domTlsa dom) }
+    pickforcedtls = filter (\x -> tlsIncSubdoms x)
  
 -- | Presence of some elements require removal of some others
 normalizeDom :: NmcDom -> NmcDom
-- 
2.39.2