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

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

-- | Data that is being signed when creating a TxSig
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 -- TODO: make the prefix bytes explicit
   in 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 = 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

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