fixed kiki to compile (todo stubs)

2 files changed, 12 insertions, 128 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 6fac344..95c348e 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -150,8 +150,6 @@ filesToLock k secring pubring = do
 -- kret :: a -> KeyRingData a
 -- kret x = KeyRingData Map.empty Nothing (KeyRingAction x)
 
-todo = error "unimplemented"
-
 data RSAPublicKey = RSAKey MPI MPI deriving (Eq,Show)
 data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
 
@@ -1971,6 +1969,7 @@ fmapWithRT g (MultiPass p atn next) = MultiPass p atn next'
 instance Functor Kiki where
     fmap f k = fmapWithRT (return f) k
 
+{-
 instance Monad Kiki where
     return x = SinglePass todo (return x)
     k >>= f  = kjoin $ fmap f k
@@ -2099,3 +2098,5 @@ keyBySpec = todo
 
 walletInputFormat :: Packet -> String
 walletInputFormat = todo
+
+-}
diff --git a/kiki.hs b/kiki.hs
index 1586517..96138c4 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -82,6 +82,7 @@ import Data.Binary.Put (putWord32be,runPut,putByteString)
 import Data.Binary.Get (runGet)
 
 import KeyRing
+import Base58
 
 -- instance Default S.ByteString where def = S.empty
 
@@ -153,8 +154,6 @@ isSubkeySignature _                    = False
 isPublicMaster k@(PublicKeyPacket {}) = not $ is_subkey k
 isPublicMaster _ = False
 
-now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
-
 verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs)
  where
     verified = do
@@ -623,85 +622,6 @@ writeOutKeyrings lkmap db = do
         -- warn $ "writing "++f
         L.writeFile f (encode m)
 
-setHome spec kd = kd { homeSpec = spec
-                     , kaction = const $ runKeyRing kd
-                     }
-
-
-cross_merge doDecrypt keyrings wallets kd f = do
-
-        let it = kd { filesToLock = HomeSec:HomePub:map ArgFile keyrings
-                    , keyringFiles = keyrings
-                    , walletFiles = wallets
-                    , kaction = go doDecrypt f
-                    }
-        runKeyRing it
- where
-    go doDecrypt f rt = do
-        let readp n = fmap (n,) (readPacketsFromFile n)
-            readw wk n = fmap (n,) (readPacketsFromWallet wk n)
-
-        let pass = do
-                ms <- mapM readp (rtRings rt)
-                let grip = rtGrip rt `mplus` (fingerprint <$> fstkey)
-                      where
-                        fstkey = listToMaybe $ mapMaybe isSecringKey ms 
-                                  where isSecringKey (fn,Message ps)
-                                            | fn== rtSecring rt = listToMaybe ps
-                                        isSecringKey _  = Nothing
-                    wk = listToMaybe $ do
-                            fp <- maybeToList grip
-                            elm <- Map.toList db0
-                            guard $ matchSpec (KeyGrip fp) elm
-                            return $ keyPacket (snd elm)
-                    db0 = foldl' (uncurry . merge) Map.empty ms
-                wms <- mapM (readw wk) (rtWallets rt)
-                let ts = do
-                        maybeToList wk
-                        (fname,xs) <- wms
-                        (_,sub,(_,m)) <- xs
-                        (tag,top) <- Map.toList m
-                        return (top,fname,sub,tag)
-
-                    importWalletKey db' (top,fname,sub,tag) = do
-                        doImportG doDecrypt 
-                                  db'
-                                  (fmap keykey $ maybeToList wk)
-                                  tag
-                                  fname
-                                  sub
-                db <- foldM importWalletKey db0 ts
-                let cs = do
-                        wk <- maybeToList wk
-                        let kk = keykey wk
-                        KeyData top topsigs uids subs <- maybeToList $ Map.lookup kk db
-                        (subkk,SubKey mp sigs) <- Map.toList subs
-                        let sub = packet mp
-                        guard $ isCryptoCoinKey sub
-                        tag <- take 1 $ mapMaybe getCryptoCoinTag (map (packet . fst) sigs)
-                        return (tag,mp)
-
-                -- export wallet keys
-                forM_ (rtWallets rt) $ \n -> do
-                    let cs' = do
-                        (nw,mp) <- cs
-                        -- let fns = Map.keys (locations mp)
-                        -- trace ("COIN KEY: "++show fns) $ return ()
-                        guard . not $ Map.member n (locations mp)
-                        let wip = walletImportFormat (CryptoCoins.private_byte_id nw) (packet mp)
-                        return (CryptoCoins.network_name nw,wip)
-                    handleIO_ (return ()) $ do
-                    withFile n AppendMode $ \fh -> do
-                    forM_ cs' $ \(net,wip) -> do
-                        warn $ n++": new WalletKey "++net
-                        hPutStrLn fh wip
-
-                db' <- f (rtSecring rt,grip) db (rtPubring rt)
-                return (rtRings rt,db')
-        (fsns,db) <- pass
-
-        let lkmap = Map.fromList $ map (,()) fsns
-        writeOutKeyrings lkmap db
 
 
 toLast f []  = []
@@ -776,47 +696,6 @@ show_wip keyspec wkgrip db = do
     let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s
     putStrLn $ walletImportFormat nwb k
 
-doExport doDecrypt (db,use_db) (fname,subspec,ms,cmd) =
-        case ms of
-            [_]   -> export
-            (_:_) -> ambiguous
-            []    -> shcmd
- where
-    ambiguous = error "Key specification is ambiguous."
-    shcmd = do
-        let noop warning = do
-            warn warning
-            return (db,use_db)
-        if null cmd then noop (fname ++ ": missing.") else do
-        let vars = [ ("file",fname)
-                   , ("usage",maybe "" id subspec) ]
-        e <- systemEnv vars cmd
-        case e of
-            ExitFailure num -> noop $ fname ++ ": failed external (code="++show num++")"
-            ExitSuccess     -> do
-                warn $ fname ++ ": generated"
-                db' <- doImport doDecrypt db (fname,subspec,ms,cmd) 
-                return (db', use_db)
-    export = do
-        let [kk] = ms
-            Just (KeyData key _ _ subkeys) = Map.lookup kk use_db
-            p = flip (maybe (Just $ packet key)) subspec $ \tag -> do
-                  let subs = Map.elems subkeys
-                      doSearch (SubKey sub_mp sigtrusts) =
-                        let (_,v,_) = findTag tag
-                                          (packet key)
-                                          (packet sub_mp) 
-                                          sigtrusts
-                        in fmap fst v==Just True
-                  case filter doSearch subs of
-                    [SubKey mp _] -> Just $ packet mp
-                    [] -> Nothing
-                    _  -> ambiguous
-        flip (maybe shcmd) p $ \p -> do
-        pun <- doDecrypt p
-        flip (maybe $ error "Bad passphrase?") pun $ \pun -> do
-        writeKeyToFile False "PEM" fname pun
-        return (db,use_db)
 
 {-
 applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve)
@@ -914,6 +793,7 @@ bitcoinAddress network_id k = address
 -- 1.2.840.10045.3.1.7  --> NIST P-256
 --
 
+{-
 doBTCImport doDecrypt db (ms,subspec,content) = do
     let fetchkey = do
             timestamp <- now
@@ -932,6 +812,7 @@ doBTCImport doDecrypt db (ms,subspec,content) = do
     when (not (null tailms) || null m0)
         $ error "Key specification is ambiguous."
     doImportG doDecrypt db m0 tag "" key
+-}
 
 -- We return into IO in case we want to make a signature here.
 setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData
@@ -1358,7 +1239,7 @@ main = do
     -}
 
     let homespec = join . take 1 <$> Map.lookup "--homedir" margs
-    cross_merge decrypt keyrings_ wallets (setHome homespec KeyRing.empty)
+    todo 
         $ \(secfile,grip) db pubring -> do
 
         use_db0 <- return db
@@ -1377,7 +1258,9 @@ main = do
 
 
         let (imports,exports) = partition fst fs
-        use_db <- foldM (doImport decrypt) use_db0 (map snd imports)
+        -- use_db <- foldM (doImport decrypt) use_db0 (map snd imports)
+
+        let use_db = todo
 
         let (btcs,_) = partition isSupportedBTC btcpairs
             isSupportedBTC (spec,"base58",cnt) = True
@@ -1391,9 +1274,9 @@ main = do
                                     in (ms,subspec,cnt)
                         return $ map conv btcs
 
-        use_db <- foldM (doBTCImport decrypt) use_db pbtcs
+        -- use_db <- foldM (doBTCImport decrypt) use_db pbtcs
 
-        (ret_db,_) <- foldM (doExport decrypt) (use_db,use_db) (map snd exports)
+        -- (ret_db,_) <- foldM (doExport decrypt) (use_db,use_db) (map snd exports)
 
         use_db <-
             flip (maybe $ return use_db)