{-# OPTIONS_GHC -Wno-orphans #-}
module Michelson.Test.Gen
( minTimestamp
, maxTimestamp
, midTimestamp
, genMutez
, genTimestamp
, genValueKeyHash
, genValueMutez
, genValueInt
, genValueList
, genValueUnit
, genValuePair
, genValueTimestamp
) where
import Data.Time.Calendar (Day, addDays, diffDays)
import Data.Time.Clock (UTCTime(..))
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.QuickCheck (Arbitrary(..), choose)
import Michelson.Typed (KnownT, T(..), Value'(..))
import Tezos.Core
(Mutez(..), Timestamp, timestampFromSeconds, timestampFromUTCTime, timestampToSeconds,
unsafeMkMutez)
import Tezos.Crypto (genKeyHash)
instance Arbitrary (Value' instr 'TKeyHash) where
arbitrary :: Gen (Value' instr 'TKeyHash)
arbitrary = KeyHash -> Value' instr 'TKeyHash
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
VKeyHash (KeyHash -> Value' instr 'TKeyHash)
-> Gen KeyHash -> Gen (Value' instr 'TKeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen KeyHash
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Value' instr 'TMutez) where
arbitrary :: Gen (Value' instr 'TMutez)
arbitrary = Mutez -> Value' instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez (Mutez -> Value' instr 'TMutez)
-> Gen Mutez -> Gen (Value' instr 'TMutez)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Mutez
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Value' instr 'TInt) where
arbitrary :: Gen (Value' instr 'TInt)
arbitrary = Integer -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Value' instr 'TInt)
-> Gen Integer -> Gen (Value' instr 'TInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
instance (KnownT a, Arbitrary (Value' instr a)) =>
Arbitrary (Value' instr ('TList a)) where
arbitrary :: Gen (Value' instr ('TList a))
arbitrary = [Value' instr a] -> Value' instr ('TList a)
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
[Value' instr t] -> Value' instr ('TList t)
VList ([Value' instr a] -> Value' instr ('TList a))
-> Gen [Value' instr a] -> Gen (Value' instr ('TList a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Value' instr a]
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Value' instr 'TUnit) where
arbitrary :: Gen (Value' instr 'TUnit)
arbitrary = Value' instr 'TUnit -> Gen (Value' instr 'TUnit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' instr 'TUnit
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
VUnit
instance (Arbitrary (Value' instr a), Arbitrary (Value' instr b))
=> Arbitrary (Value' instr ('TPair a b)) where
arbitrary :: Gen (Value' instr ('TPair a b))
arbitrary = (Value' instr a, Value' instr b) -> Value' instr ('TPair a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((Value' instr a, Value' instr b) -> Value' instr ('TPair a b))
-> (Value' instr a
-> Value' instr b -> (Value' instr a, Value' instr b))
-> Value' instr a
-> Value' instr b
-> Value' instr ('TPair a b)
forall a b c. SuperComposition a b c => a -> b -> c
... (,) (Value' instr a -> Value' instr b -> Value' instr ('TPair a b))
-> Gen (Value' instr a)
-> Gen (Value' instr b -> Value' instr ('TPair a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Value' instr a)
forall a. Arbitrary a => Gen a
arbitrary Gen (Value' instr b -> Value' instr ('TPair a b))
-> Gen (Value' instr b) -> Gen (Value' instr ('TPair a b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Value' instr b)
forall a. Arbitrary a => Gen a
arbitrary
genValueKeyHash :: MonadGen m => m (Value' instr 'TKeyHash)
genValueKeyHash :: m (Value' instr 'TKeyHash)
genValueKeyHash = KeyHash -> Value' instr 'TKeyHash
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
VKeyHash (KeyHash -> Value' instr 'TKeyHash)
-> m KeyHash -> m (Value' instr 'TKeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m KeyHash
forall (m :: * -> *). MonadGen m => m KeyHash
genKeyHash
genValueMutez :: MonadGen m => m (Value' instr 'TMutez)
genValueMutez :: m (Value' instr 'TMutez)
genValueMutez = Mutez -> Value' instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez (Mutez -> Value' instr 'TMutez)
-> m Mutez -> m (Value' instr 'TMutez)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Mutez
forall (m :: * -> *). MonadGen m => m Mutez
genMutez
genValueInt :: MonadGen m => m (Value' instr 'TInt)
genValueInt :: m (Value' instr 'TInt)
genValueInt = Integer -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Value' instr 'TInt)
-> m Integer -> m (Value' instr 'TInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom 0 -1000 1000)
genValueList :: (MonadGen m, KnownT a) => m (Value' instr a) -> m (Value' instr ('TList a))
genValueList :: m (Value' instr a) -> m (Value' instr ('TList a))
genValueList genA :: m (Value' instr a)
genA = [Value' instr a] -> Value' instr ('TList a)
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
[Value' instr t] -> Value' instr ('TList t)
VList ([Value' instr a] -> Value' instr ('TList a))
-> m [Value' instr a] -> m (Value' instr ('TList a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m (Value' instr a) -> m [Value' instr a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear 0 100) m (Value' instr a)
genA
genValueUnit :: Applicative m => m (Value' instr 'TUnit)
genValueUnit :: m (Value' instr 'TUnit)
genValueUnit = Value' instr 'TUnit -> m (Value' instr 'TUnit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' instr 'TUnit
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
VUnit
genValuePair :: MonadGen m => m (Value' instr a) -> m (Value' instr b) -> m (Value' instr ('TPair a b))
genValuePair :: m (Value' instr a)
-> m (Value' instr b) -> m (Value' instr ('TPair a b))
genValuePair genA :: m (Value' instr a)
genA genB :: m (Value' instr b)
genB = (Value' instr a, Value' instr b) -> Value' instr ('TPair a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((Value' instr a, Value' instr b) -> Value' instr ('TPair a b))
-> (Value' instr a
-> Value' instr b -> (Value' instr a, Value' instr b))
-> Value' instr a
-> Value' instr b
-> Value' instr ('TPair a b)
forall a b c. SuperComposition a b c => a -> b -> c
... (,) (Value' instr a -> Value' instr b -> Value' instr ('TPair a b))
-> m (Value' instr a)
-> m (Value' instr b -> Value' instr ('TPair a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Value' instr a)
genA m (Value' instr b -> Value' instr ('TPair a b))
-> m (Value' instr b) -> m (Value' instr ('TPair a b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Value' instr b)
genB
minDay :: Day
minDay :: Day
minDay = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Text -> Day
forall a. HasCallStack => Text -> a
error "failed to parse day 2008-11-01") (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$
Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale "%Y-%-m-%-d" "2008-11-01"
maxDay :: Day
maxDay :: Day
maxDay = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Text -> Day
forall a. HasCallStack => Text -> a
error "failed to parse day 2024-11-01") (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$
Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale "%Y-%-m-%-d" "2024-11-01"
minSec :: Integer
minSec :: Integer
minSec = 0
maxSec :: Integer
maxSec :: Integer
maxSec = 86399
minTimestamp :: Timestamp
minTimestamp :: Timestamp
minTimestamp = UTCTime -> Timestamp
timestampFromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
minDay (Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger Integer
minSec)
maxTimestamp :: Timestamp
maxTimestamp :: Timestamp
maxTimestamp = UTCTime -> Timestamp
timestampFromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
maxDay (Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger Integer
maxSec)
midTimestamp :: Timestamp
midTimestamp :: Timestamp
midTimestamp = UTCTime -> Timestamp
timestampFromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$
Day -> DiffTime -> UTCTime
UTCTime ( ((Day
maxDay Day -> Day -> Integer
`diffDays` Day
minDay) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2) Integer -> Day -> Day
`addDays` Day
minDay)
(Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ (Integer
maxSec Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
minSec) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2)
instance Arbitrary (Value' instr 'TTimestamp) where
arbitrary :: Gen (Value' instr 'TTimestamp)
arbitrary = Timestamp -> Value' instr 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
VTimestamp (Timestamp -> Value' instr 'TTimestamp)
-> Gen Timestamp -> Gen (Value' instr 'TTimestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Timestamp
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary Mutez where
arbitrary :: Gen Mutez
arbitrary = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez (Word64 -> Mutez) -> Gen Word64 -> Gen Mutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
minBound, Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
maxBound)
instance Arbitrary Timestamp where
arbitrary :: Gen Timestamp
arbitrary =
Integer -> Timestamp
timestampFromSeconds (Integer -> Timestamp) -> Gen Integer -> Gen Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
minTimestamp, Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
maxTimestamp)
genValueTimestamp :: MonadGen m => m (Value' instr 'TTimestamp)
genValueTimestamp :: m (Value' instr 'TTimestamp)
genValueTimestamp = Timestamp -> Value' instr 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
VTimestamp (Timestamp -> Value' instr 'TTimestamp)
-> m Timestamp -> m (Value' instr 'TTimestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Timestamp
forall (m :: * -> *). MonadGen m => m Timestamp
genTimestamp
genMutez :: MonadGen m => m Mutez
genMutez :: m Mutez
genMutez = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez (Word64 -> Mutez) -> m Word64 -> m Mutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> m Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.linear (Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
minBound) (Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
maxBound))
genTimestamp :: MonadGen m => m Timestamp
genTimestamp :: m Timestamp
genTimestamp =
Integer -> Timestamp
timestampFromSeconds (Integer -> Timestamp) -> m Integer -> m Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral
(Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear (Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
minTimestamp) (Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
maxTimestamp))