content: {- |
  Module     : Sample.Proposal.Create
  Maintainer : connor@mlabs.city
  Description: Generate sample data for testing the functionalities of creating proposals
  
  Sample and utilities for testing the functionalities of creating proposals.
  -}
  module Sample.Proposal.Create (
    Parameters (..),
    mkTestTree,
    totallyValidParameters,
    invalidOutputGovernorDatumParameters,
    useStakeOwnBySomeoneElseParameters,
    invalidOutputStakeParameters,
    addInvalidLocksParameters,
    exceedMaximumProposalsParameters,
    timeRangeNotTightParameters,
    timeRangeNotClosedParameters,
    invalidProposalStatusParameters,
    fakeSSTParameters,
    wrongGovernorRedeemer,
    wrongGovernorRedeemer1,
  ) where
  
  import Agora.Governor (
    Governor (..),
    GovernorDatum (..),
    GovernorRedeemer (
      CreateProposal,
      MintGATs,
      MutateGovernor
    ),
   )
  import Agora.Proposal (
    ProposalDatum (..),
    ProposalEffectGroup,
    ProposalId (ProposalId),
    ProposalStatus (..),
    ResultTag (ResultTag),
    emptyVotesFor,
   )
  import Agora.Proposal.Time (
    MaxTimeRangeWidth (
      MaxTimeRangeWidth
    ),
    ProposalStartingTime (..),
   )
  import Agora.SafeMoney (GTTag)
  import Agora.Stake (
    ProposalAction (Created, Voted),
    ProposalLock (ProposalLock),
    StakeDatum (..),
    StakeRedeemer (PermitVote),
   )
  import Data.Coerce (coerce)
  import Data.Default (Default (def))
  import Data.Map.Strict qualified as StrictMap
  import Data.Tagged (Tagged)
  import Plutarch.Context (
    input,
    mint,
    normalizeValue,
    output,
    script,
    signedWith,
    timeRange,
    txId,
    withDatum,
    withRedeemer,
    withRef,
    withValue,
   )
  import Plutarch.Extra.AssetClass (assetClassValue)
  import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
  import PlutusLedgerApi.V1.Value qualified as Value
  import PlutusLedgerApi.V2 (
    Credential (PubKeyCredential),
    POSIXTime (POSIXTime),
    POSIXTimeRange,
    Redeemer (Redeemer),
    ToData (toBuiltinData),
    TxOutRef (TxOutRef),
    always,
   )
  import Sample.Proposal.Shared (stakeTxRef)
  import Sample.Shared (
    governor,
    governorAssetClass,
    governorScriptHash,
    governorValidator,
    minAda,
    proposalAssetClass,
    proposalPolicy,
    proposalPolicySymbol,
    proposalScriptHash,
    proposalStartingTimeFromTimeRange,
    signer,
    signer2,
    stakeAssetClass,
    stakeScriptHash,
    stakeSymbol,
    stakeValidator,
   )
  import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
  import Test.Util (
    CombinableBuilder,
    closedBoundedInterval,
    mkMinting,
    mkSpending,
    sortValue,
    validatorHashes,
   )
  
  -- | Parameters for creating a proposal.
  data Parameters = Parameters
    { advanceNextProposalId :: Bool
    -- ^ Whether to advance 'GovernorDatum.nextProposalId'.
    , createdMoreThanMaximumProposals :: Bool
    -- ^ Try creating more than maximum amount of proposals.
    , stakeOwnerSignsTheTransaction :: Bool
    -- ^ Should the stake owner sign the transaction?
    , invalidNewLocks :: Bool
    -- ^ Place invalid new locks on the output stake.
    , alterOutputStakeOwner :: Bool
    -- ^ Whether to change the 'owner' field of the output stake datum.
    , timeRangeTightEnough :: Bool
    -- ^ Is 'TxInfo.validTimeRange' tight enough?
    , timeRangeClosed :: Bool
    -- ^ Is 'TxInfo.validTimeRange' closed?
    , proposalStatus :: ProposalStatus
    -- ^ The status of the newly created proposal.
    , fakeSST :: Bool
    -- ^ Whether to use SST that doesn't belong to the stake validator.
    , governorRedeemer :: Redeemer
    -- ^ The redeemer used to spend the governor.
    }
  
  --------------------------------------------------------------------------------
  
  -- | See 'GovernorDatum.maximumCreatedProposalsPerStake'.
  maxProposalPerStake :: Integer
  maxProposalPerStake = 3
  
  -- | The id of the proposal we are creating.
  thisProposalId :: ProposalId
  thisProposalId = ProposalId 25
  
  -- | The arbitrary staked amount. Doesn;t really matter in this case.
  stakedGTs :: Tagged GTTag Integer
  stakedGTs = 5
  
  -- | The owner of the stake.
  stakeOwner :: Credential
  stakeOwner = PubKeyCredential signer
  
  {- | The invalid stake owner. If the 'alterOutputStakeOwner' is set to true,
        the output stake owner will be set to this.
  -}
  alteredStakeOwner :: Credential
  alteredStakeOwner = PubKeyCredential signer2
  
  -- | Locks the stake that the input stake already has.
  defLocks :: [ProposalLock]
  defLocks = [ProposalLock (ProposalId 0) Created]
  
  -- | The effect of the newly created proposal.
  defEffects :: StrictMap.Map ResultTag ProposalEffectGroup
  defEffects =
    StrictMap.fromList
      [ (ResultTag 0, StrictMap.empty)
      , (ResultTag 1, StrictMap.empty)
      , (ResultTag 3, StrictMap.empty)
      ]
  
  --------------------------------------------------------------------------------
  
  -- | The governor input datum.
  governorInputDatum :: GovernorDatum
  governorInputDatum =
    GovernorDatum
      { proposalThresholds = def
      , nextProposalId = thisProposalId
      , proposalTimings = def
      , createProposalTimeRangeMaxWidth = def
      , maximumCreatedProposalsPerStake = maxProposalPerStake
      }
  
  -- | Create governor output datum given the parameters.
  mkGovernorOutputDatum :: Parameters -> GovernorDatum
  mkGovernorOutputDatum ps =
    let nextPid =
          if ps.advanceNextProposalId
            then ProposalId $ coerce thisProposalId + 1
            else thisProposalId
     in GovernorDatum
          { proposalThresholds = def
          , nextProposalId = nextPid
          , proposalTimings = def
          , createProposalTimeRangeMaxWidth = def
          , maximumCreatedProposalsPerStake = maxProposalPerStake
          }
  
  --------------------------------------------------------------------------------
  
  -- | Create the stake input datum given the parameters.
  mkStakeInputDatum :: Parameters -> StakeDatum
  mkStakeInputDatum ps =
    let locks =
          if ps.createdMoreThanMaximumProposals
            then
              flip ProposalLock Created . ProposalId
                <$> take
                  (fromInteger maxProposalPerStake)
                  [1 ..]
            else defLocks
     in StakeDatum
          { stakedAmount = stakedGTs
          , owner = stakeOwner
          , delegatedTo = Nothing
          , lockedBy = locks
          }
  
  -- | Create the stake output datum given the parameters.
  mkStakeOutputDatum :: Parameters -> StakeDatum
  mkStakeOutputDatum ps =
    let inputDatum = mkStakeInputDatum ps
        newLocks =
          if ps.invalidNewLocks
            then
              [ ProposalLock thisProposalId $ Voted (ResultTag 0) 100
              , ProposalLock thisProposalId $ Voted (ResultTag 1) 100
              ]
            else [ProposalLock thisProposalId Created]
        locks = newLocks <> inputDatum.lockedBy
        newOwner = mkOwner ps
     in inputDatum
          { owner = newOwner
          , lockedBy = locks
          }
  
  --------------------------------------------------------------------------------
  
  {- | Create the proposal datum for the newly created proposal, given the
        parameters.
  -}
  mkProposalOutputDatum :: Parameters -> ProposalDatum
  mkProposalOutputDatum ps =
    let effects = defEffects
        votes = emptyVotesFor defEffects
     in ProposalDatum
          { proposalId = thisProposalId
          , effects = effects
          , status = ps.proposalStatus
          , cosigners = [mkOwner ps]
          , thresholds = def
          , votes = votes
          , timingConfig = def
          , startingTime = mkProposalStartingTime ps
          }
  
  --------------------------------------------------------------------------------
  
  -- | Create time range for 'TxInfo.validTimeRange'.
  mkTimeRange :: Parameters -> POSIXTimeRange
  mkTimeRange ps =
    if ps.timeRangeClosed
      then
        let s = 0
            di :: POSIXTime = coerce (def @MaxTimeRangeWidth)
            o = if ps.timeRangeTightEnough then (-1) else 1
         in closedBoundedInterval s $ o + di
      else always
  
  -- | Get the starting time of the proposal.
  mkProposalStartingTime :: Parameters -> ProposalStartingTime
  mkProposalStartingTime ps =
    if ps.timeRangeClosed
      then proposalStartingTimeFromTimeRange $ mkTimeRange ps
      else ProposalStartingTime 0
  
  -- | Who should be the 'owner' of the output stake.
  mkOwner :: Parameters -> Credential
  mkOwner ps =
    if ps.alterOutputStakeOwner
      then alteredStakeOwner
      else stakeOwner
  
  --------------------------------------------------------------------------------
  
  -- | Reference to the input stake UTXO.
  stakeRef :: TxOutRef
  stakeRef = TxOutRef stakeTxRef 1
  
  -- | Reference to the input governor UTXO.
  governorRef :: TxOutRef
  governorRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 3
  
  --------------------------------------------------------------------------------
  
  -- | Create a 'TxInfo' that spends a stake to create a new proposal.
  createProposal :: forall b. CombinableBuilder b => Parameters -> b
  createProposal ps = builder
    where
      pst = assetClassValue proposalAssetClass 1
      sst = assetClassValue stakeAssetClass 1
      gst = assetClassValue governorAssetClass 1
  
      ---
  
      attacker = head validatorHashes
  
      fakeStakeBuilder =
        if ps.fakeSST
          then
            mconcat
              [ input @b $
                  mconcat
                    [ script attacker
                    , withValue $
                        Value.singleton
                          stakeSymbol
                          (scriptHashToTokenName attacker)
                          1
                    , withDatum $
                        (mkStakeInputDatum ps)
                          { stakedAmount = 10000000000
                          }
                    ]
              ]
          else mempty
  
      ---
  
      governorValue = sortValue $ gst <> minAda
      stakeValue =
        sortValue $
          sst
            <> assetClassValue governor.gtClassRef stakedGTs
            <> minAda
      proposalValue = sortValue $ pst <> minAda
  
      ---
  
      withSig =
        if ps.stakeOwnerSignsTheTransaction
          then case stakeOwner of
            PubKeyCredential sig -> signedWith sig
            _ -> mempty
          else mempty
  
      ---
  
      builder =
        mconcat
          [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
          , ---
            withSig
          , ---
            mint $
              normalizeValue
                pst
          , ---
            timeRange $ mkTimeRange ps
          , input $
              mconcat
                [ script governorScriptHash
                , withValue governorValue
                , withDatum governorInputDatum
                , withRedeemer ps.governorRedeemer
                , withRef governorRef
                ]
          , output $
              mconcat
                [ script governorScriptHash
                , withValue governorValue
                , withDatum (mkGovernorOutputDatum ps)
                ]
          , ---
            if ps.fakeSST
              then
                mconcat
                  [ input @b $
                      mconcat
                        [ script attacker
                        , withValue $
                            Value.singleton
                              stakeSymbol
                              (scriptHashToTokenName attacker)
                              1
                        , withDatum $
                            (mkStakeInputDatum ps)
                              { stakedAmount = 10000000000
                              }
                        ]
                  ]
              else
                mconcat
                  [ input $
                      mconcat
                        [ script stakeScriptHash
                        , withValue stakeValue
                        , withDatum (mkStakeInputDatum ps)
                        , withRef stakeRef
                        ]
                  , output $
                      mconcat
                        [ script stakeScriptHash
                        , withValue stakeValue
                        , withDatum (mkStakeOutputDatum ps)
                        ]
                  ]
          , ---
            output $
              mconcat
                [ script proposalScriptHash
                , withValue proposalValue
                , withDatum (mkProposalOutputDatum ps)
                ]
          , ---
            fakeStakeBuilder
          ]
  
  --------------------------------------------------------------------------------
  
  -- | Spend the stake with the 'PermitVote' redeemer.
  stakeRedeemer :: StakeRedeemer
  stakeRedeemer = PermitVote
  
  -- | Mint the PST with an arbitrary redeemer. Doesn't really matter.
  proposalPolicyRedeemer :: ()
  proposalPolicyRedeemer = ()
  
  --------------------------------------------------------------------------------
  
  totallyValidParameters :: Parameters
  totallyValidParameters =
    Parameters
      { advanceNextProposalId = True
      , createdMoreThanMaximumProposals = False
      , stakeOwnerSignsTheTransaction = True
      , invalidNewLocks = False
      , alterOutputStakeOwner = False
      , timeRangeTightEnough = True
      , timeRangeClosed = True
      , proposalStatus = Draft
      , fakeSST = False
      , governorRedeemer = Redeemer $ toBuiltinData CreateProposal
      }
  
  invalidOutputGovernorDatumParameters :: Parameters
  invalidOutputGovernorDatumParameters =
    totallyValidParameters
      { advanceNextProposalId = False
      }
  
  useStakeOwnBySomeoneElseParameters :: Parameters
  useStakeOwnBySomeoneElseParameters =
    totallyValidParameters
      { stakeOwnerSignsTheTransaction = False
      }
  
  invalidOutputStakeParameters :: Parameters
  invalidOutputStakeParameters =
    totallyValidParameters
      { alterOutputStakeOwner = True
      }
  
  addInvalidLocksParameters :: Parameters
  addInvalidLocksParameters =
    totallyValidParameters
      { invalidNewLocks = True
      }
  
  exceedMaximumProposalsParameters :: Parameters
  exceedMaximumProposalsParameters =
    totallyValidParameters
      { createdMoreThanMaximumProposals = True
      }
  
  timeRangeNotTightParameters :: Parameters
  timeRangeNotTightParameters =
    totallyValidParameters
      { timeRangeTightEnough = False
      }
  
  timeRangeNotClosedParameters :: Parameters
  timeRangeNotClosedParameters =
    totallyValidParameters
      { timeRangeClosed = False
      }
  
  invalidProposalStatusParameters :: [Parameters]
  invalidProposalStatusParameters =
    map
      ( \st ->
          totallyValidParameters {proposalStatus = st}
      )
      [VotingReady, Locked, Finished]
  
  fakeSSTParameters :: Parameters
  fakeSSTParameters =
    totallyValidParameters
      { fakeSST = True
      }
  
  wrongGovernorRedeemer :: Parameters
  wrongGovernorRedeemer =
    totallyValidParameters
      { governorRedeemer = Redeemer $ toBuiltinData MintGATs
      }
  
  wrongGovernorRedeemer1 :: Parameters
  wrongGovernorRedeemer1 =
    totallyValidParameters
      { governorRedeemer = Redeemer $ toBuiltinData MutateGovernor
      }
  
  --------------------------------------------------------------------------------
  
  {- | Create a test tree that runs the proposal minting policy, the governor
        validator and the stake validator to test the functionalities of creting
        proposals
  -}
  mkTestTree :: String -> Parameters -> Bool -> Bool -> Bool -> SpecificationTree
  mkTestTree
    name
    ps
    validForProposalPolicy
    validForGovernorValidator
    validForStakeValidator =
      group name [proposalTest, governorTest, stakeTest]
      where
        mint = mkMinting createProposal ps
        spend = mkSpending createProposal ps
  
        proposalTest =
          testPolicy
            validForProposalPolicy
            "proposal"
            proposalPolicy
            proposalPolicyRedeemer
            (mint proposalPolicySymbol)
  
        governorTest =
          testValidator
            validForGovernorValidator
            "governor"
            governorValidator
            governorInputDatum
            ps.governorRedeemer
            (spend governorRef)
  
        stakeTest =
          testValidator
            validForStakeValidator
            "stake"
            stakeValidator
            (mkStakeInputDatum ps)
            stakeRedeemer
            (spend stakeRef)
  