{- |
Module     : Sample.Proposal.Advance
Maintainer : connor@mlabs.city
Description: Generate sample data for testing the functionalities of advancing proposals

Sample and utilities for testing the functionalities of advancing proposals.
-}
module Sample.Proposal.Advance (
  -- * Parameters
  ParameterBundle (..),
  GovernorParameters (..),
  AuthorityTokenParameters (..),
  ProposalParameters (..),
  StakeParameters (..),
  Winner (..),

  -- * Testing Utilities
  Validity (..),
  advance,
  mkTestTree,
  mkTestTree',

  -- * Parameter Bundles
  mkValidToNextStateBundle,
  mkValidToNextStateBundles,
  mkValidToFailedStateBundles,
  mkInsufficientVotesBundle,
  mkAmbiguousWinnerBundle,
  mkFromFinishedBundles,
  mkInsufficientCosignsBundle,
  mkToNextStateTooLateBundles,
  mkMintGATsForWrongEffectsBundle,
  mkNoGATMintedBundle,
  mkGATsWithWrongDatumBundle,
  mkMintGATsWithoutTagBundle,
  mkBadGovernorOutputDatumBundle,
  mkUnexpectedOutputStakeBundles,
  mkFastforwardToFinishBundles,
  mkBadGovernorRedeemerBundle,
) where

import Agora.Governor (
  Governor (..),
  GovernorDatum (..),
  GovernorRedeemer (CreateProposal, MintGATs),
 )
import Agora.Proposal (
  ProposalDatum (..),
  ProposalEffectGroup,
  ProposalEffectMetadata (ProposalEffectMetadata),
  ProposalId (ProposalId),
  ProposalRedeemer (AdvanceProposal),
  ProposalStatus (..),
  ProposalThresholds (..),
  ProposalVotes (ProposalVotes),
  ResultTag (ResultTag),
  emptyVotesFor,
 )
import Agora.Proposal.Time (
  ProposalStartingTime (ProposalStartingTime),
  ProposalTimingConfig (
    draftTime,
    executingTime,
    lockingTime,
    votingTime
  ),
 )
import Agora.SafeMoney (AuthorityTokenTag, GTTag)
import Agora.Stake (
  StakeDatum (..),
 )
import Control.Applicative (liftA2)
import Control.Monad.State (execState, modify, when)
import Data.Default (def)
import Data.List (singleton, sort)
import Data.Map.Strict qualified as StrictMap
import Data.Maybe (fromJust)
import Data.Tagged (Tagged (Tagged), untag)
import Plutarch.Context (
  input,
  mint,
  output,
  referenceInput,
  script,
  signedWith,
  timeRange,
  withDatum,
  withInlineDatum,
  withRedeemer,
  withRef,
  withValue,
 )
import Plutarch.Extra.AssetClass (AssetClass (AssetClass), assetClassValue)
import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
import PlutusLedgerApi.V2 (
  Credential (PubKeyCredential),
  DatumHash,
  POSIXTime,
  POSIXTimeRange,
  PubKeyHash,
  ScriptHash,
  TxOutRef (TxOutRef),
 )
import PlutusTx qualified
import Sample.Proposal.Shared (
  governorTxRef,
  proposalTxRef,
  stakeTxRef,
 )
import Sample.Shared (
  authorityTokenPolicy,
  authorityTokenSymbol,
  governor,
  governorAssetClass,
  governorScriptHash,
  governorValidator,
  minAda,
  proposalAssetClass,
  proposalScriptHash,
  proposalValidator,
  signer,
  stakeAssetClass,
  stakeScriptHash,
 )
import Test.Specification (
  SpecificationTree,
  group,
  testPolicy,
  testValidator,
 )
import Test.Util (
  CombinableBuilder,
  closedBoundedInterval,
  datumHash,
  groupsOfN,
  mkMinting,
  mkSpending,
  pubKeyHashes,
  scriptHashes,
  sortValue,
  toDatum,
  validatorHashes,
 )

{- | A bunch of parameters that control the generation of the transaction
    context.
-}
data ParameterBundle = ParameterBundle
  { proposalParameters :: ProposalParameters
  -- ^ Parameters related to the the advancing proposal.
  , stakeParameters :: StakeParameters
  -- ^ Parameters related to stakes.
  , governorParameters :: Maybe GovernorParameters
  -- ^ Parameters related to GST moving. If set to 'Nothing', the GST won't
  --   be moved, thus the governor validator won't be run in 'mkTestTree'.
  , authorityTokenParameters :: [AuthorityTokenParameters]
  -- ^ Parameters related to GAT minting. If set to 'Nothing', no GAT will
  --     be minted, thus the GAT minting policy won't be run in 'mkTestTree'.
  , transactionTimeRange :: POSIXTimeRange
  -- ^ The value of 'TxInfo.txInfoValidRange', valid range of the generated
  --    transaction.
  , extraSignature :: Maybe PubKeyHash
  -- ^ An extra signator. Intended to be used when
  --    'StakeParametersstakeParameters.transactionSignedByOwners' is set to
  --    false.
  }

-- | Everything about the generated governor stuff.
data GovernorParameters = forall
    (redeemer :: Type)
    (predeemer :: PType).
  ( PUnsafeLiftDecl predeemer
  , PLifted predeemer ~ redeemer
  , PIsData predeemer
  , PlutusTx.ToData redeemer
  ) =>
  GovernorParameters
  { invalidGovernorOutputDatum :: Bool
  -- ^ The output governor datum will be changed.
  , governorRedeemer :: redeemer
  }

-- | Everything about the generated authority token stuff.
data AuthorityTokenParameters = forall
    (datum :: Type)
    (pdatum :: S -> Type).
  ( PUnsafeLiftDecl pdatum
  , PLifted pdatum ~ datum
  , PIsData pdatum
  ) =>
  AuthorityTokenParameters
  { mintGATsFor :: ScriptHash
  -- ^ GATs will be minted and sent to the given group of effects.
  , carryDatum :: Maybe datum
  -- ^ The datum that GAT UTxOs will be carrying.
  , carryAuthScript :: Maybe ScriptHash
  -- ^ The authentication script that GAT UTxOs link to through their token name.
  , invalidTokenName :: Bool
  -- ^ If set to true, GATs won't be tagged by their corresponding effect
  --    hashes.
  }

-- | Represent the winning effect group(s).
data Winner
  = -- | Only one effect at the given index has the highest votes.
    EffectAt Index
  | -- | All the effects have the same highest votes.
    All

-- | Everything about the generated proposal stuff.
data ProposalParameters = ProposalParameters
  { fromStatus :: ProposalStatus
  -- ^ What status is the proposal advancing from
  , toStatus :: ProposalStatus
  -- ^ What status is the proposal advancing to
  , effectList :: [ProposalEffectGroup]
  -- ^ The effect groups of the proposal. A neutral effect group is not
  --    required here.
  , winnerAndVotes :: Maybe (Winner, Integer)
  -- ^ Specify the effect group(s) that have the highest votes, and the value
  --    of the highest votes.
  , numCosigners :: NumStake
  -- ^ The number of cosigners.
  , invalidProposalOutputDatum :: Bool
  -- ^ Whether to make the proposal output datum invalid or not.
  }

-- | Everything about the generated stake stuff.
data StakeParameters = StakeParameters
  { numStake :: NumStake
  , perStakeGTs :: Tagged GTTag Integer
  , transactionSignedByOwners :: Bool
  }

-- | Represent the number of stakes or the number of the cosigners.
type NumStake = Int

-- | Represent an index.
type Index = Int

{- | The validity of the generated transaction for variuos componets.
     'True' means valid, 'False' means invalid.
-}
data Validity = Validity
  { forProposalValidator :: Bool
  , forStakeValidator :: Bool
  , forGovernorValidator :: Maybe Bool
  , forAuthorityTokenPolicy :: Maybe Bool
  }

--------------------------------------------------------------------------------

-- * Proposal

-- | Mock cosigners.
mkCosigners :: NumStake -> [Credential]
mkCosigners = sort . fmap PubKeyCredential . flip take pubKeyHashes

-- | Allocate the result tag for the effect at the given index.
outcomeIdxToResultTag :: Index -> ResultTag
outcomeIdxToResultTag = ResultTag . fromIntegral

-- | Add a neutral effect group and allocate result tags for the effect groups.
mkEffects ::
  ProposalParameters ->
  StrictMap.Map ResultTag ProposalEffectGroup
mkEffects ps =
  let resultTags = map ResultTag [0 ..]
      neutralEffect = StrictMap.empty
      finalEffects = ps.effectList <> [neutralEffect]
   in StrictMap.fromList $ zip resultTags finalEffects

-- | Set the votes of the winning group(s).
setWinner :: (Winner, Integer) -> ProposalVotes -> ProposalVotes
setWinner (All, votes) (ProposalVotes m) =
  ProposalVotes $ StrictMap.mapMaybe (const $ Just votes) m
setWinner (EffectAt winnerIdx, votes) (ProposalVotes m) =
  let winnerResultTag = outcomeIdxToResultTag winnerIdx
   in ProposalVotes $ StrictMap.adjust (const votes) winnerResultTag m

-- | Mock votes for the proposal, given the parameters.
mkVotes ::
  ProposalParameters ->
  ProposalVotes
mkVotes ps =
  let effects = mkEffects ps
      emptyVotes = emptyVotesFor effects
   in maybe emptyVotes (`setWinner` emptyVotes) (ps.winnerAndVotes)

-- | The starting time of every generated proposal.
proposalStartingTime :: POSIXTime
proposalStartingTime = 100

-- | Create the input proposal datum given the parameters.
mkProposalInputDatum :: ProposalParameters -> ProposalDatum
mkProposalInputDatum ps =
  let effects = mkEffects ps
      votes = mkVotes ps
      st = ProposalStartingTime proposalStartingTime
   in ProposalDatum
        { proposalId = ProposalId 0
        , effects = effects
        , status = ps.fromStatus
        , cosigners = mkCosigners ps.numCosigners
        , thresholds = def
        , votes = votes
        , timingConfig = def
        , startingTime = st
        }

-- | Create the output proposal datum given the parameters.
mkProposalOutputDatum :: ProposalParameters -> ProposalDatum
mkProposalOutputDatum ps =
  let inputDatum = mkProposalInputDatum ps
      outputCosigners =
        if ps.invalidProposalOutputDatum
          then []
          else inputDatum.cosigners
   in inputDatum
        { status = ps.toStatus
        , cosigners = outputCosigners
        }

-- | Reference to the proposal UTXO.
proposalRef :: TxOutRef
proposalRef = TxOutRef proposalTxRef 1

{- | Create a context builder that contains all the information about the
      input/output of the proposal validator, given the paramters.
-}
mkProposalBuilder :: forall b. CombinableBuilder b => ProposalParameters -> b
mkProposalBuilder ps =
  let pst = assetClassValue proposalAssetClass 1
      value = sortValue $ minAda <> pst
   in mconcat
        [ input $
            mconcat
              [ script proposalScriptHash
              , withRef proposalRef
              , withDatum (mkProposalInputDatum ps)
              , withValue value
              ]
        , output $
            mconcat
              [ script proposalScriptHash
              , withDatum (mkProposalOutputDatum ps)
              , withValue value
              ]
        ]

{- | The proposal redeemer used to spend the proposal UTXO, which is always
      'AdvanceProposal' in this case.
-}
proposalRedeemer :: ProposalRedeemer
proposalRedeemer = AdvanceProposal

--------------------------------------------------------------------------------

-- * Stake

-- Mock owners of the stakes.
mkStakeOwners :: NumStake -> [Credential]
mkStakeOwners = mkCosigners

-- | Create the input stake datums given the parameters.
mkStakeInputDatums :: StakeParameters -> [StakeDatum]
mkStakeInputDatums ps =
  let template =
        StakeDatum
          { stakedAmount = ps.perStakeGTs
          , owner = PubKeyCredential ""
          , delegatedTo = Nothing
          , lockedBy = []
          }
   in (\owner -> template {owner = owner})
        <$> mkStakeOwners ps.numStake

-- | Create the reference to a particular stake UTXO.
mkStakeRef :: Index -> TxOutRef
mkStakeRef = TxOutRef stakeTxRef . (+ 3) . fromIntegral

{- | Create a context builder that contains all the inputs/outputs of the
      stake validator.
-}
mkStakeBuilder :: forall b. CombinableBuilder b => StakeParameters -> b
mkStakeBuilder ps =
  let perStakeValue =
        sortValue $
          minAda
            <> assetClassValue stakeAssetClass 1
            <> assetClassValue
              governor.gtClassRef
              ps.perStakeGTs
      perStake idx i =
        let withSig =
              case (i.owner, ps.transactionSignedByOwners) of
                (PubKeyCredential owner, True) -> signedWith owner
                _ -> mempty
         in mconcat
              [ withSig
              , referenceInput $
                  mconcat
                    [ script stakeScriptHash
                    , withRef (mkStakeRef idx)
                    , withValue perStakeValue
                    , withInlineDatum i
                    ]
              ]
   in mconcat $
        zipWith
          perStake
          [0 :: Index ..]
          (mkStakeInputDatums ps)

--------------------------------------------------------------------------------

-- * Governor

-- | The input governor datum.
governorInputDatum :: GovernorDatum
governorInputDatum =
  GovernorDatum
    { proposalThresholds = def
    , nextProposalId = ProposalId 42
    , proposalTimings = def
    , createProposalTimeRangeMaxWidth = def
    , maximumCreatedProposalsPerStake = 3
    }

-- | Create the output governor datum given the parameters.
mkGovernorOutputDatum :: GovernorParameters -> GovernorDatum
mkGovernorOutputDatum ps =
  if ps.invalidGovernorOutputDatum
    then governorInputDatum {maximumCreatedProposalsPerStake = 15}
    else governorInputDatum

-- | Reference to the governor UTXO.
governorRef :: TxOutRef
governorRef = TxOutRef governorTxRef 2

{- | Create a context builder that contains the input and  the output of the
      governor validator.
-}
mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b
mkGovernorBuilder ps@(GovernorParameters _ redeemer) =
  let gst = assetClassValue governorAssetClass 1
      value = sortValue $ gst <> minAda
   in mconcat
        [ input $
            mconcat
              [ script governorScriptHash
              , withValue value
              , withRef governorRef
              , withDatum governorInputDatum
              , withRedeemer redeemer
              ]
        , output $
            mconcat
              [ script governorScriptHash
              , withValue value
              , withRef governorRef
              , withDatum (mkGovernorOutputDatum ps)
              ]
        ]

--------------------------------------------------------------------------------

-- * Authority Token

{- | Create a context builder that contains the infomation about the minted
      authority tokens and where they're sent to.
-}
mkAuthorityTokenBuilder ::
  forall b.
  CombinableBuilder b =>
  AuthorityTokenParameters ->
  b
mkAuthorityTokenBuilder ps@AuthorityTokenParameters {carryDatum} =
  let tn =
        case (ps.invalidTokenName, ps.carryAuthScript) of
          (True, Just _) -> "deadbeef"
          (True, Nothing) -> "deadbeef"
          (False, Just as) -> scriptHashToTokenName as
          (False, Nothing) -> ""
      ac = Tagged @AuthorityTokenTag $ AssetClass authorityTokenSymbol tn
      minted = assetClassValue ac 1
      value = sortValue $ minAda <> minted
   in mconcat
        [ mint minted
        , output $
            mconcat
              [ script ps.mintGATsFor
              , maybe mempty withDatum carryDatum
              , withValue value
              ]
        ]

-- | The redeemer used while running the authority token policy.
authorityTokenRedeemer :: ()
authorityTokenRedeemer = ()

--------------------------------------------------------------------------------

-- | Create a 'TxInfo' that update the status of a proposal.
advance ::
  forall b.
  CombinableBuilder b =>
  ParameterBundle ->
  b
advance pb =
  let mkBuilderMaybe = maybe mempty
   in mconcat
        [ mkProposalBuilder pb.proposalParameters
        , mkStakeBuilder pb.stakeParameters
        , mkBuilderMaybe mkGovernorBuilder pb.governorParameters
        , foldMap mkAuthorityTokenBuilder pb.authorityTokenParameters
        , timeRange pb.transactionTimeRange
        , maybe mempty signedWith pb.extraSignature
        ]

--------------------------------------------------------------------------------

{- | Create a test tree that runs the relavant componets to test the advancing
      functionalities.
-}
mkTestTree ::
  String ->
  ParameterBundle ->
  Validity ->
  SpecificationTree
mkTestTree name pb val =
  group name $ mconcat [proposal, governor, authority]
  where
    spend = mkSpending advance pb

    proposal =
      let proposalInputDatum = mkProposalInputDatum pb.proposalParameters
       in singleton $
            testValidator
              val.forProposalValidator
              "proposal"
              proposalValidator
              proposalInputDatum
              proposalRedeemer
              (spend proposalRef)

    governor =
      maybe
        []
        ( singleton
            . ( \(GovernorParameters _ governorRedeemer) ->
                  testValidator
                    (fromJust val.forGovernorValidator)
                    "governor"
                    governorValidator
                    governorInputDatum
                    governorRedeemer
                    (spend governorRef)
              )
        )
        (pb.governorParameters)

    authority = case pb.authorityTokenParameters of
      [] -> []
      _ ->
        singleton
          ( testPolicy
              (fromJust val.forAuthorityTokenPolicy)
              "authority"
              authorityTokenPolicy
              authorityTokenRedeemer
              (mkMinting advance pb authorityTokenSymbol)
          )

{- | Create a test tree that runs a bunch of parameter bundles. These bundles
      should have the same validity.
-}
mkTestTree' ::
  String ->
  (ParameterBundle -> String) ->
  [ParameterBundle] ->
  Validity ->
  SpecificationTree
mkTestTree' groupName mkCaseName bundles val =
  group groupName $
    (\b -> mkTestTree (mkCaseName b) b val)
      <$> bundles

--------------------------------------------------------------------------------

-- Utilities for creating parameter bundles

{- | Given the proposal status, create a time range that is in time for
      advacing to the next state.
-}
mkInTimeTimeRange :: ProposalStatus -> POSIXTimeRange
mkInTimeTimeRange advanceFrom =
  case advanceFrom of
    -- [S + 1, S + D - 1]
    Draft ->
      closedBoundedInterval
        (proposalStartingTime + 1)
        (proposalStartingTime + (def :: ProposalTimingConfig).draftTime - 1)
    -- [S + D + V + 1, S + D + V + L - 1]
    VotingReady ->
      closedBoundedInterval
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + 1
        )
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + (def :: ProposalTimingConfig).lockingTime
            - 1
        )
    -- [S + D + V + L + 1, S + + D + V + L + E - 1]
    Locked ->
      closedBoundedInterval
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + (def :: ProposalTimingConfig).lockingTime
            + 1
        )
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + (def :: ProposalTimingConfig).lockingTime
            + (def :: ProposalTimingConfig).executingTime
            - 1
        )
    Finished -> error "Cannot advance 'Finished' proposal"

{- | Given the proposal status, create a time range that is too time for
      advacing to the next state.
-}
mkTooLateTimeRange :: ProposalStatus -> POSIXTimeRange
mkTooLateTimeRange advanceFrom =
  case advanceFrom of
    -- [S + D + 1, S + D + V - 1]
    Draft ->
      closedBoundedInterval
        (proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1)
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            - 1
        )
    -- [S + D + V + L + 1, S + D + V + L + E -1]
    VotingReady ->
      closedBoundedInterval
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + (def :: ProposalTimingConfig).lockingTime
            + 1
        )
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + (def :: ProposalTimingConfig).lockingTime
            + (def :: ProposalTimingConfig).executingTime
            - 1
        )
    -- [S + D + V + L + E + 1, S + D + V + L + E + 100]
    Locked ->
      closedBoundedInterval
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + (def :: ProposalTimingConfig).lockingTime
            + (def :: ProposalTimingConfig).executingTime
            + 1
        )
        ( proposalStartingTime
            + (def :: ProposalTimingConfig).draftTime
            + (def :: ProposalTimingConfig).votingTime
            + (def :: ProposalTimingConfig).lockingTime
            + (def :: ProposalTimingConfig).executingTime
            + 100
        )
    Finished -> error "Cannot advance 'Finished' proposal"

-- | Next state of the given proposal status.
getNextState :: ProposalStatus -> ProposalStatus
getNextState = \case
  Draft -> VotingReady
  VotingReady -> Locked
  Locked -> Finished
  Finished -> error "Cannot advance 'Finished' proposal"

-- | Calculate the number of GTs per stake in order to exceed the minimum limit.
compPerStakeGTsForDraft :: NumStake -> Tagged GTTag Integer
compPerStakeGTsForDraft nCosigners =
  Tagged $
    untag (def :: ProposalThresholds).toVoting
      `div` fromIntegral nCosigners
      + 1

dummyDatum :: ()
dummyDatum = ()

dummyDatumHash :: DatumHash
dummyDatumHash = datumHash $ toDatum dummyDatum

-- | Create given number of effect groups. Each group will have 3 effects.
mkMockEffects :: Bool -> Int -> [ProposalEffectGroup]
mkMockEffects useAuthScript n = effects
  where
    effectsPerGroup = 3

    mkAuthScripts True = Just <$> scriptHashes
    mkAuthScripts False = repeat Nothing
    authScripts = mkAuthScripts useAuthScript

    datums = repeat dummyDatumHash

    effectMetadata = zipWith ProposalEffectMetadata datums authScripts
    effectScripts = validatorHashes

    effects =
      take n $
        StrictMap.fromList
          <$> groupsOfN
            effectsPerGroup
            (zip effectScripts effectMetadata)

numberOfVotesThatJustMeetsTheMinimumRequirement :: Integer
numberOfVotesThatJustMeetsTheMinimumRequirement =
  untag (def @ProposalThresholds).execute

mkWinnerVotes :: Index -> (Winner, Integer)
mkWinnerVotes idx =
  ( EffectAt idx
  , numberOfVotesThatJustMeetsTheMinimumRequirement
  )

ambiguousWinnerVotes :: (Winner, Integer)
ambiguousWinnerVotes =
  ( All
  , numberOfVotesThatJustMeetsTheMinimumRequirement
  )

--------------------------------------------------------------------------------

-- * Parameter Bundles

---

-- * Legal

defaultWinnerIdx :: Index
defaultWinnerIdx = 0

{- | Advance a proposal to the next state, perfectly valid for all the
    componets.
-}
mkValidToNextStateBundle ::
  -- | Number of cosigners.
  Word ->
  -- | Number of effects.
  Word ->
  -- | Toggle the referenc script in GAT UTXO.
  Bool ->
  -- | The initial proposal state, should not be 'Finished'.
  ProposalStatus ->
  ParameterBundle
mkValidToNextStateBundle _ _ _ Finished =
  error "Cannot advance from Finished"
mkValidToNextStateBundle nCosigners nEffects authScript from =
  let next = getNextState from
      effects = mkMockEffects authScript $ fromIntegral nEffects
      winner = defaultWinnerIdx

      template =
        ParameterBundle
          { proposalParameters =
              ProposalParameters
                { fromStatus = from
                , toStatus = next
                , effectList = effects
                , winnerAndVotes = Nothing
                , numCosigners = fromIntegral nCosigners
                , invalidProposalOutputDatum = False
                }
          , stakeParameters =
              StakeParameters
                { numStake = 0
                , perStakeGTs =
                    compPerStakeGTsForDraft $
                      fromIntegral nCosigners
                , transactionSignedByOwners = False
                }
          , governorParameters = Nothing
          , authorityTokenParameters = []
          , transactionTimeRange = mkInTimeTimeRange from
          , extraSignature = Just signer
          }

      -- This is my favourite part of the test suite, lol.
      modifyTemplate = do
        when (from == Draft) $
          modify $ \b ->
            b
              { stakeParameters =
                  b.stakeParameters
                    { transactionSignedByOwners = True
                    , numStake = fromIntegral nCosigners
                    }
              , extraSignature = Nothing
              }

        when (from == VotingReady || from == Locked) $
          modify $ \b ->
            b
              { proposalParameters =
                  b.proposalParameters
                    { winnerAndVotes = Just $ mkWinnerVotes winner
                    }
              }

        when (from == Locked) $
          modify $ \b ->
            let aut =
                  StrictMap.elems $
                    StrictMap.mapWithKey
                      ( \vh (ProposalEffectMetadata _ authScript) ->
                          AuthorityTokenParameters
                            { mintGATsFor = vh
                            , carryDatum = Just dummyDatum
                            , carryAuthScript = authScript
                            , invalidTokenName = False
                            }
                      )
                      (effects !! winner)
                gov =
                  GovernorParameters
                    { invalidGovernorOutputDatum = False
                    , governorRedeemer = MintGATs
                    }
             in b
                  { governorParameters = Just gov
                  , authorityTokenParameters = aut
                  }
   in execState modifyTemplate template

mkValidToNextStateBundles ::
  -- | Number of cosigners
  Word ->
  -- | Number of effects
  Word ->
  [ParameterBundle]
mkValidToNextStateBundles nCosigners nEffects =
  liftA2
    (mkValidToNextStateBundle nCosigners nEffects)
    [True, False]
    [Draft, VotingReady, Locked]

mkValidToFailedStateBundles ::
  -- | Number of cosigners
  Word ->
  -- | Number of effects
  Word ->
  [ParameterBundle]
mkValidToFailedStateBundles nCosigners nEffects =
  liftA2
    mkBundle
    [True, False]
    [Draft, VotingReady, Locked]
  where
    mkBundle authScript from =
      let next = Finished
          effects = mkMockEffects authScript $ fromIntegral nEffects
       in ParameterBundle
            { proposalParameters =
                ProposalParameters
                  { fromStatus = from
                  , toStatus = next
                  , effectList = effects
                  , winnerAndVotes = Nothing
                  , numCosigners = fromIntegral nCosigners
                  , invalidProposalOutputDatum = False
                  }
            , stakeParameters =
                StakeParameters
                  { numStake = 0
                  , perStakeGTs =
                      compPerStakeGTsForDraft $
                        fromIntegral nCosigners
                  , transactionSignedByOwners = False
                  }
            , governorParameters = Nothing
            , authorityTokenParameters = []
            , transactionTimeRange = mkTooLateTimeRange from
            , extraSignature = Just signer
            }

-- * Illegal

mkFromFinishedBundles ::
  -- | Number of cosigners
  Word ->
  -- | Number of effects
  Word ->
  [ParameterBundle]
mkFromFinishedBundles nCosigners nEffects =
  liftA2
    mkBundle
    [True, False]
    [Draft, VotingReady, Locked]
  where
    mkBundle authScript from =
      let template = mkValidToNextStateBundle nCosigners nEffects authScript from
       in template
            { proposalParameters =
                template.proposalParameters
                  { fromStatus = Finished
                  , toStatus = Finished
                  }
            }

mkToNextStateTooLateBundles :: Word -> Word -> [ParameterBundle]
mkToNextStateTooLateBundles nCosigners nEffects =
  liftA2
    mkBundle
    [True, False]
    [Draft, VotingReady, Locked]
  where
    mkBundle authScript from =
      let template = mkValidToNextStateBundle nCosigners nEffects authScript from
       in template
            { transactionTimeRange = mkTooLateTimeRange from
            }

mkUnexpectedOutputStakeBundles :: Word -> Word -> [ParameterBundle]
mkUnexpectedOutputStakeBundles nCosigners nEffects =
  liftA2
    mkBundle
    [True, False]
    [VotingReady, Locked]
  where
    mkBundle authScript from =
      let template = mkValidToNextStateBundle nCosigners nEffects authScript from
       in template
            { stakeParameters =
                template.stakeParameters
                  { numStake = 1
                  }
            }

-- * From Draft

mkInsufficientCosignsBundle :: Word -> Word -> ParameterBundle
mkInsufficientCosignsBundle nCosigners nEffects =
  template
    { stakeParameters =
        template.stakeParameters
          { perStakeGTs = insuffcientPerStakeGTs
          }
    }
  where
    insuffcientPerStakeGTs =
      Tagged $
        untag (def :: ProposalThresholds).toVoting
          `div` fromIntegral nCosigners
          - 1
    template = mkValidToNextStateBundle nCosigners nEffects False Draft

-- * From VotingReady

setWinnerAndVotes ::
  ParameterBundle ->
  Maybe (Winner, Integer) ->
  ParameterBundle
setWinnerAndVotes pb wv =
  pb
    { proposalParameters =
        pb.proposalParameters
          { winnerAndVotes = wv
          }
    }

mkInsufficientVotesBundle ::
  Word ->
  Word ->
  ParameterBundle
mkInsufficientVotesBundle nCosigners nEffects =
  mkValidToNextStateBundle nCosigners nEffects False VotingReady
    `setWinnerAndVotes` Nothing

mkAmbiguousWinnerBundle ::
  Word ->
  Word ->
  ParameterBundle
mkAmbiguousWinnerBundle nCosigners nEffects =
  mkValidToNextStateBundle nCosigners nEffects False VotingReady
    `setWinnerAndVotes` Just ambiguousWinnerVotes

-- * From Locked

mkValidFromLockedBundle :: Word -> Word -> ParameterBundle
mkValidFromLockedBundle nCosigners nEffects =
  mkValidToNextStateBundle nCosigners nEffects False Locked

mkMintGATsForWrongEffectsBundle ::
  Word ->
  Word ->
  ParameterBundle
mkMintGATsForWrongEffectsBundle nCosigners nEffects =
  template
    { authorityTokenParameters =
        take 4 $
          zipWith
            (\a i -> a {mintGATsFor = validatorHashes !! i})
            template.authorityTokenParameters
            [1, 3 ..]
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects

mkNoGATMintedBundle ::
  Word ->
  Word ->
  ParameterBundle
mkNoGATMintedBundle nCosigners nEffects =
  template
    { authorityTokenParameters = []
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects

mkMintGATsWithoutTagBundle ::
  Word ->
  Word ->
  ParameterBundle
mkMintGATsWithoutTagBundle nCosigners nEffects =
  template
    { authorityTokenParameters =
        ( \aut ->
            aut
              { invalidTokenName = True
              }
        )
          <$> template.authorityTokenParameters
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects

mkGATsWithWrongDatumBundle ::
  Word ->
  Word ->
  ParameterBundle
mkGATsWithWrongDatumBundle nCosigners nEffects =
  template
    { authorityTokenParameters = newAut
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects
    newAut =
      ( \aut ->
          AuthorityTokenParameters
            aut.mintGATsFor
            (Just (1 :: Integer))
            aut.carryAuthScript
            False
      )
        <$> template.authorityTokenParameters

mkBadGovernorOutputDatumBundle ::
  Word ->
  Word ->
  ParameterBundle
mkBadGovernorOutputDatumBundle nCosigners nEffects =
  template
    { governorParameters = Just gov
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects
    gov = GovernorParameters True MintGATs

mkBadGovernorRedeemerBundle ::
  Word ->
  Word ->
  ParameterBundle
mkBadGovernorRedeemerBundle nCosigners nEffects =
  template
    { governorParameters = Just gov
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects
    gov = GovernorParameters False CreateProposal

mkFastforwardToFinishBundles ::
  Word ->
  Word ->
  [ParameterBundle]
mkFastforwardToFinishBundles nCosigners nEffects = updateTemplate <$> templates
  where
    templates = mkValidToFailedStateBundles nCosigners nEffects
    mkMaliciousTimRange =
      let lb = proposalStartingTime - 1
          dub =
            1
              + proposalStartingTime
              + (def :: ProposalTimingConfig).draftTime
          vub =
            dub
              + (def :: ProposalTimingConfig).votingTime
              + (def :: ProposalTimingConfig).lockingTime
          lub =
            vub
              + (def :: ProposalTimingConfig).executingTime
          go Draft = (lb, dub)
          go VotingReady = (lb, vub)
          go Locked = (lb, lub)
          go Finished = error "cannot advance from Finished"
       in uncurry closedBoundedInterval . go
    updateTemplate template =
      template
        { transactionTimeRange =
            mkMaliciousTimRange template.proposalParameters.fromStatus
        }