From 64202f804429053058ac3efce527f77c2e12948b Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 23 Apr 2016 00:35:03 -0400
Subject: WIP: tar command.

---
 KeyRing.hs | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

(limited to 'KeyRing.hs')

diff --git a/KeyRing.hs b/KeyRing.hs
index 7369acf..d4bb099 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -938,7 +938,7 @@ parseSpec grip spec = (topspec,subspec)
                 "fp" | top=="" -> Nothing
                 "" | top=="" && is40digitHex sub -> Nothing
                 "" -> listToMaybe sub >> Just sub
-                -- "fp" -> ???  TODO: non-ehaustive patterns in case: fp:7/fp:
+                _ -> Nothing
 
      is40digitHex xs = ys == xs && length ys==40
       where
@@ -992,11 +992,14 @@ selectSecretKey (spec,mtag) db = selectKey0 False (spec,mtag) db
 selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
 selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db
 
-selectPublicKeyAndSigs :: (KeySpec,Maybe String) -> KeyDB -> [(Packet,[Packet])]
+selectPublicKeyAndSigs :: (KeySpec,Maybe String) -> KeyDB -> [(KeyKey,Packet,[Packet])]
 selectPublicKeyAndSigs (spec,mtag) db =
     case mtag of
-        Nothing -> concat $ Map.elems $ fmap (findbyspec spec) db
-        Just tag -> Map.elems (Map.filter (matchSpec spec) db) >>= findsubs tag
+        Nothing -> do
+            (kk,r) <- Map.toList $ fmap (findbyspec spec) db
+            (sub,sigs) <- r
+            return (kk,sub,sigs)
+        Just tag -> Map.toList (Map.filter (matchSpec spec) db) >>= findsubs tag
  where
     topresult kd = (keyPacket kd, map (packet .fst) $ keySigAndTrusts kd)
 
@@ -1009,22 +1012,22 @@ selectPublicKeyAndSigs (spec,mtag) db =
         ismatch (p,sigs) = matchpr g p ==g
     findbyspec spec kd = if matchSpec spec kd then [topresult kd] else []
 
-    findsubs tag (KeyData topk _ _ subs) = Map.elems subs >>= gettag
+    findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag
      where
         gettag (SubKey sub sigs) = do
             let (_,mb,_) = findTag [mkUsage tag] (packet topk) (packet sub) sigs
             (hastag,_) <- maybeToList mb
             guard hastag
-            return $ (packet sub, map (packet . fst) sigs)
+            return $ (kk, packet sub, map (packet . fst) sigs)
 
 selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
 selectKey0 wantPublic (spec,mtag) db = do
     let Message ps = flattenKeys wantPublic db
         ys = snd $ seek_key spec ps
     flip (maybe (listToMaybe ys)) mtag $ \tag -> do
-    let (subspec,ys1) = (KeyTag y tag,ys1) where y:ys1 = ys
-        zs = snd $ seek_key subspec ys1
-    listToMaybe zs
+    case ys of
+        y:ys1 -> listToMaybe $ snd $ seek_key (KeyTag y tag) ys1
+        []    -> Nothing
 
 {-
 selectAll :: Bool -> (KeySpec,Maybe String) -> KeyDB -> [(Packet,Maybe Packet)]
-- 
cgit v1.2.3