-- | Module, containing spec to test auction.tz contract.
--
-- This spec is an example of using testing capabilities of morley.
module Test.Interpreter.Auction
  ( test_Auction
  ) where

import Test.Hspec.Expectations (shouldSatisfy)
import Test.QuickCheck (Property, arbitrary, choose, counterexample, (.&&.), (===))
import Test.QuickCheck.Property (forAll, withMaxSuccess)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
import Test.Tasty.QuickCheck (testProperty)

import Michelson.Interpret (ContractEnv(..))
import Michelson.Test
  (ContractPropValidator, contractProp, midTimestamp, testTreesWithTypedContract)
import Michelson.Test.Dummy
import Michelson.Test.Util (failedProp)
import Michelson.Typed (Operation'(..), ToT, TransferTokens(..))
import qualified Michelson.Typed as T
import Tezos.Address (Address(..))
import Tezos.Core (Mutez, Timestamp, timestampPlusSeconds, unMutez, unsafeMkMutez, unsafeSubMutez)
import Tezos.Crypto (KeyHash)
import Util.Test.Arbitrary (runGen)

import Test.Util.Contracts

type Storage = (Timestamp, (Mutez, KeyHash))
type Param = KeyHash

-- | Spec to test auction.tz contract.
--
-- This test serves as an example on how to test contract with both unit tests
-- and QuickCheck.
test_Auction :: IO [TestTree]
test_Auction =
  testTreesWithTypedContract (inContractsDir "tezos_examples/attic/auction.tz") auctionTest
  where
    -- Test auction.tz, everything should be fine
    auctionTest contract =
      pure
      [ testCase "Bid after end of auction triggers failure" $
          contractProp contract
            (flip shouldSatisfy (isLeft . fst))
            (env { ceAmount = unsafeMkMutez 1200 })
            keyHash2
            (aBitBeforeMidTimestamp, (unsafeMkMutez 1000, keyHash1))

      , testProperty "Random check (sparse distribution)" $ withMaxSuccess 200 $
          qcProp contract arbitrary arbitrary

      , testProperty "Random check (dense end of auction)" $
          qcProp contract denseTime arbitrary

      , testProperty "Random check (dense amount)" $
          qcProp contract arbitrary denseAmount
      ]

    qcProp contract eoaGen amountGen =
      forAll ((,) <$> eoaGen <*> ((,) <$> amountGen <*> arbitrary)) $
        \s p ->
          let validate = validateAuction env p s
           in contractProp contract validate env p s

    aBitBeforeMidTimestamp = midTimestamp `timestampPlusSeconds` -1
    -- ^ 1s before NOW

    denseTime = timestampPlusSeconds midTimestamp <$> choose (-4, 4)
    denseAmount = unsafeMkMutez . (midAmount +) . fromInteger <$> choose (-4, 4)

    env = dummyContractEnv
            { ceNow = midTimestamp
            , ceAmount = unsafeMkMutez midAmount
            }
    midAmount = unMutez (maxBound `unsafeSubMutez` minBound) `div` 2

keyHash1 :: KeyHash
keyHash1 = runGen 300406 arbitrary

keyHash2 :: KeyHash
keyHash2 = runGen 142917 arbitrary

-- | This validator checks the result of auction.tz execution.
--
-- It checks following properties:
--
-- * Current timestamp is before end of auction
-- * Amount of new bid is higher than previous one
--
-- In case of successful execution:
--
-- * End of auction timestamp in updated storage is unchanged
-- * Amount in updated storage is equal to @AMOUNT@ of transaction
-- * Key hash in updated storage is equal to contract's parameter
-- * Script returned exactly one operation, @TransferTokens@, which
--   returns money back to the previous bidder
validateAuction
  :: ContractEnv
  -> Param
  -> Storage
  -> ContractPropValidator (ToT Storage) Property
validateAuction env newKeyHash (endOfAuction, (amount, keyHash)) (resE, _)
  | ceNow env > endOfAuction
      = counterexample "Failure didn't trigger on end of auction" $ isLeft resE
  | ceAmount env <= amount
      = counterexample ("Failure didn't trigger on attempt to bid"
                        <> " with amount <= than previous bid") $ isLeft resE
  | Left e <- resE
      = failedProp $ "Unexpected script fail: " <> show e

  | Right (_, (T.VPair ( T.VTimestamp endOfAuction', _))) <- resE
  , endOfAuction /= endOfAuction'
      = failedProp "End of auction timestamp of contract changed"

  | Right (_, (T.VPair (_, T.VPair (T.VMutez amount', _)))) <- resE
  , amount' /= ceAmount env
      = failedProp $ "Storage updated to wrong value: new amount"
                      <> " is not equal to amount of transaction"
  | Right (_, (T.VPair (_, T.VPair (_, T.VKeyHash keyHash')))) <- resE
  , keyHash' /= newKeyHash
      = failedProp $ "Storage updated to wrong value: new key hash"
                      <> " is not equal to contract's parameter"

  | Right (ops, _) <- resE
     = let counterE msg =
              counterexample $ "Invalid money back operation (" <> msg <> ")"
        in case ops of
            [OpTransferTokens (TransferTokens T.VUnit retAmount (T.VContract retAddr _))] ->
              counterE "wrong amount" (retAmount === amount)
                .&&.
              counterE "wrong address" (KeyAddress keyHash === retAddr)
            _ -> failedProp $ "Unexpected operation list: " <> show ops