More work on delete-subkey operation

1 files changed, 22 insertions, 3 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 30e0382..ff23bfb 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -371,10 +371,9 @@ data KeyRingRuntime = KeyRingRuntime
                         , rtPassphrases :: MappedPacket -> IO (KikiCondition Packet)
                         }
 
--- | TODO: Packet Update should have deletion action
---         and any other kind of roster-entry level
---         action.
+-- | Roster-entry level actions
 data PacketUpdate = InducerSignature String [SignatureSubpacket]
+                  | SubKeyDeletion KeyKey KeyKey
 
 -- | This type is used to indicate where to obtain passphrases.
 data PassphraseSpec = PassphraseSpec
@@ -2092,6 +2091,7 @@ performManipulations doDecrypt rt wk manip = do
     try (sequenceA r) $ \db -> do
     return $ KikiSuccess (rt { rtKeyDB = db },[])
  where
+    perform :: KikiCondition KeyData -> PacketUpdate -> IO (KikiCondition KeyData)
     perform kd (InducerSignature uid subpaks) = do
         try kd $ \kd -> do
         flip (maybe $ return NoWorkingKey) wk $ \wk' -> do
@@ -2133,6 +2133,15 @@ performManipulations doDecrypt rt wk manip = do
                   , om `Map.union` snd x )
         return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) }
 
+    perform kd (SubKeyDeletion topk subk) = do
+        try kd $ \kd -> do
+        -- TODO: delete key from key database
+        let kk = keykey $ packet $ keyMappedPacket kd
+            kd' | kk /= topk = kd
+                | otherwise  = kd { keySubKeys = Map.filterWithKey pred $ keySubKeys kd }
+            pred k _ = k == subk
+        return $ KikiSuccess kd'
+
 initializeMissingPEMFiles ::
     KeyRingOperation
       -> InputFileContext -> Maybe String
@@ -2308,6 +2317,7 @@ getBindings pkts = (sigs,bindings)
                 kind = guard (code==1) >> hashed >>= maybeToList . usage
             return (code,(topkey b,subkey b), kind, hashed,claimants)
 
+resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
 resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops
  where
     ops = map (\u -> InducerSignature u []) us
@@ -2340,6 +2350,15 @@ resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops
                    gs = groupBy sameMaster (sortBy (comparing code) bindings')
 
 
+resolveTransform (DeleteSubKey fp) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk
+ where
+    topk = keykey $ packet k -- key to master of key to be deleted
+    subk = do
+        (k,sub) <- Map.toList submap
+        guard (map toUpper fp == fingerprint (packet (subkeyMappedPacket sub)))
+        return k
+
+
 -- | Load and update key files according to the specified 'KeyRingOperation'.
 runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
 runKeyRing operation = do