From 9e8f7b0293dbc14e1aa9760420ec9c58f3243b7a Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 19 Apr 2014 21:27:22 -0400 Subject: added kManip --- KeyRing.hs | 38 ++++++++++++++++++++++++++++++++++++++ kiki.hs | 1 + 2 files changed, 39 insertions(+) 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 } -- cgit v1.2.3