content: module Sample.Stake.Destroy (
    ParameterBundle (..),
    StakeInputParameters (..),
    StakeBurningParameters (..),
    LeftOverStakeMode (..),
    AuthorizedBy (..),
    Validity (..),
    destroy,
    mkTestTree,
    mkTotallyValid,
    oneStake,
    multipleStakes,
    stealSST,
    stealSST1,
    stealSST3,
    lockedStakes,
    authorizedByDelegatee,
    notAuthorized,
  ) where
  
  import Agora.Proposal (ProposalId (..))
  import Agora.Stake (
    ProposalAction (Created),
    ProposalLock (ProposalLock),
    StakeDatum (..),
    StakeRedeemer (Destroy),
   )
  import Control.Exception (assert)
  import Data.Maybe (catMaybes, fromJust)
  import Data.Semigroup (stimesMonoid)
  import Plutarch.Context (
    input,
    mint,
    normalizeValue,
    output,
    pubKey,
    script,
    signedWith,
    withDatum,
    withRedeemer,
    withRef,
    withValue,
   )
  import Plutarch.Extra.AssetClass (assetClassValue)
  import PlutusLedgerApi.V1 (
    Credential (PubKeyCredential),
    TxOutRef (TxOutRef),
   )
  import PlutusLedgerApi.V2 (PubKeyHash)
  import Sample.Proposal.Shared (stakeTxRef)
  import Sample.Shared (
    minAda,
    signer2,
    stakeAssetClass,
    stakePolicy,
    stakeScriptHash,
    stakeSymbol,
    stakeValidator,
   )
  import Test.Specification (
    SpecificationTree,
    group,
    testPolicy,
    testValidator,
   )
  import Test.Util (CombinableBuilder, mkMinting, mkSpending, pubKeyHashes)
  
  data ParameterBundle = ParameterBundle
    { stakeInputParameters :: StakeInputParameters
    , stakeBurningParameters :: StakeBurningParameters
    , authorizedBy :: AuthorizedBy
    }
  
  data StakeInputParameters = StakeInputParameters
    { numInputs :: Int
    , notUnlocked :: Bool
    }
  
  data StakeBurningParameters = StakeBurningParameters
    { numBurnt :: Int
    , leftOverStakeMode :: Maybe LeftOverStakeMode
    }
  
  data LeftOverStakeMode = OutputAsIs | CollectSSTInOneUTxO
  
  data AuthorizedBy = Owner | Delegatee | NotAuthorized
  
  data Validity = Validity
    { forStakePolicy :: Maybe Bool
    , forStakeValidator :: Bool
    }
  
  --------------------------------------------------------------------------------
  
  owner :: PubKeyHash
  owner = pubKeyHashes !! 2
  
  delegatee :: PubKeyHash
  delegatee = pubKeyHashes !! 3
  
  --------------------------------------------------------------------------------
  
  mkStakeInputDatum :: StakeInputParameters -> StakeDatum
  mkStakeInputDatum ps =
    StakeDatum
      { stakedAmount = 114514
      , owner = PubKeyCredential owner
      , delegatedTo = Just $ PubKeyCredential delegatee
      , lockedBy = [ProposalLock (ProposalId 0) Created | ps.notUnlocked]
      }
  
  mkStakeRef :: Int -> TxOutRef
  mkStakeRef = TxOutRef stakeTxRef . fromIntegral
  
  stakeRedeemer :: StakeRedeemer
  stakeRedeemer = Destroy
  
  --------------------------------------------------------------------------------
  
  destroy :: forall b. CombinableBuilder b => ParameterBundle -> b
  destroy ps =
    let stakeInputDatum = mkStakeInputDatum ps.stakeInputParameters
  
        sst = assetClassValue stakeAssetClass 1
  
        stakeUTxOTemplate =
          mconcat
            [ script stakeScriptHash
            , withDatum stakeInputDatum
            , withValue $ normalizeValue $ sst <> minAda
            ]
  
        stakeInputBuilder =
          foldMap
            ( \i ->
                input $
                  mconcat
                    [ stakeUTxOTemplate
                    , withRef $ mkStakeRef i
                    , withRedeemer stakeRedeemer
                    ]
            )
            [1 .. ps.stakeInputParameters.numInputs]
  
        withSSTsBurnt =
          mint $
            normalizeValue $
              assetClassValue stakeAssetClass $
                negate $
                  fromIntegral ps.stakeBurningParameters.numBurnt
  
        ---
  
        leftOverStakes =
          ps.stakeInputParameters.numInputs
            - ps.stakeBurningParameters.numBurnt
  
        stealSSTs =
          case fromJust ps.stakeBurningParameters.leftOverStakeMode of
            OutputAsIs ->
              foldMap output $
                replicate
                  leftOverStakes
                  stakeUTxOTemplate
            CollectSSTInOneUTxO ->
              output $
                mconcat
                  [ pubKey signer2
                  , withValue $ stimesMonoid leftOverStakes sst
                  ]
  
        stakeOutputBuilder =
          assert (leftOverStakes >= 0) $
            mconcat
              [ withSSTsBurnt
              , if leftOverStakes > 0
                  then stealSSTs
                  else mempty
              ]
  
        ---
  
        sigBuilder = case ps.authorizedBy of
          Owner -> signedWith owner
          Delegatee -> signedWith delegatee
          NotAuthorized -> mempty
     in mconcat
          [ stakeInputBuilder
          , stakeOutputBuilder
          , sigBuilder
          ]
  
  --------------------------------------------------------------------------------
  
  mkTestTree ::
    String ->
    ParameterBundle ->
    Validity ->
    SpecificationTree
  mkTestTree name pb val = group name $ catMaybes [validator, policy]
    where
      spend = mkSpending destroy pb
      mint = mkMinting destroy pb
      validator =
        Just $
          testValidator
            val.forStakeValidator
            "stake validator"
            stakeValidator
            (mkStakeInputDatum pb.stakeInputParameters)
            stakeRedeemer
            (spend $ mkStakeRef 1)
  
      policy = case pb.stakeBurningParameters.numBurnt of
        0 -> Nothing
        _ ->
          Just $
            testPolicy
              (fromJust val.forStakePolicy)
              "stake policy"
              stakePolicy
              ()
              (mint stakeSymbol)
  
  --------------------------------------------------------------------------------
  
  mkTotallyValid :: Int -> ParameterBundle
  mkTotallyValid numStakes =
    ParameterBundle
      { stakeInputParameters =
          StakeInputParameters
            { numInputs = numStakes
            , notUnlocked = False
            }
      , stakeBurningParameters =
          StakeBurningParameters
            { numBurnt = numStakes
            , leftOverStakeMode = Nothing
            }
      , authorizedBy = Owner
      }
  
  oneStake :: ParameterBundle
  oneStake = mkTotallyValid 1
  
  multipleStakes :: ParameterBundle
  multipleStakes = mkTotallyValid 10
  
  stealSST :: ParameterBundle
  stealSST =
    multipleStakes
      { stakeBurningParameters =
          StakeBurningParameters
            { numBurnt = 1
            , leftOverStakeMode = Just CollectSSTInOneUTxO
            }
      }
  
  stealSST1 :: ParameterBundle
  stealSST1 =
    multipleStakes
      { stakeBurningParameters =
          StakeBurningParameters
            { numBurnt = 0
            , leftOverStakeMode = Just CollectSSTInOneUTxO
            }
      }
  
  stealSST3 :: ParameterBundle
  stealSST3 =
    multipleStakes
      { stakeBurningParameters =
          StakeBurningParameters
            { numBurnt = 1
            , leftOverStakeMode = Just OutputAsIs
            }
      }
  
  lockedStakes :: ParameterBundle
  lockedStakes =
    multipleStakes
      { stakeInputParameters =
          multipleStakes.stakeInputParameters
            { notUnlocked = True
            }
      }
  
  authorizedByDelegatee :: ParameterBundle
  authorizedByDelegatee =
    multipleStakes
      { authorizedBy = Delegatee
      }
  
  notAuthorized :: ParameterBundle
  notAuthorized =
    multipleStakes
      { authorizedBy = NotAuthorized
      }
  