{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.UTxO.TxWitness
  ( TxWitness,
    TxInWitness (..),
    TxSigData (..),
    TxSig,
    recoverSigData,
  )
where

import Cardano.Binary
  ( Annotated (..),
    Case (..),
    DecoderError (DecoderErrorUnknownTag),
    FromCBOR (..),
    ToCBOR (..),
    decodeListLen,
    encodeListLen,
    matchSize,
    serialize',
    szCases,
  )
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.Prelude
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
/= :: TxInWitness -> TxInWitness -> Bool
$c/= :: TxInWitness -> TxInWitness -> Bool
== :: TxInWitness -> TxInWitness -> Bool
$c== :: 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
showList :: [TxInWitness] -> ShowS
$cshowList :: [TxInWitness] -> ShowS
show :: TxInWitness -> String
$cshow :: TxInWitness -> String
showsPrec :: Int -> TxInWitness -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep TxInWitness x -> TxInWitness
$cfrom :: forall x. TxInWitness -> Rep TxInWitness x
Generic)
  deriving anyclass (TxInWitness -> ()
(TxInWitness -> ()) -> NFData 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) =
    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 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 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 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 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 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. ToCBOR 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 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 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 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

-- Used for debugging purposes only
instance ToJSON TxInWitness

instance ToCBOR TxInWitness where
  toCBOR :: TxInWitness -> Encoding
toCBOR 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. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (VerificationKey, TxSig) -> Encoding
forall a. ToCBOR 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. ToCBOR a => a -> Encoding
toCBOR (Word8
2 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (RedeemVerificationKey, RedeemSignature TxSigData) -> Encoding
forall a. ToCBOR a => a -> Encoding
encodeKnownCborDataItem (RedeemVerificationKey
key, RedeemSignature TxSigData
sig)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy TxInWitness -> Size
encodedSizeExpr forall t. ToCBOR 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 (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. ToCBOR t => Proxy t -> Size
size (Proxy (VerificationKey, TxSig) -> Size)
-> Proxy (VerificationKey, TxSig) -> Size
forall a b. (a -> b) -> a -> b
$ Proxy (VerificationKey, TxSig)
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. ToCBOR t => Proxy t -> Size
size (Proxy (RedeemVerificationKey, RedeemSignature TxSigData) -> Size)
-> Proxy (RedeemVerificationKey, RedeemSignature TxSigData) -> Size
forall a b. (a -> b) -> a -> b
$
                  Proxy (RedeemVerificationKey, RedeemSignature TxSigData)
forall k (t :: k). Proxy t
Proxy @(RedeemVerificationKey, RedeemSignature TxSigData)
            ]
        )

instance FromCBOR TxInWitness where
  fromCBOR :: Decoder s TxInWitness
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    forall s. FromCBOR Word8 => Decoder s Word8
forall a s. FromCBOR a => Decoder s a
fromCBOR @Word8 Decoder s Word8
-> (Word8 -> Decoder s TxInWitness) -> Decoder s TxInWitness
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. FromCBOR 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. FromCBOR a => Decoder s a
decodeKnownCborDataItem
      Word8
tag -> DecoderError -> Decoder s TxInWitness
forall e s a. Buildable e => e -> Decoder s 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
/= :: TxSigData -> TxSigData -> Bool
$c/= :: TxSigData -> TxSigData -> Bool
== :: TxSigData -> TxSigData -> Bool
$c== :: 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
showList :: [TxSigData] -> ShowS
$cshowList :: [TxSigData] -> ShowS
show :: TxSigData -> String
$cshow :: TxSigData -> String
showsPrec :: Int -> TxSigData -> ShowS
$cshowsPrec :: Int -> 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
$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 = Annotated Tx ByteString
-> Hash (BaseType (Annotated Tx ByteString))
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded Annotated Tx ByteString
atx
      signedBytes :: ByteString
signedBytes = Hash Tx -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' 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
txSigData = Hash Tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (TxSigData -> Hash Tx
txSigTxHash TxSigData
txSigData)
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy TxSigData -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy TxSigData
pxy = Proxy (Hash Tx) -> Size
forall t. ToCBOR 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 FromCBOR TxSigData where
  fromCBOR :: Decoder s TxSigData
fromCBOR = 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 a s. FromCBOR a => Decoder s a
fromCBOR

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