Tickets.hs

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

-- | Tests on basic tickets functionality.
--
-- Tests on helpers from "Lorentz.Tickets" module lie in a different module.
module Test.Lorentz.Tickets
  ( test_Interpreter
  ) where

import Lorentz
import Prelude ()

import Test.HUnit ((@?=))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Hedgehog.Gen.Tezos.Address
import Morley.Michelson.Interpret (ContractEnv(..))
import Morley.Michelson.Runtime.Dummy (dummyContractEnv)
import Test.Cleveland.Util

-- | Address of self assigned in tests runs by Lorentz interpreter.
dummySelf :: Address
dummySelf = ceSelf dummyContractEnv

addr1, addr2 :: Address
addr1 = runGen 100 1 genAddress
addr2 = runGen 100 2 genAddress

test_Interpreter :: [TestTree]
test_Interpreter =
  [ testGroup "TICKET"
    [ testCase "Simple case" $
        ticket -$ ([mt|a|], 10)
        @?= Ticket
          { tTicketer = dummySelf
          , tData = [mt|a|]
          , tAmount = 10
          }
    ]

  , testGroup "READ_TICKET"
    [ testCase "Simple case" $
        readTicket # dip drop -$ Ticket
          { tTicketer = addr1
          , tData = [mt|b|]
          , tAmount = 5
          }
        @?= ReadTicket
          { rtTicketer = addr1
          , rtData = [mt|b|]
          , rtAmount = 5
          }
    ]

  , testGroup "SPLIT_TICKET"
    [ testCase "Working case" $
        splitTicket -$ (Ticket addr1 [mt|a|] 5, (2, 3))
        @?= Just (Ticket addr1 [mt|a|] 2, Ticket addr1 [mt|a|] 3)

    , testCase "Invalid sum" $
        splitTicket -$ (Ticket addr1 [mt|a|] 5, (2, 2))
        @?= Nothing
    ]

  , testGroup "JOIN_TICKETS"
    [ testCase "Working case" $
        joinTickets -$
          ( Ticket addr1 [mt|a|] 5
          , Ticket addr1 [mt|a|] 3
          )
        @?= Just (Ticket addr1 [mt|a|] 8)

    , testCase "Mismatching value" $
        joinTickets -$
          ( Ticket addr1 [mt|a|] 5
          , Ticket addr1 [mt|b|] 3
          )
        @?= Nothing

    , testCase "Mismatching address" $
        joinTickets -$
          ( Ticket addr1 [mt|a|] 5
          , Ticket addr2 [mt|a|] 3
          )
        @?= Nothing

    ]

  ]