input-output-hk/foliage
1
1
Fork 0
mirror of https://github.com/input-output-hk/foliage.git synced 2024-09-11 20:27:09 +03:00
Code Issues Packages Projects Releases Wiki Activity

Fix #13: create keys should show the public keys

Browse Source
This commit is contained in:
Yvan Sraka 2023-04-26 13:18:58 +02:00
parent acc0f88727
commit 59e0d72cb9
No known key found for this signature in database
GPG Key ID: A4FB3EAA6F452379
2 changed files with 25 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
app/Foliage/HackageSecurity.hs
View File

@ -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

2
foliage.cabal
View File

@ -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,