{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Shelley.TxOut (
ShelleyTxOut (ShelleyTxOut, TxOutCompact),
addrEitherShelleyTxOutL,
valueEitherShelleyTxOutL,
) where
import qualified Cardano.Crypto.Hash as HS
import Cardano.HeapWords (HeapWords (..))
import Cardano.Ledger.Address (Addr (..), CompactAddr, compactAddr, decompactAddr)
import Cardano.Ledger.Binary (
DecCBOR (..),
DecShareCBOR (..),
EncCBOR (..),
FromCBOR (..),
Interns (..),
ToCBOR (..),
decodeRecordNamed,
encodeListLen,
)
import Cardano.Ledger.Compactible (Compactible (CompactForm, fromCompact, toCompact))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Crypto (Crypto (ADDRHASH), StandardCrypto)
import Cardano.Ledger.Keys (KeyRole (..))
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams ()
import Cardano.Ledger.Val (Val)
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Control.DeepSeq (NFData (rnf))
import Data.ByteString.Short (ShortByteString, pack)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.Word (Word8)
import GHC.Stack (HasCallStack)
import Lens.Micro
import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))
data ShelleyTxOut era = TxOutCompact
{ forall era. ShelleyTxOut era -> CompactAddr (EraCrypto era)
txOutCompactAddr :: {-# UNPACK #-} !(CompactAddr (EraCrypto era))
, forall era. ShelleyTxOut era -> CompactForm (Value era)
txOutCompactValue :: !(CompactForm (Value era))
}
instance Crypto crypto => EraTxOut (ShelleyEra crypto) where
{-# SPECIALIZE instance EraTxOut (ShelleyEra StandardCrypto) #-}
type TxOut (ShelleyEra crypto) = ShelleyTxOut (ShelleyEra crypto)
mkBasicTxOut :: HasCallStack =>
Addr (EraCrypto (ShelleyEra crypto))
-> Value (ShelleyEra crypto) -> TxOut (ShelleyEra crypto)
mkBasicTxOut = forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut
upgradeTxOut :: EraTxOut (PreviousEra (ShelleyEra crypto)) =>
TxOut (PreviousEra (ShelleyEra crypto))
-> TxOut (ShelleyEra crypto)
upgradeTxOut = forall a. HasCallStack => [Char] -> a
error [Char]
"It is not possible to translate Byron TxOut with 'upgradeTxOut'"
addrEitherTxOutL :: Lens'
(TxOut (ShelleyEra crypto))
(Either
(Addr (EraCrypto (ShelleyEra crypto)))
(CompactAddr (EraCrypto (ShelleyEra crypto))))
addrEitherTxOutL = forall era.
Lens'
(ShelleyTxOut era)
(Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era)))
addrEitherShelleyTxOutL
{-# INLINE addrEitherTxOutL #-}
valueEitherTxOutL :: Lens'
(TxOut (ShelleyEra crypto))
(Either
(Value (ShelleyEra crypto))
(CompactForm (Value (ShelleyEra crypto))))
valueEitherTxOutL = forall era.
Val (Value era) =>
Lens'
(ShelleyTxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherShelleyTxOutL
{-# INLINE valueEitherTxOutL #-}
getMinCoinTxOut :: PParams (ShelleyEra crypto) -> TxOut (ShelleyEra crypto) -> Coin
getMinCoinTxOut PParams (ShelleyEra crypto)
pp TxOut (ShelleyEra crypto)
_ = PParams (ShelleyEra crypto)
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL
addrEitherShelleyTxOutL ::
Lens' (ShelleyTxOut era) (Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era)))
addrEitherShelleyTxOutL :: forall era.
Lens'
(ShelleyTxOut era)
(Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era)))
addrEitherShelleyTxOutL =
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ShelleyTxOut era -> CompactAddr (EraCrypto era)
txOutCompactAddr)
( \ShelleyTxOut era
txOut -> \case
Left Addr (EraCrypto era)
addr -> ShelleyTxOut era
txOut {txOutCompactAddr :: CompactAddr (EraCrypto era)
txOutCompactAddr = forall c. Addr c -> CompactAddr c
compactAddr Addr (EraCrypto era)
addr}
Right CompactAddr (EraCrypto era)
cAddr -> ShelleyTxOut era
txOut {txOutCompactAddr :: CompactAddr (EraCrypto era)
txOutCompactAddr = CompactAddr (EraCrypto era)
cAddr}
)
{-# INLINE addrEitherShelleyTxOutL #-}
valueEitherShelleyTxOutL ::
Val (Value era) => Lens' (ShelleyTxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherShelleyTxOutL :: forall era.
Val (Value era) =>
Lens'
(ShelleyTxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherShelleyTxOutL =
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ShelleyTxOut era -> CompactForm (Value era)
txOutCompactValue)
( \ShelleyTxOut era
txOut -> \case
Left Value era
value ->
ShelleyTxOut era
txOut
{ txOutCompactValue :: CompactForm (Value era)
txOutCompactValue =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Illegal value in TxOut: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value era
value) forall a b. (a -> b) -> a -> b
$ forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Value era
value
}
Right CompactForm (Value era)
cValue -> ShelleyTxOut era
txOut {txOutCompactValue :: CompactForm (Value era)
txOutCompactValue = CompactForm (Value era)
cValue}
)
{-# INLINE valueEitherShelleyTxOutL #-}
instance (Era era, HeapWords (CompactForm (Value era))) => HeapWords (ShelleyTxOut era) where
heapWords :: ShelleyTxOut era -> Int
heapWords (TxOutCompact CompactAddr (EraCrypto era)
_ CompactForm (Value era)
vl) =
Int
3
forall a. Num a => a -> a -> a
+ forall a. HeapWords a => a -> Int
heapWords (forall (proxy :: * -> *) era.
Crypto (EraCrypto era) =>
proxy era -> ShortByteString
packedADDRHASH (forall {k} (t :: k). Proxy t
Proxy :: Proxy era))
forall a. Num a => a -> a -> a
+ forall a. HeapWords a => a -> Int
heapWords CompactForm (Value era)
vl
instance (Era era, Val (Value era)) => Show (ShelleyTxOut era) where
show :: ShelleyTxOut era -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(Era era, Val (Value era)) =>
ShelleyTxOut era -> (Addr (EraCrypto era), Value era)
viewCompactTxOut
deriving instance Eq (CompactForm (Value era)) => Eq (ShelleyTxOut era)
instance NFData (ShelleyTxOut era) where
rnf :: ShelleyTxOut era -> ()
rnf = (seq :: forall a b. a -> b -> b
`seq` ())
deriving via InspectHeapNamed "TxOut" (ShelleyTxOut era) instance NoThunks (ShelleyTxOut era)
pattern ShelleyTxOut ::
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) ->
Value era ->
ShelleyTxOut era
pattern $bShelleyTxOut :: forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
$mShelleyTxOut :: forall {r} {era}.
(HasCallStack, Era era, Val (Value era)) =>
ShelleyTxOut era
-> (Addr (EraCrypto era) -> Value era -> r) -> ((# #) -> r) -> r
ShelleyTxOut addr vl <-
(viewCompactTxOut -> (addr, vl))
where
ShelleyTxOut Addr (EraCrypto era)
addr Value era
vl =
forall era.
CompactAddr (EraCrypto era)
-> CompactForm (Value era) -> ShelleyTxOut era
TxOutCompact
(forall c. Addr c -> CompactAddr c
compactAddr Addr (EraCrypto era)
addr)
(forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Illegal value in TxOut: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value era
vl) forall a b. (a -> b) -> a -> b
$ forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Value era
vl)
{-# COMPLETE ShelleyTxOut #-}
viewCompactTxOut ::
(Era era, Val (Value era)) => ShelleyTxOut era -> (Addr (EraCrypto era), Value era)
viewCompactTxOut :: forall era.
(Era era, Val (Value era)) =>
ShelleyTxOut era -> (Addr (EraCrypto era), Value era)
viewCompactTxOut TxOutCompact {CompactAddr (EraCrypto era)
txOutCompactAddr :: CompactAddr (EraCrypto era)
txOutCompactAddr :: forall era. ShelleyTxOut era -> CompactAddr (EraCrypto era)
txOutCompactAddr, CompactForm (Value era)
txOutCompactValue :: CompactForm (Value era)
txOutCompactValue :: forall era. ShelleyTxOut era -> CompactForm (Value era)
txOutCompactValue} =
(forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
txOutCompactAddr, forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
txOutCompactValue)
instance (Era era, EncCBOR (CompactForm (Value era))) => EncCBOR (ShelleyTxOut era) where
encCBOR :: ShelleyTxOut era -> Encoding
encCBOR (TxOutCompact CompactAddr (EraCrypto era)
addr CompactForm (Value era)
coin) =
Word -> Encoding
encodeListLen Word
2
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactAddr (EraCrypto era)
addr
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm (Value era)
coin
instance (Era era, DecCBOR (CompactForm (Value era))) => DecCBOR (ShelleyTxOut era) where
decCBOR :: forall s. Decoder s (ShelleyTxOut era)
decCBOR =
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyTxOut" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ do
CompactAddr (EraCrypto era)
cAddr <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall era.
CompactAddr (EraCrypto era)
-> CompactForm (Value era) -> ShelleyTxOut era
TxOutCompact CompactAddr (EraCrypto era)
cAddr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
instance (Era era, DecCBOR (CompactForm (Value era))) => DecShareCBOR (ShelleyTxOut era) where
type Share (ShelleyTxOut era) = Interns (Credential 'Staking (EraCrypto era))
decShareCBOR :: forall s. Share (ShelleyTxOut era) -> Decoder s (ShelleyTxOut era)
decShareCBOR Share (ShelleyTxOut era)
_ = forall a s. DecCBOR a => Decoder s a
decCBOR
instance (Era era, EncCBOR (CompactForm (Value era))) => ToCBOR (ShelleyTxOut era) where
toCBOR :: ShelleyTxOut era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era
instance (Era era, DecCBOR (CompactForm (Value era))) => FromCBOR (ShelleyTxOut era) where
fromCBOR :: forall s. Decoder s (ShelleyTxOut era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era
instance (Era era, Val (Value era)) => ToJSON (ShelleyTxOut era) where
toJSON :: ShelleyTxOut era -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a era.
(KeyValue e a, Era era, Val (Value era)) =>
ShelleyTxOut era -> [a]
toTxOutPair
toEncoding :: ShelleyTxOut era -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a era.
(KeyValue e a, Era era, Val (Value era)) =>
ShelleyTxOut era -> [a]
toTxOutPair
toTxOutPair :: (KeyValue e a, Era era, Val (Value era)) => ShelleyTxOut era -> [a]
toTxOutPair :: forall e a era.
(KeyValue e a, Era era, Val (Value era)) =>
ShelleyTxOut era -> [a]
toTxOutPair (ShelleyTxOut !Addr (EraCrypto era)
addr !Value era
amount) =
[ Key
"address" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Addr (EraCrypto era)
addr
, Key
"amount" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value era
amount
]
packedADDRHASH :: forall proxy era. Crypto (EraCrypto era) => proxy era -> ShortByteString
packedADDRHASH :: forall (proxy :: * -> *) era.
Crypto (EraCrypto era) =>
proxy era -> ShortByteString
packedADDRHASH proxy era
_ =
[Word8] -> ShortByteString
pack forall a b. (a -> b) -> a -> b
$
forall a. Int -> a -> [a]
replicate
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
1 forall a. Num a => a -> a -> a
+ Word
2 forall a. Num a => a -> a -> a
* forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
HS.sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ADDRHASH (EraCrypto era)))))
(Word8
1 :: Word8)