1 files changed, 62 insertions, 46 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index b6f16ca..0522fdb 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -96,7 +96,18 @@ data FileType = KeyRingFile (Maybe PassWordFile)
               | PEMFile UsageTag
               | WalletFile -- (Maybe UsageTag)
 
-data RefType = ConstRef | MutableRef (Maybe Initializer)
+-- | RefType is perhaps not a good name for this...
+--   It is sort of like a read/write flag, although
+--   semantically, it is indicating the intention of
+--   an action and not just the access level of an 
+--   object.
+data RefType = ConstRef
+             -- ^ merge into database but do not update
+             | MutableRef (Maybe Initializer)
+             -- ^ sync into database
+             --         update dabase and also update file
+             --   Initializer is a shell command that creates
+             --   the file; eg, ssh-keygen
 
 isMutable (MutableRef {}) = True
 isMutable _               = False
@@ -127,22 +138,15 @@ data KeyRingRuntime = KeyRingRuntime
 
 data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
 
-data SubKeyKey = SubKeyKey KeyKey | UIDKey String
- deriving (Eq,Ord)
-
-data PacketUpdate = InducerSignature [SignatureSubpacket]
+-- | TODO: Packet Update should have deletiong action
+--         and any other kind of roster entry level
+--         action.
+data PacketUpdate = InducerSignature String [SignatureSubpacket]
 
-data KeyRingAddress a = KeyRingAddress
-    { topkeyAddress :: KeyKey
-    , subkeyAddress :: SubKeyKey
-    , keyringAddressed :: a
-    }
- deriving Functor
+noManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]
+noManip _ _ = []
 
-noManip :: KeyRingRuntime -> [KeyRingAddress PacketUpdate]
-noManip = const []
-
-data KeyRingData = KeyRingData
+data KeyRingOperation = KeyRingOperation
     { kFiles :: Map.Map InputFile (RefType,FileType)
     , kImports :: Map.Map InputFile (KeyRingRuntime -> KeyData -> Maybe Bool)
     -- ^ 
@@ -153,7 +157,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]
+    , kManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]--[KeyRingAddress PacketUpdate]
     , homeSpec :: Maybe String
     }
 
@@ -173,8 +177,8 @@ filesToLock k secring pubring = do
         MutableRef {} -> resolveInputFile secring pubring f
 
 
--- kret :: a -> KeyRingData a
--- kret x = KeyRingData Map.empty Nothing (KeyRingAction x)
+-- kret :: a -> KeyRingOperation a
+-- kret x = KeyRingOperation Map.empty Nothing (KeyRingAction x)
 
 data RSAPublicKey = RSAKey MPI MPI deriving (Eq,Show)
 data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
@@ -682,7 +686,7 @@ importPEMKey doDecrypt db' tup = do
             return $ KikiSuccess (db'', report0 ++ report)
 
 buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet))
-              -> FilePath -> FilePath -> Maybe String -> KeyRingData
+              -> FilePath -> FilePath -> Maybe String -> KeyRingOperation
               -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)]))
 buildKeyDB doDecrypt secring pubring grip0 keyring = do
     let 
@@ -954,7 +958,7 @@ walletImportFormat idbyte k = secret_base58_foo
     (_,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d)
     seckey = S.cons idbyte bigendian
 
-writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)])
+writeWalletKeys :: KeyRingOperation -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)])
 writeWalletKeys krd db wk = do
     let cs = db `coinKeysOwnedBy` wk
     -- export wallet keys
@@ -1019,7 +1023,7 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
                             guard $ matchSpec (KeyGrip fp) elm
                             return $ keyPacket (snd elm)
 
-writeRingKeys :: KeyRingData -> KeyRingRuntime
+writeRingKeys :: KeyRingOperation -> KeyRingRuntime
                 {-
                 ->  KeyDB -> Maybe Packet
                 -> FilePath -> FilePath
@@ -1200,13 +1204,15 @@ 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
-    homedir <- getHomeDir (homeSpec keyring)
+runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
+runKeyRing operation = do
+    homedir <- getHomeDir (homeSpec operation)
     let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b)
         -- FIXME: try' should probably accept a list of KikiReportActions.
         --  This would be useful for reporting on disk writes that have already
@@ -1216,7 +1222,7 @@ runKeyRing keyring = do
                    Left e -> return $ KikiResult e []
                    Right wkun -> body wkun
     try' homedir $ \(homedir,secring,pubring,grip0) -> do
-    let tolocks = filesToLock keyring secring pubring
+    let tolocks = filesToLock operation secring pubring
     lks <- forM tolocks $ \f -> do
         lk <- dotlock_create f 0
         v <- flip (maybe $ return Nothing) lk $ \lk -> do
@@ -1231,23 +1237,23 @@ runKeyRing keyring = do
        else do
 
         pws <-
-            -- TODO: head will throw an exception if a File Descriptor keyring
+            -- TODO: head will throw an exception if a File Descriptor operation
             -- file is present.  We probably should change OriginMap to use InputFile
             -- instead of FilePath.
             Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . snd)
                              (Map.mapKeys (head . resolveInputFile secring pubring)
-                                $ Map.filter (isJust . pwfile . snd) $ kFiles keyring)
+                                $ Map.filter (isJust . pwfile . snd) $ kFiles operation)
 
         unkeysRef <- newIORef Map.empty
 
         -- merge all keyrings, PEM files, and wallets
-        bresult <- buildKeyDB (doDecrypt unkeysRef pws) secring pubring grip0 keyring
+        bresult <- buildKeyDB (doDecrypt unkeysRef pws) secring pubring grip0 operation
 
         try' bresult $ \((db,grip,wk),report_imports) -> do
 
         nonexistents <- 
            filterM (fmap not . doesFileExist . fst)
-               $ do (f,t) <- Map.toList (kFiles keyring)
+               $ do (f,t) <- Map.toList (kFiles operation)
                     f <- resolveInputFile secring pubring f
                     return (f,t)
 
@@ -1314,7 +1320,11 @@ runKeyRing keyring = do
 
         try' externals_ret $ \(db,report_externals) -> do
 
-        let manips0 = kManip keyring rt
+        db <- let perform kd (InducerSignature uid subpaks) = error "todo"
+                in Traversable.mapM (\kd -> foldM perform kd (kManip operation rt kd)) db
+
+{-
+        let manips0 = kManip operation rt
             manips :: Map.Map KeyKey [KeyRingAddress PacketUpdate]
             manips = Map.fromList $ do
                 ms <- groupBy ((==EQ) .: comparing topkeyAddress)
@@ -1329,11 +1339,12 @@ runKeyRing keyring = do
                 foldM interpretManip kd ms
 
         db' <- Traversable.mapM doManips db
+-}
 
-        r <- writeWalletKeys keyring db wk
+        r <- writeWalletKeys operation db wk
         try' r $ \report_wallets -> do
 
-        r <- writeRingKeys keyring rt -- db wk secring pubring
+        r <- writeRingKeys operation rt -- db wk secring pubring
         try' r $ \report_rings -> do
 
         r <- writePEMKeys (doDecrypt unkeysRef pws) db exports
@@ -1708,6 +1719,11 @@ type SigAndTrust = ( MappedPacket
 
 type KeyKey = [ByteString]
 data SubKey = SubKey MappedPacket [SigAndTrust]
+
+-- | This is a roster entry, it's poorly named
+--   but we are keeping the name around until
+--   we're sure we wont be cutting and pasting
+--   code with master any more
 data KeyData = KeyData MappedPacket    -- main key
                        [SigAndTrust]  -- sigs on main key
                        (Map.Map String ([SigAndTrust],OriginMap))  -- uids
@@ -1938,8 +1954,8 @@ flattenUid fname ispub (str,(sigs,om)) =
  
 {-
 data Kiki a =
-    SinglePass (KeyRingData -> KeyRingAction a)
-    | forall b. MultiPass (KeyRingData -> KeyRingAction b)
+    SinglePass (KeyRingOperation -> KeyRingAction a)
+    | forall b. MultiPass (KeyRingOperation -> KeyRingAction b)
                           (Kiki (b -> a))
 
 fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
@@ -1960,13 +1976,13 @@ instance Monad Kiki where
     k >>= f  = eval' $ fmapWithRT (\rt x -> eval rt (f x)) k
                 where (.:) = (.) . (.)
 
-eval :: KeyRingRuntime -> Kiki a -> KeyRingData -> a
+eval :: KeyRingRuntime -> Kiki a -> KeyRingOperation -> a
 eval rt (SinglePass f) kd =
     case f kd of KeyRingAction v -> v
                  RunTimeAction g -> g rt                       
 eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd
 
-eval' :: Kiki (KeyRingData -> a) -> Kiki a
+eval' :: Kiki (KeyRingOperation -> a) -> Kiki a
 eval' k@(SinglePass pass) = SinglePass pass'
  where
     pass' kd = case pass kd of
@@ -1981,9 +1997,9 @@ eval' k@(MultiPass p kk) = MultiPass p kk'
 
 
 {-
-fmapWithRT g (SinglePass d@(KeyRingData { kAction = KeyRingAction v}))
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v}))
     = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
-fmapWithRT g (SinglePass d@(KeyRingData { kAction = RunTimeAction f}))
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f}))
     = SinglePass $ d { kAction = RunTimeAction f' }
     where f' rt = g rt (f rt)
 fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
@@ -1992,10 +2008,10 @@ fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
 
 
 data Kiki a =
-    SinglePass { passInfo :: KeyRingData
+    SinglePass { passInfo :: KeyRingOperation
                , rtAction :: KeyRingAction a }
     | forall b.
-       MultiPass { passInfo :: KeyRingData
+       MultiPass { passInfo :: KeyRingOperation
                  , passAction :: KeyRingAction b
                  , nextPass :: Kiki (b -> a)
                  }
@@ -2093,8 +2109,8 @@ instance Functor Kiki where
 -}
 
 {-
-data Kiki a = SinglePass (KeyRingData a)
-              | forall b. MultiPass (KeyRingData b) (Kiki (b -> a))
+data Kiki a = SinglePass (KeyRingOperation a)
+              | forall b. MultiPass (KeyRingOperation b) (Kiki (b -> a))
 
 instance Functor Kiki where
     fmap f (SinglePass d) = SinglePass $ case kAction d of
@@ -2103,14 +2119,14 @@ instance Functor Kiki where
     fmap f (MultiPass p k)= MultiPass p (fmap (f .) k)
 
 eval :: KeyRingRuntime -> Kiki a -> a
-eval rt (SinglePass (KeyRingData { kAction = KeyRingAction v})) = v
-eval rt (SinglePass (KeyRingData { kAction = RunTimeAction f})) = f rt
+eval rt (SinglePass (KeyRingOperation { kAction = KeyRingAction v})) = v
+eval rt (SinglePass (KeyRingOperation { kAction = RunTimeAction f})) = f rt
 eval rt (MultiPass p kk) = eval rt kk $ eval rt (SinglePass p)
 
 fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
-fmapWithRT g (SinglePass d@(KeyRingData { kAction = KeyRingAction v}))
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v}))
     = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
-fmapWithRT g (SinglePass d@(KeyRingData { kAction = RunTimeAction f}))
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f}))
     = SinglePass $ d { kAction = RunTimeAction f' }
     where f' rt = g rt (f rt)
 fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)