{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# 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.Hashes (EraIndependentTxBody, 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 = TxId {TxId -> SafeHash EraIndependentTxBody
unTxId :: SafeHash EraIndependentTxBody}
  deriving (Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxId] -> ShowS
$cshowList :: [TxId] -> ShowS
show :: TxId -> String
$cshow :: TxId -> String
showsPrec :: Int -> TxId -> ShowS
$cshowsPrec :: Int -> TxId -> ShowS
Show, TxId -> TxId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c== :: TxId -> TxId -> Bool
Eq, Eq 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
min :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmax :: TxId -> TxId -> TxId
>= :: TxId -> TxId -> Bool
$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
compare :: TxId -> TxId -> Ordering
$ccompare :: TxId -> TxId -> Ordering
Ord, 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
$cto :: forall x. Rep TxId x -> TxId
$cfrom :: forall x. TxId -> Rep TxId x
Generic)
  deriving newtype (Context -> TxId -> IO (Maybe ThunkInfo)
Proxy TxId -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy TxId -> String
$cshowTypeOf :: Proxy TxId -> String
wNoThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> TxId -> IO (Maybe ThunkInfo)
NoThunks, [TxId] -> Encoding
[TxId] -> Value
TxId -> Bool
TxId -> Encoding
TxId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: TxId -> Bool
$comitField :: TxId -> Bool
toEncodingList :: [TxId] -> Encoding
$ctoEncodingList :: [TxId] -> Encoding
toJSONList :: [TxId] -> Value
$ctoJSONList :: [TxId] -> Value
toEncoding :: TxId -> Encoding
$ctoEncoding :: TxId -> Encoding
toJSON :: TxId -> Value
$ctoJSON :: TxId -> Value
ToJSON, Maybe TxId
Value -> Parser [TxId]
Value -> Parser TxId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe TxId
$comittedField :: Maybe TxId
parseJSONList :: Value -> Parser [TxId]
$cparseJSONList :: Value -> Parser [TxId]
parseJSON :: Value -> Parser TxId
$cparseJSON :: Value -> Parser TxId
FromJSON, TxId -> Int
forall a. (a -> Int) -> HeapWords a
heapWords :: TxId -> Int
$cheapWords :: TxId -> Int
HeapWords, Typeable 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
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [TxId] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [TxId] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxId -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxId -> Size
encCBOR :: TxId -> Encoding
$cencCBOR :: TxId -> Encoding
EncCBOR, Typeable 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 ()
label :: Proxy TxId -> Text
$clabel :: Proxy TxId -> Text
dropCBOR :: forall s. Proxy TxId -> Decoder s ()
$cdropCBOR :: forall s. Proxy TxId -> Decoder s ()
decCBOR :: forall s. Decoder s TxId
$cdecCBOR :: forall s. Decoder s TxId
DecCBOR, TxId -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxId -> ()
$crnf :: TxId -> ()
NFData)

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

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

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

txInToText :: TxIn -> Text
txInToText :: TxIn -> Text
txInToText (TxIn (TxId SafeHash EraIndependentTxBody
txidHash) TxIx
ix) =
  forall h a. Hash h a -> Text
hashToTextAsHex (forall i. SafeHash i -> Hash HASH i
extractHash SafeHash 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 = TxIn !TxId {-# UNPACK #-} !TxIx
  deriving (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
$cto :: forall x. Rep TxIn x -> TxIn
$cfrom :: forall x. TxIn -> Rep TxIn x
Generic, TxIn -> TxIn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxIn -> TxIn -> Bool
$c/= :: TxIn -> TxIn -> Bool
== :: TxIn -> TxIn -> Bool
$c== :: TxIn -> TxIn -> Bool
Eq, Eq 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
min :: TxIn -> TxIn -> TxIn
$cmin :: TxIn -> TxIn -> TxIn
max :: TxIn -> TxIn -> TxIn
$cmax :: TxIn -> TxIn -> TxIn
>= :: TxIn -> TxIn -> Bool
$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
compare :: TxIn -> TxIn -> Ordering
$ccompare :: TxIn -> TxIn -> Ordering
Ord, Int -> TxIn -> ShowS
[TxIn] -> ShowS
TxIn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxIn] -> ShowS
$cshowList :: [TxIn] -> ShowS
show :: TxIn -> String
$cshow :: TxIn -> String
showsPrec :: Int -> TxIn -> ShowS
$cshowsPrec :: Int -> TxIn -> ShowS
Show)

-- | 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => 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
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR TxId
txId
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR TxIx
index

instance DecCBOR TxIn where
  decCBOR :: forall s. Decoder s TxIn
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)
      (TxId -> TxIx -> TxIn
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)