{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

-- | The UTxO is large and is kept in-memory. It is important to use as
-- small a representation as possible to keep overall memory use reasonable.
--
-- This module provides a special compact representation for data types
-- contained within the UTxO.
--
-- The idea here is that the compact representation is optimised only for
-- storage size and does not have to be the same as the representation used
-- when operating on the data. Conversion functions are to be used when
-- inserting and retrieving values from the UTxO.
module Cardano.Chain.UTxO.Compact (
  CompactTxIn (..),
  toCompactTxIn,
  fromCompactTxIn,
  CompactTxId,
  toCompactTxId,
  fromCompactTxId,
  CompactTxOut (..),
  toCompactTxOut,
  fromCompactTxOut,
) where

import Cardano.Chain.Common.Compact (
  CompactAddress,
  fromCompactAddress,
  toCompactAddress,
 )
import Cardano.Chain.Common.Lovelace (Lovelace)
import Cardano.Chain.UTxO.Tx (TxId, TxIn (..), TxOut (..))
import Cardano.Crypto.Hashing (hashToBytes, unsafeHashFromBytes)
import Cardano.HeapWords (HeapWords (..), heapWordsUnpacked)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Data.Binary.Get (Get, getWord64le, runGet)
import Data.Binary.Put (Put, putWord64le, runPut)
import qualified Data.ByteString.Lazy as BSL (fromStrict, toStrict)
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- Compact TxIn
--------------------------------------------------------------------------------

-- | A compact in-memory representation for a 'TxIn'.
--
-- Convert using 'toCompactTxIn' and 'fromCompactTxIn'.
data CompactTxIn
  = CompactTxInUtxo
      {-# UNPACK #-} !CompactTxId
      {-# UNPACK #-} !Word16
  deriving (CompactTxIn -> CompactTxIn -> Bool
(CompactTxIn -> CompactTxIn -> Bool)
-> (CompactTxIn -> CompactTxIn -> Bool) -> Eq CompactTxIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactTxIn -> CompactTxIn -> Bool
== :: CompactTxIn -> CompactTxIn -> Bool
$c/= :: CompactTxIn -> CompactTxIn -> Bool
/= :: CompactTxIn -> CompactTxIn -> Bool
Eq, Eq CompactTxIn
Eq CompactTxIn =>
(CompactTxIn -> CompactTxIn -> Ordering)
-> (CompactTxIn -> CompactTxIn -> Bool)
-> (CompactTxIn -> CompactTxIn -> Bool)
-> (CompactTxIn -> CompactTxIn -> Bool)
-> (CompactTxIn -> CompactTxIn -> Bool)
-> (CompactTxIn -> CompactTxIn -> CompactTxIn)
-> (CompactTxIn -> CompactTxIn -> CompactTxIn)
-> Ord CompactTxIn
CompactTxIn -> CompactTxIn -> Bool
CompactTxIn -> CompactTxIn -> Ordering
CompactTxIn -> CompactTxIn -> CompactTxIn
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 :: CompactTxIn -> CompactTxIn -> Ordering
compare :: CompactTxIn -> CompactTxIn -> Ordering
$c< :: CompactTxIn -> CompactTxIn -> Bool
< :: CompactTxIn -> CompactTxIn -> Bool
$c<= :: CompactTxIn -> CompactTxIn -> Bool
<= :: CompactTxIn -> CompactTxIn -> Bool
$c> :: CompactTxIn -> CompactTxIn -> Bool
> :: CompactTxIn -> CompactTxIn -> Bool
$c>= :: CompactTxIn -> CompactTxIn -> Bool
>= :: CompactTxIn -> CompactTxIn -> Bool
$cmax :: CompactTxIn -> CompactTxIn -> CompactTxIn
max :: CompactTxIn -> CompactTxIn -> CompactTxIn
$cmin :: CompactTxIn -> CompactTxIn -> CompactTxIn
min :: CompactTxIn -> CompactTxIn -> CompactTxIn
Ord, (forall x. CompactTxIn -> Rep CompactTxIn x)
-> (forall x. Rep CompactTxIn x -> CompactTxIn)
-> Generic CompactTxIn
forall x. Rep CompactTxIn x -> CompactTxIn
forall x. CompactTxIn -> Rep CompactTxIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompactTxIn -> Rep CompactTxIn x
from :: forall x. CompactTxIn -> Rep CompactTxIn x
$cto :: forall x. Rep CompactTxIn x -> CompactTxIn
to :: forall x. Rep CompactTxIn x -> CompactTxIn
Generic, Int -> CompactTxIn -> ShowS
[CompactTxIn] -> ShowS
CompactTxIn -> String
(Int -> CompactTxIn -> ShowS)
-> (CompactTxIn -> String)
-> ([CompactTxIn] -> ShowS)
-> Show CompactTxIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompactTxIn -> ShowS
showsPrec :: Int -> CompactTxIn -> ShowS
$cshow :: CompactTxIn -> String
show :: CompactTxIn -> String
$cshowList :: [CompactTxIn] -> ShowS
showList :: [CompactTxIn] -> ShowS
Show)
  deriving anyclass (CompactTxIn -> ()
(CompactTxIn -> ()) -> NFData CompactTxIn
forall a. (a -> ()) -> NFData a
$crnf :: CompactTxIn -> ()
rnf :: CompactTxIn -> ()
NFData, Context -> CompactTxIn -> IO (Maybe ThunkInfo)
Proxy CompactTxIn -> String
(Context -> CompactTxIn -> IO (Maybe ThunkInfo))
-> (Context -> CompactTxIn -> IO (Maybe ThunkInfo))
-> (Proxy CompactTxIn -> String)
-> NoThunks CompactTxIn
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy CompactTxIn -> String
showTypeOf :: Proxy CompactTxIn -> String
NoThunks)

instance HeapWords CompactTxIn where
  heapWords :: CompactTxIn -> Int
heapWords CompactTxIn
_ =
    -- We have
    --
    -- > data CompactTxIn = CompactTxInUtxo {-# UNPACK #-} !CompactTxId
    -- >                                    {-# UNPACK #-} !Word16
    --
    -- so 'CompactTxInUtxo' requires:
    --
    -- - 1 word for the 'CompactTxInUtxo' object header
    -- - 4 words (on a 64-bit arch) for the unpacked 'CompactTxId'
    -- - 1 word for the unpacked 'Word16'
    --
    -- +---------------------------------------------+
    -- │CompactTxInUtxo│Word#|Word#│Word#│Word#│Word#│
    -- +---------------------------------------------+
    --
    Int
6

instance ToCBOR CompactTxIn where
  toCBOR :: CompactTxIn -> Encoding
toCBOR = CompactTxIn -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR CompactTxIn where
  fromCBOR :: forall s. Decoder s CompactTxIn
fromCBOR = Decoder s CompactTxIn
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance DecCBOR CompactTxIn where
  decCBOR :: forall s. Decoder s CompactTxIn
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"CompactTxIn" Int
2
    CompactTxId -> Word16 -> CompactTxIn
CompactTxInUtxo
      (CompactTxId -> Word16 -> CompactTxIn)
-> Decoder s CompactTxId -> Decoder s (Word16 -> CompactTxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s CompactTxId
forall s. Decoder s CompactTxId
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (Word16 -> CompactTxIn)
-> Decoder s Word16 -> Decoder s CompactTxIn
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 Word16
forall s. Decoder s Word16
forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR CompactTxIn where
  encCBOR :: CompactTxIn -> Encoding
encCBOR (CompactTxInUtxo CompactTxId
txId Word16
txIndex) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactTxId -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactTxId
txId
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word16
txIndex

toCompactTxIn :: TxIn -> CompactTxIn
toCompactTxIn :: TxIn -> CompactTxIn
toCompactTxIn (TxInUtxo TxId
txId Word16
txIndex) =
  CompactTxId -> Word16 -> CompactTxIn
CompactTxInUtxo (TxId -> CompactTxId
toCompactTxId TxId
txId) Word16
txIndex

fromCompactTxIn :: CompactTxIn -> TxIn
fromCompactTxIn :: CompactTxIn -> TxIn
fromCompactTxIn (CompactTxInUtxo CompactTxId
compactTxId Word16
txIndex) =
  TxId -> Word16 -> TxIn
TxInUtxo (CompactTxId -> TxId
fromCompactTxId CompactTxId
compactTxId) Word16
txIndex

--------------------------------------------------------------------------------
-- Compact TxId
--------------------------------------------------------------------------------

-- | A compact in-memory representation for a 'TxId'.
--
-- Convert using 'toCompactTxId' and 'fromCompactTxId'.
--
-- Compared to a normal 'TxId', this takes 5 heap words rather than 12.
data CompactTxId
  = CompactTxId
      {-# UNPACK #-} !Word64
      {-# UNPACK #-} !Word64
      {-# UNPACK #-} !Word64
      {-# UNPACK #-} !Word64
  deriving (CompactTxId -> CompactTxId -> Bool
(CompactTxId -> CompactTxId -> Bool)
-> (CompactTxId -> CompactTxId -> Bool) -> Eq CompactTxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactTxId -> CompactTxId -> Bool
== :: CompactTxId -> CompactTxId -> Bool
$c/= :: CompactTxId -> CompactTxId -> Bool
/= :: CompactTxId -> CompactTxId -> Bool
Eq, (forall x. CompactTxId -> Rep CompactTxId x)
-> (forall x. Rep CompactTxId x -> CompactTxId)
-> Generic CompactTxId
forall x. Rep CompactTxId x -> CompactTxId
forall x. CompactTxId -> Rep CompactTxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompactTxId -> Rep CompactTxId x
from :: forall x. CompactTxId -> Rep CompactTxId x
$cto :: forall x. Rep CompactTxId x -> CompactTxId
to :: forall x. Rep CompactTxId x -> CompactTxId
Generic, Eq CompactTxId
Eq CompactTxId =>
(CompactTxId -> CompactTxId -> Ordering)
-> (CompactTxId -> CompactTxId -> Bool)
-> (CompactTxId -> CompactTxId -> Bool)
-> (CompactTxId -> CompactTxId -> Bool)
-> (CompactTxId -> CompactTxId -> Bool)
-> (CompactTxId -> CompactTxId -> CompactTxId)
-> (CompactTxId -> CompactTxId -> CompactTxId)
-> Ord CompactTxId
CompactTxId -> CompactTxId -> Bool
CompactTxId -> CompactTxId -> Ordering
CompactTxId -> CompactTxId -> CompactTxId
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 :: CompactTxId -> CompactTxId -> Ordering
compare :: CompactTxId -> CompactTxId -> Ordering
$c< :: CompactTxId -> CompactTxId -> Bool
< :: CompactTxId -> CompactTxId -> Bool
$c<= :: CompactTxId -> CompactTxId -> Bool
<= :: CompactTxId -> CompactTxId -> Bool
$c> :: CompactTxId -> CompactTxId -> Bool
> :: CompactTxId -> CompactTxId -> Bool
$c>= :: CompactTxId -> CompactTxId -> Bool
>= :: CompactTxId -> CompactTxId -> Bool
$cmax :: CompactTxId -> CompactTxId -> CompactTxId
max :: CompactTxId -> CompactTxId -> CompactTxId
$cmin :: CompactTxId -> CompactTxId -> CompactTxId
min :: CompactTxId -> CompactTxId -> CompactTxId
Ord, Int -> CompactTxId -> ShowS
[CompactTxId] -> ShowS
CompactTxId -> String
(Int -> CompactTxId -> ShowS)
-> (CompactTxId -> String)
-> ([CompactTxId] -> ShowS)
-> Show CompactTxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompactTxId -> ShowS
showsPrec :: Int -> CompactTxId -> ShowS
$cshow :: CompactTxId -> String
show :: CompactTxId -> String
$cshowList :: [CompactTxId] -> ShowS
showList :: [CompactTxId] -> ShowS
Show)
  deriving anyclass (CompactTxId -> ()
(CompactTxId -> ()) -> NFData CompactTxId
forall a. (a -> ()) -> NFData a
$crnf :: CompactTxId -> ()
rnf :: CompactTxId -> ()
NFData, Context -> CompactTxId -> IO (Maybe ThunkInfo)
Proxy CompactTxId -> String
(Context -> CompactTxId -> IO (Maybe ThunkInfo))
-> (Context -> CompactTxId -> IO (Maybe ThunkInfo))
-> (Proxy CompactTxId -> String)
-> NoThunks CompactTxId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy CompactTxId -> String
showTypeOf :: Proxy CompactTxId -> String
NoThunks)

instance HeapWords CompactTxId where
  heapWords :: CompactTxId -> Int
heapWords CompactTxId
_ =
    -- We have
    --
    -- > data CompactTxId = CompactTxId {-# UNPACK #-} !Word64
    -- >                                {-# UNPACK #-} !Word64
    -- >                                {-# UNPACK #-} !Word64
    -- >                                {-# UNPACK #-} !Word64
    --
    -- so 'CompactTxId' requires:
    --
    -- - 1 word for the 'CompactTxId' object header
    -- - 1 word (on a 64-bit arch) for the unpacked 'Word64'
    -- - 1 word (on a 64-bit arch) for the unpacked 'Word64'
    -- - 1 word (on a 64-bit arch) for the unpacked 'Word64'
    -- - 1 word (on a 64-bit arch) for the unpacked 'Word64'
    --
    -- +-----------------------------------+
    -- │CompactTxId│Word#│Word#│Word#│Word#│
    -- +-----------------------------------+
    --
    Int
5

instance ToCBOR CompactTxId where
  toCBOR :: CompactTxId -> Encoding
toCBOR = CompactTxId -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR CompactTxId where
  fromCBOR :: forall s. Decoder s CompactTxId
fromCBOR = Decoder s CompactTxId
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance DecCBOR CompactTxId where
  decCBOR :: forall s. Decoder s CompactTxId
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"CompactTxId" Int
4
    Word64 -> Word64 -> Word64 -> Word64 -> CompactTxId
CompactTxId
      (Word64 -> Word64 -> Word64 -> Word64 -> CompactTxId)
-> Decoder s Word64
-> Decoder s (Word64 -> Word64 -> Word64 -> CompactTxId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (Word64 -> Word64 -> Word64 -> CompactTxId)
-> Decoder s Word64 -> Decoder s (Word64 -> Word64 -> CompactTxId)
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 Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (Word64 -> Word64 -> CompactTxId)
-> Decoder s Word64 -> Decoder s (Word64 -> CompactTxId)
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 Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (Word64 -> CompactTxId)
-> Decoder s Word64 -> Decoder s CompactTxId
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 Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR CompactTxId where
  encCBOR :: CompactTxId -> Encoding
encCBOR (CompactTxId Word64
a Word64
b Word64
c Word64
d) =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
a
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
b
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
c
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
d

getCompactTxId :: Get CompactTxId
getCompactTxId :: Get CompactTxId
getCompactTxId =
  Word64 -> Word64 -> Word64 -> Word64 -> CompactTxId
CompactTxId
    (Word64 -> Word64 -> Word64 -> Word64 -> CompactTxId)
-> Get Word64 -> Get (Word64 -> Word64 -> Word64 -> CompactTxId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
    Get (Word64 -> Word64 -> Word64 -> CompactTxId)
-> Get Word64 -> Get (Word64 -> Word64 -> CompactTxId)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
    Get (Word64 -> Word64 -> CompactTxId)
-> Get Word64 -> Get (Word64 -> CompactTxId)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
    Get (Word64 -> CompactTxId) -> Get Word64 -> Get CompactTxId
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le

putCompactTxId :: CompactTxId -> Put
putCompactTxId :: CompactTxId -> Put
putCompactTxId (CompactTxId Word64
a Word64
b Word64
c Word64
d) =
  Word64 -> Put
putWord64le Word64
a
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
b
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
c
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
d

toCompactTxId :: TxId -> CompactTxId
toCompactTxId :: TxId -> CompactTxId
toCompactTxId =
  Get CompactTxId -> ByteString -> CompactTxId
forall a. Get a -> ByteString -> a
runGet Get CompactTxId
getCompactTxId (ByteString -> CompactTxId)
-> (TxId -> ByteString) -> TxId -> CompactTxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (TxId -> ByteString) -> TxId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId -> ByteString
forall algo a. AbstractHash algo a -> ByteString
hashToBytes

fromCompactTxId :: CompactTxId -> TxId
fromCompactTxId :: CompactTxId -> TxId
fromCompactTxId =
  ByteString -> TxId
forall a. ByteString -> Hash a
unsafeHashFromBytes (ByteString -> TxId)
-> (CompactTxId -> ByteString) -> CompactTxId -> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (CompactTxId -> ByteString) -> CompactTxId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Put -> ByteString
runPut (Put -> ByteString)
-> (CompactTxId -> Put) -> CompactTxId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CompactTxId -> Put
putCompactTxId

--------------------------------------------------------------------------------
-- Compact TxOut
--------------------------------------------------------------------------------

-- | A compact in-memory representation for a 'TxOut'.
--
-- Convert using 'toCompactTxOut' and 'fromCompactTxOut'.
data CompactTxOut
  = CompactTxOut
      {-# UNPACK #-} !CompactAddress
      {-# UNPACK #-} !Lovelace
  deriving (CompactTxOut -> CompactTxOut -> Bool
(CompactTxOut -> CompactTxOut -> Bool)
-> (CompactTxOut -> CompactTxOut -> Bool) -> Eq CompactTxOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactTxOut -> CompactTxOut -> Bool
== :: CompactTxOut -> CompactTxOut -> Bool
$c/= :: CompactTxOut -> CompactTxOut -> Bool
/= :: CompactTxOut -> CompactTxOut -> Bool
Eq, Eq CompactTxOut
Eq CompactTxOut =>
(CompactTxOut -> CompactTxOut -> Ordering)
-> (CompactTxOut -> CompactTxOut -> Bool)
-> (CompactTxOut -> CompactTxOut -> Bool)
-> (CompactTxOut -> CompactTxOut -> Bool)
-> (CompactTxOut -> CompactTxOut -> Bool)
-> (CompactTxOut -> CompactTxOut -> CompactTxOut)
-> (CompactTxOut -> CompactTxOut -> CompactTxOut)
-> Ord CompactTxOut
CompactTxOut -> CompactTxOut -> Bool
CompactTxOut -> CompactTxOut -> Ordering
CompactTxOut -> CompactTxOut -> CompactTxOut
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 :: CompactTxOut -> CompactTxOut -> Ordering
compare :: CompactTxOut -> CompactTxOut -> Ordering
$c< :: CompactTxOut -> CompactTxOut -> Bool
< :: CompactTxOut -> CompactTxOut -> Bool
$c<= :: CompactTxOut -> CompactTxOut -> Bool
<= :: CompactTxOut -> CompactTxOut -> Bool
$c> :: CompactTxOut -> CompactTxOut -> Bool
> :: CompactTxOut -> CompactTxOut -> Bool
$c>= :: CompactTxOut -> CompactTxOut -> Bool
>= :: CompactTxOut -> CompactTxOut -> Bool
$cmax :: CompactTxOut -> CompactTxOut -> CompactTxOut
max :: CompactTxOut -> CompactTxOut -> CompactTxOut
$cmin :: CompactTxOut -> CompactTxOut -> CompactTxOut
min :: CompactTxOut -> CompactTxOut -> CompactTxOut
Ord, (forall x. CompactTxOut -> Rep CompactTxOut x)
-> (forall x. Rep CompactTxOut x -> CompactTxOut)
-> Generic CompactTxOut
forall x. Rep CompactTxOut x -> CompactTxOut
forall x. CompactTxOut -> Rep CompactTxOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompactTxOut -> Rep CompactTxOut x
from :: forall x. CompactTxOut -> Rep CompactTxOut x
$cto :: forall x. Rep CompactTxOut x -> CompactTxOut
to :: forall x. Rep CompactTxOut x -> CompactTxOut
Generic, Int -> CompactTxOut -> ShowS
[CompactTxOut] -> ShowS
CompactTxOut -> String
(Int -> CompactTxOut -> ShowS)
-> (CompactTxOut -> String)
-> ([CompactTxOut] -> ShowS)
-> Show CompactTxOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompactTxOut -> ShowS
showsPrec :: Int -> CompactTxOut -> ShowS
$cshow :: CompactTxOut -> String
show :: CompactTxOut -> String
$cshowList :: [CompactTxOut] -> ShowS
showList :: [CompactTxOut] -> ShowS
Show)
  deriving anyclass (CompactTxOut -> ()
(CompactTxOut -> ()) -> NFData CompactTxOut
forall a. (a -> ()) -> NFData a
$crnf :: CompactTxOut -> ()
rnf :: CompactTxOut -> ()
NFData, Context -> CompactTxOut -> IO (Maybe ThunkInfo)
Proxy CompactTxOut -> String
(Context -> CompactTxOut -> IO (Maybe ThunkInfo))
-> (Context -> CompactTxOut -> IO (Maybe ThunkInfo))
-> (Proxy CompactTxOut -> String)
-> NoThunks CompactTxOut
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy CompactTxOut -> String
showTypeOf :: Proxy CompactTxOut -> String
NoThunks)

instance HeapWords CompactTxOut where
  heapWords :: CompactTxOut -> Int
heapWords (CompactTxOut CompactAddress
compactAddr Lovelace
_) =
    -- We have
    --
    -- > data CompactTxOut = CompactTxOut {-# UNPACK #-} !CompactAddress
    -- >                                  {-# UNPACK #-} !Lovelace
    -- > newtype CompactAddress = CompactAddress ShortByteString
    -- > newtype Lovelace = Lovelace { getLovelace :: Word64 }
    --
    -- so @CompactTxOut {-# UNPACK #-} !CompactAddress {-# UNPACK #-} !Lovelace@
    -- requires:
    --
    -- - 1 word for the 'CompactTxOut' object header
    -- - 1 word for the pointer to the byte array object
    -- - 1 word (on a 64-bit arch) for the unpacked 'Word64' ('Lovelace')
    -- - the heap words required by the byte array object
    --
    -- Note that for the sake of uniformity, we use 'heapWordsUnpacked' to
    -- account for the level of indirection removed by the @UNPACK@ pragma.
    --
    -- +----------------------+
    -- │CompactTxOut│ * │Word#│
    -- +--------------+-------+
    --                |
    --                v
    --                +--------------+
    --                │BA#│sz│payload│
    --                +--------------+
    --
    Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CompactAddress -> Int
forall a. HeapWords a => a -> Int
heapWordsUnpacked CompactAddress
compactAddr

instance ToCBOR CompactTxOut where
  toCBOR :: CompactTxOut -> Encoding
toCBOR = CompactTxOut -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR CompactTxOut where
  fromCBOR :: forall s. Decoder s CompactTxOut
fromCBOR = Decoder s CompactTxOut
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance DecCBOR CompactTxOut where
  decCBOR :: forall s. Decoder s CompactTxOut
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"CompactTxOut" Int
2
    CompactAddress -> Lovelace -> CompactTxOut
CompactTxOut
      (CompactAddress -> Lovelace -> CompactTxOut)
-> Decoder s CompactAddress -> Decoder s (Lovelace -> CompactTxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s CompactAddress
forall s. Decoder s CompactAddress
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (Lovelace -> CompactTxOut)
-> Decoder s Lovelace -> Decoder s CompactTxOut
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 Lovelace
forall s. Decoder s Lovelace
forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR CompactTxOut where
  encCBOR :: CompactTxOut -> Encoding
encCBOR (CompactTxOut CompactAddress
compactAddr Lovelace
lovelace) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactAddress -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactAddress
compactAddr
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Lovelace
lovelace

toCompactTxOut :: TxOut -> CompactTxOut
toCompactTxOut :: TxOut -> CompactTxOut
toCompactTxOut (TxOut Address
addr Lovelace
lovelace) =
  CompactAddress -> Lovelace -> CompactTxOut
CompactTxOut (Address -> CompactAddress
toCompactAddress Address
addr) Lovelace
lovelace

fromCompactTxOut :: CompactTxOut -> TxOut
fromCompactTxOut :: CompactTxOut -> TxOut
fromCompactTxOut (CompactTxOut CompactAddress
compactAddr Lovelace
lovelace) =
  Address -> Lovelace -> TxOut
TxOut (CompactAddress -> Address
fromCompactAddress CompactAddress
compactAddr) Lovelace
lovelace