{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, enforceSize)
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.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
/= :: CompactTxIn -> CompactTxIn -> Bool
$c/= :: CompactTxIn -> CompactTxIn -> Bool
== :: CompactTxIn -> CompactTxIn -> Bool
$c== :: 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
min :: CompactTxIn -> CompactTxIn -> CompactTxIn
$cmin :: CompactTxIn -> CompactTxIn -> CompactTxIn
max :: CompactTxIn -> CompactTxIn -> CompactTxIn
$cmax :: CompactTxIn -> CompactTxIn -> CompactTxIn
>= :: CompactTxIn -> CompactTxIn -> Bool
$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
compare :: CompactTxIn -> CompactTxIn -> Ordering
$ccompare :: CompactTxIn -> CompactTxIn -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep CompactTxIn x -> CompactTxIn
$cfrom :: forall x. CompactTxIn -> Rep CompactTxIn x
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
showList :: [CompactTxIn] -> ShowS
$cshowList :: [CompactTxIn] -> ShowS
show :: CompactTxIn -> String
$cshow :: CompactTxIn -> String
showsPrec :: Int -> CompactTxIn -> ShowS
$cshowsPrec :: Int -> CompactTxIn -> ShowS
Show)
  deriving anyclass (CompactTxIn -> ()
(CompactTxIn -> ()) -> NFData CompactTxIn
forall a. (a -> ()) -> NFData a
rnf :: CompactTxIn -> ()
$crnf :: 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
showTypeOf :: Proxy CompactTxIn -> String
$cshowTypeOf :: Proxy CompactTxIn -> String
wNoThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactTxIn -> IO (Maybe ThunkInfo)
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 FromCBOR CompactTxIn where
  fromCBOR :: Decoder s CompactTxIn
fromCBOR = 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 a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Word16 -> CompactTxIn)
-> Decoder s Word16 -> Decoder s CompactTxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word16
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR CompactTxIn where
  toCBOR :: CompactTxIn -> Encoding
toCBOR (CompactTxInUtxo CompactTxId
txId Word16
txIndex) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactTxId -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactTxId
txId
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR 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
/= :: CompactTxId -> CompactTxId -> Bool
$c/= :: CompactTxId -> CompactTxId -> Bool
== :: CompactTxId -> CompactTxId -> Bool
$c== :: 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
$cto :: forall x. Rep CompactTxId x -> CompactTxId
$cfrom :: forall x. CompactTxId -> Rep CompactTxId x
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
min :: CompactTxId -> CompactTxId -> CompactTxId
$cmin :: CompactTxId -> CompactTxId -> CompactTxId
max :: CompactTxId -> CompactTxId -> CompactTxId
$cmax :: CompactTxId -> CompactTxId -> CompactTxId
>= :: CompactTxId -> CompactTxId -> Bool
$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
compare :: CompactTxId -> CompactTxId -> Ordering
$ccompare :: CompactTxId -> CompactTxId -> Ordering
$cp1Ord :: Eq 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
showList :: [CompactTxId] -> ShowS
$cshowList :: [CompactTxId] -> ShowS
show :: CompactTxId -> String
$cshow :: CompactTxId -> String
showsPrec :: Int -> CompactTxId -> ShowS
$cshowsPrec :: Int -> CompactTxId -> ShowS
Show)
  deriving anyclass (CompactTxId -> ()
(CompactTxId -> ()) -> NFData CompactTxId
forall a. (a -> ()) -> NFData a
rnf :: CompactTxId -> ()
$crnf :: 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
showTypeOf :: Proxy CompactTxId -> String
$cshowTypeOf :: Proxy CompactTxId -> String
wNoThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactTxId -> IO (Maybe ThunkInfo)
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 FromCBOR CompactTxId where
  fromCBOR :: Decoder s CompactTxId
fromCBOR = 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 a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Word64 -> Word64 -> Word64 -> CompactTxId)
-> Decoder s Word64 -> Decoder s (Word64 -> Word64 -> CompactTxId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Word64 -> Word64 -> CompactTxId)
-> Decoder s Word64 -> Decoder s (Word64 -> CompactTxId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Word64 -> CompactTxId)
-> Decoder s Word64 -> Decoder s CompactTxId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR CompactTxId where
  toCBOR :: CompactTxId -> Encoding
toCBOR (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. ToCBOR a => a -> Encoding
toCBOR Word64
a
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
b
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
c
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR 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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
    Get (Word64 -> CompactTxId) -> Get Word64 -> Get CompactTxId
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
b
    Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
c
    Put -> Put -> Put
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 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 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 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 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 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
/= :: CompactTxOut -> CompactTxOut -> Bool
$c/= :: CompactTxOut -> CompactTxOut -> Bool
== :: CompactTxOut -> CompactTxOut -> Bool
$c== :: 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
min :: CompactTxOut -> CompactTxOut -> CompactTxOut
$cmin :: CompactTxOut -> CompactTxOut -> CompactTxOut
max :: CompactTxOut -> CompactTxOut -> CompactTxOut
$cmax :: CompactTxOut -> CompactTxOut -> CompactTxOut
>= :: CompactTxOut -> CompactTxOut -> Bool
$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
compare :: CompactTxOut -> CompactTxOut -> Ordering
$ccompare :: CompactTxOut -> CompactTxOut -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep CompactTxOut x -> CompactTxOut
$cfrom :: forall x. CompactTxOut -> Rep CompactTxOut x
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
showList :: [CompactTxOut] -> ShowS
$cshowList :: [CompactTxOut] -> ShowS
show :: CompactTxOut -> String
$cshow :: CompactTxOut -> String
showsPrec :: Int -> CompactTxOut -> ShowS
$cshowsPrec :: Int -> CompactTxOut -> ShowS
Show)
  deriving anyclass (CompactTxOut -> ()
(CompactTxOut -> ()) -> NFData CompactTxOut
forall a. (a -> ()) -> NFData a
rnf :: CompactTxOut -> ()
$crnf :: 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
showTypeOf :: Proxy CompactTxOut -> String
$cshowTypeOf :: Proxy CompactTxOut -> String
wNoThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactTxOut -> IO (Maybe ThunkInfo)
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 FromCBOR CompactTxOut where
  fromCBOR :: Decoder s CompactTxOut
fromCBOR = 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 a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Lovelace -> CompactTxOut)
-> Decoder s Lovelace -> Decoder s CompactTxOut
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Lovelace
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR CompactTxOut where
  toCBOR :: CompactTxOut -> Encoding
toCBOR (CompactTxOut CompactAddress
compactAddr Lovelace
lovelace) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactAddress -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactAddress
compactAddr
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR 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