Promote KeyDB to a type.

1 files changed, 18 insertions, 15 deletions

diff --git a/kiki.hs b/kiki.hs
index b4512f3..a8f1bc6 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -231,19 +231,19 @@ partitionStaticArguments specs args = psa args
         Just n  -> first ((a:take n as):) $ psa (drop n as)
 
 show_wk :: FilePath
-           -> Maybe [Char] -> Map.Map KeyKey KeyData -> IO ()
+           -> 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 db
+    let sec_db = Map.filter gripmatch (byKeyKey db)
         gripmatch (KeyData p _ _ _) =
             Map.member secring_file (locations p)
             || Map.member "&secret" (locations p)
         Message sec = flattenKeys False sec_db
     putStrLn $ listKeysFiltered (maybeToList grip) sec
 
-debug_dump :: FilePath -> p -> Map.Map KeyKey KeyData -> IO ()
+debug_dump :: FilePath -> p -> KeyDB -> IO ()
 debug_dump secring_file grip db = do
-    let sec_db = Map.filter gripmatch db
+    let sec_db = Map.filter gripmatch (byKeyKey db)
         gripmatch (KeyData p _ _ _) =
             Map.member secring_file (locations p)
             || Map.member "&secret" (locations p)
@@ -252,19 +252,20 @@ debug_dump secring_file grip db = do
 
 show_all :: KeyDB -> IO ()
 show_all db = do
-    let Message packets = flattenKeys True db
+    let Message packets = flattenKeys True (byKeyKey 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 }) db
+    let Message packets = flattenKeys (case puborsec of { "sec":_ -> False; _ -> True })
+                                      (byKeyKey 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 db
+    let ks = whoseKey input_key (byKeyKey db)
     case ks of
         [KeyData k _ uids _] -> do
             putStrLn $ fingerprint (packet k)
@@ -299,11 +300,11 @@ dnsPresentationFromPacket k = do
         ,qq
         ]
 
-show_id :: String -> p -> Map.Map KeyKey KeyData -> IO ()
+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 db)
+            (_,k) <- filterMatches (fst s) (Map.toList $ byKeyKey db)
             mp <- flattenTop "" True k
             return $ packet mp
     -- putStrLn $ "show key " ++ show s
@@ -440,7 +441,7 @@ bitcoinAddress network_id k = address
 #endif
             address = base58_encode hsh
 
-whoseKey :: RSAPublicKey -> KeyDB -> [KeyData]
+whoseKey :: RSAPublicKey -> Map.Map KeyKey KeyData -> [KeyData]
 whoseKey rsakey db = filter matchkey (Map.elems db)
  where
     matchkey (KeyData k _ _ subs) =
@@ -1678,7 +1679,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 = (rtKeyDB rt Map.! kk)
+        let kd = (byKeyKey (rtKeyDB rt) Map.! kk)
             Hostnames addr onames ns _ = getHostnames kd
         oname <- onames
         return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs)
@@ -1689,14 +1690,16 @@ 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.!) (rtKeyDB rt) . keykey
+                        -> maybeToList (rtWorkingKey rt)
+                            >>= return . (Map.!) (byKeyKey $ rtKeyDB rt) . keykey
                     Just topspec
-                        -> map snd $ filterMatches topspec $ Map.toList $ rtKeyDB rt
+                        -> map snd $ filterMatches topspec $ Map.toList $ byKeyKey $ rtKeyDB rt
                     w -> []
 
     lookupSecret tag kd = maybeToList $ selectSecretKey (KeyGrip "",Just tag) m
       where
-        m = Map.singleton (keykey $ keyPacket kd) kd
+        m = KeyDB { byKeyKey = Map.singleton (keykey $ keyPacket kd) kd
+                  }
 
     dir :: FilePath -> FilePath
     dir d = d -- TODO: prepend prefix path?
@@ -1766,7 +1769,7 @@ tarC (sargs,margs) = do
         knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey)
          where
             ns = onames ++ others
-            Hostnames _ onames others _ = getHostnames $ rtKeyDB rt Map.! kk
+            Hostnames _ onames others _ = getHostnames $ byKeyKey (rtKeyDB rt) Map.! kk
 
     build_secret :: Num t => KeyRingRuntime  -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b)
     build_secret rt k = ( fromIntegral $ timestamp k