Delegates.hs

-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module TestSuite.Cleveland.Delegates
  ( test_Delegates
  ) where

import Test.Tasty (TestTree)

import Morley.Tezos.Address
import Test.Cleveland
import TestSuite.Util

test_Delegates :: [TestTree]
test_Delegates =
  [ testScenario "Registering delegate works" $ scenario do
      addr <- newFreshAddress "delegated"
      let kh = unImplicitAddress $ toImplicitAddress addr
      transfer addr [tz|1milli|] -- just about enough to pay all the fees
      getDelegate addr @@== Nothing
      registerDelegate addr
      getDelegate addr @@== Just kh
  , testScenario "Setting delegate on origination works" $ scenario do
      addr <- newFreshAddress "delegated"
      let kh = unImplicitAddress $ toImplicitAddress addr
      transfer addr [tz|1milli|] -- just about enough to pay all the fees
      registerDelegate addr
      contract <- originate "idContract" () (idContract @()) kh
      getDelegate contract @@== Just kh
  , testScenario "Registering delegate twice doesn't error" $ scenario do
      addr <- newFreshAddress "delegated"
      let kh = unImplicitAddress $ toImplicitAddress addr
      transfer addr [tz|1milli|] -- just about enough to pay all the fees
      registerDelegate addr
      getDelegate addr @@== Just kh
      registerDelegate addr
      getDelegate addr @@== Just kh
  , testScenario "Setting/unsetting delegate explicitly works" $ scenario do
      addr <- newFreshAddress "delegated"
      transfer addr [tz|2milli|]
      delegate <- newAddress "delegate"
      let delegateKh = unImplicitAddress $ toImplicitAddress delegate
      registerDelegate delegate
      getDelegate addr @@== Nothing
      setDelegate addr (Just delegateKh)
      getDelegate addr @@== Just delegateKh
      setDelegate addr Nothing
      getDelegate addr @@== Nothing
  , testScenario "Can't set/unset delegate on a registered delegate" $ scenario do
      addr <- newFreshAddress "delegated"
      let kh = unImplicitAddress $ toImplicitAddress addr
      transfer addr [tz|1milli|]
      delegate <- newAddress "delegate"
      let delegateKh = unImplicitAddress $ toImplicitAddress delegate
      registerDelegate delegate
      registerDelegate addr
      getDelegate addr @@== Just kh
      errorMessage <- ifEmulation
        (pure "Delegate deletion is forbidden")
        (pure "Failed to withdraw delegation for")
      setDelegate addr (Just delegateKh)
        & shouldFailWithMessage errorMessage
      setDelegate addr Nothing
        & shouldFailWithMessage errorMessage
      getDelegate addr @@== Just kh
  ]