From 59e0d72cb964fa91234f9bf8d6ae36d5c7867bb2 Mon Sep 17 00:00:00 2001 From: Yvan Sraka Date: Wed, 26 Apr 2023 13:18:58 +0200 Subject: [PATCH 1/3] Fix #13: create keys should show the public keys --- app/Foliage/HackageSecurity.hs | 25 +++++++++++++++++++++++-- foliage.cabal | 2 ++ 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/app/Foliage/HackageSecurity.hs b/app/Foliage/HackageSecurity.hs index d2825c4..d99d092 100644 --- a/app/Foliage/HackageSecurity.hs +++ b/app/Foliage/HackageSecurity.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImportQualifiedPost #-} module Foliage.HackageSecurity ( module Foliage.HackageSecurity, @@ -11,6 +13,9 @@ module Foliage.HackageSecurity where import Control.Monad (replicateM_) +import Crypto.Sign.Ed25519 (unPublicKey) +import Data.ByteString.Base16 qualified as Base16 +import qualified Data.ByteString.Char8 as BS import Data.ByteString.Lazy qualified as BSL import Hackage.Security.Key.Env (fromKeys) import Hackage.Security.Server @@ -32,20 +37,36 @@ computeFileInfoSimple fp = do createKeys :: FilePath -> IO () createKeys base = do + putStrLn " root keys:" createDirectoryIfMissing True (base "root") replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "root") + putStrLn " target keys:" createDirectoryIfMissing True (base "target") replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "target") + putStrLn " timestamp keys:" createDirectoryIfMissing True (base "timestamp") replicateM_ 1 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "timestamp") + putStrLn " snapshot keys:" createDirectoryIfMissing True (base "snapshot") replicateM_ 1 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "snapshot") + putStrLn " mirrors keys:" createDirectoryIfMissing True (base "mirrors") replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "mirrors") writeKeyWithId :: FilePath -> Some Key -> IO () -writeKeyWithId base k = - writeKey (base keyIdString (someKeyId k) <.> "json") k +writeKeyWithId base k = do + let keyId' = keyIdString $ someKeyId k + let publicKey' = somePublicKey k + putStr " " + putStrLn $ BS.unpack $ Base16.encode $ exportSomePublicKey publicKey' + + writeKey (base keyId' <.> "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 diff --git a/foliage.cabal b/foliage.cabal index c89401c..8c45823 100644 --- a/foliage.cabal +++ b/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, From f40673352f7d7dca605c589799234c0e720c4dac Mon Sep 17 00:00:00 2001 From: Yvan Sraka Date: Mon, 15 May 2023 10:58:44 +0200 Subject: [PATCH 2/3] Update app/Foliage/HackageSecurity.hs Co-authored-by: Andrea Bedini --- app/Foliage/HackageSecurity.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/app/Foliage/HackageSecurity.hs b/app/Foliage/HackageSecurity.hs index d99d092..69368ca 100644 --- a/app/Foliage/HackageSecurity.hs +++ b/app/Foliage/HackageSecurity.hs @@ -40,18 +40,6 @@ createKeys base = do putStrLn " root keys:" createDirectoryIfMissing True (base "root") replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "root") - putStrLn " target keys:" - createDirectoryIfMissing True (base "target") - replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "target") - putStrLn " timestamp keys:" - createDirectoryIfMissing True (base "timestamp") - replicateM_ 1 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "timestamp") - putStrLn " snapshot keys:" - createDirectoryIfMissing True (base "snapshot") - replicateM_ 1 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "snapshot") - putStrLn " mirrors keys:" - createDirectoryIfMissing True (base "mirrors") - replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "mirrors") writeKeyWithId :: FilePath -> Some Key -> IO () writeKeyWithId base k = do From 8fef0cd997077d69654a4709a878b1c017e0e18a Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 15 May 2023 17:51:26 +0800 Subject: [PATCH 3/3] Fix up, print root keys but create the other keys too --- app/Foliage/HackageSecurity.hs | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/app/Foliage/HackageSecurity.hs b/app/Foliage/HackageSecurity.hs index 69368ca..e3741fa 100644 --- a/app/Foliage/HackageSecurity.hs +++ b/app/Foliage/HackageSecurity.hs @@ -12,11 +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 qualified Data.ByteString.Char8 as BS +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 @@ -37,18 +38,26 @@ computeFileInfoSimple fp = do createKeys :: FilePath -> IO () createKeys base = do - putStrLn " root keys:" - createDirectoryIfMissing True (base "root") - replicateM_ 3 $ createKey' KeyTypeEd25519 >>= writeKeyWithId (base "root") + 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 -writeKeyWithId :: FilePath -> Some Key -> IO () -writeKeyWithId base k = do - let keyId' = keyIdString $ someKeyId k - let publicKey' = somePublicKey k - putStr " " - putStrLn $ BS.unpack $ Base16.encode $ exportSomePublicKey publicKey' + showKeys keys = + for_ keys $ \key -> + putStrLn $ " " ++ showKey key - writeKey (base keyId' <.> "json") k +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