{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}


-- | Transaction bodies
--
module Cardano.Api.TxIn (
    -- * Transaction inputs
    TxIn(..),
    TxIx(..),

    -- * Transaction Ids
    TxId(..),
    parseTxId,

    -- * Data family instances
    AsType(AsTxId),

    -- * Internal conversion functions
    toByronTxId,
    toShelleyTxId,
    fromShelleyTxId,
    toByronTxIn,
    fromByronTxIn,
    toShelleyTxIn,
    fromShelleyTxIn,
    renderTxIn,
  ) where

import           Control.Applicative (some)
import           Data.Aeson (withText)
import qualified Data.Aeson as Aeson
import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)

import qualified Data.ByteString.Char8 as BSC
import           Data.String
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Text.Parsec as Parsec
import           Text.Parsec ((<?>))
import qualified Text.Parsec.Language as Parsec
import qualified Text.Parsec.String as Parsec
import qualified Text.Parsec.Token as Parsec

import qualified Cardano.Crypto.Hash.Class as Crypto

import qualified Cardano.Chain.UTxO as Byron
import qualified Cardano.Crypto.Hashing as Byron

import qualified Cardano.Ledger.BaseTypes as Ledger
import           Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Keys as Shelley
import qualified Cardano.Ledger.SafeHash as SafeHash

import qualified Cardano.Ledger.Shelley.TxBody as Shelley
import qualified Cardano.Ledger.TxIn as Ledger

import           Cardano.Api.Error
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.SerialiseJSON
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.Utils

{- HLINT ignore "Redundant flip" -}
{- HLINT ignore "Use section" -}

-- ----------------------------------------------------------------------------
-- Transaction Ids
--

newtype TxId = TxId (Shelley.Hash StandardCrypto Shelley.EraIndependentTxBody)
  -- We use the Shelley representation and convert to/from the Byron one
  deriving stock (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)
  deriving (Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TxId] -> ShowS
$cshowList :: [TxId] -> ShowS
show :: TxId -> [Char]
$cshow :: TxId -> [Char]
showsPrec :: Int -> TxId -> ShowS
$cshowsPrec :: Int -> TxId -> ShowS
Show, [Char] -> TxId
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> TxId
$cfromString :: [Char] -> TxId
IsString)         via UsingRawBytesHex TxId
  deriving ([TxId] -> Value
[TxId] -> Encoding
TxId -> Value
TxId -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
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, Value -> Parser [TxId]
Value -> Parser TxId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxId]
$cparseJSONList :: Value -> Parser [TxId]
parseJSON :: Value -> Parser TxId
$cparseJSON :: Value -> Parser TxId
FromJSON)       via UsingRawBytesHex TxId
  deriving (ToJSONKeyFunction [TxId]
ToJSONKeyFunction TxId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [TxId]
$ctoJSONKeyList :: ToJSONKeyFunction [TxId]
toJSONKey :: ToJSONKeyFunction TxId
$ctoJSONKey :: ToJSONKeyFunction TxId
ToJSONKey, FromJSONKeyFunction [TxId]
FromJSONKeyFunction TxId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [TxId]
$cfromJSONKeyList :: FromJSONKeyFunction [TxId]
fromJSONKey :: FromJSONKeyFunction TxId
$cfromJSONKey :: FromJSONKeyFunction TxId
FromJSONKey) via UsingRawBytesHex TxId

instance HasTypeProxy TxId where
    data AsType TxId = AsTxId
    proxyToAsType :: Proxy TxId -> AsType TxId
proxyToAsType Proxy TxId
_ = AsType TxId
AsTxId

instance SerialiseAsRawBytes TxId where
    serialiseToRawBytes :: TxId -> ByteString
serialiseToRawBytes (TxId Hash StandardCrypto EraIndependentTxBody
h) = forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash StandardCrypto EraIndependentTxBody
h
    deserialiseFromRawBytes :: AsType TxId -> ByteString -> Either SerialiseAsRawBytesError TxId
deserialiseFromRawBytes AsType TxId
R:AsTypeTxId
AsTxId ByteString
bs = case forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs of
      Just Hash Blake2b_256 EraIndependentTxBody
a -> forall a b. b -> Either a b
Right (Hash StandardCrypto EraIndependentTxBody -> TxId
TxId Hash Blake2b_256 EraIndependentTxBody
a)
      Maybe (Hash Blake2b_256 EraIndependentTxBody)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char] -> SerialiseAsRawBytesError
SerialiseAsRawBytesError [Char]
"Unable to deserialise TxId"

toByronTxId :: TxId -> Byron.TxId
toByronTxId :: TxId -> TxId
toByronTxId (TxId Hash StandardCrypto EraIndependentTxBody
h) =
    forall a. ByteString -> Hash a
Byron.unsafeHashFromBytes (forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash StandardCrypto EraIndependentTxBody
h)

toShelleyTxId :: TxId -> Ledger.TxId StandardCrypto
toShelleyTxId :: TxId -> TxId StandardCrypto
toShelleyTxId (TxId Hash StandardCrypto EraIndependentTxBody
h) =
    forall crypto. SafeHash crypto EraIndependentTxBody -> TxId crypto
Ledger.TxId (forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
SafeHash.unsafeMakeSafeHash (forall h a b. Hash h a -> Hash h b
Crypto.castHash Hash StandardCrypto EraIndependentTxBody
h))

fromShelleyTxId :: Ledger.TxId StandardCrypto -> TxId
fromShelleyTxId :: TxId StandardCrypto -> TxId
fromShelleyTxId (Ledger.TxId SafeHash StandardCrypto EraIndependentTxBody
h) =
    Hash StandardCrypto EraIndependentTxBody -> TxId
TxId (forall h a b. Hash h a -> Hash h b
Crypto.castHash (forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
SafeHash.extractHash SafeHash StandardCrypto EraIndependentTxBody
h))


-- ----------------------------------------------------------------------------
-- Transaction inputs
--

data TxIn = TxIn TxId TxIx
  deriving (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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TxIn] -> ShowS
$cshowList :: [TxIn] -> ShowS
show :: TxIn -> [Char]
$cshow :: TxIn -> [Char]
showsPrec :: Int -> TxIn -> ShowS
$cshowsPrec :: Int -> TxIn -> ShowS
Show)

instance ToJSON TxIn where
  toJSON :: TxIn -> Value
toJSON TxIn
txIn = Text -> Value
Aeson.String forall a b. (a -> b) -> a -> b
$ TxIn -> Text
renderTxIn TxIn
txIn

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

instance FromJSON TxIn where
  parseJSON :: Value -> Parser TxIn
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"TxIn" forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Text -> Parser a
runParsecParser Parser TxIn
parseTxIn

instance FromJSONKey TxIn where
  fromJSONKey :: FromJSONKeyFunction TxIn
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Text -> Parser a
runParsecParser Parser TxIn
parseTxIn

parseTxId :: Parsec.Parser TxId
parseTxId :: Parser TxId
parseTxId = do
  [Char]
str <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.hexDigit forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"transaction id (hexadecimal)"
  forall (m :: * -> *) e a.
MonadFail m =>
(e -> [Char]) -> Either e a -> m a
failEitherWith
    (\RawBytesHexError
e -> [Char]
"Incorrect transaction id format: " forall a. [a] -> [a] -> [a]
++ forall e. Error e => e -> [Char]
displayError RawBytesHexError
e) forall a b. (a -> b) -> a -> b
$
    forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType TxId
AsTxId forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BSC.pack [Char]
str

parseTxIn :: Parsec.Parser TxIn
parseTxIn :: Parser TxIn
parseTxIn = TxId -> TxIx -> TxIn
TxIn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TxId
parseTxId forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'#' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Char] () Identity TxIx
parseTxIx)

parseTxIx :: Parsec.Parser TxIx
parseTxIx :: ParsecT [Char] () Identity TxIx
parseTxIx = Word -> TxIx
TxIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
decimal

decimal :: Parsec.Parser Integer
Parsec.TokenParser { decimal :: forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
Parsec.decimal = Parser Integer
decimal } = forall st. TokenParser st
Parsec.haskell


renderTxIn :: TxIn -> Text
renderTxIn :: TxIn -> Text
renderTxIn (TxIn TxId
txId (TxIx Word
ix)) =
  forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
txId forall a. Semigroup a => a -> a -> a
<> Text
"#" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show Word
ix)


newtype TxIx = TxIx Word
  deriving stock (TxIx -> TxIx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxIx -> TxIx -> Bool
$c/= :: TxIx -> TxIx -> Bool
== :: TxIx -> TxIx -> Bool
$c== :: TxIx -> TxIx -> Bool
Eq, Eq TxIx
TxIx -> TxIx -> Bool
TxIx -> TxIx -> Ordering
TxIx -> TxIx -> TxIx
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 :: TxIx -> TxIx -> TxIx
$cmin :: TxIx -> TxIx -> TxIx
max :: TxIx -> TxIx -> TxIx
$cmax :: TxIx -> TxIx -> TxIx
>= :: TxIx -> TxIx -> Bool
$c>= :: TxIx -> TxIx -> Bool
> :: TxIx -> TxIx -> Bool
$c> :: TxIx -> TxIx -> Bool
<= :: TxIx -> TxIx -> Bool
$c<= :: TxIx -> TxIx -> Bool
< :: TxIx -> TxIx -> Bool
$c< :: TxIx -> TxIx -> Bool
compare :: TxIx -> TxIx -> Ordering
$ccompare :: TxIx -> TxIx -> Ordering
Ord, Int -> TxIx -> ShowS
[TxIx] -> ShowS
TxIx -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TxIx] -> ShowS
$cshowList :: [TxIx] -> ShowS
show :: TxIx -> [Char]
$cshow :: TxIx -> [Char]
showsPrec :: Int -> TxIx -> ShowS
$cshowsPrec :: Int -> TxIx -> ShowS
Show)
  deriving newtype (Int -> TxIx
TxIx -> Int
TxIx -> [TxIx]
TxIx -> TxIx
TxIx -> TxIx -> [TxIx]
TxIx -> TxIx -> TxIx -> [TxIx]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TxIx -> TxIx -> TxIx -> [TxIx]
$cenumFromThenTo :: TxIx -> TxIx -> TxIx -> [TxIx]
enumFromTo :: TxIx -> TxIx -> [TxIx]
$cenumFromTo :: TxIx -> TxIx -> [TxIx]
enumFromThen :: TxIx -> TxIx -> [TxIx]
$cenumFromThen :: TxIx -> TxIx -> [TxIx]
enumFrom :: TxIx -> [TxIx]
$cenumFrom :: TxIx -> [TxIx]
fromEnum :: TxIx -> Int
$cfromEnum :: TxIx -> Int
toEnum :: Int -> TxIx
$ctoEnum :: Int -> TxIx
pred :: TxIx -> TxIx
$cpred :: TxIx -> TxIx
succ :: TxIx -> TxIx
$csucc :: TxIx -> TxIx
Enum)
  deriving newtype ([TxIx] -> Value
[TxIx] -> Encoding
TxIx -> Value
TxIx -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxIx] -> Encoding
$ctoEncodingList :: [TxIx] -> Encoding
toJSONList :: [TxIx] -> Value
$ctoJSONList :: [TxIx] -> Value
toEncoding :: TxIx -> Encoding
$ctoEncoding :: TxIx -> Encoding
toJSON :: TxIx -> Value
$ctoJSON :: TxIx -> Value
ToJSON, Value -> Parser [TxIx]
Value -> Parser TxIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxIx]
$cparseJSONList :: Value -> Parser [TxIx]
parseJSON :: Value -> Parser TxIx
$cparseJSON :: Value -> Parser TxIx
FromJSON)

fromByronTxIn :: Byron.TxIn -> TxIn
fromByronTxIn :: TxIn -> TxIn
fromByronTxIn (Byron.TxInUtxo TxId
txId Word16
index) =
  let shortBs :: ShortByteString
shortBs = forall algo a. AbstractHash algo a -> ShortByteString
Byron.abstractHashToShort TxId
txId
      mApiHash :: Maybe (Hash Blake2b_256 EraIndependentTxBody)
mApiHash = forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
Crypto.hashFromBytesShort ShortByteString
shortBs
  in case Maybe (Hash Blake2b_256 EraIndependentTxBody)
mApiHash of
       Just Hash Blake2b_256 EraIndependentTxBody
apiHash -> TxId -> TxIx -> TxIn
TxIn (Hash StandardCrypto EraIndependentTxBody -> TxId
TxId Hash Blake2b_256 EraIndependentTxBody
apiHash) (Word -> TxIx
TxIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Word16
index)
       Maybe (Hash Blake2b_256 EraIndependentTxBody)
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Error converting Byron era TxId: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show TxId
txId

toByronTxIn :: TxIn -> Byron.TxIn
toByronTxIn :: TxIn -> TxIn
toByronTxIn (TxIn TxId
txid (TxIx Word
txix)) =
    TxId -> Word16 -> TxIn
Byron.TxInUtxo (TxId -> TxId
toByronTxId TxId
txid) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
txix)

-- | This function may overflow on the transaction index. Call sites must ensure
-- that all uses of this function are appropriately guarded.
toShelleyTxIn :: TxIn -> Ledger.TxIn StandardCrypto
toShelleyTxIn :: TxIn -> TxIn StandardCrypto
toShelleyTxIn (TxIn TxId
txid (TxIx Word
txix)) =
    forall crypto. TxId crypto -> TxIx -> TxIn crypto
Ledger.TxIn (TxId -> TxId StandardCrypto
toShelleyTxId TxId
txid) (Word64 -> TxIx
Ledger.TxIx forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
txix)

fromShelleyTxIn :: Ledger.TxIn StandardCrypto -> TxIn
fromShelleyTxIn :: TxIn StandardCrypto -> TxIn
fromShelleyTxIn (Ledger.TxIn TxId StandardCrypto
txid (Ledger.TxIx Word64
txix)) =
    TxId -> TxIx -> TxIn
TxIn (TxId StandardCrypto -> TxId
fromShelleyTxId TxId StandardCrypto
txid) (Word -> TxIx
TxIx (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
txix))