{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Ledger.Keys.Bootstrap (
BootstrapWitness (..),
ChainCode (..),
bootstrapWitKeyHash,
unpackByronVKey,
makeBootstrapWitness,
verifyBootstrapWit,
)
where
import qualified Cardano.Chain.Common as Byron
import Cardano.Crypto.DSIGN (SignedDSIGN (..))
import qualified Cardano.Crypto.DSIGN as DSIGN
import qualified Cardano.Crypto.DSIGN.Class as C
import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.Signing as Byron
import qualified Cardano.Crypto.Wallet as WC
import Cardano.Ledger.Binary (
Annotator,
DecCBOR (..),
EncCBOR (..),
)
import Cardano.Ledger.Binary.Plain (
FromCBOR (..),
ToCBOR (..),
decodeRecordNamed,
encodeListLen,
serialize',
)
import Cardano.Ledger.Hashes (ADDRHASH, EraIndependentTxBody, HASH, Hash, KeyHash (..))
import Cardano.Ledger.Keys.Internal (
DSIGN,
KeyRole (..),
VKey (..),
verifySignedDSIGN,
)
import Control.DeepSeq (NFData (..), rwhnf)
import Data.ByteString (ByteString)
import Data.Coerce (coerce)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Quiet
newtype ChainCode = ChainCode {ChainCode -> ByteString
unChainCode :: ByteString}
deriving (ChainCode -> ChainCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainCode -> ChainCode -> Bool
$c/= :: ChainCode -> ChainCode -> Bool
== :: ChainCode -> ChainCode -> Bool
$c== :: ChainCode -> ChainCode -> Bool
Eq, forall x. Rep ChainCode x -> ChainCode
forall x. ChainCode -> Rep ChainCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainCode x -> ChainCode
$cfrom :: forall x. ChainCode -> Rep ChainCode x
Generic)
deriving (Int -> ChainCode -> ShowS
[ChainCode] -> ShowS
ChainCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainCode] -> ShowS
$cshowList :: [ChainCode] -> ShowS
show :: ChainCode -> String
$cshow :: ChainCode -> String
showsPrec :: Int -> ChainCode -> ShowS
$cshowsPrec :: Int -> ChainCode -> ShowS
Show) via Quiet ChainCode
deriving newtype (Context -> ChainCode -> IO (Maybe ThunkInfo)
Proxy ChainCode -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ChainCode -> String
$cshowTypeOf :: Proxy ChainCode -> String
wNoThunks :: Context -> ChainCode -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ChainCode -> IO (Maybe ThunkInfo)
noThunks :: Context -> ChainCode -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ChainCode -> IO (Maybe ThunkInfo)
NoThunks, Typeable ChainCode
ChainCode -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ChainCode] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy ChainCode -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ChainCode] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ChainCode] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ChainCode -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ChainCode -> Size
toCBOR :: ChainCode -> Encoding
$ctoCBOR :: ChainCode -> Encoding
ToCBOR, Typeable ChainCode
Proxy ChainCode -> Text
forall s. Decoder s ChainCode
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy ChainCode -> Text
$clabel :: Proxy ChainCode -> Text
fromCBOR :: forall s. Decoder s ChainCode
$cfromCBOR :: forall s. Decoder s ChainCode
FromCBOR, Typeable ChainCode
ChainCode -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ChainCode] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy ChainCode -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ChainCode] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ChainCode] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy ChainCode -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy ChainCode -> Size
encCBOR :: ChainCode -> Encoding
$cencCBOR :: ChainCode -> Encoding
EncCBOR, Typeable ChainCode
Proxy ChainCode -> Text
forall s. Decoder s ChainCode
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy ChainCode -> Decoder s ()
label :: Proxy ChainCode -> Text
$clabel :: Proxy ChainCode -> Text
dropCBOR :: forall s. Proxy ChainCode -> Decoder s ()
$cdropCBOR :: forall s. Proxy ChainCode -> Decoder s ()
decCBOR :: forall s. Decoder s ChainCode
$cdecCBOR :: forall s. Decoder s ChainCode
DecCBOR, ChainCode -> ()
forall a. (a -> ()) -> NFData a
rnf :: ChainCode -> ()
$crnf :: ChainCode -> ()
NFData)
data BootstrapWitness = BootstrapWitness
{ BootstrapWitness -> VKey 'Witness
bwKey :: !(VKey 'Witness)
, BootstrapWitness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSignature :: !(SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
, BootstrapWitness -> ChainCode
bwChainCode :: !ChainCode
, BootstrapWitness -> ByteString
bwAttributes :: !ByteString
}
deriving (forall x. Rep BootstrapWitness x -> BootstrapWitness
forall x. BootstrapWitness -> Rep BootstrapWitness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BootstrapWitness x -> BootstrapWitness
$cfrom :: forall x. BootstrapWitness -> Rep BootstrapWitness x
Generic, Int -> BootstrapWitness -> ShowS
[BootstrapWitness] -> ShowS
BootstrapWitness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapWitness] -> ShowS
$cshowList :: [BootstrapWitness] -> ShowS
show :: BootstrapWitness -> String
$cshow :: BootstrapWitness -> String
showsPrec :: Int -> BootstrapWitness -> ShowS
$cshowsPrec :: Int -> BootstrapWitness -> ShowS
Show, BootstrapWitness -> BootstrapWitness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapWitness -> BootstrapWitness -> Bool
$c/= :: BootstrapWitness -> BootstrapWitness -> Bool
== :: BootstrapWitness -> BootstrapWitness -> Bool
$c== :: BootstrapWitness -> BootstrapWitness -> Bool
Eq)
instance NFData BootstrapWitness where
rnf :: BootstrapWitness -> ()
rnf = forall a. a -> ()
rwhnf
instance NoThunks BootstrapWitness
instance ToCBOR BootstrapWitness where
toCBOR :: BootstrapWitness -> Encoding
toCBOR cwr :: BootstrapWitness
cwr@(BootstrapWitness VKey 'Witness
_ SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
_ ChainCode
_ ByteString
_) =
let BootstrapWitness {ByteString
SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
VKey 'Witness
ChainCode
bwAttributes :: ByteString
bwChainCode :: ChainCode
bwSignature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwKey :: VKey 'Witness
bwAttributes :: BootstrapWitness -> ByteString
bwChainCode :: BootstrapWitness -> ChainCode
bwSignature :: BootstrapWitness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwKey :: BootstrapWitness -> VKey 'Witness
..} = BootstrapWitness
cwr
in Word -> Encoding
encodeListLen Word
4
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR VKey 'Witness
bwKey
forall a. Semigroup a => a -> a -> a
<> forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
C.encodeSignedDSIGN SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSignature
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR ChainCode
bwChainCode
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
bwAttributes
instance EncCBOR BootstrapWitness
instance FromCBOR BootstrapWitness where
fromCBOR :: forall s. Decoder s BootstrapWitness
fromCBOR =
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"BootstrapWitnessRaw" (forall a b. a -> b -> a
const Int
4) forall a b. (a -> b) -> a -> b
$
VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness
BootstrapWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
fromCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
C.decodeSignedDSIGN forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. FromCBOR a => Decoder s a
fromCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. FromCBOR a => Decoder s a
fromCBOR
instance DecCBOR BootstrapWitness
instance DecCBOR (Annotator BootstrapWitness) where
decCBOR :: forall s. Decoder s (Annotator BootstrapWitness)
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
instance Ord BootstrapWitness where
compare :: BootstrapWitness -> BootstrapWitness -> Ordering
compare = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing BootstrapWitness -> KeyHash 'Witness
bootstrapWitKeyHash
bootstrapWitKeyHash ::
BootstrapWitness ->
KeyHash 'Witness
bootstrapWitKeyHash :: BootstrapWitness -> KeyHash 'Witness
bootstrapWitKeyHash (BootstrapWitness (VKey VerKeyDSIGN DSIGN
key) SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
_ (ChainCode ByteString
cc) ByteString
attributes) =
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteString -> Hash ADDRHASH a
hash_crypto forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash_SHA3_256 forall a b. (a -> b) -> a -> b
$ ByteString
bytes
where
prefix :: ByteString
prefix :: ByteString
prefix = ByteString
"\131\00\130\00\88\64"
keyBytes :: ByteString
keyBytes = forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
DSIGN.rawSerialiseVerKeyDSIGN VerKeyDSIGN DSIGN
key
bytes :: ByteString
bytes = ByteString
prefix forall a. Semigroup a => a -> a -> a
<> ByteString
keyBytes forall a. Semigroup a => a -> a -> a
<> ByteString
cc forall a. Semigroup a => a -> a -> a
<> ByteString
attributes
hash_SHA3_256 :: ByteString -> ByteString
hash_SHA3_256 :: ByteString -> ByteString
hash_SHA3_256 = forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
Hash.digest (forall {k} (t :: k). Proxy t
Proxy :: Proxy Hash.SHA3_256)
hash_crypto :: ByteString -> Hash.Hash ADDRHASH a
hash_crypto :: forall a. ByteString -> Hash ADDRHASH a
hash_crypto = forall h a b. Hash h a -> Hash h b
Hash.castHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith @ADDRHASH forall a. a -> a
id
unpackByronVKey ::
Byron.VerificationKey ->
(VKey 'Witness, ChainCode)
unpackByronVKey :: VerificationKey -> (VKey 'Witness, ChainCode)
unpackByronVKey
( Byron.VerificationKey
(WC.XPub ByteString
vkeyBytes (WC.ChainCode ByteString
chainCodeBytes))
) = case forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
DSIGN.rawDeserialiseVerKeyDSIGN ByteString
vkeyBytes of
Maybe (VerKeyDSIGN DSIGN)
Nothing -> forall a. HasCallStack => String -> a
error String
"unpackByronVKey: impossible!"
Just VerKeyDSIGN DSIGN
vk -> (forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey VerKeyDSIGN DSIGN
vk, ByteString -> ChainCode
ChainCode ByteString
chainCodeBytes)
verifyBootstrapWit ::
Hash HASH EraIndependentTxBody ->
BootstrapWitness ->
Bool
verifyBootstrapWit :: Hash HASH EraIndependentTxBody -> BootstrapWitness -> Bool
verifyBootstrapWit Hash HASH EraIndependentTxBody
txbodyHash BootstrapWitness
witness =
forall a (kd :: KeyRole).
Signable DSIGN a =>
VKey kd -> a -> SignedDSIGN DSIGN a -> Bool
verifySignedDSIGN
(BootstrapWitness -> VKey 'Witness
bwKey BootstrapWitness
witness)
Hash HASH EraIndependentTxBody
txbodyHash
(coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ BootstrapWitness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSignature BootstrapWitness
witness)
coerceSignature :: WC.XSignature -> DSIGN.SigDSIGN DSIGN.Ed25519DSIGN
coerceSignature :: XSignature -> SigDSIGN DSIGN
coerceSignature XSignature
sig =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"coerceSignature: impossible! signature size mismatch") forall a b. (a -> b) -> a -> b
$
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
DSIGN.rawDeserialiseSigDSIGN (XSignature -> ByteString
WC.unXSignature XSignature
sig)
makeBootstrapWitness ::
Hash HASH EraIndependentTxBody ->
Byron.SigningKey ->
Byron.Attributes Byron.AddrAttributes ->
BootstrapWitness
makeBootstrapWitness :: Hash HASH EraIndependentTxBody
-> SigningKey -> Attributes AddrAttributes -> BootstrapWitness
makeBootstrapWitness Hash HASH EraIndependentTxBody
txBodyHash SigningKey
byronSigningKey Attributes AddrAttributes
addrAttributes =
VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness
BootstrapWitness VKey 'Witness
vk SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature ChainCode
cc (forall a. ToCBOR a => a -> ByteString
serialize' Attributes AddrAttributes
addrAttributes)
where
(VKey 'Witness
vk, ChainCode
cc) = VerificationKey -> (VKey 'Witness, ChainCode)
unpackByronVKey forall a b. (a -> b) -> a -> b
$ SigningKey -> VerificationKey
Byron.toVerification SigningKey
byronSigningKey
signature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature =
forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. XSignature -> SigDSIGN DSIGN
coerceSignature forall a b. (a -> b) -> a -> b
$
forall passPhrase msg.
(ByteArrayAccess passPhrase, ByteArrayAccess msg) =>
passPhrase -> XPrv -> msg -> XSignature
WC.sign
(forall a. Monoid a => a
mempty :: ByteString)
(SigningKey -> XPrv
Byron.unSigningKey SigningKey
byronSigningKey)
(forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash HASH EraIndependentTxBody
txBodyHash)