RateSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module AWS.EventBridge.RateSpec (tests) where

import AWS.EventBridge.Rate
import Data.Time.Clock (secondsToNominalDiffTime)
import qualified Data.Text as T
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))
import Test.Tasty.QuickCheck as QC
import TestSupport (assertLeft)

tests :: TestTree
tests =
  testGroup "rate"
    [ manualTests
    , propertyTests
    ]

manualTests :: TestTree
manualTests = testGroup "manual"
  [ testCase "parse minutes" $ parseRateText "rate(5 minutes)" @?= Right (RateMinutes 5)
  , testCase "parse minute singular" $ parseRateText "rate(1 minute)" @?= Right (RateMinutes 1)
  , testCase "parse hours plural" $ parseRateText "rate(10 hours)" @?= Right (RateHours 10)
  , testCase "parse hour singular" $ parseRateText "rate(1 hour)" @?= Right (RateHours 1)
  , testCase "parse days" $ parseRateText "rate(3 days)" @?= Right (RateDays 3)
  , testCase "parse day singular" $ parseRateText "rate(1 day)" @?= Right (RateDays 1)
  , testCase "parse trims surrounding whitespace" $ parseRateText "  rate(2 hours)\n" @?= Right (RateHours 2)
  , testCase "parse without separator fails" $ assertLeft (parseRateText "rate(5minutes)")
  , testCase "parse negative rejected" $ assertLeft (parseRateText "rate(-5 minutes)")
  , testCase "evaluate minutes" $
      evaluateRateT (RateMinutes 15) @?= Right (secondsToNominalDiffTime 900)
  , testCase "evaluate hours" $
      evaluateRateT (RateHours 2) @?= Right (secondsToNominalDiffTime 7200)
  , testCase "evaluate days" $
      evaluateRateT (RateDays 1) @?= Right (secondsToNominalDiffTime 86400)
  , testCase "evaluate minutes upper bound" $
    evaluateRateT (RateMinutes 31536000)
        @?= Right (secondsToNominalDiffTime (fromInteger (31536000 * 60)))
  , testCase "evaluate hours upper bound" $
    evaluateRateT (RateHours 8760)
        @?= Right (secondsToNominalDiffTime (fromInteger (8760 * 3600)))
  , testCase "evaluate days upper bound" $
    evaluateRateT (RateDays 365)
        @?= Right (secondsToNominalDiffTime (fromInteger (365 * 86400)))
  , testCase "minutes below range rejected" $
      assertLeft (evaluateRateT (RateMinutes 0))
  , testCase "minutes above range rejected" $
      assertLeft (evaluateRateT (RateMinutes 40000000))
  , testCase "hours below range rejected" $
      assertLeft (evaluateRateT (RateHours 0))
  , testCase "hours above range rejected" $
      assertLeft (evaluateRateT (RateHours 9000))
  , testCase "days below range rejected" $
      assertLeft (evaluateRateT (RateDays 0))
  , testCase "days above range rejected" $
      assertLeft (evaluateRateT (RateDays 400))
  , testCase "invalid unit fails" $
      case parseRateText "rate(5 weeks)" of
        Left _ -> pure ()
        Right val -> fail ("unexpected success: " <> show val)
  ]

propertyTests :: TestTree
propertyTests = testGroup "properties"
  [ QC.testProperty "minutes evaluate to consistent seconds" propMinutesEvaluate
  , QC.testProperty "hours evaluate to consistent seconds" propHoursEvaluate
  , QC.testProperty "days evaluate to consistent seconds" propDaysEvaluate
  , QC.testProperty "parser round-trips generated expressions" propParserRoundTrip
  ]

propMinutesEvaluate :: QC.Property
propMinutesEvaluate =
  QC.forAll (QC.chooseInt (1, 31536000)) $ \m ->
    evaluateRateT (RateMinutes m)
      QC.=== Right (secondsToNominalDiffTime (fromIntegral (m * 60)))

propHoursEvaluate :: QC.Property
propHoursEvaluate =
  QC.forAll (QC.chooseInt (1, 8760)) $ \h ->
    evaluateRateT (RateHours h)
      QC.=== Right (secondsToNominalDiffTime (fromIntegral (h * 3600)))

propDaysEvaluate :: QC.Property
propDaysEvaluate =
  QC.forAll (QC.chooseInt (1, 365)) $ \d ->
    evaluateRateT (RateDays d)
      QC.=== Right (secondsToNominalDiffTime (fromIntegral (d * 86400)))

propParserRoundTrip :: QC.Property
propParserRoundTrip =
  QC.forAll genRateExprText $ \(expr, input) ->
    parseRateText input QC.=== Right expr

genRateExprText :: QC.Gen (RateExprT, T.Text)
genRateExprText =
  QC.oneof
    [ genCase RateMinutes 31536000 "minute"
    , genCase RateHours 8760 "hour"
    , genCase RateDays 365 "day"
    ]

genCase :: (Int -> RateExprT) -> Int -> String -> QC.Gen (RateExprT, T.Text)
genCase constructor upperBound unitLabel = do
  n <- QC.chooseInt (1, upperBound)
  plural <- QC.elements [False, True]
  prefix <- QC.elements ["", " ", "\t", "\n"]
  suffix <- QC.elements ["", " ", "\t", "\n"]
  gap <- QC.elements [" ", "  ", "\t"]
  let token = unitLabel <> if plural then "s" else ""
      rendered = prefix <> "rate(" <> show n <> gap <> token <> ")" <> suffix
  pure (constructor n, T.pack rendered)