From 7a94f5103671011295f818bfcf30280423c44042 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Tue, 16 Jul 2019 17:51:31 -0400
Subject: use more Fingerprint WIP

---
 kiki.hs                   |  6 ------
 lib/KeyRing/BuildKeyDB.hs |  4 ++--
 lib/KeyRing/Types.hs      | 13 +++++++------
 lib/Kiki.hs               |  6 +++---
 4 files changed, 12 insertions(+), 17 deletions(-)

diff --git a/kiki.hs b/kiki.hs
index 6b3d36e..9b78e8f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -16,7 +16,6 @@ import Data.Binary
 import Data.Bits
 import Data.Char
 import Data.IORef
-import Data.Int
 import Data.List
 import Data.Maybe
 import Data.OpenPGP
@@ -24,15 +23,11 @@ import Data.Ord
 import Data.String
 import Text.Show.Pretty as PP ( ppShow )
 import Data.Text.Encoding
-import System.Posix.Files
-import Foreign.C.Types (CTime(..))
 import System.Environment
 import System.Exit
 import System.IO (hPutStrLn,stderr)
 import qualified Data.ByteString.Char8 as S8
 import Data.ByteArray.Encoding
-import qualified Codec.Archive.Tar as Tar
-import qualified Codec.Archive.Tar.Entry as Tar
 import Crypto.Hash.Algorithms (RIPEMD160(..))
 import Crypto.Hash
 import Data.ByteArray (convert)
@@ -59,7 +54,6 @@ import qualified DNSKey as DNS
 import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
 import Kiki
 import KeyDB
-import Network.Socket (SockAddr)
 import FunctorToMaybe
 
 -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 90f7292..461afa2 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -35,7 +35,7 @@ import           Data.List
 import qualified Data.Map                   as Map
 import           Data.Maybe
 import           Data.OpenPGP
-import           Data.OpenPGP.Util          (GenerateKeyParams (..), fingerprint, generateKey, pgpSign, verify)
+import           Data.OpenPGP.Util          (Fingerprint, GenerateKeyParams (..), fingerprint, generateKey, pgpSign, verify)
 
 
 import           Data.Time.Clock            (UTCTime)
@@ -408,7 +408,7 @@ usageFromFilter _                = mzero
 
 -- | Parse a key specification.
 -- The first argument is a grip for the default working key.
-parseSpec :: String -> String -> (KeySpec,Maybe String)
+parseSpec :: Fingerprint -> String -> (KeySpec,Maybe String)
 parseSpec wkgrip spec =
     if not slashed
         then
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs
index 5318b31..1177789 100644
--- a/lib/KeyRing/Types.hs
+++ b/lib/KeyRing/Types.hs
@@ -349,14 +349,15 @@ isTrust _                = False
 --
 -- matchpr fp = Data.List.Extra.takeEnd (length fp)
 --
-matchpr :: String -> Packet -> String
-matchpr fp k = reverse $ zipWith const (reverse (show $ fingerprint k)) fp
-
+matchpr :: Fingerprint -> Packet -> Bool
+matchpr fp k = p == show fp
+  where
+    p = reverse $ zipWith const (reverse (show $ fingerprint k)) (show fp)
 
 
 
 data KeySpec =
-      KeyGrip String       -- fp:
+      KeyGrip Fingerprint  -- fp:
     | KeyTag Packet String -- fp:????/t:
     | KeyUidMatch String   -- u:
  deriving Show
@@ -427,8 +428,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 == grip
-    pred p@(PublicKeyPacket {}) = matchpr grip p == grip
+    pred p@(SecretKeyPacket {}) = matchpr grip p
+    pred p@(PublicKeyPacket {}) = matchpr grip p
     pred _                      = False
 
 seek_key (KeyTag key tag) ps
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 7825c85..9934aaa 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -462,7 +462,7 @@ getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs
 
 data MyIdentity = MyIdentity {
   myGpgAddress :: SockAddr,
-  myGpgKeyGrip :: String
+  myGpgKeyGrip :: Fingerprint
 }
 
 installIpsecConf :: FileWriter -> MyIdentity -> [Peer] -> IO ()
@@ -495,7 +495,7 @@ getMyIdentity :: KeyRingRuntime -> Maybe MyIdentity
 getMyIdentity rt = do
     wk <- rtWorkingKey rt
     wkaddr <- gpgipv6addr . getHostnames <$> lookupKeyData (keykey wk) (rtKeyDB rt)
-    return $ MyIdentity wkaddr (show $ fingerprint wk)
+    return $ MyIdentity wkaddr (fingerprint wk)
 
 refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
 refreshCache rt rootdir = do
@@ -638,7 +638,7 @@ show_sshfp keyspec wkgrip db = do
 show_ssh :: String -> String -> KeyDB -> IO ()
 show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
 
-show_ssh' :: String -> String -> KeyDB -> Either String String
+show_ssh' :: String -> Fingerprint -> KeyDB -> Either String String
 show_ssh' keyspec wkgrip db = do
     let s = parseSpec wkgrip keyspec
     flip (maybe . Left $ keyspec ++ ": not found")
-- 
cgit v1.2.3