this compiles

2 files changed, 29 insertions, 19 deletions

diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 461afa2..510c820 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -83,9 +83,9 @@ newtype IPsToWriteToHostsFile = IPsToWriteToHostsFile [SockAddr]
 --
 --   merge all keyrings, PEM files, and wallets into process memory.
 --
-buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation
+buildKeyDB :: InputFileContext -> Maybe Fingerprint -> KeyRingOperation
               -> IO (KikiCondition (({- db        -} KeyDB
-                                    ,{- grip      -} Maybe String
+                                    ,{- grip      -} Maybe Fingerprint
                                     ,{- wk        -} Maybe MappedPacket
                                     ,{- hs        -} ({- hostdbs0 -}[Hosts.Hosts],
                                                       {- hostdbs  -}[Hosts.Hosts],
@@ -128,7 +128,8 @@ buildKeyDB ctx grip0 keyring = do
         ringPackets <- Map.traverseWithKey readp ringMap
         let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message)
 
-        let grip = grip0 `mplus` (show . fingerprint <$> fstkey)
+        let grip :: Maybe Fingerprint
+            grip = grip0 `mplus` (fingerprint <$> fstkey)
               where
                 fstkey = do
                     (_,Message ps) <- Map.lookup HomeSec ringPackets
@@ -223,7 +224,7 @@ buildKeyDB ctx grip0 keyring = do
             guard $ all (==usage) $ drop 1 us
             -- TODO: KikiCondition reporting for spill/fill usage mismatch?
             -- TODO: parseSpec3
-            let (topspec,subspec) = parseSpec grip usage
+            let (topspec,subspec) = parseSpec (Just grip) usage
                 ms = map fst $ filterMatches topspec (kkData db)
                 cmd = initializer stream
             return (n,subspec,ms,stream, cmd)
@@ -408,16 +409,16 @@ usageFromFilter _                = mzero
 
 -- | Parse a key specification.
 -- The first argument is a grip for the default working key.
-parseSpec :: Fingerprint -> String -> (KeySpec,Maybe String)
+parseSpec :: Maybe Fingerprint -> String -> (KeySpec,Maybe String)
 parseSpec wkgrip spec =
     if not slashed
         then
             case prespec of
                 AnyMatch                               -> (KeyGrip "", Nothing)
                 EmptyMatch                             -> error "Bad key spec."
-                WorkingKeyMatch                        -> (KeyGrip wkgrip, Nothing)
-                SubstringMatch (Just KeyTypeField) tag -> (KeyGrip wkgrip, Just tag)
-                SubstringMatch Nothing str             -> (KeyGrip wkgrip, Just str)
+                WorkingKeyMatch                        -> (KeyGrip $ show wkgrip, Nothing)
+                SubstringMatch (Just KeyTypeField) tag -> (KeyGrip $ show wkgrip, Just tag)
+                SubstringMatch Nothing str             -> (KeyGrip $ show wkgrip, Just str)
                 SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing)
                 FingerprintMatch fp                    -> (KeyGrip fp, Nothing)
         else
@@ -780,8 +781,8 @@ is40digitHex xs = ys == xs && length ys==40
 
 matchSpec :: KeySpec -> KeyData -> Bool
 matchSpec (KeyGrip grip) (KeyData p _ _ _)
-    | matchpr grip (packet p)==grip = True
-    | otherwise                     = False
+    | matchpr' grip (packet p) = True
+    | otherwise                = False
 
 matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
  where
@@ -791,7 +792,7 @@ matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
                 && has_issuer key p
     has_issuer key p = isJust $ do
         issuer <- signature_issuer p
-        guard $ matchpr issuer key == issuer
+        guard $ matchpr' issuer key
     has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p)
                     || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p))
 
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs
index 1177789..1a12a61 100644
--- a/lib/KeyRing/Types.hs
+++ b/lib/KeyRing/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DeriveFunctor     #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE PatternSynonyms   #-}
@@ -119,7 +120,7 @@ data PassphraseSpec = PassphraseSpec
     { passSpecRingFile :: Maybe FilePath
     -- ^ If not Nothing, the passphrase is to be used for packets
     -- from this file.
-    , passSpecKeySpec :: Maybe String
+    , passSpecKeySpec :: Maybe Fingerprint
     -- ^ Non-Nothing value reserved for future use.
     -- (TODO: Use this to implement per-key passphrase associations).
     , passSpecPassFile :: InputFile
@@ -129,6 +130,9 @@ data PassphraseSpec = PassphraseSpec
     | PassphraseMemoizer { passSpecTranscoder :: PacketTranscoder }
     | PassphraseAgent
 
+deriving instance Ord Fingerprint
+deriving instance Eq Fingerprint
+
 instance Show PassphraseSpec where
     show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c)
     show (PassphraseMemoizer _) = "PassphraseMemoizer"
@@ -350,14 +354,19 @@ isTrust _                = False
 -- matchpr fp = Data.List.Extra.takeEnd (length fp)
 --
 matchpr :: Fingerprint -> Packet -> Bool
-matchpr fp k = p == show fp
-  where
-    p = reverse $ zipWith const (reverse (show $ fingerprint k)) (show fp)
+matchpr fp k = matchpr' (show fp) k
 
+matchpr' :: String -> Packet -> Bool
+matchpr' fp k = p == fp
+  where
+    p = reverse $ zipWith const (reverse (show $ fingerprint k)) fp
 
+matchpr'' :: String -> Packet -> String
+matchpr'' fp k | matchpr' fp k = fp
+matchpr'' fp k | otherwise = ""
 
 data KeySpec =
-      KeyGrip Fingerprint  -- fp:
+      KeyGrip String       -- fp:
     | KeyTag Packet String -- fp:????/t:
     | KeyUidMatch String   -- u:
  deriving Show
@@ -428,8 +437,8 @@ seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
 seek_key (KeyGrip grip) sec = (pre, subs)
   where
     (pre,subs) = break pred sec
-    pred p@(SecretKeyPacket {}) = matchpr grip p
-    pred p@(PublicKeyPacket {}) = matchpr grip p
+    pred p@(SecretKeyPacket {}) = matchpr' grip p
+    pred p@(PublicKeyPacket {}) = matchpr' grip p
     pred _                      = False
 
 seek_key (KeyTag key tag) ps
@@ -442,7 +451,7 @@ seek_key (KeyTag key tag) ps
     (as,bs) = break (\p -> isSignaturePacket p
                         && has_tag tag p
                         && isJust (signature_issuer p)
-                        && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) )
+                        && matchpr' (fromJust $ signature_issuer p) key)
                     ps
     (rs,qs) = break isKey (reverse as)