1 files changed, 19 insertions, 21 deletions

diff --git a/kiki.hs b/kiki.hs
index 2379e74..b3cc880 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -225,38 +225,37 @@ show_wk :: FilePath
            -> Maybe [Char] -> KeyDB -> IO ()
 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 (byKeyKey db)
-        gripmatch (KeyData p _ _ _) =
+    let gripmatch (KeyData p _ _ _) =
             Map.member secring_file (locations p)
             || Map.member "&secret" (locations p)
-        Message sec = flattenKeys False sec_db
+        Message sec = flattenFiltered False gripmatch db
     putStrLn $ listKeysFiltered (maybeToList grip) sec
 
 debug_dump :: FilePath -> p -> KeyDB -> IO ()
 debug_dump secring_file grip db = do
-    let sec_db = Map.filter gripmatch (byKeyKey db)
-        gripmatch (KeyData p _ _ _) =
+    let gripmatch (KeyData p _ _ _) =
             Map.member secring_file (locations p)
             || Map.member "&secret" (locations p)
-        Message sec = flattenKeys False sec_db
+        Message sec = flattenFiltered False gripmatch db
     mapM_ print sec
 
 show_all :: KeyDB -> IO ()
 show_all db = do
-    let Message packets = flattenKeys True (byKeyKey db)
+    let Message packets = flattenFiltered True (const True) db
     putStrLn $ listKeys packets
 
 show_packets :: (Eq a, IsString a) =>
                 [a] -> KeyDB -> IO ()
 show_packets puborsec db = do
-    let Message packets = flattenKeys (case puborsec of { "sec":_ -> False; _ -> True })
-                                      (byKeyKey db)
+    let Message packets = flattenFiltered (case puborsec of { "sec":_ -> False; _ -> True })
+                                          (const True)
+                                          db
     forM_ packets $ putStrLn . showPacket
 
 show_whose_key :: Maybe RSAPublicKey -> KeyDB -> IO ()
 show_whose_key input_key db =
     flip (maybe $ return ()) input_key $ \input_key -> do
-    let ks = whoseKey input_key (byKeyKey db)
+    let ks = whoseKey input_key db
     case ks of
         [KeyData k _ uids _] -> do
             putStrLn $ fingerprint (packet k)
@@ -291,7 +290,7 @@ show_id :: String -> p -> KeyDB -> IO ()
 show_id keyspec wkgrip db = do
     let s = parseSpec "" keyspec
     let ps = do
-            (_,k) <- filterMatches (fst s) (Map.toList $ byKeyKey db)
+            (_,k) <- filterMatches (fst s) (kkData db)
             mp <- flattenTop "" True k
             return $ packet mp
     -- putStrLn $ "show key " ++ show s
@@ -416,8 +415,8 @@ bitcoinAddress network_id k = address
             ripemd160 x = convert (Crypto.Hash.hash x :: Digest RIPEMD160) :: S.ByteString
             address = base58_encode hsh
 
-whoseKey :: RSAPublicKey -> Map.Map KeyKey KeyData -> [KeyData]
-whoseKey rsakey db = filter matchkey (Map.elems db)
+whoseKey :: RSAPublicKey -> KeyDB -> [KeyData]
+whoseKey rsakey db = filter matchkey (keyData db)
  where
     matchkey (KeyData k _ _ subs) =
         any (ismatch k) $ Map.elems subs
@@ -1656,7 +1655,7 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
  where
     ipsecs = do
         (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt)
-        let kd = (byKeyKey (rtKeyDB rt) Map.! kk)
+        let kd = fromJust $ lookupKeyData kk (rtKeyDB rt)
             Hostnames addr onames ns _ = getHostnames kd
         oname <- onames
         return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs)
@@ -1668,15 +1667,14 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
     secrets_kd = case fst . parseSpec "" <$> (++"/") <$> spec of
                     _ | spec == Just "-" || spec == Just ""
                         -> maybeToList (rtWorkingKey rt)
-                            >>= return . (Map.!) (byKeyKey $ rtKeyDB rt) . keykey
+                            >>= return . fromJust . (`lookupKeyData` rtKeyDB rt) . keykey
                     Just topspec
-                        -> map snd $ filterMatches topspec $ Map.toList $ byKeyKey $ rtKeyDB rt
+                        -> map snd $ filterMatches topspec $ kkData $ rtKeyDB rt
                     w -> []
 
-    lookupSecret tag kd = maybeToList $ selectSecretKey (KeyGrip "",Just tag) m
-      where
-        m = KeyDB { byKeyKey = Map.singleton (keykey $ keyPacket kd) kd
-                  }
+    lookupSecret tag kd = take 1 $ snd $ (\(y:ys) -> seek_key (KeyTag y tag) ys)
+                                 $ snd $ seek_key (KeyGrip "")
+                                 $ map packet $ flattenTop "" False kd
 
     dir :: FilePath -> FilePath
     dir d = d -- TODO: prepend prefix path?
@@ -1746,7 +1744,7 @@ tarC (sargs,margs) = do
         knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey)
          where
             ns = onames ++ others
-            Hostnames _ onames others _ = getHostnames $ byKeyKey (rtKeyDB rt) Map.! kk
+            Hostnames _ onames others _ = getHostnames $ fromJust $ lookupKeyData kk (rtKeyDB rt)
 
     build_secret :: Num t => KeyRingRuntime  -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b)
     build_secret rt k = ( fromIntegral $ timestamp k