diff --git a/app/Foliage/HackageSecurity.hs b/app/Foliage/HackageSecurity.hs index d2825c4..e3741fa 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, @@ -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) 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,