-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Utilities for arbitrary data generation in property tests.
--
--   == Deprecation Notice
--
--   At the moment, this module exposes both Hedgehog generators and QuickCheck `Arbitrary`
--   instances for convenience.
--   However, `Arbitrary` instances should be considered deprecated and will eventually be removed.

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

-- | Minimal (earliest) timestamp used for @Arbitrary (CValue 'CTimestamp)@
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)

-- | Maximal (latest) timestamp used for @Arbitrary (CValue 'CTimestamp)@
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)

-- | Median of 'minTimestamp' and 'maxTimestamp'.
-- Useful for testing (exactly half of generated dates will be before and after
-- this date).
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))