1 files changed, 78 insertions, 18 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 39bff4c..b223ee7 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -9,6 +9,7 @@ import Data.Maybe
 import Data.Char
 import Data.List
 import Data.OpenPGP
+import Data.Functor
 import Control.Applicative    ( (<$>) )
 import System.Directory       ( getHomeDirectory, doesFileExist )
 import Control.Arrow          ( first, second )
@@ -17,6 +18,7 @@ import Data.ByteString.Lazy   ( ByteString )
 import Text.Show.Pretty as PP ( ppShow )
 import qualified Data.Map as Map
 
+import FunctorToMaybe
 import DotLock
 
 data HomeDir =
@@ -51,13 +53,29 @@ data KeyRingData a = KeyRingData
 
 todo = error "unimplemented"
 
-data KikiResult = KikiSuccess | FailedToLock [FilePath]
-
-{-
-newtype KeyRing a = KeyRing
-    { krAction :: KeyRingData b -> IO a
+data KikiCondition a = KikiSuccess a | FailedToLock [FilePath]
+
+#define TRIVIAL(OP) fmap _ (OP) = OP
+instance Functor KikiCondition where
+    fmap f (KikiSuccess a) = KikiSuccess (f a)
+    TRIVIAL( FailedToLock x )
+instance FunctorToMaybe KikiCondition where
+    functorToMaybe (KikiSuccess a) = Just a
+    functorToMaybe _               = Nothing
+
+data KikiReportAction =
+        NewPacket String
+        | MissingPacket String
+        | ExportedSubkey
+        | GeneratedSubkeyFile
+        | NewWalletKey String
+        | YieldSignature
+        | YieldSecretKeyPacket String
+
+data KikiResult a = KikiResult
+    { kikiCondition :: KikiCondition a
+    , kikiReport :: [ (FilePath, KikiReportAction) ]
     }
--}
 
 empty = KeyRingData { filesToLock = []
                     , homeSpec = Nothing
@@ -66,13 +84,7 @@ empty = KeyRingData { filesToLock = []
                     , walletFiles = []
                     }
 
-{-
-runKeyRing :: KeyRing () -> IO a
-runKeyRing keyring = krAction keyring empty
--}
-
-
-runKeyRing :: KeyRingData a -> IO KikiResult
+runKeyRing :: KeyRingData a -> IO (KikiResult a)
 runKeyRing keyring = do
     (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring)
     let tolocks = map resolve (filesToLock keyring)
@@ -87,21 +99,23 @@ runKeyRing keyring = do
                         else dotlock_destroy lk >> return Nothing
         return (v,f)
     let (lked, map snd -> failed) = partition (isJust . fst) lks
-        ret = if null failed then KikiSuccess else FailedToLock failed
+        ret = if null failed then KikiSuccess () else FailedToLock failed
 
-    case ret of
-      KikiSuccess -> kaction keyring KeyRingRuntime
+    ret <- case functorToEither ret of
+      Right {} -> do
+         a <- kaction keyring KeyRingRuntime
                         { rtPubring = pubring
                         , rtSecring = secring
                         , rtRings = secring:pubring:keyringFiles keyring
                         , rtWallets = walletFiles keyring
                         , rtGrip = grip0
                         }
-      _ -> return undefined
+         return (KikiSuccess a)
+      Left err -> return err
 
     forM_ lked $ \(Just lk, fname) -> do dotlock_release lk
                                          dotlock_destroy lk
-    return ret
+    return KikiResult { kikiCondition = ret, kikiReport = [] }
 
 parseOptionFile fname = do
     xs <- fmap lines (readFile fname)
@@ -358,3 +372,49 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
     mergeSubSig n sig Nothing = error $
         "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
 
+data Kiki a = Kiki
+
+goHome :: Maybe FilePath -> Kiki ()
+goHome = todo
+
+syncRing :: InputFile -> Kiki ()
+syncRing = todo
+
+syncSubKey :: String -> FilePath -> String -> Kiki ()
+syncSubKey usage path cmd = todo
+
+syncWallet :: FilePath -> Kiki ()
+syncWallet = todo
+
+usePassphraseFD :: Int -> Kiki ()
+usePassphraseFD = todo
+
+importAll :: Kiki ()
+importAll = todo
+
+importAllAuthentic :: Kiki ()
+importAllAuthentic = todo
+
+signSelfAuthorized :: Kiki ()
+signSelfAuthorized = todo
+
+showIdentity :: Message -> String
+showIdentity = todo
+
+identities :: Kiki [Message]
+identities = todo
+
+currentIdentity :: Kiki Message
+currentIdentity = todo
+
+identityBySpec :: String -> Kiki Message
+identityBySpec = todo
+
+identityBySSHKey :: String -> Kiki Message
+identityBySSHKey = todo
+
+keyBySpec :: String -> Kiki Packet
+keyBySpec = todo
+
+walletInputFormat :: Packet -> String
+walletInputFormat = todo