From 77f220c41d93078c7a6a8f55296f0f970d1b913b Mon Sep 17 00:00:00 2001
From: James Crayne <jim.crayne@gmail.com>
Date: Sat, 20 Jun 2015 23:37:30 -0400
Subject: Fix: Show master keys which have no subkeys.

---
 kiki.hs | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

(limited to 'kiki.hs')

diff --git a/kiki.hs b/kiki.hs
index a50c237..d05424f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -49,6 +49,7 @@ import qualified CryptoCoins
 -- import Chroot
 import ProcessUtils
 import qualified SSHKey as SSH
+import Text.Printf
 
 -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
 -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-}
@@ -124,9 +125,15 @@ fpmatch grip key =
 
 listKeys pkts = listKeysFiltered [] pkts
 
+-- | listKeysFiltered
+--    @grips    fingerprints of keys to show
+--    @pkts     list of pgp packets
+-- Build the display output
+-- Operates in List Monad...
+-- returns all output as a single string
 listKeysFiltered grips pkts = do
-    -- FIXME: Will not show any output when there are no subkeys.
-    let (certs,bs) = getBindings pkts
+    let masterkeys = filter (\k -> isKey k && not (is_subkey k)) pkts
+        (certs,bs) = getBindings pkts
         as = accBindings bs
         defaultkind (k:_) hs = k
         defaultkind []    hs = fromMaybe "subkey"
@@ -143,8 +150,14 @@ listKeysFiltered grips pkts = do
         matchgrip ((code,(top,sub), kind, hashed,claimants):_) | any (flip fpmatch top . Just) grips = True
         matchgrip _ = False
         gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as)
+        singles = filter (\k -> fingerprint k `notElem` map fingerprint parents) masterkeys -- \\ parents
+          where parents = do
+                    subs@((_,(top,_),_,_,_):_) <- gs
+                    return top
         showsigs claimants = map (\k -> "      " ++ "^ signed: " ++ fingerprint k) claimants
-    subs@((_,(top,_),_,_,_):_) <- gs
+    subs0 <- map Left gs ++ map Right singles
+    let (top,subs) = case subs0 of Left subs1@((_,(top0,_),_,_,_):_) -> (top0,subs1)
+                                   Right top0                        -> (top0,[])
     let subkeys = do
             (code,(top,sub), kind, hashed,claimants) <- subs
             let ar = case code of
@@ -244,6 +257,7 @@ partitionStaticArguments specs args = psa args
         Just n  -> first ((a:take n as):) $ psa (drop n as)
 
 show_wk secring_file grip db = do
+    -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db)
     let sec_db = Map.filter gripmatch db
         gripmatch (KeyData p _ _ _) =
             Map.member secring_file (locations p)
-- 
cgit v1.2.3