1 files changed, 16 insertions, 24 deletions

diff --git a/kiki.hs b/kiki.hs
index 9b78e8f..d7099b6 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -41,7 +41,7 @@ import Data.Binary.Put
 import System.Posix.User
 
 import CommandLine
-import Data.OpenPGP.Util (verify, fingerprint, GenerateKeyParams(..))
+import Data.OpenPGP.Util (Fingerprint, verify, fingerprint, GenerateKeyParams(..))
 import ScanningParser
 import PEM
 import DotLock
@@ -63,13 +63,6 @@ isCertificationSig :: SignatureOver -> Bool
 isCertificationSig (CertificationSignature {}) = True
 isCertificationSig _                           = True
 
-fpmatch :: Maybe [Char] -> Packet -> Bool
-fpmatch grip key =
-    (==) Nothing
-         (fmap (backend (show $ fingerprint key)) grip >>= guard . not)
- where
-    backend xs ys = and $ zipWith (==) (reverse xs) (reverse ys)
-
 listKeys :: [Packet] -> [Char]
 listKeys pkts = listKeysFiltered [] pkts
 
@@ -79,7 +72,7 @@ listKeys pkts = listKeysFiltered [] pkts
 -- Build the display output
 -- Operates in List Monad...
 -- returns all output as a single string
-listKeysFiltered :: Foldable t => t [Char] -> [Packet] -> [Char]
+listKeysFiltered :: Foldable t => t Fingerprint -> [Packet] -> [Char]
 listKeysFiltered grips pkts = do
     let masterkeys = filter (\k -> isKey k && not (is_subkey k)) pkts
         (certs,bs) = getBindings pkts
@@ -96,7 +89,7 @@ listKeysFiltered grips pkts = do
         ownerkey (_,(a,_),_,_,_) = a
         sameMaster (ownerkey->a) (ownerkey->b) = fingerprint_material a==fingerprint_material b
         matchgrip _ | null grips = True
-        matchgrip ((code,(top,sub), kind, hashed,claimants):_) | any (flip fpmatch top . Just) grips = True
+        matchgrip ((code,(top,sub), kind, hashed,claimants):_) | any (flip matchpr top) grips = True
         matchgrip _ = False
         gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as)
         singles = filter (\k -> show (fingerprint k) `notElem` map (show . fingerprint) parents) masterkeys -- \\ parents
@@ -152,7 +145,7 @@ listKeysFiltered grips pkts = do
             let issuers = do
                     sig_over <- signatures_over sig
                     i <- maybeToList $ signature_issuer sig_over
-                    maybeToList $ find_key (matchpr i) (Message keys) (reverse (take 16 (reverse i)))
+                    maybeToList $ find_key (matchpr'' i) (Message keys) (reverse (take 16 (reverse i)))
                 (primary,secondary) = partition (==top) issuers
 
             -- trace ("PRIMARY: "++show (map fingerprint primary)) $ return ()
@@ -215,8 +208,7 @@ partitionStaticArguments specs args = psa args
         Nothing -> second (a:) $ psa as
         Just n  -> first ((a:take n as):) $ psa (drop n as)
 
-show_wk :: FilePath
-           -> Maybe [Char] -> KeyDB -> IO ()
+show_wk :: FilePath -> Maybe Fingerprint -> KeyDB -> IO ()
 show_wk secring_file grip db = do
     -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db)
     let gripmatch (KeyData p _ _ _) =
@@ -257,7 +249,7 @@ show_whose_key input_key db =
         (_:_) -> error "ambiguous"
         [] -> return ()
 
-show_dns :: [Char] -> String -> KeyDB -> IO ()
+show_dns :: [Char] -> Maybe Fingerprint -> KeyDB -> IO ()
 show_dns keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db dnsPresentationFromPacket
 
 dnsPresentationFromPacket :: Monad m => Packet -> m String
@@ -282,7 +274,7 @@ dnsPresentationFromPacket k = do
 
 show_id :: String -> p -> KeyDB -> IO ()
 show_id keyspec wkgrip db = do
-    let s = parseSpec "" keyspec
+    let s = parseSpec Nothing keyspec
     let ps = do
             (_,k) <- filterMatches (fst s) (kkData db)
             mp <- flattenTop "" True k
@@ -290,7 +282,7 @@ show_id keyspec wkgrip db = do
     -- putStrLn $ "show key " ++ show s
     putStrLn $ listKeys ps
 
-show_wip :: [Char] -> String -> KeyDB -> IO ()
+show_wip :: [Char] -> Maybe Fingerprint -> KeyDB -> IO ()
 show_wip keyspec wkgrip db = do
     let s = parseSpec wkgrip keyspec
     flip (maybe $ void (warn (keyspec ++ ": not found")))
@@ -320,7 +312,7 @@ show_torhash pubkey _ = do
         keys = catMaybes $ scanAndParse (pkcs1 <> pkcs8 <> cert) $ Char8.lines bs
     mapM_ (putStrLn . addy . torhash) keys
 
-show_cert :: [Char] -> String -> KeyDB -> IO ()
+show_cert :: [Char] -> Maybe Fingerprint -> KeyDB -> IO ()
 show_cert keyspec wkgrip db = do
     let s = parseSpec wkgrip keyspec
     case selectPublicKeyAndSigs s db of
@@ -1235,13 +1227,13 @@ kiki "show" args = do
                                       ,("--all",const show_all)
                                       ,("--whose-key", const $ show_whose_key input_key)
                                       ,("--packets", show_packets)
-                                      ,("--key",\[x] -> show_id x $ fromMaybe "" grip)
-                                      ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip)
-                                      ,("--dns",\[x] -> show_dns x $ fromMaybe "" grip)
-                                      ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip)
-                                      ,("--sshfp",\[x] -> show_sshfp x $ fromMaybe "" grip)
-                                      ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip)
-                                      ,("--cert",\[x] -> show_cert x $ fromMaybe "" grip)
+                                      ,("--key",\[x] -> show_id x grip)
+                                      ,("--pem",\[x] -> show_pem x grip)
+                                      ,("--dns",\[x] -> show_dns x grip)
+                                      ,("--ssh",\[x] -> show_ssh x grip)
+                                      ,("--sshfp",\[x] -> show_sshfp x grip)
+                                      ,("--wip",\[x] -> show_wip x grip)
+                                      ,("--cert",\[x] -> show_cert x grip)
                                       ,("--torhash",\[x] -> show_torhash x)
                                       ,("--dump", const $ debug_dump (rtSecring rt) grip)
                                       ]