Merge pull request input-output-hk#56 from yvan-sraka/show-public-keys

Fix input-output-hk#13: create keys should show the public keys

app/Foliage/HackageSecurity.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImportQualifiedPost #-}
 
 module Foliage.HackageSecurity
   ( module Foliage.HackageSecurity,
@@ -10,8 +12,12 @@ module Foliage.HackageSecurity
   )
 where
 
-import Control.Monad (replicateM_)
+import Control.Monad (replicateM)
+import Crypto.Sign.Ed25519 (unPublicKey)
+import Data.ByteString.Base16 qualified as Base16
+import Data.ByteString.Char8 qualified as BS
 import Data.ByteString.Lazy qualified as BSL
+import Data.Foldable (for_)
 import Hackage.Security.Key.Env (fromKeys)
 import Hackage.Security.Server
 import Hackage.Security.TUF.FileMap
@@ -32,21 +38,33 @@ computeFileInfoSimple fp = do
 
 createKeys :: FilePath -> IO ()
 createKeys base = do
-  createDirectoryIfMissing True (base </> "root")
-  replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base </> "root")
-  createDirectoryIfMissing True (base </> "target")
-  replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base </> "target")
-  createDirectoryIfMissing True (base </> "timestamp")
-  replicateM_ 1 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base </> "timestamp")
-  createDirectoryIfMissing True (base </> "snapshot")
-  replicateM_ 1 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base </> "snapshot")
-  createDirectoryIfMissing True (base </> "mirrors")
-  replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base </> "mirrors")
+  putStrLn "root keys:"
+  createKeyGroup "root" >>= showKeys
+  for_ ["target", "timestamp", "snapshot", "mirrors"] createKeyGroup
+  where
+    createKeyGroup group = do
+      createDirectoryIfMissing True (base </> group)
+      keys <- replicateM 3 $ createKey' KeyTypeEd25519
+      for_ keys $ writeKeyWithId (base </> group)
+      pure keys
+
+    showKeys keys =
+      for_ keys $ \key ->
+        putStrLn $ "  " ++ showKey key
+
+showKey :: Some Key -> [Char]
+showKey k = BS.unpack $ Base16.encode $ exportSomePublicKey $ somePublicKey k
 
 writeKeyWithId :: FilePath -> Some Key -> IO ()
 writeKeyWithId base k =
   writeKey (base </> keyIdString (someKeyId k) <.> "json") k
 
+exportSomePublicKey :: Some PublicKey -> BS.ByteString
+exportSomePublicKey (Some k) = exportPublicKey k
+
+exportPublicKey :: PublicKey a -> BS.ByteString
+exportPublicKey (PublicKeyEd25519 pub) = unPublicKey pub
+
 writeKey :: FilePath -> Some Key -> IO ()
 writeKey fp key = do
   p <- makeAbsolute (fromFilePath fp)

foliage.cabal

@@ -46,6 +46,7 @@ executable foliage
         base                 >=4.14.3.0   && <4.18,
         aeson                >=2.0.3.0    && <2.2,
         base64               >=0.4.2.3    && <0.5,
+        base16-bytestring,
         binary,
         bytestring           >=0.10.12.0  && <0.12,
         Cabal                >=3.8        && <3.9,
@@ -54,6 +55,7 @@ executable foliage
         containers           >=0.6.5.1    && <0.7,
         cryptohash-sha256    >=0.11.102.1 && <0.12,
         directory            >=1.3.6.0    && <1.4,
+        ed25519,
         filepath             >=1.4.2.1    && <1.5,
         hackage-security     >=0.6.2.1    && <0.7,
         network-uri         ^>=2.6.4.1,