3 files changed, 340 insertions, 282 deletions

diff --git a/Base58.hs b/Base58.hs
new file mode 100644
index 0000000..26f1cb2
--- /dev/null
+++ b/Base58.hs
@@ -0,0 +1,37 @@
+module Base58 where
+
+import qualified Crypto.Hash.SHA256 as SHA256
+import qualified Data.ByteString      as S
+import Data.Maybe
+import Data.List
+import Data.Word ( Word8 )
+import Control.Monad
+
+base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
+
+base58digits :: [Char] -> Maybe [Int]
+base58digits str = sequence mbs
+ where
+    mbs = map (flip elemIndex base58chars) str
+    
+-- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ
+base58_decode :: [Char] -> Maybe (Word8,[Word8])
+base58_decode str = do
+    ds <- base58digits str
+    let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] )
+        rbytes = unfoldr getbyte n
+        getbyte d = do
+            guard (d/=0)
+            let (q,b) = d `divMod` 256
+            return (fromIntegral b,q)
+    
+    let (rcksum,rpayload) = splitAt 4 $ rbytes
+        a_payload = reverse rpayload
+        hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload
+        expected_hash = S.pack $ reverse rcksum
+        (network_id,payload) = splitAt 1 a_payload
+    
+    network_id <- listToMaybe network_id
+    guard (hash_result==expected_hash)
+    return (network_id,payload)
+
diff --git a/KeyRing.hs b/KeyRing.hs
index cdfcd34..2a80930 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings #-}
 module KeyRing where
 
 import System.Environment
@@ -11,17 +12,32 @@ import Data.Char
 import Data.List
 import Data.OpenPGP
 import Data.Functor
-import Control.Applicative    ( (<$>) )
+import Data.Bits              ( (.|.) )
+-- import Control.Applicative    ( (<$>) )
 import System.Directory       ( getHomeDirectory, doesFileExist )
 import Control.Arrow          ( first, second )
 import Data.OpenPGP.Util      ( fingerprint )
 import Data.ByteString.Lazy   ( ByteString )
 import Text.Show.Pretty as PP ( ppShow )
+import Data.Word ( Word8 )
+import Data.Binary ( decode )
+import ControlMaybe ( handleIO_ )
 import qualified Data.Map as Map
-
+import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString )
+import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) 
+import qualified Crypto.Types.PubKey.ECC as ECC
+import System.Posix.Types (EpochTime)
+import System.Posix.Files ( modificationTime, getFileStatus )
+
+import qualified CryptoCoins as CryptoCoins
+import Base58
 import FunctorToMaybe
 import DotLock
 
+-- DER-encoded elliptic curve ids
+nistp256_id  = 0x2a8648ce3d030107
+secp256k1_id = 0x2b8104000a
+
 data HomeDir =
     HomeDir { homevar :: String
             , appdir :: String
@@ -51,6 +67,7 @@ data KeyRingRuntime = KeyRingRuntime
                         , rtRings :: [FilePath]
                         , rtWallets :: [FilePath]
                         , rtGrip :: Maybe String
+                        , rtKeyDB :: KeyDB
                         }
 
 data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
@@ -61,17 +78,19 @@ data KeyRingData = KeyRingData
     , homeSpec :: Maybe String
     }
 
-filesToLock k secring pubring = do
-    (f,(rtyp,ftyp)) <- Map.toList (kFiles k)
-    case rtyp of
-        ConstRef -> []
-        MutableRef {} -> resolve f
+resolveInputFile secring pubring = resolve
  where
     resolve HomeSec = return secring
     resolve HomePub = return pubring
     resolve (ArgFile f) = return f
     resolve _ = []
 
+filesToLock k secring pubring = do
+    (f,(rtyp,ftyp)) <- Map.toList (kFiles k)
+    case rtyp of
+        ConstRef -> []
+        MutableRef {} -> resolveInputFile secring pubring f
+
 
 -- kret :: a -> KeyRingData a
 -- kret x = KeyRingData Map.empty Nothing (KeyRingAction x)
@@ -102,6 +121,188 @@ data KikiResult a = KikiResult
     , kikiReport :: [ (FilePath, KikiReportAction) ]
     }
 
+keyPacket (KeyData k _ _ _) = packet k
+
+usage (NotationDataPacket
+        { human_readable = True
+        , notation_name  = "usage@"
+        , notation_value = u
+        }) = Just u
+usage _    = Nothing
+
+keyflags flgs@(KeyFlagsPacket {}) =
+    Just . toEnum $
+        (   bit 0x1 certify_keys
+        .|. bit 0x2 sign_data
+        .|. bit 0x4 encrypt_communication
+        .|. bit 0x8 encrypt_storage )     :: Maybe PGPKeyFlags
+    -- other flags:
+    --  split_key
+    --  authentication (ssh-client)
+    --  group_key
+ where
+    bit v f = if f flgs then v else 0
+keyflags _ = Nothing
+
+
+data PGPKeyFlags =
+    Special
+    | Vouch -- Signkey
+    | Sign
+    | VouchSign
+    | Communication
+    | VouchCommunication
+    | SignCommunication
+    | VouchSignCommunication
+    | Storage
+    | VouchStorage
+    | SignStorage
+    | VouchSignStorage
+    | Encrypt
+    | VouchEncrypt
+    | SignEncrypt
+    | VouchSignEncrypt
+ deriving (Eq,Show,Read,Enum)
+usageString flgs =
+ case flgs of
+    Special -> "special"
+    Vouch -> "vouch" -- signkey
+    Sign -> "sign"
+    VouchSign -> "vouch-sign"
+    Communication -> "communication"
+    VouchCommunication -> "vouch-communication"
+    SignCommunication -> "sign-communication"
+    VouchSignCommunication -> "vouch-sign-communication"
+    Storage -> "storage"
+    VouchStorage -> "vouch-storage"
+    SignStorage -> "sign-storage"
+    VouchSignStorage -> "vouch-sign-storage"
+    Encrypt -> "encrypt"
+    VouchEncrypt -> "vouch-encrypt"
+    SignEncrypt -> "sign-encrypt"
+    VouchSignEncrypt -> "vouch-sign-encrypt"
+
+
+
+
+-- matchpr computes the fingerprint of the given key truncated to
+-- be the same lenght as the given fingerprint for comparison.
+matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp
+
+keyFlags  wkun uids = keyFlags0 wkun (filter isSignaturePacket uids)
+keyFlags0 wkun uidsigs = concat
+                      [ keyflags
+                      , preferredsym
+                      , preferredhash
+                      , preferredcomp
+                      , features ]
+
+ where
+    subs = concatMap hashed_subpackets uidsigs
+    keyflags = filterOr isflags subs $
+               KeyFlagsPacket { certify_keys = True
+                              , sign_data = True
+                              , encrypt_communication = False
+                              , encrypt_storage = False
+                              , split_key = False
+                              , authentication = False
+                              , group_key = False
+                              }
+    preferredsym = filterOr ispreferedsym subs $
+               PreferredSymmetricAlgorithmsPacket
+                              [ AES256
+                              , AES192
+                              , AES128
+                              , CAST5
+                              , TripleDES
+                              ]
+    preferredhash = filterOr ispreferedhash subs $
+               PreferredHashAlgorithmsPacket
+                              [ SHA256
+                              , SHA1
+                              , SHA384
+                              , SHA512
+                              , SHA224
+                              ]
+    preferredcomp = filterOr ispreferedcomp subs $
+               PreferredCompressionAlgorithmsPacket
+                              [ ZLIB
+                              , BZip2
+                              , ZIP
+                              ]
+    features = filterOr isfeatures subs $
+               FeaturesPacket { supports_mdc = True
+                              }
+
+    filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs
+
+    isflags (KeyFlagsPacket {}) = True
+    isflags _ = False
+    ispreferedsym (PreferredSymmetricAlgorithmsPacket {}) = True
+    ispreferedsym _ = False
+    ispreferedhash (PreferredHashAlgorithmsPacket {}) = True
+    ispreferedhash _ = False
+    ispreferedcomp (PreferredCompressionAlgorithmsPacket {}) = True
+    ispreferedcomp _ = False
+    isfeatures (FeaturesPacket {}) = True
+    isfeatures _ = False
+
+
+matchSpec (KeyGrip grip) (_,KeyData p _ _ _) 
+    | matchpr grip (packet p)==grip = True
+    | otherwise                     = False
+
+matchSpec (KeyTag key tag) (_,KeyData _ sigs _ _) = not . null $ filter match ps
+ where
+    ps = map (packet .fst) sigs
+    match p = isSignaturePacket p
+                && has_tag tag p
+                && has_issuer key p
+    has_issuer key p = isJust $ do
+        issuer <- signature_issuer p
+        guard $ matchpr issuer key == issuer
+    has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p)
+                    || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p))
+
+matchSpec (KeyUidMatch pat) (_,KeyData _ _ uids _) = not $ null us
+  where
+    us = filter (isInfixOf pat) $ Map.keys uids
+
+
+data KeySpec =
+      KeyGrip String
+    | KeyTag Packet String
+    | KeyUidMatch String
+ deriving Show
+
+
+buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData
+              -> IO ((KeyDB,String),[(FilePath,KikiReportAction)])
+buildKeyDB secring pubring grip0 keyring = do
+    let rings = do
+            (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring)
+            let isring (KeyRingFile {}) = True
+                isring _                = False
+            guard (isring ftyp)
+            resolveInputFile secring pubring f
+        readp n = fmap (n,) (readPacketsFromFile n)
+        readw wk n = fmap (n,) (readPacketsFromWallet wk n)
+    ms <- mapM readp rings
+    let grip = grip0 `mplus` (fingerprint <$> fstkey)
+          where
+            fstkey = listToMaybe $ mapMaybe isSecringKey ms 
+                      where isSecringKey (fn,Message ps)
+                                | fn==secring = 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
+    db <- return db0 -- todo
+    return ( (db, todo), todo )
+
 runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a)
 runKeyRing keyring op = do
     (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring)
@@ -117,7 +318,7 @@ runKeyRing keyring op = do
         ret = if null failed then KikiSuccess () else FailedToLock failed
     ret <- case functorToEither ret of
       Right {} -> do
-         report <- todo -- build db
+         ((db,grip), report1) <- buildKeyDB secring pubring grip0 keyring -- build db
 
          a <- return $ op KeyRingRuntime
                         { rtPubring = pubring
@@ -125,10 +326,11 @@ runKeyRing keyring op = do
                         , rtRings = [] -- todo secring:pubring:keyringFiles keyring
                         , rtWallets = [] -- todo walletFiles keyring
                         , rtGrip = grip0
+                        , rtKeyDB = db
                         }
-         report <- todo report -- write files
+         report2 <- todo -- write files
         
-         return $ KikiResult (KikiSuccess a) report
+         return $ KikiResult (KikiSuccess a) (report1 ++ report2)
       Left err -> return $ KikiResult err []
 
     forM_ lked $ \(Just lk, fname) -> do dotlock_release lk
@@ -196,6 +398,97 @@ isUserID _                 = False
 isTrust (TrustPacket {}) = True
 isTrust _                = False
 
+slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString])
+slurpWIPKeys stamp "" = ([],[])
+slurpWIPKeys stamp cs =
+    let (b58,xs) = Char8.span (\x -> elem x base58chars) cs
+        mb        = decode_btc_key stamp (Char8.unpack b58)
+    in if L.null b58 
+        then let (ys,xs') = Char8.break (\x -> elem x base58chars) cs
+                 (ks,js)  = slurpWIPKeys stamp xs'
+             in (ks,ys:js) 
+        else let (ks,js) = slurpWIPKeys stamp xs
+             in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb
+
+
+decode_btc_key timestamp str = do
+    (network_id,us) <- base58_decode str
+    return . (network_id,) $ Message $ do
+        let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer])
+            {-
+            xy = secp256k1_G `pmul` d
+            x = getx xy
+            y = gety xy
+            -- y² = x³ + 7 (mod p)
+            y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve)
+            y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve)
+            -}
+            secp256k1 = ECC.getCurveByName ECC.SEC_p256k1
+            ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1
+            -- pub = cannonical_eckey x y
+            -- hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $  pub
+            -- address = base58_encode hash
+            -- pubstr = concatMap (printf "%02x") $ pub
+            -- _ = pubstr :: String
+        return $ {- trace (unlines ["pub="++show pubstr
+                                ,"add="++show address
+                                ,"y  ="++show y
+                                ,"y' ="++show y'
+                                ,"y''="++show y'']) -}
+            SecretKeyPacket 
+            { version = 4
+            , timestamp = toEnum (fromEnum timestamp)
+            , key_algorithm = ECDSA
+            , key = [ -- public fields...
+                     ('c',MPI secp256k1_id) -- secp256k1 (bitcoin curve)
+                    ,('l',MPI 256)
+                    ,('x',MPI x)
+                    ,('y',MPI y)
+                    -- secret fields
+                    ,('d',MPI d)
+                    ]
+            , s2k_useage = 0
+            , s2k = S2K 100 ""
+            , symmetric_algorithm = Unencrypted
+            , encrypted_data = ""
+            , is_subkey = True
+            }
+
+readPacketsFromWallet :: 
+    Maybe Packet
+    -> FilePath 
+    -> IO [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
+readPacketsFromWallet wk fname = do
+    timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ 
+                    modificationTime <$> getFileStatus fname
+    input <- L.readFile fname
+    let (ks,_) = slurpWIPKeys timestamp input
+    when (not (null ks)) $ do
+        -- decrypt wk
+        -- create sigs
+        -- return key/sig pairs
+        return ()
+    return $ do
+        wk <- maybeToList wk
+        guard (not $ null ks)
+        let prep (tagbyte,k) = (wk,k,(k,Map.singleton tag wk))
+                                where tag = CryptoCoins.nameFromSecretByte tagbyte
+        (wk,MarkerPacket,(MarkerPacket,Map.empty))
+         :map prep ks
+
+readPacketsFromFile :: FilePath -> IO Message
+readPacketsFromFile fname = do
+    -- warn $ fname ++ ": reading..."
+    input <- L.readFile fname
+#if MIN_VERSION_binary(0,6,4)
+    return $
+      case decodeOrFail input of
+        Right (_,_,msg ) -> msg
+        Left  (_,_,_)    -> trace (fname++": read fail") $ Message []
+#else
+    return $ decode input
+#endif
+
 
 data OriginFlags = OriginFlags {
         originallyPublic :: Bool,
diff --git a/kiki.hs b/kiki.hs
index 365562b..d7ea9c7 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -347,13 +347,6 @@ isPublicMaster _ = False
 
 now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
 
-usage (NotationDataPacket
-        { human_readable = True
-        , notation_name  = "usage@"
-        , notation_value = u
-        }) = Just u
-usage _    = Nothing
-
 verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs)
  where
     verified = do
@@ -380,10 +373,6 @@ grip k = drop 32 $ fingerprint k
 
 smallpr k = drop 24 $ fingerprint k
 
--- matchpr computes the fingerprint of the given key truncated to
--- be the same lenght as the given fingerprint for comparison.
-matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp
-
 
 disjoint_fp ks = {- concatMap group2 $ -} transpose grouped
  where
@@ -587,58 +576,6 @@ listKeysFiltered grips pkts = do
     "master-key " ++ fingerprint top ++ "\n" ++ uid ++"  ...\n" ++ subkeys ++ "\n"
 
 
-data PGPKeyFlags =
-    Special
-    | Vouch -- Signkey
-    | Sign
-    | VouchSign
-    | Communication
-    | VouchCommunication
-    | SignCommunication
-    | VouchSignCommunication
-    | Storage
-    | VouchStorage
-    | SignStorage
-    | VouchSignStorage
-    | Encrypt
-    | VouchEncrypt
-    | SignEncrypt
-    | VouchSignEncrypt
- deriving (Eq,Show,Read,Enum)
-
-usageString flgs =
- case flgs of
-    Special -> "special"
-    Vouch -> "vouch" -- signkey
-    Sign -> "sign"
-    VouchSign -> "vouch-sign"
-    Communication -> "communication"
-    VouchCommunication -> "vouch-communication"
-    SignCommunication -> "sign-communication"
-    VouchSignCommunication -> "vouch-sign-communication"
-    Storage -> "storage"
-    VouchStorage -> "vouch-storage"
-    SignStorage -> "sign-storage"
-    VouchSignStorage -> "vouch-sign-storage"
-    Encrypt -> "encrypt"
-    VouchEncrypt -> "vouch-encrypt"
-    SignEncrypt -> "sign-encrypt"
-    VouchSignEncrypt -> "vouch-sign-encrypt"
-
-
-keyflags flgs@(KeyFlagsPacket {}) =
-    Just . toEnum $
-        (   bit 0x1 certify_keys
-        .|. bit 0x2 sign_data
-        .|. bit 0x4 encrypt_communication
-        .|. bit 0x8 encrypt_storage )     :: Maybe PGPKeyFlags
-    -- other flags:
-    --  split_key
-    --  authentication (ssh-client)
-    --  group_key
- where
-    bit v f = if f flgs then v else 0
-keyflags _ = Nothing
 
 
 modifyUID (UserIDPacket str) = UserIDPacket str'
@@ -666,53 +603,6 @@ expandPath path []                 = []
 
 -- type TimeStamp = Word32
 
-slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString])
-slurpWIPKeys stamp "" = ([],[])
-slurpWIPKeys stamp cs =
-    let (b58,xs) = Char8.span (\x -> elem x base58chars) cs
-        mb        = decode_btc_key stamp (Char8.unpack b58)
-    in if L.null b58 
-        then let (ys,xs') = Char8.break (\x -> elem x base58chars) cs
-                 (ks,js)  = slurpWIPKeys stamp xs'
-             in (ks,ys:js) 
-        else let (ks,js) = slurpWIPKeys stamp xs
-             in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb
-
-readPacketsFromWallet :: 
-    Maybe Packet
-    -> FilePath 
-    -> IO [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
-readPacketsFromWallet wk fname = do
-    timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ 
-                    modificationTime <$> getFileStatus fname
-    input <- L.readFile fname
-    let (ks,_) = slurpWIPKeys timestamp input
-    when (not (null ks)) $ do
-        -- decrypt wk
-        -- create sigs
-        -- return key/sig pairs
-        return ()
-    return $ do
-        wk <- maybeToList wk
-        guard (not $ null ks)
-        let prep (tagbyte,k) = (wk,k,(k,Map.singleton tag wk))
-                                where tag = CryptoCoins.nameFromSecretByte tagbyte
-        (wk,MarkerPacket,(MarkerPacket,Map.empty))
-         :map prep ks
-
-readPacketsFromFile :: FilePath -> IO Message
-readPacketsFromFile fname = do
-    -- warn $ fname ++ ": reading..."
-    input <- L.readFile fname
-#if MIN_VERSION_binary(0,6,4)
-    return $
-      case decodeOrFail input of
-        Right (_,_,msg ) -> msg
-        Left  (_,_,_)    -> trace (fname++": read fail") $ Message []
-#else
-    return $ decode input
-#endif
-
 -- | Attempts to lock each file in the list.
 -- Returns a list of locks and a list of filenames
 -- that could not be locked.
@@ -984,12 +874,6 @@ getPassphrase cmd =
 
 #define HOMEOPTION (def &= explicit &= name "homedir" &= typDir )
 
-data KeySpec =
-      KeyGrip String
-    | KeyTag Packet String
-    | KeyUidMatch String
- deriving Show
-
 is40digitHex xs = ys == xs && length ys==40
   where
     ys = filter ishex xs
@@ -1062,7 +946,6 @@ sortByHint fname f = sortBy (comparing gethint)
     defnum = -1
 
 keyMappedPacket (KeyData k _ _ _) = k
-keyPacket (KeyData k _ _ _) = packet k
 
 writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO ()
 writeOutKeyrings lkmap db = do
@@ -1417,34 +1300,6 @@ secp256k1_G = ECPa secp256k1_curve
     -}
 -}
 
-base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
-
-base58digits :: [Char] -> Maybe [Int]
-base58digits str = sequence mbs
- where
-    mbs = map (flip elemIndex base58chars) str
-    
--- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ
-base58_decode :: [Char] -> Maybe (Word8,[Word8])
-base58_decode str = do
-    ds <- base58digits str
-    let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] )
-        rbytes = unfoldr getbyte n
-        getbyte d = do
-            guard (d/=0)
-            let (q,b) = d `divMod` 256
-            return (fromIntegral b,q)
-    
-    let (rcksum,rpayload) = splitAt 4 $ rbytes
-        a_payload = reverse rpayload
-        hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload
-        expected_hash = S.pack $ reverse rcksum
-        (network_id,payload) = splitAt 1 a_payload
-    
-    network_id <- listToMaybe network_id
-    guard (hash_result==expected_hash)
-    return (network_id,payload)
-
 walletImportFormat idbyte k = secret_base58_foo
  where
     -- isSecret (SecretKeyPacket {}) = True
@@ -1530,48 +1385,6 @@ bitcoinAddress network_id k = address
 --  0x4e*128+0x3d 10045
 -- 1.2.840.10045.3.1.7  --> NIST P-256
 --
-decode_btc_key timestamp str = do
-    (network_id,us) <- base58_decode str
-    return . (network_id,) $ Message $ do
-        let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer])
-            {-
-            xy = secp256k1_G `pmul` d
-            x = getx xy
-            y = gety xy
-            -- y² = x³ + 7 (mod p)
-            y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve)
-            y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve)
-            -}
-            secp256k1 = ECC.getCurveByName ECC.SEC_p256k1
-            ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1
-            -- pub = cannonical_eckey x y
-            -- hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $  pub
-            -- address = base58_encode hash
-            -- pubstr = concatMap (printf "%02x") $ pub
-            -- _ = pubstr :: String
-        return $ {- trace (unlines ["pub="++show pubstr
-                                ,"add="++show address
-                                ,"y  ="++show y
-                                ,"y' ="++show y'
-                                ,"y''="++show y'']) -}
-            SecretKeyPacket 
-            { version = 4
-            , timestamp = toEnum (fromEnum timestamp)
-            , key_algorithm = ECDSA
-            , key = [ -- public fields...
-                     ('c',MPI secp256k1_id) -- secp256k1 (bitcoin curve)
-                    ,('l',MPI 256)
-                    ,('x',MPI x)
-                    ,('y',MPI y)
-                    -- secret fields
-                    ,('d',MPI d)
-                    ]
-            , s2k_useage = 0
-            , s2k = S2K 100 ""
-            , symmetric_algorithm = Unencrypted
-            , encrypted_data = ""
-            , is_subkey = True
-            }
 
 doBTCImport doDecrypt db (ms,subspec,content) = do
     let fetchkey = do
@@ -2494,26 +2307,6 @@ selectKey0 wantPublic (spec,mtag) db = do
         zs = snd $ seek_key subspec ys1
     listToMaybe zs
 
-matchSpec (KeyGrip grip) (_,KeyData p _ _ _) 
-    | matchpr grip (packet p)==grip = True
-    | otherwise                     = False
-
-matchSpec (KeyTag key tag) (_,KeyData _ sigs _ _) = not . null $ filter match ps
- where
-    ps = map (packet .fst) sigs
-    match p = isSignaturePacket p
-                && has_tag tag p
-                && has_issuer key p
-    has_issuer key p = isJust $ do
-        issuer <- signature_issuer p
-        guard $ matchpr issuer key == issuer
-    has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p)
-                    || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p))
-
-matchSpec (KeyUidMatch pat) (_,KeyData _ _ uids _) = not $ null us
-  where
-    us = filter (isInfixOf pat) $ Map.keys uids
-
 seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
 seek_key (KeyGrip grip) sec = (pre, subs)
   where
@@ -2614,68 +2407,3 @@ sigpackets typ hashed unhashed = return $
         0 -- Word16 -- Left 16 bits of the signed hash value
         [] -- [MPI]
 
-keyFlags  wkun uids = keyFlags0 wkun (filter isSignaturePacket uids)
- {-
- where
-    vs = map (verify (Message [wkun])) (signatures (Message (wkun:uids)))
-    ws = map signatures_over vs
-    xs = filter null ws
-    -}
-
-keyFlags0 wkun uidsigs = concat
-                      [ keyflags
-                      , preferredsym
-                      , preferredhash
-                      , preferredcomp
-                      , features ]
-
- where
-    subs = concatMap hashed_subpackets uidsigs
-    keyflags = filterOr isflags subs $
-               KeyFlagsPacket { certify_keys = True
-                              , sign_data = True
-                              , encrypt_communication = False
-                              , encrypt_storage = False
-                              , split_key = False
-                              , authentication = False
-                              , group_key = False
-                              }
-    preferredsym = filterOr ispreferedsym subs $
-               PreferredSymmetricAlgorithmsPacket
-                              [ AES256
-                              , AES192
-                              , AES128
-                              , CAST5
-                              , TripleDES
-                              ]
-    preferredhash = filterOr ispreferedhash subs $
-               PreferredHashAlgorithmsPacket
-                              [ SHA256
-                              , SHA1
-                              , SHA384
-                              , SHA512
-                              , SHA224
-                              ]
-    preferredcomp = filterOr ispreferedcomp subs $
-               PreferredCompressionAlgorithmsPacket
-                              [ ZLIB
-                              , BZip2
-                              , ZIP
-                              ]
-    features = filterOr isfeatures subs $
-               FeaturesPacket { supports_mdc = True
-                              }
-
-    filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs
-
-    isflags (KeyFlagsPacket {}) = True
-    isflags _ = False
-    ispreferedsym (PreferredSymmetricAlgorithmsPacket {}) = True
-    ispreferedsym _ = False
-    ispreferedhash (PreferredHashAlgorithmsPacket {}) = True
-    ispreferedhash _ = False
-    ispreferedcomp (PreferredCompressionAlgorithmsPacket {}) = True
-    ispreferedcomp _ = False
-    isfeatures (FeaturesPacket {}) = True
-    isfeatures _ = False
-