{-# 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 UndecidableInstances #-}

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

import Cardano.Binary
  ( Annotator,
    FromCBOR (..),
    ToCBOR (..),
    annotatorSlice,
    encodeListLen,
    encodePreEncoded,
    serialize',
    serializeEncoding,
  )
import qualified Cardano.Chain.Common as Byron
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.Crypto (ADDRHASH, DSIGN)
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.Keys
  ( Hash,
    KeyHash (..),
    KeyRole (..),
    VKey (..),
    verifySignedDSIGN,
  )
import qualified Cardano.Ledger.Keys as Keys
import Cardano.Ledger.Serialization (decodeRecordNamed)
import Cardano.Prelude (panic)
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
(ChainCode -> ChainCode -> Bool)
-> (ChainCode -> ChainCode -> Bool) -> Eq ChainCode
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. ChainCode -> Rep ChainCode x)
-> (forall x. Rep ChainCode x -> ChainCode) -> Generic ChainCode
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
(Int -> ChainCode -> ShowS)
-> (ChainCode -> String)
-> ([ChainCode] -> ShowS)
-> Show ChainCode
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
(Context -> ChainCode -> IO (Maybe ThunkInfo))
-> (Context -> ChainCode -> IO (Maybe ThunkInfo))
-> (Proxy ChainCode -> String)
-> NoThunks ChainCode
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
Typeable ChainCode
-> (ChainCode -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy ChainCode -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [ChainCode] -> Size)
-> ToCBOR 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
$cp1ToCBOR :: Typeable ChainCode
ToCBOR, Typeable ChainCode
Decoder s ChainCode
Typeable ChainCode
-> (forall s. Decoder s ChainCode)
-> (Proxy ChainCode -> Text)
-> FromCBOR 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 :: Decoder s ChainCode
$cfromCBOR :: forall s. Decoder s ChainCode
$cp1FromCBOR :: Typeable ChainCode
FromCBOR, ChainCode -> ()
(ChainCode -> ()) -> NFData ChainCode
forall a. (a -> ()) -> NFData a
rnf :: ChainCode -> ()
$crnf :: ChainCode -> ()
NFData)

data BootstrapWitness crypto = BootstrapWitness'
  { BootstrapWitness crypto -> VKey 'Witness crypto
bwKey' :: !(VKey 'Witness crypto),
    BootstrapWitness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
bwSig' ::
      !( Keys.SignedDSIGN
           crypto
           (Hash crypto EraIndependentTxBody)
       ),
    BootstrapWitness crypto -> ChainCode
bwChainCode' :: !ChainCode,
    BootstrapWitness crypto -> ByteString
bwAttributes' :: !ByteString,
    BootstrapWitness crypto -> ByteString
bwBytes :: LBS.ByteString
  }
  deriving ((forall x.
 BootstrapWitness crypto -> Rep (BootstrapWitness crypto) x)
-> (forall x.
    Rep (BootstrapWitness crypto) x -> BootstrapWitness crypto)
-> Generic (BootstrapWitness crypto)
forall x.
Rep (BootstrapWitness crypto) x -> BootstrapWitness crypto
forall x.
BootstrapWitness crypto -> Rep (BootstrapWitness crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (BootstrapWitness crypto) x -> BootstrapWitness crypto
forall crypto x.
BootstrapWitness crypto -> Rep (BootstrapWitness crypto) x
$cto :: forall crypto x.
Rep (BootstrapWitness crypto) x -> BootstrapWitness crypto
$cfrom :: forall crypto x.
BootstrapWitness crypto -> Rep (BootstrapWitness crypto) x
Generic)

deriving instance CC.Crypto crypto => Show (BootstrapWitness crypto)

deriving instance CC.Crypto crypto => Eq (BootstrapWitness crypto)

instance
  ( CC.Crypto era,
    NFData (DSIGN.VerKeyDSIGN (DSIGN era)),
    NFData (DSIGN.SigDSIGN (DSIGN era))
  ) =>
  NFData (BootstrapWitness era)

deriving via
  (AllowThunksIn '["bwBytes"] (BootstrapWitness crypto))
  instance
    CC.Crypto crypto => NoThunks (BootstrapWitness crypto)

pattern BootstrapWitness ::
  CC.Crypto crypto =>
  VKey 'Witness crypto ->
  Keys.SignedDSIGN crypto (Hash crypto EraIndependentTxBody) ->
  ChainCode ->
  ByteString ->
  BootstrapWitness crypto
pattern $bBootstrapWitness :: VKey 'Witness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness crypto
$mBootstrapWitness :: forall r crypto.
Crypto crypto =>
BootstrapWitness crypto
-> (VKey 'Witness crypto
    -> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
    -> ChainCode
    -> ByteString
    -> r)
-> (Void# -> r)
-> r
BootstrapWitness {BootstrapWitness crypto -> Crypto crypto => VKey 'Witness crypto
bwKey, BootstrapWitness crypto
-> Crypto crypto =>
   SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
bwSig, BootstrapWitness crypto -> Crypto crypto => ChainCode
bwChainCode, BootstrapWitness crypto -> Crypto crypto => ByteString
bwAttributes} <-
  BootstrapWitness' bwKey bwSig bwChainCode bwAttributes _
  where
    BootstrapWitness VKey 'Witness crypto
key SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
sig ChainCode
cc ByteString
attributes =
      let bytes :: ByteString
bytes =
            Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
              Word -> Encoding
encodeListLen Word
4
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VKey 'Witness crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR VKey 'Witness crypto
key
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignedDSIGN crypto (Hash crypto EraIndependentTxBody) -> Encoding
forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
DSIGN.encodeSignedDSIGN SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
sig
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ChainCode -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ChainCode
cc
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
attributes
       in VKey 'Witness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> ChainCode
-> ByteString
-> ByteString
-> BootstrapWitness crypto
forall crypto.
VKey 'Witness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> ChainCode
-> ByteString
-> ByteString
-> BootstrapWitness crypto
BootstrapWitness' VKey 'Witness crypto
key SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
sig ChainCode
cc ByteString
attributes ByteString
bytes

{-# COMPLETE BootstrapWitness #-}

instance CC.Crypto crypto => Ord (BootstrapWitness crypto) where
  compare :: BootstrapWitness crypto -> BootstrapWitness crypto -> Ordering
compare = (BootstrapWitness crypto -> KeyHash 'Witness crypto)
-> BootstrapWitness crypto -> BootstrapWitness crypto -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing BootstrapWitness crypto -> KeyHash 'Witness crypto
forall crypto.
Crypto crypto =>
BootstrapWitness crypto -> KeyHash 'Witness crypto
bootstrapWitKeyHash

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

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

-- | Rebuild the addrRoot of the corresponding address.
bootstrapWitKeyHash ::
  forall crypto.
  CC.Crypto crypto =>
  BootstrapWitness crypto ->
  KeyHash 'Witness crypto
bootstrapWitKeyHash :: BootstrapWitness crypto -> KeyHash 'Witness crypto
bootstrapWitKeyHash (BootstrapWitness (VKey VerKeyDSIGN (DSIGN crypto)
key) SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
_ (ChainCode ByteString
cc) ByteString
attributes) =
  Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash 'Witness crypto
forall (discriminator :: KeyRole) crypto.
Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash discriminator crypto
KeyHash (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
 -> KeyHash 'Witness crypto)
-> (ByteString
    -> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
-> ByteString
-> KeyHash 'Witness crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
forall a. ByteString -> Hash (ADDRHASH crypto) a
hash_crypto (ByteString -> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
-> (ByteString -> ByteString)
-> ByteString
-> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash_SHA3_256 (ByteString -> KeyHash 'Witness crypto)
-> ByteString -> KeyHash 'Witness crypto
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 = VerKeyDSIGN (DSIGN crypto) -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
DSIGN.rawSerialiseVerKeyDSIGN VerKeyDSIGN (DSIGN crypto)
key
    bytes :: ByteString
bytes = ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
keyBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
attributes
    hash_SHA3_256 :: ByteString -> ByteString
    hash_SHA3_256 :: ByteString -> ByteString
hash_SHA3_256 = Proxy SHA3_256 -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
Hash.digest (Proxy SHA3_256
forall k (t :: k). Proxy t
Proxy :: Proxy Hash.SHA3_256)
    hash_crypto :: ByteString -> Hash.Hash (ADDRHASH crypto) a
    hash_crypto :: ByteString -> Hash (ADDRHASH crypto) a
hash_crypto = Hash (ADDRHASH crypto) ByteString -> Hash (ADDRHASH crypto) a
forall h a b. Hash h a -> Hash h b
Hash.castHash (Hash (ADDRHASH crypto) ByteString -> Hash (ADDRHASH crypto) a)
-> (ByteString -> Hash (ADDRHASH crypto) ByteString)
-> ByteString
-> Hash (ADDRHASH crypto) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash (ADDRHASH crypto) ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith @(ADDRHASH crypto) ByteString -> ByteString
forall a. a -> a
id

unpackByronVKey ::
  forall crypto.
  (DSIGN crypto ~ DSIGN.Ed25519DSIGN) =>
  Byron.VerificationKey ->
  (VKey 'Witness crypto, ChainCode)
unpackByronVKey :: VerificationKey -> (VKey 'Witness crypto, ChainCode)
unpackByronVKey
  ( Byron.VerificationKey
      (WC.XPub ByteString
vkeyBytes (WC.ChainCode ByteString
chainCodeBytes))
    ) = case ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
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 Ed25519DSIGN)
Nothing -> Text -> (VKey 'Witness crypto, ChainCode)
forall a. HasCallStack => Text -> a
panic Text
"unpackByronVKey: impossible!"
    Just VerKeyDSIGN Ed25519DSIGN
vk -> (VerKeyDSIGN (DSIGN crypto) -> VKey 'Witness crypto
forall (kd :: KeyRole) crypto.
VerKeyDSIGN (DSIGN crypto) -> VKey kd crypto
VKey VerKeyDSIGN Ed25519DSIGN
VerKeyDSIGN (DSIGN crypto)
vk, ByteString -> ChainCode
ChainCode ByteString
chainCodeBytes)

verifyBootstrapWit ::
  forall crypto.
  ( CC.Crypto crypto,
    DSIGN.Signable (DSIGN crypto) (Hash crypto EraIndependentTxBody)
  ) =>
  Hash crypto EraIndependentTxBody ->
  BootstrapWitness crypto ->
  Bool
verifyBootstrapWit :: Hash crypto EraIndependentTxBody -> BootstrapWitness crypto -> Bool
verifyBootstrapWit Hash crypto EraIndependentTxBody
txbodyHash BootstrapWitness crypto
witness =
  VKey 'Witness crypto
-> Hash crypto EraIndependentTxBody
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> Bool
forall crypto a (kd :: KeyRole).
(Crypto crypto, Signable (DSIGN crypto) a) =>
VKey kd crypto -> a -> SignedDSIGN crypto a -> Bool
verifySignedDSIGN
    (BootstrapWitness crypto -> Crypto crypto => VKey 'Witness crypto
forall crypto.
BootstrapWitness crypto -> Crypto crypto => VKey 'Witness crypto
bwKey BootstrapWitness crypto
witness)
    Hash crypto EraIndependentTxBody
txbodyHash
    (SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
coerce (SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
 -> SignedDSIGN crypto (Hash crypto EraIndependentTxBody))
-> (BootstrapWitness crypto
    -> SignedDSIGN crypto (Hash crypto EraIndependentTxBody))
-> BootstrapWitness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BootstrapWitness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
forall crypto.
BootstrapWitness crypto
-> Crypto crypto =>
   SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
bwSig (BootstrapWitness crypto
 -> SignedDSIGN crypto (Hash crypto EraIndependentTxBody))
-> BootstrapWitness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
forall a b. (a -> b) -> a -> b
$ BootstrapWitness crypto
witness)

coerceSignature :: WC.XSignature -> DSIGN.SigDSIGN DSIGN.Ed25519DSIGN
coerceSignature :: XSignature -> SigDSIGN Ed25519DSIGN
coerceSignature XSignature
sig =
  SigDSIGN Ed25519DSIGN
-> Maybe (SigDSIGN Ed25519DSIGN) -> SigDSIGN Ed25519DSIGN
forall a. a -> Maybe a -> a
fromMaybe (Text -> SigDSIGN Ed25519DSIGN
forall a. HasCallStack => Text -> a
panic Text
"coerceSignature: impossible! signature size mismatch") (Maybe (SigDSIGN Ed25519DSIGN) -> SigDSIGN Ed25519DSIGN)
-> Maybe (SigDSIGN Ed25519DSIGN) -> SigDSIGN Ed25519DSIGN
forall a b. (a -> b) -> a -> b
$
    ByteString -> Maybe (SigDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
DSIGN.rawDeserialiseSigDSIGN (XSignature -> ByteString
WC.unXSignature XSignature
sig)

makeBootstrapWitness ::
  forall crypto.
  ( DSIGN crypto ~ DSIGN.Ed25519DSIGN,
    CC.Crypto crypto
  ) =>
  Hash crypto EraIndependentTxBody ->
  Byron.SigningKey ->
  Byron.Attributes Byron.AddrAttributes ->
  BootstrapWitness crypto
makeBootstrapWitness :: Hash crypto EraIndependentTxBody
-> SigningKey
-> Attributes AddrAttributes
-> BootstrapWitness crypto
makeBootstrapWitness Hash crypto EraIndependentTxBody
txBodyHash SigningKey
byronSigningKey Attributes AddrAttributes
addrAttributes =
  VKey 'Witness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness crypto
forall crypto.
Crypto crypto =>
VKey 'Witness crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness crypto
BootstrapWitness VKey 'Witness crypto
vk SignedDSIGN Ed25519DSIGN (Hash crypto EraIndependentTxBody)
SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
signature ChainCode
cc (Attributes AddrAttributes -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' Attributes AddrAttributes
addrAttributes)
  where
    (VKey 'Witness crypto
vk, ChainCode
cc) = VerificationKey -> (VKey 'Witness crypto, ChainCode)
forall crypto.
(DSIGN crypto ~ Ed25519DSIGN) =>
VerificationKey -> (VKey 'Witness crypto, ChainCode)
unpackByronVKey (VerificationKey -> (VKey 'Witness crypto, ChainCode))
-> VerificationKey -> (VKey 'Witness crypto, ChainCode)
forall a b. (a -> b) -> a -> b
$ SigningKey -> VerificationKey
Byron.toVerification SigningKey
byronSigningKey
    signature :: SignedDSIGN Ed25519DSIGN (Hash crypto EraIndependentTxBody)
signature =
      SigDSIGN Ed25519DSIGN
-> SignedDSIGN Ed25519DSIGN (Hash crypto EraIndependentTxBody)
forall v a. SigDSIGN v -> SignedDSIGN v a
DSIGN.SignedDSIGN (SigDSIGN Ed25519DSIGN
 -> SignedDSIGN Ed25519DSIGN (Hash crypto EraIndependentTxBody))
-> (XSignature -> SigDSIGN Ed25519DSIGN)
-> XSignature
-> SignedDSIGN Ed25519DSIGN (Hash crypto EraIndependentTxBody)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XSignature -> SigDSIGN Ed25519DSIGN
coerceSignature (XSignature
 -> SignedDSIGN Ed25519DSIGN (Hash crypto EraIndependentTxBody))
-> XSignature
-> SignedDSIGN Ed25519DSIGN (Hash crypto EraIndependentTxBody)
forall a b. (a -> b) -> a -> b
$
        ByteString -> XPrv -> ByteString -> XSignature
forall passPhrase msg.
(ByteArrayAccess passPhrase, ByteArrayAccess msg) =>
passPhrase -> XPrv -> msg -> XSignature
WC.sign
          (ByteString
forall a. Monoid a => a
mempty :: ByteString)
          (SigningKey -> XPrv
Byron.unSigningKey SigningKey
byronSigningKey)
          (Hash crypto EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash crypto EraIndependentTxBody
txBodyHash)