Merge pull request #5552 from IntersectMBO/qnikst/canonical-pots-v0

Introduce CanonicalCoin type

Author: qnikst

libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/BasicTypes.hs

@@ -6,14 +6,17 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Cardano.Ledger.CanonicalState.BasicTypes (
   OnChain (..),
   DecodeOnChain (..),
+  CanonicalCoin (..),
 ) where
 
+import Cardano.Ledger.Coin (Coin (..), CompactForm (CompactCoin))
 import Cardano.SCLS.CBOR.Canonical (CanonicalDecoder)
 import Cardano.SCLS.CBOR.Canonical.Decoder (FromCanonicalCBOR (..))
 import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..))
@@ -55,3 +58,18 @@ instance DecodeOnChain v a => FromCanonicalCBOR v (OnChain a) where
 -- `toPlainDecoder`.
 class DecodeOnChain (v :: Symbol) (a :: Type) where
   decodeOnChain :: BS.ByteString -> CanonicalDecoder s a
+
+-- | Wrapper for the coin type.
+--
+-- Despite the fact that Coin is on-chain type, we do not want to use
+-- 'OnChain' wrapper for it. Because it's expected that if we keep chain
+-- structure like transaction in canonical state, then we should keep entire
+-- structure there and keep that as a whole, like 'UTxOut'.
+newtype CanonicalCoin = CanonicalCoin {unCoin :: CompactForm Coin}
+  deriving (Eq, Ord, Show, Generic)
+
+instance FromCanonicalCBOR v CanonicalCoin where
+  fromCanonicalCBOR = fmap (CanonicalCoin . CompactCoin) <$> fromCanonicalCBOR
+
+instance ToCanonicalCBOR v CanonicalCoin where
+  toCanonicalCBOR v (CanonicalCoin (CompactCoin c)) = toCanonicalCBOR v c

libs/cardano-ledger-canonical-state/testlib/Test/Cardano/Ledger/CanonicalState/Arbitrary.hs

@@ -7,9 +7,11 @@
 
 module Test.Cardano.Ledger.CanonicalState.Arbitrary () where
 
+import Cardano.Ledger.CanonicalState.BasicTypes (CanonicalCoin (..))
 import Cardano.Ledger.CanonicalState.Conway ()
 import qualified Cardano.Ledger.CanonicalState.Namespace.Blocks.V0 as Blocks.V0
 import qualified Cardano.Ledger.CanonicalState.Namespace.UTxO.V0 as UtxoOut.V0
+import Cardano.Ledger.Coin (CompactForm (CompactCoin))
 import Cardano.Ledger.Core (Era, EraTxOut, TxOut)
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.QuickCheck (Arbitrary (..), Positive (..))
@@ -21,3 +23,6 @@ instance Arbitrary Blocks.V0.BlockOut where
 
 instance (EraTxOut era, Arbitrary (TxOut era), Era era) => Arbitrary (UtxoOut.V0.UtxoOut era) where
   arbitrary = UtxoOut.V0.mkUtxo <$> arbitrary
+
+instance Arbitrary CanonicalCoin where
+  arbitrary = CanonicalCoin . CompactCoin <$> arbitrary