{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Binary.Arbitrary (
  genVersion,
) where

import Cardano.Crypto.DSIGN (deriveVerKeyDSIGN)
import Cardano.Crypto.Leios (LeiosCert, LeiosCommittee (..), LeiosSeat (..))
import Cardano.Ledger.Binary.Version
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.Vector.Strict as V
import GHC.Stack
import Test.Cardano.Base.Arbitrary ()
import Test.Cardano.Binary.Arbitrary ()
import Test.Cardano.Crypto.Leios.Gen (genLeiosCert, genLeiosSigningKey)
import Test.Data.VMap.Arbitrary ()
import Test.QuickCheck
import Test.QuickCheck.Instances ()

instance Arbitrary Version where
  arbitrary :: Gen Version
arbitrary = HasCallStack => Version -> Version -> Gen Version
Version -> Version -> Gen Version
genVersion Version
forall a. Bounded a => a
minBound Version
forall a. Bounded a => a
maxBound

genVersion :: HasCallStack => Version -> Version -> Gen Version
genVersion :: HasCallStack => Version -> Version -> Gen Version
genVersion Version
minVersion Version
maxVersion =
  Word32 -> Word32 -> Gen Version
genVersion32 (Version -> Word32
getVersion32 Version
minVersion) (Version -> Word32
getVersion32 Version
maxVersion)
  where
    genVersion32 :: Word32 -> Word32 -> Gen Version
genVersion32 Word32
minVersion32 Word32
maxVersion32 = do
      v32 <- (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
minVersion32, Word32
maxVersion32)
      case mkVersion32 v32 of
        Maybe Version
Nothing -> [Char] -> Gen Version
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen Version) -> [Char] -> Gen Version
forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible: Invalid version generated: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
v32
        Just Version
v -> Version -> Gen Version
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v

instance Arbitrary LeiosCert where
  arbitrary :: Gen LeiosCert
arbitrary = Gen LeiosCert
genLeiosCert

instance Arbitrary LeiosSeat where
  arbitrary :: Gen LeiosSeat
arbitrary = do
    weight <- Gen Weight
forall a. Arbitrary a => Gen a
arbitrary
    vkey <-
      oneof
        [ SJust . deriveVerKeyDSIGN <$> genLeiosSigningKey
        , pure SNothing
        ]
    pure (LeiosSeat weight vkey)

instance Arbitrary LeiosCommittee where
  arbitrary :: Gen LeiosCommittee
arbitrary = Vector LeiosSeat -> LeiosCommittee
UnsafeLeiosCommittee (Vector LeiosSeat -> LeiosCommittee)
-> ([LeiosSeat] -> Vector LeiosSeat)
-> [LeiosSeat]
-> LeiosCommittee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LeiosSeat] -> Vector LeiosSeat
forall a. [a] -> Vector a
V.fromList ([LeiosSeat] -> LeiosCommittee)
-> Gen [LeiosSeat] -> Gen LeiosCommittee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [LeiosSeat]
forall a. Arbitrary a => Gen a
arbitrary