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

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

import Cardano.Crypto.Hash.Class (hashToTextAsHex)
import Cardano.HeapWords (HeapWords (..))
import qualified Cardano.HeapWords as HW
import Cardano.Ledger.BaseTypes (TxIx (..), mkTxIxPartial)
import Cardano.Ledger.Binary (DecCBOR (decCBOR), EncCBOR (..), decodeRecordNamed, encodeListLen)
import Cardano.Ledger.Crypto
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.SafeHash (SafeHash, extractHash)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON (..))
import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
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 c = TxId {forall c. TxId c -> SafeHash c EraIndependentTxBody
unTxId :: SafeHash c EraIndependentTxBody}
  deriving (Int -> TxId c -> ShowS
forall c. Int -> TxId c -> ShowS
forall c. [TxId c] -> ShowS
forall c. TxId c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxId c] -> ShowS
$cshowList :: forall c. [TxId c] -> ShowS
show :: TxId c -> String
$cshow :: forall c. TxId c -> String
showsPrec :: Int -> TxId c -> ShowS
$cshowsPrec :: forall c. Int -> TxId c -> ShowS
Show, TxId c -> TxId c -> Bool
forall c. TxId c -> TxId c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId c -> TxId c -> Bool
$c/= :: forall c. TxId c -> TxId c -> Bool
== :: TxId c -> TxId c -> Bool
$c== :: forall c. TxId c -> TxId c -> Bool
Eq, TxId c -> TxId c -> Bool
TxId c -> TxId c -> Ordering
TxId c -> TxId c -> TxId c
forall c. Eq (TxId c)
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
forall c. TxId c -> TxId c -> Bool
forall c. TxId c -> TxId c -> Ordering
forall c. TxId c -> TxId c -> TxId c
min :: TxId c -> TxId c -> TxId c
$cmin :: forall c. TxId c -> TxId c -> TxId c
max :: TxId c -> TxId c -> TxId c
$cmax :: forall c. TxId c -> TxId c -> TxId c
>= :: TxId c -> TxId c -> Bool
$c>= :: forall c. TxId c -> TxId c -> Bool
> :: TxId c -> TxId c -> Bool
$c> :: forall c. TxId c -> TxId c -> Bool
<= :: TxId c -> TxId c -> Bool
$c<= :: forall c. TxId c -> TxId c -> Bool
< :: TxId c -> TxId c -> Bool
$c< :: forall c. TxId c -> TxId c -> Bool
compare :: TxId c -> TxId c -> Ordering
$ccompare :: forall c. TxId c -> TxId c -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (TxId c) x -> TxId c
forall c x. TxId c -> Rep (TxId c) x
$cto :: forall c x. Rep (TxId c) x -> TxId c
$cfrom :: forall c x. TxId c -> Rep (TxId c) x
Generic)
  deriving newtype (Context -> TxId c -> IO (Maybe ThunkInfo)
Proxy (TxId c) -> String
forall c. Context -> TxId c -> IO (Maybe ThunkInfo)
forall c. Proxy (TxId c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxId c) -> String
$cshowTypeOf :: forall c. Proxy (TxId c) -> String
wNoThunks :: Context -> TxId c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> TxId c -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> TxId c -> IO (Maybe ThunkInfo)
NoThunks, [TxId c] -> Encoding
[TxId c] -> Value
TxId c -> Bool
TxId c -> Encoding
TxId c -> Value
forall c. Crypto c => [TxId c] -> Encoding
forall c. Crypto c => [TxId c] -> Value
forall c. Crypto c => TxId c -> Bool
forall c. Crypto c => TxId c -> Encoding
forall c. Crypto c => TxId c -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: TxId c -> Bool
$comitField :: forall c. Crypto c => TxId c -> Bool
toEncodingList :: [TxId c] -> Encoding
$ctoEncodingList :: forall c. Crypto c => [TxId c] -> Encoding
toJSONList :: [TxId c] -> Value
$ctoJSONList :: forall c. Crypto c => [TxId c] -> Value
toEncoding :: TxId c -> Encoding
$ctoEncoding :: forall c. Crypto c => TxId c -> Encoding
toJSON :: TxId c -> Value
$ctoJSON :: forall c. Crypto c => TxId c -> Value
ToJSON, Maybe (TxId c)
Value -> Parser [TxId c]
Value -> Parser (TxId c)
forall c. Crypto c => Maybe (TxId c)
forall c. Crypto c => Value -> Parser [TxId c]
forall c. Crypto c => Value -> Parser (TxId c)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe (TxId c)
$comittedField :: forall c. Crypto c => Maybe (TxId c)
parseJSONList :: Value -> Parser [TxId c]
$cparseJSONList :: forall c. Crypto c => Value -> Parser [TxId c]
parseJSON :: Value -> Parser (TxId c)
$cparseJSON :: forall c. Crypto c => Value -> Parser (TxId c)
FromJSON)

deriving newtype instance Crypto c => HeapWords (TxId c)

deriving newtype instance Crypto c => EncCBOR (TxId c)

deriving newtype instance Crypto c => DecCBOR (TxId c)

deriving newtype instance Crypto c => NFData (TxId c)

instance Crypto c => HeapWords (TxIn c) where
  heapWords :: TxIn c -> Int
heapWords (TxIn TxId c
txId TxIx
_) =
    Int
2 forall a. Num a => a -> a -> a
+ forall a. HeapWords a => a -> Int
HW.heapWords TxId c
txId forall a. Num a => a -> a -> a
+ Int
1 {- txIx -}

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

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

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

-- | The input of a UTxO.
data TxIn c = TxIn !(TxId c) {-# UNPACK #-} !TxIx
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (TxIn c) x -> TxIn c
forall c x. TxIn c -> Rep (TxIn c) x
$cto :: forall c x. Rep (TxIn c) x -> TxIn c
$cfrom :: forall c x. TxIn c -> Rep (TxIn c) x
Generic)

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

deriving instance Eq (TxIn c)

deriving instance Ord (TxIn c)

deriving instance Show (TxIn c)

deriving instance Crypto c => NFData (TxIn c)

instance NoThunks (TxIn c)

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

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