{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.CanonicalState.Namespace.UTxO.V0 (
  UtxoIn (..),
  UtxoOut (..),
  mkUtxo,
) where

import Cardano.Ledger.Binary (decodeFull', encCBOR, serialize')
import Cardano.Ledger.CanonicalState.BasicTypes
import Cardano.Ledger.Core (EraScript, EraTxOut, TxOut, eraProtVerLow)
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.SCLS.CBOR.Canonical.Decoder as D
import Cardano.SCLS.CBOR.Canonical.Encoder
import Cardano.SCLS.CDDL ()
import Cardano.SCLS.Entry.IsKey (IsKey (..))
import Cardano.SCLS.NamespaceCodec
import Data.MemPack
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)

-- | Key for the UTxO entry.
newtype UtxoIn
  = UtxoKeyIn TxIn
  deriving (UtxoIn -> UtxoIn -> Bool
(UtxoIn -> UtxoIn -> Bool)
-> (UtxoIn -> UtxoIn -> Bool) -> Eq UtxoIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UtxoIn -> UtxoIn -> Bool
== :: UtxoIn -> UtxoIn -> Bool
$c/= :: UtxoIn -> UtxoIn -> Bool
/= :: UtxoIn -> UtxoIn -> Bool
Eq, Eq UtxoIn
Eq UtxoIn =>
(UtxoIn -> UtxoIn -> Ordering)
-> (UtxoIn -> UtxoIn -> Bool)
-> (UtxoIn -> UtxoIn -> Bool)
-> (UtxoIn -> UtxoIn -> Bool)
-> (UtxoIn -> UtxoIn -> Bool)
-> (UtxoIn -> UtxoIn -> UtxoIn)
-> (UtxoIn -> UtxoIn -> UtxoIn)
-> Ord UtxoIn
UtxoIn -> UtxoIn -> Bool
UtxoIn -> UtxoIn -> Ordering
UtxoIn -> UtxoIn -> UtxoIn
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 :: UtxoIn -> UtxoIn -> Ordering
compare :: UtxoIn -> UtxoIn -> Ordering
$c< :: UtxoIn -> UtxoIn -> Bool
< :: UtxoIn -> UtxoIn -> Bool
$c<= :: UtxoIn -> UtxoIn -> Bool
<= :: UtxoIn -> UtxoIn -> Bool
$c> :: UtxoIn -> UtxoIn -> Bool
> :: UtxoIn -> UtxoIn -> Bool
$c>= :: UtxoIn -> UtxoIn -> Bool
>= :: UtxoIn -> UtxoIn -> Bool
$cmax :: UtxoIn -> UtxoIn -> UtxoIn
max :: UtxoIn -> UtxoIn -> UtxoIn
$cmin :: UtxoIn -> UtxoIn -> UtxoIn
min :: UtxoIn -> UtxoIn -> UtxoIn
Ord, Int -> UtxoIn -> ShowS
[UtxoIn] -> ShowS
UtxoIn -> String
(Int -> UtxoIn -> ShowS)
-> (UtxoIn -> String) -> ([UtxoIn] -> ShowS) -> Show UtxoIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UtxoIn -> ShowS
showsPrec :: Int -> UtxoIn -> ShowS
$cshow :: UtxoIn -> String
show :: UtxoIn -> String
$cshowList :: [UtxoIn] -> ShowS
showList :: [UtxoIn] -> ShowS
Show)
  deriving ((forall x. UtxoIn -> Rep UtxoIn x)
-> (forall x. Rep UtxoIn x -> UtxoIn) -> Generic UtxoIn
forall x. Rep UtxoIn x -> UtxoIn
forall x. UtxoIn -> Rep UtxoIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UtxoIn -> Rep UtxoIn x
from :: forall x. UtxoIn -> Rep UtxoIn x
$cto :: forall x. Rep UtxoIn x -> UtxoIn
to :: forall x. Rep UtxoIn x -> UtxoIn
Generic)

instance IsKey UtxoIn where
  keySize :: Int
keySize = forall (ns :: Symbol). KnownNat (NamespaceKeySize ns) => Int
namespaceKeySize @"utxo/v0"
  packKeyM :: forall b. UtxoIn -> Pack b ()
packKeyM (UtxoKeyIn TxIn
txIn) = TxIn -> Pack b ()
forall s. TxIn -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM TxIn
txIn
  unpackKeyM :: forall b s. Buffer b => Unpack' s b UtxoIn
unpackKeyM = TxIn -> UtxoIn
UtxoKeyIn (TxIn -> UtxoIn) -> Unpack s b TxIn -> Unpack s b UtxoIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack s b TxIn
forall a b s. (MemPack a, Buffer b) => Unpack s b a
forall b s. Buffer b => Unpack s b TxIn
unpackM

instance CanonicalCBOREntryEncoder "utxo/v0" (UtxoOut era) where
  encodeEntry :: UtxoOut era -> CanonicalEncoding
encodeEntry UtxoOut era
n = Proxy "utxo/v0" -> UtxoOut era -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy "utxo/v0" -> UtxoOut era -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"utxo/v0") UtxoOut era
n

instance
  DecodeOnChain "utxo/v0" (TxOut era) =>
  CanonicalCBOREntryDecoder "utxo/v0" (UtxoOut era)
  where
  decodeEntry :: forall s. CanonicalDecoder s (Versioned "utxo/v0" (UtxoOut era))
decodeEntry = CanonicalDecoder s (Versioned "utxo/v0" (UtxoOut era))
forall s. CanonicalDecoder s (Versioned "utxo/v0" (UtxoOut era))
forall (v :: Symbol) a s.
FromCanonicalCBOR v a =>
CanonicalDecoder s (Versioned v a)
fromCanonicalCBOR

instance ToCanonicalCBOR "utxo/v0" (UtxoOut era) where
  toCanonicalCBOR :: forall (proxy :: Symbol -> *).
proxy "utxo/v0" -> UtxoOut era -> CanonicalEncoding
toCanonicalCBOR proxy "utxo/v0"
v (UtxoOut OnChain (TxOut era)
out) = proxy "utxo/v0" -> OnChain (TxOut era) -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy "utxo/v0" -> OnChain (TxOut era) -> CanonicalEncoding
toCanonicalCBOR proxy "utxo/v0"
v OnChain (TxOut era)
out

instance
  DecodeOnChain "utxo/v0" (TxOut era) =>
  FromCanonicalCBOR "utxo/v0" (UtxoOut era)
  where
  fromCanonicalCBOR :: forall s. CanonicalDecoder s (Versioned "utxo/v0" (UtxoOut era))
fromCanonicalCBOR = (OnChain (TxOut era) -> UtxoOut era)
-> Versioned "utxo/v0" (OnChain (TxOut era))
-> Versioned "utxo/v0" (UtxoOut era)
forall a b.
(a -> b) -> Versioned "utxo/v0" a -> Versioned "utxo/v0" b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OnChain (TxOut era) -> UtxoOut era
forall era. OnChain (TxOut era) -> UtxoOut era
UtxoOut (Versioned "utxo/v0" (OnChain (TxOut era))
 -> Versioned "utxo/v0" (UtxoOut era))
-> CanonicalDecoder s (Versioned "utxo/v0" (OnChain (TxOut era)))
-> CanonicalDecoder s (Versioned "utxo/v0" (UtxoOut era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CanonicalDecoder s (Versioned "utxo/v0" (OnChain (TxOut era)))
forall s.
CanonicalDecoder s (Versioned "utxo/v0" (OnChain (TxOut era)))
forall (v :: Symbol) a s.
FromCanonicalCBOR v a =>
CanonicalDecoder s (Versioned v a)
fromCanonicalCBOR

-- | As Utxo should represent an on chain data it's encoding should be
-- extactly the same as on the wire protocol. But because the structure
-- and types may not be the same in different eras we just keep a final
-- encoding here.
newtype UtxoOut era = UtxoOut (OnChain (TxOut era))

deriving instance
  Eq (TxOut era) =>
  Eq (UtxoOut era)

deriving instance
  Show (TxOut era) =>
  Show (UtxoOut era)

mkUtxo :: forall era. EraTxOut era => TxOut era -> UtxoOut era
mkUtxo :: forall era. EraTxOut era => TxOut era -> UtxoOut era
mkUtxo TxOut era
txOut =
  OnChain (TxOut era) -> UtxoOut era
forall era. OnChain (TxOut era) -> UtxoOut era
UtxoOut (OnChain (TxOut era) -> UtxoOut era)
-> OnChain (TxOut era) -> UtxoOut era
forall a b. (a -> b) -> a -> b
$ TxOut era -> ByteString -> OnChain (TxOut era)
forall a. a -> ByteString -> OnChain a
OnChain TxOut era
txOut (ByteString -> OnChain (TxOut era))
-> ByteString -> OnChain (TxOut era)
forall a b. (a -> b) -> a -> b
$ Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' (forall era. Era era => Version
eraProtVerLow @era) (TxOut era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR TxOut era
txOut)

instance (EraTxOut era, EraScript era, TxOut era ~ x) => DecodeOnChain "utxo/v0" x where
  decodeOnChain :: forall s. ByteString -> CanonicalDecoder s x
decodeOnChain = (DecoderError -> CanonicalDecoder s x)
-> (x -> CanonicalDecoder s x)
-> Either DecoderError x
-> CanonicalDecoder s x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> CanonicalDecoder s x
forall a. String -> CanonicalDecoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> CanonicalDecoder s x)
-> (DecoderError -> String) -> DecoderError -> CanonicalDecoder s x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall a. Show a => a -> String
show) x -> CanonicalDecoder s x
forall a. a -> CanonicalDecoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecoderError x -> CanonicalDecoder s x)
-> (ByteString -> Either DecoderError x)
-> ByteString
-> CanonicalDecoder s x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> ByteString -> Either DecoderError x
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' (forall era. Era era => Version
eraProtVerLow @era)