{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.Chain.UTxO.TxWitness (
TxWitness,
TxInWitness (..),
TxSigData (..),
TxSig,
recoverSigData,
)
where
import Cardano.Chain.Common (addressHash)
import Cardano.Chain.Common.CBOR (
decodeKnownCborDataItem,
encodeKnownCborDataItem,
knownCborDataItemSizeExpr,
)
import Cardano.Chain.UTxO.Tx (Tx)
import Cardano.Crypto (
Hash,
RedeemSignature,
RedeemVerificationKey,
Signature,
VerificationKey,
hashDecoded,
shortHashF,
)
import Cardano.Ledger.Binary (
Annotated (..),
Case (..),
DecCBOR (..),
DecoderError (DecoderErrorUnknownTag),
EncCBOR (..),
FromCBOR (..),
ToCBOR (..),
byronProtVer,
cborError,
decodeListLen,
encodeListLen,
fromByronCBOR,
matchSize,
serialize',
szCases,
toByronCBOR,
)
import Cardano.Prelude hiding (cborError)
import Data.Aeson (ToJSON)
import Data.Vector (Vector)
import Formatting (bprint, build)
import qualified Formatting.Buildable as B
type TxWitness = Vector TxInWitness
data TxInWitness
=
VKWitness !VerificationKey !TxSig
|
RedeemWitness !RedeemVerificationKey !(RedeemSignature TxSigData)
deriving (TxInWitness -> TxInWitness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxInWitness -> TxInWitness -> Bool
$c/= :: TxInWitness -> TxInWitness -> Bool
== :: TxInWitness -> TxInWitness -> Bool
$c== :: TxInWitness -> TxInWitness -> Bool
Eq, Int -> TxInWitness -> ShowS
[TxInWitness] -> ShowS
TxInWitness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxInWitness] -> ShowS
$cshowList :: [TxInWitness] -> ShowS
show :: TxInWitness -> String
$cshow :: TxInWitness -> String
showsPrec :: Int -> TxInWitness -> ShowS
$cshowsPrec :: Int -> TxInWitness -> ShowS
Show, forall x. Rep TxInWitness x -> TxInWitness
forall x. TxInWitness -> Rep TxInWitness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxInWitness x -> TxInWitness
$cfrom :: forall x. TxInWitness -> Rep TxInWitness x
Generic)
deriving anyclass (TxInWitness -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxInWitness -> ()
$crnf :: TxInWitness -> ()
NFData)
instance B.Buildable TxInWitness where
build :: TxInWitness -> Builder
build (VKWitness VerificationKey
key TxSig
sig) =
forall a. Format Builder a -> a
bprint
( Format
(VerificationKey
-> AddressHash VerificationKey -> TxSig -> Builder)
(VerificationKey
-> AddressHash VerificationKey -> TxSig -> Builder)
"VKWitness: key = "
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
(AddressHash VerificationKey -> TxSig -> Builder)
(AddressHash VerificationKey -> TxSig -> Builder)
", key hash = "
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (TxSig -> Builder) (TxSig -> Builder)
", sig = "
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
)
VerificationKey
key
(forall a. EncCBOR a => a -> AddressHash a
addressHash VerificationKey
key)
TxSig
sig
build (RedeemWitness RedeemVerificationKey
key RedeemSignature TxSigData
sig) =
forall a. Format Builder a -> a
bprint (Format
(RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
(RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
"VKWitness: key = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
(RedeemSignature TxSigData -> Builder)
(RedeemSignature TxSigData -> Builder)
", sig = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build) RedeemVerificationKey
key RedeemSignature TxSigData
sig
instance ToCBOR TxInWitness where
toCBOR :: TxInWitness -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR
instance FromCBOR TxInWitness where
fromCBOR :: forall s. Decoder s TxInWitness
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR
instance ToJSON TxInWitness
instance EncCBOR TxInWitness where
encCBOR :: TxInWitness -> Encoding
encCBOR TxInWitness
input = case TxInWitness
input of
VKWitness VerificationKey
key TxSig
sig ->
Word -> Encoding
encodeListLen Word
2
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encodeKnownCborDataItem (VerificationKey
key, TxSig
sig)
RedeemWitness RedeemVerificationKey
key RedeemSignature TxSigData
sig ->
Word -> Encoding
encodeListLen Word
2
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encodeKnownCborDataItem (RedeemVerificationKey
key, RedeemSignature TxSigData
sig)
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy TxInWitness -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy TxInWitness
_ =
Size
2
forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Size -> Size
knownCborDataItemSizeExpr)
[ forall t. Text -> t -> Case t
Case Text
"VKWitness" forall a b. (a -> b) -> a -> b
$ forall t. EncCBOR t => Proxy t -> Size
size forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @(VerificationKey, TxSig)
, forall t. Text -> t -> Case t
Case Text
"RedeemWitness"
forall a b. (a -> b) -> a -> b
$ forall t. EncCBOR t => Proxy t -> Size
size
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @(RedeemVerificationKey, RedeemSignature TxSigData)
]
)
instance DecCBOR TxInWitness where
decCBOR :: forall s. Decoder s TxInWitness
decCBOR = do
Int
len <- forall s. Decoder s Int
decodeListLen
forall a s. DecCBOR a => Decoder s a
decCBOR @Word8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
0 -> do
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"TxInWitness.VKWitness" Int
len Int
2
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VerificationKey -> TxSig -> TxInWitness
VKWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decodeKnownCborDataItem
Word8
2 -> do
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"TxInWitness.RedeemWitness" Int
len Int
2
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RedeemVerificationKey -> RedeemSignature TxSigData -> TxInWitness
RedeemWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decodeKnownCborDataItem
Word8
tag -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"TxInWitness" Word8
tag
newtype TxSigData = TxSigData
{ TxSigData -> Hash Tx
txSigTxHash :: Hash Tx
}
deriving (TxSigData -> TxSigData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxSigData -> TxSigData -> Bool
$c/= :: TxSigData -> TxSigData -> Bool
== :: TxSigData -> TxSigData -> Bool
$c== :: TxSigData -> TxSigData -> Bool
Eq, Int -> TxSigData -> ShowS
[TxSigData] -> ShowS
TxSigData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxSigData] -> ShowS
$cshowList :: [TxSigData] -> ShowS
show :: TxSigData -> String
$cshow :: TxSigData -> String
showsPrec :: Int -> TxSigData -> ShowS
$cshowsPrec :: Int -> TxSigData -> ShowS
Show, forall x. Rep TxSigData x -> TxSigData
forall x. TxSigData -> Rep TxSigData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxSigData x -> TxSigData
$cfrom :: forall x. TxSigData -> Rep TxSigData x
Generic)
recoverSigData :: Annotated Tx ByteString -> Annotated TxSigData ByteString
recoverSigData :: Annotated Tx ByteString -> Annotated TxSigData ByteString
recoverSigData Annotated Tx ByteString
atx =
let txHash :: Hash (BaseType (Annotated Tx ByteString))
txHash = forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded Annotated Tx ByteString
atx
signedBytes :: ByteString
signedBytes = forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer Hash Tx
txHash
in forall b a. b -> a -> Annotated b a
Annotated (Hash Tx -> TxSigData
TxSigData Hash Tx
txHash) ByteString
signedBytes
instance ToJSON TxSigData
instance ToCBOR TxSigData where
toCBOR :: TxSigData -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR
instance FromCBOR TxSigData where
fromCBOR :: forall s. Decoder s TxSigData
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR
instance EncCBOR TxSigData where
encCBOR :: TxSigData -> Encoding
encCBOR TxSigData
txSigData = forall a. EncCBOR a => a -> Encoding
encCBOR (TxSigData -> Hash Tx
txSigTxHash TxSigData
txSigData)
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxSigData -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy TxSigData
pxy = forall t. EncCBOR t => Proxy t -> Size
size (TxSigData -> Hash Tx
txSigTxHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxSigData
pxy)
instance DecCBOR TxSigData where
decCBOR :: forall s. Decoder s TxSigData
decCBOR = Hash Tx -> TxSigData
TxSigData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
type TxSig = Signature TxSigData