{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.TxIn (
  TxId (..),
  TxIn (TxIn),
  mkTxInPartial,
  txInToText,
  TxIx,
) where

import Cardano.Crypto.Hash.Class (hashToTextAsHex)
import Cardano.Ledger.BaseTypes (TxIx (..), mkTxIxPartial)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  TokenType (..),
  decodeMemPack,
  decodeRecordNamed,
  encodeListLen,
  peekTokenType,
 )
import Cardano.Ledger.Hashes (EraIndependentTxBody, SafeHash, extractHash)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON (..))
import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
import Data.MemPack
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks (..))

-- ===================================================================================
-- Because we expect other Era's to import and use TxId, TxIn, TxOut, we use the weakest
-- constraint possible when deriving their instances. A Stronger constraint, Gathering
-- many constraints together, like:  type Strong = (C1 x, C2 x, ..., Cn x)
-- may make this file look systematic by having things like:
-- derving instance (Strong x) => Foo x,  for many Foo (Eq, Show, NfData, etc) BUT this
-- forces unnecessary requirements on any new Era which tries to embed one of these
-- types in their own datatypes, if they then try and derive (Foo TheirDataType).
-- ====================================================================================

-- | A unique ID of a transaction, which is computable from the transaction.
newtype TxId = TxId {TxId -> SafeHash EraIndependentTxBody
unTxId :: SafeHash EraIndependentTxBody}
  deriving (Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> String
(Int -> TxId -> ShowS)
-> (TxId -> String) -> ([TxId] -> ShowS) -> Show TxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxId -> ShowS
showsPrec :: Int -> TxId -> ShowS
$cshow :: TxId -> String
show :: TxId -> String
$cshowList :: [TxId] -> ShowS
showList :: [TxId] -> ShowS
Show, TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
/= :: TxId -> TxId -> Bool
Eq, Eq TxId
Eq TxId =>
(TxId -> TxId -> Ordering)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> TxId)
-> (TxId -> TxId -> TxId)
-> Ord TxId
TxId -> TxId -> Bool
TxId -> TxId -> Ordering
TxId -> TxId -> TxId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxId -> TxId -> Ordering
compare :: TxId -> TxId -> Ordering
$c< :: TxId -> TxId -> Bool
< :: TxId -> TxId -> Bool
$c<= :: TxId -> TxId -> Bool
<= :: TxId -> TxId -> Bool
$c> :: TxId -> TxId -> Bool
> :: TxId -> TxId -> Bool
$c>= :: TxId -> TxId -> Bool
>= :: TxId -> TxId -> Bool
$cmax :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
min :: TxId -> TxId -> TxId
Ord, (forall x. TxId -> Rep TxId x)
-> (forall x. Rep TxId x -> TxId) -> Generic TxId
forall x. Rep TxId x -> TxId
forall x. TxId -> Rep TxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxId -> Rep TxId x
from :: forall x. TxId -> Rep TxId x
$cto :: forall x. Rep TxId x -> TxId
to :: forall x. Rep TxId x -> TxId
Generic)
  deriving newtype (Context -> TxId -> IO (Maybe ThunkInfo)
Proxy TxId -> String
(Context -> TxId -> IO (Maybe ThunkInfo))
-> (Context -> TxId -> IO (Maybe ThunkInfo))
-> (Proxy TxId -> String)
-> NoThunks TxId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TxId -> String
showTypeOf :: Proxy TxId -> String
NoThunks, [TxId] -> Value
[TxId] -> Encoding
TxId -> Bool
TxId -> Value
TxId -> Encoding
(TxId -> Value)
-> (TxId -> Encoding)
-> ([TxId] -> Value)
-> ([TxId] -> Encoding)
-> (TxId -> Bool)
-> ToJSON TxId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TxId -> Value
toJSON :: TxId -> Value
$ctoEncoding :: TxId -> Encoding
toEncoding :: TxId -> Encoding
$ctoJSONList :: [TxId] -> Value
toJSONList :: [TxId] -> Value
$ctoEncodingList :: [TxId] -> Encoding
toEncodingList :: [TxId] -> Encoding
$comitField :: TxId -> Bool
omitField :: TxId -> Bool
ToJSON, Maybe TxId
Value -> Parser [TxId]
Value -> Parser TxId
(Value -> Parser TxId)
-> (Value -> Parser [TxId]) -> Maybe TxId -> FromJSON TxId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TxId
parseJSON :: Value -> Parser TxId
$cparseJSONList :: Value -> Parser [TxId]
parseJSONList :: Value -> Parser [TxId]
$comittedField :: Maybe TxId
omittedField :: Maybe TxId
FromJSON, Typeable TxId
Typeable TxId =>
(TxId -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxId -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [TxId] -> Size)
-> EncCBOR TxId
TxId -> Encoding
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [TxId] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxId -> 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
$cencCBOR :: TxId -> Encoding
encCBOR :: TxId -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxId -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxId -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [TxId] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [TxId] -> Size
EncCBOR, Typeable TxId
Typeable TxId =>
(forall s. Decoder s TxId)
-> (forall s. Proxy TxId -> Decoder s ())
-> (Proxy TxId -> Text)
-> DecCBOR TxId
Proxy TxId -> Text
forall s. Decoder s TxId
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy TxId -> Decoder s ()
$cdecCBOR :: forall s. Decoder s TxId
decCBOR :: forall s. Decoder s TxId
$cdropCBOR :: forall s. Proxy TxId -> Decoder s ()
dropCBOR :: forall s. Proxy TxId -> Decoder s ()
$clabel :: Proxy TxId -> Text
label :: Proxy TxId -> Text
DecCBOR, TxId -> ()
(TxId -> ()) -> NFData TxId
forall a. (a -> ()) -> NFData a
$crnf :: TxId -> ()
rnf :: TxId -> ()
NFData, String
String
-> (TxId -> Int)
-> (forall s. TxId -> Pack s ())
-> (forall b. Buffer b => Unpack b TxId)
-> MemPack TxId
TxId -> Int
forall a.
String
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b. Buffer b => Unpack b a)
-> MemPack a
forall b. Buffer b => Unpack b TxId
forall s. TxId -> Pack s ()
$ctypeName :: String
typeName :: String
$cpackedByteCount :: TxId -> Int
packedByteCount :: TxId -> Int
$cpackM :: forall s. TxId -> Pack s ()
packM :: forall s. TxId -> Pack s ()
$cunpackM :: forall b. Buffer b => Unpack b TxId
unpackM :: forall b. Buffer b => Unpack b TxId
MemPack)

instance ToJSON TxIn where
  toJSON :: TxIn -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (TxIn -> Text) -> TxIn -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Text
txInToText
  toEncoding :: TxIn -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (TxIn -> Text) -> TxIn -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Text
txInToText

instance ToJSONKey TxIn where
  toJSONKey :: ToJSONKeyFunction TxIn
toJSONKey = (TxIn -> Text) -> ToJSONKeyFunction TxIn
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText TxIn -> Text
txInToText

txInToText :: TxIn -> Text
txInToText :: TxIn -> Text
txInToText (TxIn (TxId SafeHash EraIndependentTxBody
txidHash) TxIx
ix) =
  Hash HASH EraIndependentTxBody -> Text
forall h a. Hash h a -> Text
hashToTextAsHex (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
extractHash SafeHash EraIndependentTxBody
txidHash)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"#"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (TxIx -> String
forall a. Show a => a -> String
show TxIx
ix)

-- | The input of a UTxO.
data TxIn = TxIn !TxId {-# UNPACK #-} !TxIx
  deriving ((forall x. TxIn -> Rep TxIn x)
-> (forall x. Rep TxIn x -> TxIn) -> Generic TxIn
forall x. Rep TxIn x -> TxIn
forall x. TxIn -> Rep TxIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxIn -> Rep TxIn x
from :: forall x. TxIn -> Rep TxIn x
$cto :: forall x. Rep TxIn x -> TxIn
to :: forall x. Rep TxIn x -> TxIn
Generic, TxIn -> TxIn -> Bool
(TxIn -> TxIn -> Bool) -> (TxIn -> TxIn -> Bool) -> Eq TxIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxIn -> TxIn -> Bool
== :: TxIn -> TxIn -> Bool
$c/= :: TxIn -> TxIn -> Bool
/= :: TxIn -> TxIn -> Bool
Eq, Eq TxIn
Eq TxIn =>
(TxIn -> TxIn -> Ordering)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> TxIn)
-> (TxIn -> TxIn -> TxIn)
-> Ord TxIn
TxIn -> TxIn -> Bool
TxIn -> TxIn -> Ordering
TxIn -> TxIn -> TxIn
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxIn -> TxIn -> Ordering
compare :: TxIn -> TxIn -> Ordering
$c< :: TxIn -> TxIn -> Bool
< :: TxIn -> TxIn -> Bool
$c<= :: TxIn -> TxIn -> Bool
<= :: TxIn -> TxIn -> Bool
$c> :: TxIn -> TxIn -> Bool
> :: TxIn -> TxIn -> Bool
$c>= :: TxIn -> TxIn -> Bool
>= :: TxIn -> TxIn -> Bool
$cmax :: TxIn -> TxIn -> TxIn
max :: TxIn -> TxIn -> TxIn
$cmin :: TxIn -> TxIn -> TxIn
min :: TxIn -> TxIn -> TxIn
Ord, Int -> TxIn -> ShowS
[TxIn] -> ShowS
TxIn -> String
(Int -> TxIn -> ShowS)
-> (TxIn -> String) -> ([TxIn] -> ShowS) -> Show TxIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxIn -> ShowS
showsPrec :: Int -> TxIn -> ShowS
$cshow :: TxIn -> String
show :: TxIn -> String
$cshowList :: [TxIn] -> ShowS
showList :: [TxIn] -> ShowS
Show)

instance MemPack TxIn where
  packedByteCount :: TxIn -> Int
packedByteCount (TxIn TxId
txId TxIx
txIx) = TxId -> Int
forall a. MemPack a => a -> Int
packedByteCount TxId
txId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TxIx -> Int
forall a. MemPack a => a -> Int
packedByteCount TxIx
txIx
  {-# INLINE packedByteCount #-}
  packM :: forall s. TxIn -> Pack s ()
packM (TxIn TxId
txId TxIx
txIx) = TxId -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. TxId -> Pack s ()
packM TxId
txId Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxIx -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. TxIx -> Pack s ()
packM TxIx
txIx
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b TxIn
unpackM = TxId -> TxIx -> TxIn
TxIn (TxId -> TxIx -> TxIn) -> Unpack b TxId -> Unpack b (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b TxId
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b TxId
unpackM Unpack b (TxIx -> TxIn) -> Unpack b TxIx -> Unpack b TxIn
forall a b. Unpack b (a -> b) -> Unpack b a -> Unpack b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Unpack b TxIx
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b TxIx
unpackM
  {-# INLINE unpackM #-}

-- | Construct `TxIn` while throwing an error for an out of range `TxIx`. Make
-- sure to use it only for testing.
mkTxInPartial :: HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial :: HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial TxId
txId = TxId -> TxIx -> TxIn
TxIn TxId
txId (TxIx -> TxIn) -> (Integer -> TxIx) -> Integer -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial

instance NFData TxIn

instance NoThunks TxIn

instance EncCBOR TxIn where
  encCBOR :: TxIn -> Encoding
encCBOR (TxIn TxId
txId TxIx
index) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxId -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR TxId
txId
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxIx -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR TxIx
index

instance DecCBOR TxIn where
  decCBOR :: forall s. Decoder s TxIn
decCBOR =
    Text -> (TxIn -> Int) -> Decoder s TxIn -> Decoder s TxIn
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
      Text
"TxIn"
      (Int -> TxIn -> Int
forall a b. a -> b -> a
const Int
2)
      (TxId -> TxIx -> TxIn
TxIn (TxId -> TxIx -> TxIn)
-> Decoder s TxId -> Decoder s (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxId
forall s. Decoder s TxId
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (TxIx -> TxIn) -> Decoder s TxIx -> Decoder s TxIn
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s TxIx
forall s. Decoder s TxIx
forall a s. DecCBOR a => Decoder s a
decCBOR)

instance DecShareCBOR TxIn where
  decShareCBOR :: forall s. Share TxIn -> Decoder s TxIn
decShareCBOR Share TxIn
_ =
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s TxIn) -> Decoder s TxIn
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
      TokenType
TypeBytes -> Decoder s TxIn
forall a s. MemPack a => Decoder s a
decodeMemPack
      TokenType
TypeBytesIndef -> Decoder s TxIn
forall a s. MemPack a => Decoder s a
decodeMemPack
      TokenType
_ -> Decoder s TxIn
forall s. Decoder s TxIn
forall a s. DecCBOR a => Decoder s a
decCBOR