Skip to content

Introduce pots/v0 namespace for canonical state #5552

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
qnikst wants to merge 1 commit into
base: master
Choose a base branch
from
+140 −0
Open

Introduce pots/v0 namespace for canonical state #5552

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions libs/cardano-ledger-canonical-state/cardano-ledger-canonical-state.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,7 @@ 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
Expand All @@ -50,6 +51,7 @@ library
scls-cardano,
scls-cbor,
scls-core,
text,

library conway
import: warnings
Expand Down Expand Up @@ -78,6 +80,7 @@ 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
Expand Down
35 changes: 35 additions & 0 deletions libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/BasicTypes.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,14 +6,18 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.CanonicalState.BasicTypes (
OnChain (..),
DecodeOnChain (..),
CanonicalCoin (..),
IsCanonicalCoin (..),
) where

import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.SCLS.CBOR.Canonical (CanonicalDecoder)
import Cardano.SCLS.CBOR.Canonical.Decoder (FromCanonicalCBOR (..))
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..))
Expand Down Expand Up @@ -55,3 +59,34 @@ 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
newtype CanonicalCoin = CanonicalCoin {unCoin :: Integer}
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 ToCanonicalCBOR v CanonicalCoin where
toCanonicalCBOR v (CanonicalCoin ci) = toCanonicalCBOR v ci

instance FromCanonicalCBOR v CanonicalCoin where
fromCanonicalCBOR = fmap CanonicalCoin <$> fromCanonicalCBOR
88 changes: 88 additions & 0 deletions libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/Namespace/Pots/V0.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,88 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.CanonicalState.Namespace.Pots.V0 (
PotsIn (..),
PotsOut (..),
) where

import Cardano.Ledger.BaseTypes (EpochNo (..))
import Cardano.Ledger.CanonicalState.BasicTypes (CanonicalCoin (..))
import Cardano.SCLS.CBOR.Canonical.Decoder (FromCanonicalCBOR (..), decodeMapLenCanonicalOf)
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..), encodeAsMap, mkEncodablePair)
import Cardano.SCLS.Entry.IsKey (IsKey (..))
import Cardano.SCLS.NamespaceCodec (
CanonicalCBOREntryDecoder (..),
CanonicalCBOREntryEncoder (..),
KnownNamespace (..),
namespaceKeySize,
)
import Cardano.SCLS.Versioned (Versioned (..))
import Data.MemPack.ByteOrdered (packWord64beM, unpackBigEndianM)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import GHC.Generics (Generic)

instance KnownNamespace "pots/v0" where
type NamespaceKey "pots/v0" = PotsIn
type NamespaceEntry "pots/v0" = PotsOut

newtype PotsIn = PotsIn EpochNo
deriving (Eq, Ord, Show)

instance IsKey PotsIn where
keySize = namespaceKeySize @"pots/v0"
packKeyM (PotsIn (EpochNo epochNo)) = do
packWord64beM epochNo
unpackKeyM = do
epochNo <- unpackBigEndianM
return $ PotsIn (EpochNo epochNo)

data PotsOut = PotsOut
{ poFee :: !CanonicalCoin
, poDeposit :: !CanonicalCoin
, poDonation :: !CanonicalCoin
, poReserves :: !CanonicalCoin
, poTreasury :: !CanonicalCoin
}
deriving (Eq, Show)
deriving (Generic)

instance ToCanonicalCBOR "pots/v0" PotsOut where
toCanonicalCBOR v PotsOut {..} =
encodeAsMap
[ mkEncodablePair v ("fee" :: Text) poFee
, mkEncodablePair v ("deposit" :: Text) poDeposit
, mkEncodablePair v ("donation" :: Text) poDonation
, mkEncodablePair v ("reserves" :: Text) poReserves
, mkEncodablePair v ("treasury" :: Text) poTreasury
]

instance FromCanonicalCBOR "pots/v0" PotsOut where
fromCanonicalCBOR = do
decodeMapLenCanonicalOf 5
Versioned ("fee" :: Text) <- fromCanonicalCBOR
Versioned poFee <- fromCanonicalCBOR
Versioned ("deposit" :: Text) <- fromCanonicalCBOR
Versioned poDeposit <- fromCanonicalCBOR
Versioned ("donation" :: Text) <- fromCanonicalCBOR
Versioned poDonation <- fromCanonicalCBOR
Versioned ("reserves" :: Text) <- fromCanonicalCBOR
Versioned poReserves <- fromCanonicalCBOR
Versioned ("treasury" :: Text) <- fromCanonicalCBOR
Versioned poTreasury <- fromCanonicalCBOR
pure (Versioned PotsOut {..})

instance CanonicalCBOREntryEncoder "pots/v0" PotsOut where
encodeEntry n = toCanonicalCBOR (Proxy @"pots/v0") n

instance CanonicalCBOREntryDecoder "pots/v0" PotsOut where
decodeEntry = fromCanonicalCBOR
5 changes: 5 additions & 0 deletions libs/cardano-ledger-canonical-state/test/Test/Cardano/Ledger/CanonicalState/Spec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ 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 (..))
Expand All @@ -24,11 +25,15 @@ 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 ::
Expand Down
9 changes: 9 additions & 0 deletions libs/cardano-ledger-canonical-state/testlib/Test/Cardano/Ledger/CanonicalState/Arbitrary.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,13 @@

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.Core (Era, EraTxOut, TxOut)
import Generic.Random (genericArbitraryU)
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.QuickCheck (Arbitrary (..), Positive (..))

Expand All @@ -21,3 +24,9 @@ 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 . fromIntegral . getPositive @Integer <$> arbitrary

instance Arbitrary Pots.V0.PotsOut where
arbitrary = genericArbitraryU