Core.hs

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

module Hedgehog.Gen.Tezos.Core
  ( genChainId
  , genMutez
  , genMutez'
  , genTimestamp
  , minTimestamp
  , maxTimestamp
  , midTimestamp
  ) where

import Data.Time.Calendar (Day, addDays, diffDays)
import Data.Time.Clock (UTCTime(..))
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import Hedgehog (MonadGen, Range)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import Morley.Tezos.Core
  (ChainId(..), Mutez(..), Timestamp, timestampFromSeconds, timestampFromUTCTime,
  timestampToSeconds, unsafeMkMutez)

import Test.Cleveland.Instances ()

genChainId :: MonadGen m => m ChainId
genChainId  = UnsafeChainId <$> Gen.bytes (Range.singleton 4)

-- | Generates an arbitrary `Mutez` value using the data type's full range.
genMutez :: MonadGen m => m Mutez
genMutez = genMutez' Range.linearBounded

-- | Generates an arbitrary `Mutez` value constrained to the given range.
genMutez' :: MonadGen m => Range Mutez -> m Mutez
genMutez' range = unsafeMkMutez <$> Gen.word64 (unMutez <$> range)

genTimestamp :: MonadGen m => m Timestamp
genTimestamp =
  timestampFromSeconds <$> Gen.integral
    (Range.linear (timestampToSeconds minTimestamp) (timestampToSeconds maxTimestamp))

-- | Minimal (earliest) timestamp used for @Arbitrary (CValue 'CTimestamp)@
minTimestamp :: Timestamp
minTimestamp = timestampFromUTCTime $ UTCTime minDay (fromIntegralToRealFrac minSec)

-- | Maximal (latest) timestamp used for @Arbitrary (CValue 'CTimestamp)@
maxTimestamp :: Timestamp
maxTimestamp = timestampFromUTCTime $ UTCTime maxDay (fromIntegralToRealFrac maxSec)

-- | Median of 'minTimestamp' and 'maxTimestamp'.
-- Useful for testing (exactly half of generated dates will be before and after
-- this date).
midTimestamp :: Timestamp
midTimestamp = timestampFromUTCTime $
  UTCTime ( ((maxDay `diffDays` minDay) `div` 2) `addDays` minDay)
          (fromIntegralToRealFrac $ (maxSec - minSec) `div` 2)

minDay :: Day
minDay = fromMaybe (error "failed to parse day 2008-11-01") $
            parseTimeM True defaultTimeLocale "%Y-%-m-%-d" "2008-11-01"

maxDay :: Day
maxDay = fromMaybe (error "failed to parse day 2024-11-01") $
            parseTimeM True defaultTimeLocale "%Y-%-m-%-d" "2024-11-01"

minSec :: Integer
minSec = 0

maxSec :: Integer
maxSec = 86399