{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Keys.Bootstrap (
  BootstrapWitness (
    BootstrapWitness,
    bwKey,
    bwSig,
    bwChainCode,
    bwAttributes
  ),
  ChainCode (..),
  bootstrapWitKeyHash,
  unpackByronVKey,
  makeBootstrapWitness,
  verifyBootstrapWit,
  eqBootstrapWitnessRaw,
)
where

import qualified Cardano.Chain.Common as Byron
import Cardano.Crypto.DSIGN (SignedDSIGN (..))
import qualified Cardano.Crypto.DSIGN as DSIGN
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 (..),
  annotatorSlice,
  byronProtVer,
  decodeRecordNamed,
  encodeListLen,
  serialize,
  serialize',
 )
import Cardano.Ledger.Binary.Crypto (
  decodeSignedDSIGN,
  encodeSignedDSIGN,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Hashes (ADDRHASH, EraIndependentTxBody, HASH, Hash, KeyHash (..))
import Cardano.Ledger.Keys.Internal (
  DSIGN,
  KeyRole (..),
  VKey (..),
  verifySignedDSIGN,
 )
import Cardano.Ledger.MemoBytes (EqRaw (..))
import Control.DeepSeq (NFData)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Coerce (coerce)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunksIn (..), 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. 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)
bwSig' :: !(SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
  , BootstrapWitness -> ChainCode
bwChainCode' :: !ChainCode
  , BootstrapWitness -> ByteString
bwAttributes' :: !ByteString
  , BootstrapWitness -> ByteString
bwBytes :: LBS.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

deriving via
  (AllowThunksIn '["bwBytes"] BootstrapWitness)
  instance
    NoThunks BootstrapWitness

pattern BootstrapWitness ::
  VKey 'Witness ->
  SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) ->
  ChainCode ->
  ByteString ->
  BootstrapWitness
pattern $bBootstrapWitness :: VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness
$mBootstrapWitness :: forall {r}.
BootstrapWitness
-> (VKey 'Witness
    -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
    -> ChainCode
    -> ByteString
    -> r)
-> ((# #) -> r)
-> r
BootstrapWitness {BootstrapWitness -> VKey 'Witness
bwKey, BootstrapWitness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSig, BootstrapWitness -> ChainCode
bwChainCode, BootstrapWitness -> ByteString
bwAttributes} <-
  BootstrapWitness' bwKey bwSig bwChainCode bwAttributes _
  where
    BootstrapWitness VKey 'Witness
key SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig ChainCode
cc ByteString
attributes =
      let bytes :: ByteString
bytes =
            forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer forall a b. (a -> b) -> a -> b
$
              Word -> Encoding
encodeListLen Word
4
                forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR VKey 'Witness
key
                forall a. Semigroup a => a -> a -> a
<> forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig
                forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ChainCode
cc
                forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ByteString
attributes
       in VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ChainCode
-> ByteString
-> ByteString
-> BootstrapWitness
BootstrapWitness' VKey 'Witness
key SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig ChainCode
cc ByteString
attributes ByteString
bytes

{-# COMPLETE 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

instance Plain.ToCBOR BootstrapWitness where
  toCBOR :: BootstrapWitness -> Encoding
toCBOR = ByteString -> Encoding
Plain.encodePreEncoded forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. BootstrapWitness -> ByteString
bwBytes

-- | Encodes memoized bytes created upon construction.
instance EncCBOR BootstrapWitness

instance DecCBOR (Annotator BootstrapWitness) where
  decCBOR :: forall s. Decoder s (Annotator BootstrapWitness)
decCBOR = forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice forall a b. (a -> b) -> a -> b
$
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"BootstrapWitness" (forall a b. a -> b -> a
const Int
4) forall a b. (a -> b) -> a -> b
$
      do
        VKey 'Witness
key <- forall a s. DecCBOR a => Decoder s a
decCBOR
        SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig <- forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
decodeSignedDSIGN
        ChainCode
cc <- forall a s. DecCBOR a => Decoder s a
decCBOR
        ByteString
attributes <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ChainCode
-> ByteString
-> ByteString
-> BootstrapWitness
BootstrapWitness' VKey 'Witness
key SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig ChainCode
cc ByteString
attributes

-- | 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 b c a. (b -> c) -> (a -> b) -> a -> c
. BootstrapWitness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSig forall a b. (a -> b) -> a -> b
$ 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. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer 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)

eqBootstrapWitnessRaw :: BootstrapWitness -> BootstrapWitness -> Bool
eqBootstrapWitnessRaw :: BootstrapWitness -> BootstrapWitness -> Bool
eqBootstrapWitnessRaw BootstrapWitness
bw1 BootstrapWitness
bw2 =
  BootstrapWitness -> VKey 'Witness
bwKey BootstrapWitness
bw1 forall a. Eq a => a -> a -> Bool
== BootstrapWitness -> VKey 'Witness
bwKey BootstrapWitness
bw2
    Bool -> Bool -> Bool
&& BootstrapWitness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSig BootstrapWitness
bw1 forall a. Eq a => a -> a -> Bool
== BootstrapWitness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSig BootstrapWitness
bw2
    Bool -> Bool -> Bool
&& BootstrapWitness -> ChainCode
bwChainCode BootstrapWitness
bw1 forall a. Eq a => a -> a -> Bool
== BootstrapWitness -> ChainCode
bwChainCode BootstrapWitness
bw2
    Bool -> Bool -> Bool
&& BootstrapWitness -> ByteString
bwAttributes BootstrapWitness
bw1 forall a. Eq a => a -> a -> Bool
== BootstrapWitness -> ByteString
bwAttributes BootstrapWitness
bw2

instance EqRaw BootstrapWitness where
  eqRaw :: BootstrapWitness -> BootstrapWitness -> Bool
eqRaw = BootstrapWitness -> BootstrapWitness -> Bool
eqBootstrapWitnessRaw