Remove non-canonical types

Author: qnikst

libs/cardano-ledger-canonical-state/cardano-ledger-canonical-state.cabal

@@ -37,7 +37,6 @@ library
   exposed-modules:
     Cardano.Ledger.CanonicalState.BasicTypes
     Cardano.Ledger.CanonicalState.Namespace.Blocks.V0
-    Cardano.Ledger.CanonicalState.Namespace.Pots.V0
     Cardano.Ledger.CanonicalState.Namespace.UTxO.V0
 
   hs-source-dirs: src
@@ -51,7 +50,6 @@ library
     scls-cardano,
     scls-cbor,
     scls-core,
-    text,
 
 library conway
   import: warnings
@@ -80,7 +78,6 @@ library testlib
     cardano-ledger-canonical-state:{cardano-ledger-canonical-state, conway},
     cardano-ledger-conway:testlib,
     cardano-ledger-core,
-    generic-random,
 
 test-suite tests
   import: warnings

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

@@ -14,10 +14,9 @@ module Cardano.Ledger.CanonicalState.BasicTypes (
   OnChain (..),
   DecodeOnChain (..),
   CanonicalCoin (..),
-  IsCanonicalCoin (..),
 ) where
 
-import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
+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 (..))
@@ -60,33 +59,17 @@ instance DecodeOnChain v a => FromCanonicalCBOR v (OnChain a) where
 class DecodeOnChain (v :: Symbol) (a :: Type) where
   decodeOnChain :: BS.ByteString -> CanonicalDecoder s a
 
--- | Wrapper for the coin type
-newtype CanonicalCoin = CanonicalCoin {unCoin :: Integer}
+-- | 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)
 
--- | We introduce type class here because Coin can be created from multiple types.
-class IsCanonicalCoin a where
-  mkCanonicalCoin :: a -> CanonicalCoin
-  fromCanonicalCoin :: CanonicalCoin -> a
-
-instance IsCanonicalCoin CanonicalCoin where
-  mkCanonicalCoin = id
-  fromCanonicalCoin = id
-
-instance IsCanonicalCoin Coin where
-  mkCanonicalCoin Coin {..} = CanonicalCoin {..}
-  fromCanonicalCoin (CanonicalCoin i) = Coin i
-
-instance IsCanonicalCoin (CompactForm Coin) where
-  mkCanonicalCoin (CompactCoin ci) = CanonicalCoin (fromIntegral ci)
-  fromCanonicalCoin (CanonicalCoin ci) = CompactCoin (fromIntegral ci)
-
-instance IsCanonicalCoin Integer where
-  mkCanonicalCoin = CanonicalCoin
-  fromCanonicalCoin (CanonicalCoin ci) = ci
+instance FromCanonicalCBOR v CanonicalCoin where
+  fromCanonicalCBOR = fmap (CanonicalCoin . CompactCoin) <$> fromCanonicalCBOR
 
 instance ToCanonicalCBOR v CanonicalCoin where
-  toCanonicalCBOR v (CanonicalCoin ci) = toCanonicalCBOR v ci
-
-instance FromCanonicalCBOR v CanonicalCoin where
-  fromCanonicalCBOR = fmap CanonicalCoin <$> fromCanonicalCBOR
+  toCanonicalCBOR v (CanonicalCoin (CompactCoin c)) = toCanonicalCBOR v c

libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/Namespace/Pots/V0.hs

@@ -9,7 +9,6 @@ module Test.Cardano.Ledger.CanonicalState.Spec (spec) where
 
 import Cardano.Ledger.CanonicalState.Conway ()
 import qualified Cardano.Ledger.CanonicalState.Namespace.Blocks.V0 as Blocks.V0
-import qualified Cardano.Ledger.CanonicalState.Namespace.Pots.V0 as Pots.V0
 import qualified Cardano.Ledger.CanonicalState.Namespace.UTxO.V0 as UTxO.V0
 import Cardano.Ledger.Conway (ConwayEra)
 import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..))
@@ -25,15 +24,11 @@ spec = do
     describe "blocks/v0" $ do
       isCanonical @"blocks/v0" @Blocks.V0.BlockOut
       validateType @"blocks/v0" @Blocks.V0.BlockOut "record_entry"
-    describe "pots/v0" $ do
-      isCanonical @"pots/v0" @Pots.V0.PotsOut
-      validateType @"pots/v0" @Pots.V0.PotsOut "record_entry"
     describe "utxo/v0" $ do
       isCanonical @"utxo/v0" @(UTxO.V0.UtxoOut ConwayEra)
       validateType @"utxo/v0" @(UTxO.V0.UtxoOut ConwayEra) "record_entry"
   describe "namespaces" $ do
     testNS @"blocks/v0"
-    testNS @"pots/v0"
     testNS @"utxo/v0"
 
 isCanonical ::

libs/cardano-ledger-canonical-state/test/Test/Cardano/Ledger/CanonicalState/Spec.hs

@@ -10,10 +10,9 @@ 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.Pots.V0 as Pots.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 Generic.Random (genericArbitraryU)
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.QuickCheck (Arbitrary (..), Positive (..))
 
@@ -26,7 +25,4 @@ instance (EraTxOut era, Arbitrary (TxOut era), Era era) => Arbitrary (UtxoOut.V0
   arbitrary = UtxoOut.V0.mkUtxo <$> arbitrary
 
 instance Arbitrary CanonicalCoin where
-  arbitrary = CanonicalCoin . fromIntegral . getPositive @Integer <$> arbitrary
-
-instance Arbitrary Pots.V0.PotsOut where
-  arbitrary = genericArbitraryU
+  arbitrary = CanonicalCoin . CompactCoin <$> arbitrary