Add Uniform instance for Ptr, SlotNo32, CertIx and TxIx

Author: lehins

libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs

@@ -160,6 +160,7 @@ import Data.Aeson.Types (Pair)
 import qualified Data.Binary.Put as B
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
+import Data.Coerce (coerce)
 import Data.Default (Default (def))
 import qualified Data.Fixed as FP (Fixed, HasResolution, resolution)
 import Data.Functor.Identity (Identity)
@@ -186,6 +187,7 @@ import GHC.Stack (HasCallStack)
 import NoThunks.Class (NoThunks (..))
 import Numeric.Natural (Natural)
 import Quiet (Quiet (Quiet))
+import System.Random.Stateful (Random, Uniform (..), UniformRange (..))
 
 maxDecimalsWord64 :: Int
 maxDecimalsWord64 = 19
@@ -832,6 +834,14 @@ newtype TxIx = TxIx {unTxIx :: Word16}
   deriving newtype
     (NFData, Enum, Bounded, NoThunks, FromCBOR, ToCBOR, EncCBOR, DecCBOR, ToJSON, MemPack)
 
+instance Random TxIx
+
+instance Uniform TxIx where
+  uniformM g = TxIx <$> uniformM g
+
+instance UniformRange TxIx where
+  uniformRM r g = TxIx <$> uniformRM (coerce r) g
+
 -- | Construct a `TxIx` from a 16 bit unsigned integer
 mkTxIx :: Word16 -> TxIx
 mkTxIx = TxIx . fromIntegral
@@ -857,6 +867,14 @@ newtype CertIx = CertIx {unCertIx :: Word16}
   deriving stock (Eq, Ord, Show)
   deriving newtype (NFData, Enum, Bounded, NoThunks, EncCBOR, DecCBOR, ToCBOR, FromCBOR, ToJSON)
 
+instance Random CertIx
+
+instance Uniform CertIx where
+  uniformM g = CertIx <$> uniformM g
+
+instance UniformRange CertIx where
+  uniformRM r g = CertIx <$> uniformRM (coerce r) g
+
 -- | Construct a `CertIx` from a 16 bit unsigned integer
 mkCertIx :: Word16 -> CertIx
 mkCertIx = CertIx . fromIntegral

libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs

@@ -69,6 +69,7 @@ import Data.Aeson (
  )
 import qualified Data.Aeson as Aeson
 import Data.Aeson.Types (toJSONKeyText)
+import Data.Coerce (coerce)
 import Data.Default (Default (..))
 import Data.Foldable (asum)
 import Data.Maybe (fromMaybe)
@@ -78,6 +79,7 @@ import Data.Typeable (Typeable)
 import Data.Word
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
+import System.Random.Stateful (Uniform (..), UniformRange (..), Random)
 
 -- | Script hash or key hash for a payment or a staking object.
 --
@@ -198,13 +200,24 @@ newtype SlotNo32 = SlotNo32 Word32
   deriving newtype
     (Eq, Ord, Num, Bounded, NFData, NoThunks, EncCBOR, DecCBOR, FromCBOR, ToCBOR, FromJSON, ToJSON)
 
+instance Random SlotNo32
+
+instance Uniform SlotNo32 where
+  uniformM g = SlotNo32 <$> uniformM g
+
+instance UniformRange SlotNo32 where
+  uniformRM r g = SlotNo32 <$> uniformRM (coerce r) g
+
 -- | Pointer to a slot number, transaction index and an index in certificate
 -- list.
 data Ptr = Ptr {-# UNPACK #-} !SlotNo32 {-# UNPACK #-} !TxIx {-# UNPACK #-} !CertIx
   deriving (Eq, Ord, Generic)
   deriving (EncCBOR, DecCBOR) via CBORGroup Ptr
   deriving (ToJSON) via KeyValuePairs Ptr
 
+instance Uniform Ptr where
+  uniformM g = Ptr <$> uniformM g <*> (TxIx <$> uniformM g) <*> (CertIx <$> uniformM g)
+
 instance NFData Ptr
 
 instance NoThunks Ptr