mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-09-11 12:25:55 +03:00
Merge pull request #56 from yvan-sraka/show-public-keys
Fix #13: create keys should show the public keys
This commit is contained in:
commit
9a1eaafe73
@ -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)
|
||||
|
@ -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,
|
||||
|
Loading…
Reference in New Issue
Block a user