{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Binary.Random (
  QC (..),
  mkDummyHash,
  mkHashStdGen,
)
where

import Cardano.Crypto.Hash.Class (Hash, HashAlgorithm, hashToBytesShort)
import Cardano.Crypto.Hash.Short (Blake2bPrefix)
import Cardano.Ledger.Binary (EncCBOR (encCBOR), hashWithEncoder, shelleyProtVer)
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import Data.Coerce (coerce)
import Data.Primitive.ByteArray (ByteArray (ByteArray), indexByteArray)
import System.Random.Stateful (
  StatefulGen (..),
  StdGen,
  mkStdGen,
  runStateGen_,
 )
import Test.QuickCheck.Gen (Gen (MkGen))

-- | This is a pseudo random number generator used by QuickCheck and allows to use
-- @random@'s stateful interface to work dierctly in `Gen` monad. This comes from an
-- unmerged QuickCheck PR: https://github.com/nick8325/quickcheck/pull/333
data QC = QC

instance StatefulGen QC Gen where
  uniformWord32 :: QC -> Gen Word32
uniformWord32 QC
QC = forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_n -> forall g a. RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ QCGen
r forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32)
  {-# INLINE uniformWord32 #-}
  uniformWord64 :: QC -> Gen Word64
uniformWord64 QC
QC = forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_n -> forall g a. RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ QCGen
r forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64)
  {-# INLINE uniformWord64 #-}
  uniformShortByteString :: Int -> QC -> Gen ShortByteString
uniformShortByteString Int
k QC
QC =
    forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_n -> forall g a. RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ QCGen
r (forall g (m :: * -> *).
StatefulGen g m =>
Int -> g -> m ShortByteString
uniformShortByteString Int
k))
  {-# INLINE uniformShortByteString #-}

-- | It is possible to use a hash of a binary representation of any type as a source of
-- randomness, since hash value by its definiteion is uniformly distributed.
mkDummyHash :: forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash :: forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @h Version
shelleyProtVer forall a. EncCBOR a => a -> Encoding
encCBOR

-- | Use a hash of the binary representation of a type as a seed to construct `StdGen`,
-- that can be further used to generate random values.
mkHashStdGen :: EncCBOR x => x -> StdGen
mkHashStdGen :: forall x. EncCBOR x => x -> StdGen
mkHashStdGen x
x =
  case forall h a. Hash h a -> ShortByteString
hashToBytesShort forall a b. (a -> b) -> a -> b
$ forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @(Blake2bPrefix 8) x
x of
    SBS ByteArray#
ba -> Int -> StdGen
mkStdGen (forall a. Prim a => ByteArray -> Int -> a
indexByteArray (ByteArray# -> ByteArray
ByteArray ByteArray#
ba) Int
0)