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

-- | A witness is a proof that a transaction is allowed to spend the funds it
--   spends (by providing signatures, redeeming scripts, etc). A separate proof
--   is provided for each input.
type TxWitness = Vector TxInWitness

-- | A witness for a single input
data TxInWitness
  = -- | VKWitness twKey twSig
    VKWitness !VerificationKey !TxSig
  | -- | RedeemWitness twRedeemKey twRedeemSig
    RedeemWitness !RedeemVerificationKey !(RedeemSignature TxSigData)
  deriving (TxInWitness -> TxInWitness -> Bool
(TxInWitness -> TxInWitness -> Bool)
-> (TxInWitness -> TxInWitness -> Bool) -> Eq TxInWitness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxInWitness -> TxInWitness -> Bool
== :: TxInWitness -> TxInWitness -> Bool
$c/= :: TxInWitness -> TxInWitness -> Bool
/= :: TxInWitness -> TxInWitness -> Bool
Eq, Int -> TxInWitness -> ShowS
[TxInWitness] -> ShowS
TxInWitness -> String
(Int -> TxInWitness -> ShowS)
-> (TxInWitness -> String)
-> ([TxInWitness] -> ShowS)
-> Show TxInWitness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxInWitness -> ShowS
showsPrec :: Int -> TxInWitness -> ShowS
$cshow :: TxInWitness -> String
show :: TxInWitness -> String
$cshowList :: [TxInWitness] -> ShowS
showList :: [TxInWitness] -> ShowS
Show, (forall x. TxInWitness -> Rep TxInWitness x)
-> (forall x. Rep TxInWitness x -> TxInWitness)
-> Generic TxInWitness
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
$cfrom :: forall x. TxInWitness -> Rep TxInWitness x
from :: forall x. TxInWitness -> Rep TxInWitness x
$cto :: forall x. Rep TxInWitness x -> TxInWitness
to :: forall x. Rep TxInWitness x -> TxInWitness
Generic)
  deriving anyclass (TxInWitness -> ()
(TxInWitness -> ()) -> NFData TxInWitness
forall a. (a -> ()) -> NFData a
$crnf :: TxInWitness -> ()
rnf :: TxInWitness -> ()
NFData)

instance B.Buildable TxInWitness where
  build :: TxInWitness -> Builder
build (VKWitness VerificationKey
key TxSig
sig) =
    Format
  Builder
  (VerificationKey
   -> AddressHash VerificationKey -> TxSig -> Builder)
-> VerificationKey
-> AddressHash VerificationKey
-> TxSig
-> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (VerificationKey
   -> AddressHash VerificationKey -> TxSig -> Builder)
  (VerificationKey
   -> AddressHash VerificationKey -> TxSig -> Builder)
"VKWitness: key = "
          Format
  (VerificationKey
   -> AddressHash VerificationKey -> TxSig -> Builder)
  (VerificationKey
   -> AddressHash VerificationKey -> TxSig -> Builder)
-> Format
     Builder
     (VerificationKey
      -> AddressHash VerificationKey -> TxSig -> Builder)
-> Format
     Builder
     (VerificationKey
      -> AddressHash VerificationKey -> TxSig -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
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)
  (VerificationKey
   -> AddressHash VerificationKey -> TxSig -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (AddressHash VerificationKey -> TxSig -> Builder)
  (VerificationKey
   -> AddressHash VerificationKey -> TxSig -> Builder)
-> Format Builder (AddressHash VerificationKey -> TxSig -> Builder)
-> Format
     Builder
     (VerificationKey
      -> AddressHash VerificationKey -> TxSig -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
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 = "
          Format
  (AddressHash VerificationKey -> TxSig -> Builder)
  (AddressHash VerificationKey -> TxSig -> Builder)
-> Format Builder (AddressHash VerificationKey -> TxSig -> Builder)
-> Format Builder (AddressHash VerificationKey -> TxSig -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
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)
  (AddressHash VerificationKey -> TxSig -> Builder)
forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF
          Format
  (TxSig -> Builder)
  (AddressHash VerificationKey -> TxSig -> Builder)
-> Format Builder (TxSig -> Builder)
-> Format Builder (AddressHash VerificationKey -> TxSig -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
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 = "
          Format (TxSig -> Builder) (TxSig -> Builder)
-> Format Builder (TxSig -> Builder)
-> Format Builder (TxSig -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (TxSig -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
      )
      VerificationKey
key
      (VerificationKey -> AddressHash VerificationKey
forall a. EncCBOR a => a -> AddressHash a
addressHash VerificationKey
key)
      TxSig
sig
  build (RedeemWitness RedeemVerificationKey
key RedeemSignature TxSigData
sig) =
    Format
  Builder
  (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
-> RedeemVerificationKey -> RedeemSignature TxSigData -> Builder
forall a. Format Builder a -> a
bprint (Format
  (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
  (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
"VKWitness: key = " Format
  (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
  (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
-> Format
     Builder
     (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
-> Format
     Builder
     (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
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)
  (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format
  (RedeemSignature TxSigData -> Builder)
  (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
-> Format Builder (RedeemSignature TxSigData -> Builder)
-> Format
     Builder
     (RedeemVerificationKey -> RedeemSignature TxSigData -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
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 = " Format
  (RedeemSignature TxSigData -> Builder)
  (RedeemSignature TxSigData -> Builder)
-> Format Builder (RedeemSignature TxSigData -> Builder)
-> Format Builder (RedeemSignature TxSigData -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (RedeemSignature TxSigData -> Builder)
forall a r. Buildable a => Format r (a -> r)
build) RedeemVerificationKey
key RedeemSignature TxSigData
sig

instance ToCBOR TxInWitness where
  toCBOR :: TxInWitness -> Encoding
toCBOR = TxInWitness -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR TxInWitness where
  fromCBOR :: forall s. Decoder s TxInWitness
fromCBOR = Decoder s TxInWitness
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Used for debugging purposes only
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
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (VerificationKey, TxSig) -> Encoding
forall a. EncCBOR a => a -> Encoding
encodeKnownCborDataItem (VerificationKey
key, TxSig
sig)
    RedeemWitness RedeemVerificationKey
key RedeemSignature TxSigData
sig ->
      Word -> Encoding
encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (RedeemVerificationKey, RedeemSignature TxSigData) -> Encoding
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
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
        ( (Case Size -> Case Size) -> [Case Size] -> [Case Size]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
            ((Size -> Size) -> Case Size -> Case Size
forall a b. (a -> b) -> Case a -> Case b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Size -> Size
knownCborDataItemSizeExpr)
            [ Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"VKWitness" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ Proxy (VerificationKey, TxSig) -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Proxy (VerificationKey, TxSig) -> Size)
-> Proxy (VerificationKey, TxSig) -> Size
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VerificationKey, TxSig)
            , Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"RedeemWitness"
                (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ Proxy (RedeemVerificationKey, RedeemSignature TxSigData) -> Size
forall t. EncCBOR t => Proxy t -> Size
size
                (Proxy (RedeemVerificationKey, RedeemSignature TxSigData) -> Size)
-> Proxy (RedeemVerificationKey, RedeemSignature TxSigData) -> Size
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RedeemVerificationKey, RedeemSignature TxSigData)
            ]
        )

instance DecCBOR TxInWitness where
  decCBOR :: forall s. Decoder s TxInWitness
decCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    forall a s. DecCBOR a => Decoder s a
decCBOR @Word8 Decoder s Word8
-> (Word8 -> Decoder s TxInWitness) -> Decoder s TxInWitness
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0 -> do
        Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"TxInWitness.VKWitness" Int
len Int
2
        (VerificationKey -> TxSig -> TxInWitness)
-> (VerificationKey, TxSig) -> TxInWitness
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VerificationKey -> TxSig -> TxInWitness
VKWitness ((VerificationKey, TxSig) -> TxInWitness)
-> Decoder s (VerificationKey, TxSig) -> Decoder s TxInWitness
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VerificationKey, TxSig)
forall a s. DecCBOR a => Decoder s a
decodeKnownCborDataItem
      Word8
2 -> do
        Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"TxInWitness.RedeemWitness" Int
len Int
2
        (RedeemVerificationKey -> RedeemSignature TxSigData -> TxInWitness)
-> (RedeemVerificationKey, RedeemSignature TxSigData)
-> TxInWitness
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RedeemVerificationKey -> RedeemSignature TxSigData -> TxInWitness
RedeemWitness ((RedeemVerificationKey, RedeemSignature TxSigData) -> TxInWitness)
-> Decoder s (RedeemVerificationKey, RedeemSignature TxSigData)
-> Decoder s TxInWitness
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (RedeemVerificationKey, RedeemSignature TxSigData)
forall a s. DecCBOR a => Decoder s a
decodeKnownCborDataItem
      Word8
tag -> DecoderError -> Decoder s TxInWitness
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError -> Decoder s TxInWitness)
-> DecoderError -> Decoder s TxInWitness
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"TxInWitness" Word8
tag

-- | Data that is being signed when creating a TxSig
newtype TxSigData = TxSigData
  { TxSigData -> Hash Tx
txSigTxHash :: Hash Tx
  }
  deriving (TxSigData -> TxSigData -> Bool
(TxSigData -> TxSigData -> Bool)
-> (TxSigData -> TxSigData -> Bool) -> Eq TxSigData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSigData -> TxSigData -> Bool
== :: TxSigData -> TxSigData -> Bool
$c/= :: TxSigData -> TxSigData -> Bool
/= :: TxSigData -> TxSigData -> Bool
Eq, Int -> TxSigData -> ShowS
[TxSigData] -> ShowS
TxSigData -> String
(Int -> TxSigData -> ShowS)
-> (TxSigData -> String)
-> ([TxSigData] -> ShowS)
-> Show TxSigData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSigData -> ShowS
showsPrec :: Int -> TxSigData -> ShowS
$cshow :: TxSigData -> String
show :: TxSigData -> String
$cshowList :: [TxSigData] -> ShowS
showList :: [TxSigData] -> ShowS
Show, (forall x. TxSigData -> Rep TxSigData x)
-> (forall x. Rep TxSigData x -> TxSigData) -> Generic TxSigData
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
$cfrom :: forall x. TxSigData -> Rep TxSigData x
from :: forall x. TxSigData -> Rep TxSigData x
$cto :: forall x. Rep TxSigData x -> TxSigData
to :: forall x. Rep TxSigData x -> TxSigData
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 = Annotated Tx ByteString
-> Hash (BaseType (Annotated Tx ByteString))
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded Annotated Tx ByteString
atx
      signedBytes :: ByteString
signedBytes = Version -> Hash Tx -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer Hash Tx
txHash -- TODO: make the prefix bytes explicit
   in TxSigData -> ByteString -> Annotated TxSigData ByteString
forall b a. b -> a -> Annotated b a
Annotated (Hash Tx -> TxSigData
TxSigData Hash Tx
txHash) ByteString
signedBytes

-- Used for debugging purposes only
instance ToJSON TxSigData

instance ToCBOR TxSigData where
  toCBOR :: TxSigData -> Encoding
toCBOR = TxSigData -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR TxSigData where
  fromCBOR :: forall s. Decoder s TxSigData
fromCBOR = Decoder s TxSigData
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR TxSigData where
  encCBOR :: TxSigData -> Encoding
encCBOR TxSigData
txSigData = Hash Tx -> Encoding
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 = Proxy (Hash Tx) -> Size
forall t. EncCBOR t => Proxy t -> Size
size (TxSigData -> Hash Tx
txSigTxHash (TxSigData -> Hash Tx) -> Proxy TxSigData -> Proxy (Hash Tx)
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 (Hash Tx -> TxSigData)
-> Decoder s (Hash Tx) -> Decoder s TxSigData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Hash Tx)
forall s. Decoder s (Hash Tx)
forall a s. DecCBOR a => Decoder s a
decCBOR

-- | 'Signature' of addrId
type TxSig = Signature TxSigData