per file transforms

1 files changed, 32 insertions, 16 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 57f80d9..023c027 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -219,6 +219,7 @@ data Access = AutoAccess -- ^ secret or public as appropriate based on existing
                          --   (see 'rtRingAccess')
             | Sec        -- ^ secret information
             | Pub        -- ^ public information
+ deriving (Eq,Ord,Show)
 
 -- | Note that the documentation here is intended for when this value is
 -- assigned to 'fill'.  For other usage, see 'spill'.
@@ -328,7 +329,7 @@ data KeyRingRuntime = KeyRingRuntime
                         -- ^ The common information pool where files spilled
                         -- their content and from which they received new
                         -- content.
-                        , rtRingAccess :: Map.Map FilePath Access
+                        , rtRingAccess :: Map.Map InputFile Access
                         -- ^ The 'Access' values used for files of type
                         -- 'KeyRingFile'.  If 'AutoAccess' was specified
                         -- for a file, this 'Map.Map' will indicate the
@@ -1206,7 +1207,7 @@ buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation
                                              Hosts.Hosts,
                                              [(SockAddr, (KeyKey, KeyKey))],
                                              [SockAddr])
-                                    ,Map.Map FilePath Access
+                                    ,Map.Map InputFile Access
                                     ,MappedPacket -> IO (KikiCondition Packet)
                                     ,Map.Map InputFile Message
                                     )
@@ -1234,7 +1235,7 @@ buildKeyDB ctx grip0 keyring = do
         readw wk n = fmap (n,) (readPacketsFromWallet wk (ArgFile n))
 
     -- KeyRings (todo: KikiCondition reporting?)
-    (db_rings,mwk,grip,accs,keys,unspilled) <- do
+    (spilled,mwk,grip,accs,keys,unspilled) <- do
         ringPackets <- Map.traverseWithKey readp ringMap
         let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message)
 
@@ -1244,8 +1245,6 @@ buildKeyDB ctx grip0 keyring = do
                     (_,Message ps) <- Map.lookup HomeSec ringPackets
                     listToMaybe ps
             (spilled,unspilled) = Map.partition (spillable . fst) ringPackets
-            db_rings = Map.foldlWithKey mergeIt Map.empty spilled
-                        where mergeIt db f (_,ps) = merge db f ps
             keys :: Map.Map KeyKey MappedPacket
             keys = Map.foldl slurpkeys Map.empty
                         $ Map.mapWithKey filterSecrets ringPackets
@@ -1262,13 +1261,32 @@ buildKeyDB ctx grip0 keyring = do
                     let matchfp mp = not (is_subkey p) && matchpr fp p == fp
                             where p = packet mp
                     Map.elems $ Map.filter matchfp keys
-            accs = Map.mapKeys (concat . resolveInputFile ctx)
-                        $ fmap (access . fst) ringPackets
-        return (db_rings,wk,grip,accs,keys,fmap snd unspilled)
+            accs = fmap (access . fst) ringPackets
+        return (spilled,wk,grip,accs,keys,fmap snd unspilled)
 
     doDecrypt <- makeMemoizingDecrypter keyring ctx keys
 
     let wk = fmap packet mwk
+        rt0 = KeyRingRuntime { rtPubring = homepubPath ctx
+                             , rtSecring = homesecPath ctx
+                             , rtGrip = grip
+                             , rtWorkingKey = wk
+                             , rtRingAccess = accs
+                             , rtKeyDB = Map.empty
+                             }
+    transformed <-
+        let trans f (info,ps) = do
+                let manip = combineTransforms (transforms info)
+                    rt1 = rt0 { rtKeyDB = merge Map.empty f ps }
+                    acc = True
+                r <- performManipulations doDecrypt rt1 mwk manip
+                return $ either (const (info,ps))
+                                (\(rt2,report) -> (info,flattenKeys acc $ rtKeyDB rt2))
+                            $ functorToEither r
+        in Map.traverseWithKey trans spilled
+    let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed
+                    where
+                      mergeIt db f (info,ps) = merge db f ps
 
     -- Wallets
     let importWalletKey wk db' (top,fname,sub,tag) = do
@@ -1647,7 +1665,7 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled = do
                     importByExistingMaster kd@(KeyData p _ _ _) =
                         fmap originallyPublic $ Map.lookup f $ locations p
                 d <- sortByHint f keyMappedPacket (Map.elems db')
-                acc <- maybeToList $ Map.lookup f (rtRingAccess rt)
+                acc <- maybeToList $ Map.lookup f0 (rtRingAccess rt)
                 only_public <- maybeToList $ wantedForFill acc (fill stream) d
                 case fill stream of
                     KF_Match usage -> do grip <- maybeToList $ rtGrip rt
@@ -1849,12 +1867,11 @@ makeMemoizingDecrypter operation ctx keys = do
 
 performManipulations ::
                 (MappedPacket -> IO (KikiCondition Packet))
-                -> KeyRingOperation
                 -> KeyRingRuntime
                 -> Maybe MappedPacket
                 -> (KeyRingRuntime -> KeyData -> [PacketUpdate])
                 -> IO (KikiCondition (KeyRingRuntime,[(FilePath,KikiReportAction)]))
-performManipulations doDecrypt operation rt wk manip = do
+performManipulations doDecrypt rt wk manip = do
     let db = rtKeyDB rt
         performAll kd = foldM perform (KikiSuccess kd) $ manip rt kd
     r <- Traversable.mapM performAll db
@@ -1977,12 +1994,12 @@ interpretManip kd (KeyRingAddress kk sk (InducerSignature ps)) = error "todo"
 interpretManip kd manip = return kd
 -}
 
-combineTransforms :: KeyRingOperation -> KeyRingRuntime -> KeyData -> [PacketUpdate]
-combineTransforms operation rt kd = updates
+combineTransforms :: [Transform] -> KeyRingRuntime -> KeyData -> [PacketUpdate]
+combineTransforms trans rt kd = updates
  where
     updates = -- kManip operation rt kd ++
               concatMap (\t -> resolveTransform t rt kd) sanitized
-    sanitized = group (sort (opTransforms operation)) >>= take 1
+    sanitized = group (sort trans) >>= take 1
 
 isSubkeySignature (SubkeySignature {}) = True
 isSubkeySignature _                    = False
@@ -2160,10 +2177,9 @@ runKeyRing operation = do
                        }
 
         r <- performManipulations decrypt
-                                  operation
                                   rt
                                   wk
-                                  (combineTransforms operation)
+                                  (combineTransforms $ opTransforms operation)
         try' r $ \(rt,report_manips) -> do
 
         r <- writeWalletKeys operation (rtKeyDB rt) (fmap packet wk)