{-# 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 (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 Ord BootstrapWitness where
  compare :: BootstrapWitness -> BootstrapWitness -> Ordering
compare = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing BootstrapWitness -> KeyHash 'Witness
bootstrapWitKeyHash

-- | Rebuild the addrRoot of the corresponding address.
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
    -- The payload hashed to create an addrRoot consists of the following:
    -- 1: a token indicating a list of length 3
    -- 2: the addrType
    -- 3: the key
    -- 3a: token indicating list length 2
    -- 3b: token indicating address type (which will be a vkey address)
    -- 3c: a token indicating a bytestring of length 64
    -- 3d: public key bytes (32)
    -- 3e: chain code bytes (32)
    -- 4: the addrAttributes
    -- the prefix is constant, and hard coded here:
    prefix :: ByteString
    prefix :: ByteString
prefix = ByteString
"\131\00\130\00\88\64"
    -- Here we are reserializing a key which we have previously deserialized.
    -- This is normally naughty. However, this is a blob of bytes -- serializing
    -- it amounts to wrapping the underlying byte array in a ByteString
    -- constructor.
    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
    -- This maybe is produced by a check that the length of the public key
    -- is the correct one. (32 bytes). If the XPub was constructed correctly,
    -- we already know that it has this length.
    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)