{-# 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 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.Crypto (Crypto (ADDRHASH, DSIGN))
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.Keys.Internal (
  Hash,
  KeyHash (..),
  KeyRole (..),
  SignedDSIGN,
  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 c = BootstrapWitness'
  { forall c. BootstrapWitness c -> VKey 'Witness c
bwKey' :: !(VKey 'Witness c)
  , forall c.
BootstrapWitness c -> SignedDSIGN c (Hash c EraIndependentTxBody)
bwSig' :: !(SignedDSIGN c (Hash c EraIndependentTxBody))
  , forall c. BootstrapWitness c -> ChainCode
bwChainCode' :: !ChainCode
  , forall c. BootstrapWitness c -> ByteString
bwAttributes' :: !ByteString
  , forall c. BootstrapWitness c -> ByteString
bwBytes :: LBS.ByteString
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (BootstrapWitness c) x -> BootstrapWitness c
forall c x. BootstrapWitness c -> Rep (BootstrapWitness c) x
$cto :: forall c x. Rep (BootstrapWitness c) x -> BootstrapWitness c
$cfrom :: forall c x. BootstrapWitness c -> Rep (BootstrapWitness c) x
Generic)

deriving instance Crypto c => Show (BootstrapWitness c)

deriving instance Crypto c => Eq (BootstrapWitness c)

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

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

pattern BootstrapWitness ::
  Crypto c =>
  VKey 'Witness c ->
  SignedDSIGN c (Hash c EraIndependentTxBody) ->
  ChainCode ->
  ByteString ->
  BootstrapWitness c
pattern $bBootstrapWitness :: forall c.
Crypto c =>
VKey 'Witness c
-> SignedDSIGN c (Hash c EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness c
$mBootstrapWitness :: forall {r} {c}.
Crypto c =>
BootstrapWitness c
-> (VKey 'Witness c
    -> SignedDSIGN c (Hash c EraIndependentTxBody)
    -> ChainCode
    -> ByteString
    -> r)
-> ((# #) -> r)
-> r
BootstrapWitness {forall c. Crypto c => BootstrapWitness c -> VKey 'Witness c
bwKey, forall c.
Crypto c =>
BootstrapWitness c -> SignedDSIGN c (Hash c EraIndependentTxBody)
bwSig, forall c. Crypto c => BootstrapWitness c -> ChainCode
bwChainCode, forall c. Crypto c => BootstrapWitness c -> ByteString
bwAttributes} <-
  BootstrapWitness' bwKey bwSig bwChainCode bwAttributes _
  where
    BootstrapWitness VKey 'Witness c
key SignedDSIGN c (Hash c 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 c
key
                forall a. Semigroup a => a -> a -> a
<> forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN SignedDSIGN c (Hash c 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 forall c.
VKey 'Witness c
-> SignedDSIGN c (Hash c EraIndependentTxBody)
-> ChainCode
-> ByteString
-> ByteString
-> BootstrapWitness c
BootstrapWitness' VKey 'Witness c
key SignedDSIGN c (Hash c EraIndependentTxBody)
sig ChainCode
cc ByteString
attributes ByteString
bytes

{-# COMPLETE BootstrapWitness #-}

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

instance Crypto c => Plain.ToCBOR (BootstrapWitness c) where
  toCBOR :: BootstrapWitness c -> 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
. forall c. BootstrapWitness c -> ByteString
bwBytes

-- | Encodes memoized bytes created upon construction.
instance Crypto c => EncCBOR (BootstrapWitness c)

instance Crypto c => DecCBOR (Annotator (BootstrapWitness c)) where
  decCBOR :: forall s. Decoder s (Annotator (BootstrapWitness c))
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 c
key <- forall a s. DecCBOR a => Decoder s a
decCBOR
        SignedDSIGN (DSIGN c) (Hash (HASH c) 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
$ forall c.
VKey 'Witness c
-> SignedDSIGN c (Hash c EraIndependentTxBody)
-> ChainCode
-> ByteString
-> ByteString
-> BootstrapWitness c
BootstrapWitness' VKey 'Witness c
key SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
sig ChainCode
cc ByteString
attributes

-- | Rebuild the addrRoot of the corresponding address.
bootstrapWitKeyHash ::
  forall c.
  Crypto c =>
  BootstrapWitness c ->
  KeyHash 'Witness c
bootstrapWitKeyHash :: forall c. Crypto c => BootstrapWitness c -> KeyHash 'Witness c
bootstrapWitKeyHash (BootstrapWitness (VKey VerKeyDSIGN (DSIGN c)
key) SignedDSIGN c (Hash c EraIndependentTxBody)
_ (ChainCode ByteString
cc) ByteString
attributes) =
  forall (r :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c)) -> KeyHash r c
KeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteString -> Hash (ADDRHASH c) 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 c)
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 c) a
    hash_crypto :: forall a. ByteString -> Hash (ADDRHASH c) 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 c) forall a. a -> a
id

unpackByronVKey ::
  forall c.
  DSIGN c ~ DSIGN.Ed25519DSIGN =>
  Byron.VerificationKey ->
  (VKey 'Witness c, ChainCode)
unpackByronVKey :: forall c.
(DSIGN c ~ Ed25519DSIGN) =>
VerificationKey -> (VKey 'Witness c, 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 Ed25519DSIGN)
Nothing -> forall a. HasCallStack => String -> a
error String
"unpackByronVKey: impossible!"
    Just VerKeyDSIGN Ed25519DSIGN
vk -> (forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
VKey VerKeyDSIGN Ed25519DSIGN
vk, ByteString -> ChainCode
ChainCode ByteString
chainCodeBytes)

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

coerceSignature :: WC.XSignature -> DSIGN.SigDSIGN DSIGN.Ed25519DSIGN
coerceSignature :: XSignature -> SigDSIGN Ed25519DSIGN
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 ::
  forall c.
  ( DSIGN c ~ DSIGN.Ed25519DSIGN
  , Crypto c
  ) =>
  Hash c EraIndependentTxBody ->
  Byron.SigningKey ->
  Byron.Attributes Byron.AddrAttributes ->
  BootstrapWitness c
makeBootstrapWitness :: forall c.
(DSIGN c ~ Ed25519DSIGN, Crypto c) =>
Hash c EraIndependentTxBody
-> SigningKey -> Attributes AddrAttributes -> BootstrapWitness c
makeBootstrapWitness Hash c EraIndependentTxBody
txBodyHash SigningKey
byronSigningKey Attributes AddrAttributes
addrAttributes =
  forall c.
Crypto c =>
VKey 'Witness c
-> SignedDSIGN c (Hash c EraIndependentTxBody)
-> ChainCode
-> ByteString
-> BootstrapWitness c
BootstrapWitness VKey 'Witness c
vk SignedDSIGN Ed25519DSIGN (Hash c EraIndependentTxBody)
signature ChainCode
cc (forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer Attributes AddrAttributes
addrAttributes)
  where
    (VKey 'Witness c
vk, ChainCode
cc) = forall c.
(DSIGN c ~ Ed25519DSIGN) =>
VerificationKey -> (VKey 'Witness c, ChainCode)
unpackByronVKey forall a b. (a -> b) -> a -> b
$ SigningKey -> VerificationKey
Byron.toVerification SigningKey
byronSigningKey
    signature :: SignedDSIGN Ed25519DSIGN (Hash c EraIndependentTxBody)
signature =
      forall v a. SigDSIGN v -> SignedDSIGN v a
DSIGN.SignedDSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. XSignature -> SigDSIGN Ed25519DSIGN
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 c EraIndependentTxBody
txBodyHash)

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

instance Crypto c => EqRaw (BootstrapWitness c) where
  eqRaw :: BootstrapWitness c -> BootstrapWitness c -> Bool
eqRaw = forall c.
Crypto c =>
BootstrapWitness c -> BootstrapWitness c -> Bool
eqBootstrapWitnessRaw