added kManip

2 files changed, 39 insertions, 0 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 4033c3b..b6f16ca 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -127,6 +127,21 @@ data KeyRingRuntime = KeyRingRuntime
 
 data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
 
+data SubKeyKey = SubKeyKey KeyKey | UIDKey String
+ deriving (Eq,Ord)
+
+data PacketUpdate = InducerSignature [SignatureSubpacket]
+
+data KeyRingAddress a = KeyRingAddress
+    { topkeyAddress :: KeyKey
+    , subkeyAddress :: SubKeyKey
+    , keyringAddressed :: a
+    }
+ deriving Functor
+
+noManip :: KeyRingRuntime -> [KeyRingAddress PacketUpdate]
+noManip = const []
+
 data KeyRingData = KeyRingData
     { kFiles :: Map.Map InputFile (RefType,FileType)
     , kImports :: Map.Map InputFile (KeyRingRuntime -> KeyData -> Maybe Bool)
@@ -138,6 +153,7 @@ data KeyRingData = KeyRingData
     -- Note that subkeys will always be imported if their owner key is
     -- already in the ring.
     --   TODO: Even if their signatures are bad?
+    , kManip :: KeyRingRuntime -> [KeyRingAddress PacketUpdate]
     , homeSpec :: Maybe String
     }
 
@@ -310,6 +326,9 @@ usage (NotationDataPacket
         }) = Just u
 usage _    = Nothing
 
+torSigOver
+  :: Packet
+     -> Packet -> Packet -> [SignatureSubpacket] -> SignatureOver
 -- torsig g topk wkun uid timestamp extras = todo
 torSigOver topk wkun uid extras
     = CertificationSignature (secretToPublic topk)
@@ -1181,6 +1200,9 @@ doDecrypt unkeysRef pws mp = do
                    (return . KikiSuccess)
                 $ Map.lookup kk unkeys
 
+interpretManip :: KeyData -> KeyRingAddress PacketUpdate -> IO KeyData
+interpretManip kd (KeyRingAddress kk sk (InducerSignature ps)) = error "todo"
+interpretManip kd manip = return kd
 
 runKeyRing :: KeyRingData -> IO (KikiResult KeyRingRuntime)
 runKeyRing keyring = do
@@ -1292,6 +1314,22 @@ runKeyRing keyring = do
 
         try' externals_ret $ \(db,report_externals) -> do
 
+        let manips0 = kManip keyring rt
+            manips :: Map.Map KeyKey [KeyRingAddress PacketUpdate]
+            manips = Map.fromList $ do
+                ms <- groupBy ((==EQ) .: comparing topkeyAddress)
+                        $ sortBy (comparing topkeyAddress)
+                                 manips0
+                k <- fmap topkeyAddress $ take 1 ms
+                return (k,ms)
+              where (.:) = (.).(.)
+            doManips kd = do
+                let kk = keykey $ keyPacket kd
+                    ms = maybe [] id $ Map.lookup kk manips
+                foldM interpretManip kd ms
+
+        db' <- Traversable.mapM doManips db
+
         r <- writeWalletKeys keyring db wk
         try' r $ \report_wallets -> do
 
diff --git a/kiki.hs b/kiki.hs
index 7c89882..2968067 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1352,6 +1352,7 @@ main = do
                 ++ walts
             , kImports = Map.fromList $
                 [ ( HomePub, importStyle ) ]
+            , kManip = noManip
             , homeSpec = homespec
             }