{- |
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,
  mkInvalidOutputStakeBundles,
  mkMintGATsForWrongEffectsBundle,
  mkNoGATMintedBundle,
  mkGATsWithWrongDatumBundle,
  mkMintGATsWithoutTagBundle,
  mkBadGovernorOutputDatumBundle,
) where

import Agora.AuthorityToken (
  AuthorityToken (AuthorityToken),
  authorityTokenPolicy,
 )
import Agora.Governor (
  GovernorDatum (..),
  GovernorRedeemer (MintGATs),
 )
import Agora.Governor.Scripts (governorValidator)
import Agora.Proposal (
  ProposalDatum (..),
  ProposalId (ProposalId),
  ProposalRedeemer (AdvanceProposal),
  ProposalStatus (..),
  ProposalThresholds (..),
  ProposalVotes (ProposalVotes),
  ResultTag (ResultTag),
  emptyVotesFor,
 )
import Agora.Proposal.Scripts (proposalValidator)
import Agora.Proposal.Time (
  ProposalStartingTime (ProposalStartingTime),
  ProposalTimingConfig (
    draftTime,
    executingTime,
    lockingTime,
    votingTime
  ),
 )
import Agora.Stake (
  Stake (gtClassRef),
  StakeDatum (..),
  StakeRedeemer (WitnessStake),
 )
import Agora.Stake.Scripts (stakeValidator)
import Agora.Utils (validatorHashToTokenName)
import Control.Monad.State (execState, modify, when)
import Data.Default (def)
import Data.List (sort)
import Data.Maybe (catMaybes, fromJust)
import Data.Tagged (Tagged (..), untag)
import Plutarch.Context (
  input,
  mint,
  output,
  script,
  signedWith,
  timeRange,
  withDatum,
  withOutRef,
  withValue,
 )
import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
import PlutusLedgerApi.V1 (
  DatumHash,
  POSIXTime,
  POSIXTimeRange,
  PubKeyHash,
  TxOutRef (TxOutRef),
  ValidatorHash,
 )
import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (
  governorTxRef,
  proposalTxRef,
  stakeTxRef,
 )
import Sample.Shared (
  authorityTokenSymbol,
  govAssetClass,
  govValidatorHash,
  minAda,
  proposalPolicySymbol,
  proposalValidatorHash,
  signer,
  stake,
  stakeAssetClass,
  stakeValidatorHash,
 )
import Sample.Shared qualified as Shared
import Test.Specification (
  SpecificationTree,
  group,
  testPolicy,
  testValidator,
 )
import Test.Util (
  CombinableBuilder,
  closedBoundedInterval,
  datumHash,
  groupsOfN,
  mkMinting,
  mkSpending,
  pubKeyHashes,
  sortValue,
  toDatum,
  updateMap,
  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 :: Maybe 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.
newtype GovernorParameters = GovernorParameters
  { invalidGovernorOutputDatum :: Bool
  -- ^ The output governor datum will be changed.
  }

-- | Everything about the generated authority token stuff.
data AuthorityTokenParameters = forall
    (datum :: Type)
    (pdatum :: S -> Type).
  ( PUnsafeLiftDecl pdatum
  , PLifted pdatum ~ datum
  , PIsData pdatum
  ) =>
  AuthorityTokenParameters
  { mintGATsFor :: [ValidatorHash]
  -- ^ GATs will be minted and sent to the given group of effects.
  , carryDatum :: Maybe datum
  -- ^ The datum that GAT UTxOs will be carrying.
  , 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 :: [AssocMap.Map ValidatorHash DatumHash]
  -- ^ 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 :: Integer
  , transactionSignedByOwners :: Bool
  , invalidStakeOutputDatum :: 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 transacrion 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 -> [PubKeyHash]
mkCosigners = sort . 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 ->
  AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
mkEffects ps =
  let resultTags = map ResultTag [0 ..]
      neutralEffect = AssocMap.empty
      finalEffects = ps.effectList <> [neutralEffect]
   in AssocMap.fromList $ zip resultTags finalEffects

-- | Set the votes of the winning group(s).
setWinner :: (Winner, Integer) -> ProposalVotes -> ProposalVotes
setWinner (All, votes) (ProposalVotes m) =
  ProposalVotes $ AssocMap.mapMaybe (const $ Just votes) m
setWinner (EffectAt winnerIdx, votes) (ProposalVotes m) =
  let winnerResultTag = outcomeIdxToResultTag winnerIdx
   in ProposalVotes $ updateMap (const $ Just 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 = 0

-- | 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 = Value.singleton proposalPolicySymbol "" 1
      value = sortValue $ minAda <> pst
   in mconcat
        [ input $
            mconcat
              [ script proposalValidatorHash
              , withOutRef proposalRef
              , withDatum (mkProposalInputDatum ps)
              , withValue value
              ]
        , output $
            mconcat
              [ script proposalValidatorHash
              , 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 -> [PubKeyHash]
mkStakeOwners = mkCosigners

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

-- | Create the output stake datums given the parameters.
mkStakeOutputDatums :: StakeParameters -> [StakeDatum]
mkStakeOutputDatums ps =
  let inputDatums = mkStakeInputDatums ps
      outputStakedAmount =
        Tagged $
          if ps.invalidStakeOutputDatum
            then ps.perStakeGTs * 10
            else ps.perStakeGTs
      modify inp = inp {stakedAmount = outputStakedAmount}
   in modify <$> inputDatums

{- | Get the input stake datum given the index. The range of the index is
    @[0, 'StakeParameters.numStake - 1']@
-}
getStakeInputDatumAt :: StakeParameters -> Index -> StakeDatum
getStakeInputDatumAt ps = (!!) (mkStakeInputDatums ps)

-- | 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
            <> Value.assetClassValue stakeAssetClass 1
            <> Value.assetClassValue
              (untag stake.gtClassRef)
              ps.perStakeGTs
      perStake idx i o =
        let withSig =
              if ps.transactionSignedByOwners
                then signedWith i.owner
                else mempty
         in mconcat
              [ withSig
              , input $
                  mconcat
                    [ script stakeValidatorHash
                    , withOutRef (mkStakeRef idx)
                    , withValue perStakeValue
                    , withDatum i
                    ]
              , output $
                  mconcat
                    [ script stakeValidatorHash
                    , withValue perStakeValue
                    , withDatum o
                    ]
              ]
   in mconcat $
        zipWith3
          perStake
          [0 :: Index ..]
          (mkStakeInputDatums ps)
          (mkStakeOutputDatums ps)

{- | The proposal redeemer used to spend the stake UTXO, which is always
      'WitnessStake' in this case.
-}
stakeRedeemer :: StakeRedeemer
stakeRedeemer = WitnessStake

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

-- * Governor

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

-- | Create the output governor datum given the parameters.
mkGovernorOutputDatum :: GovernorParameters -> GovernorDatum
mkGovernorOutputDatum ps =
  if ps.invalidGovernorOutputDatum
    then governorInputDatum {maximumProposalsPerStake = 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 =
  let gst = Value.assetClassValue govAssetClass 1
      value = sortValue $ gst <> minAda
   in mconcat
        [ input $
            mconcat
              [ script govValidatorHash
              , withValue value
              , withOutRef governorRef
              , withDatum governorInputDatum
              ]
        , output $
            mconcat
              [ script govValidatorHash
              , withValue value
              , withOutRef governorRef
              , withDatum (mkGovernorOutputDatum ps)
              ]
        ]

{- | The proposal redeemer used to spend the governor UTXO, which is always
      'MintGATs' in this case.
-}
governorRedeemer :: GovernorRedeemer
governorRedeemer = MintGATs

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

-- * 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 (AuthorityTokenParameters es mdt invalidTokenName) =
  foldMap perEffect es
  where
    perEffect :: ValidatorHash -> b
    perEffect vh =
      let tn =
            if invalidTokenName
              then ""
              else validatorHashToTokenName vh
          ac = AssetClass (authorityTokenSymbol, tn)
          minted = Value.assetClassValue ac 1
          value = sortValue $ minAda <> minted
       in mconcat
            [ mint minted
            , output $
                mconcat
                  [ script vh
                  , maybe mempty withDatum mdt
                  , 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
        , mkBuilderMaybe 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 $ catMaybes [proposal, stake, governor, authority]
  where
    spend = mkSpending advance pb
    mint = mkMinting advance pb

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

    stake =
      let idx = 0
       in Just $
            testValidator
              val.forStakeValidator
              "stake"
              (stakeValidator Shared.stake)
              (getStakeInputDatumAt pb.stakeParameters idx)
              stakeRedeemer
              ( spend (mkStakeRef idx)
              )

    governor =
      testValidator
        (fromJust val.forGovernorValidator)
        "governor"
        (governorValidator Shared.governor)
        governorInputDatum
        governorRedeemer
        (spend governorRef)
        <$ pb.governorParameters

    authority =
      testPolicy
        (fromJust val.forAuthorityTokenPolicy)
        "authority"
        (authorityTokenPolicy $ AuthorityToken Shared.govAssetClass)
        authorityTokenRedeemer
        (mint authorityTokenSymbol)
        <$ (pb.authorityTokenParameters)

{- | 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 -> Integer
compPerStakeGTsForDraft nCosigners =
  untag (def :: ProposalThresholds).vote
    `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 :: Int -> [AssocMap.Map ValidatorHash DatumHash]
mkMockEffects =
  flip
    take
    ( AssocMap.fromList
        . flip zip (repeat dummyDatumHash)
        <$> groupsOfN 3 validatorHashes
    )

numberOfVotesThatExceedsTheMinimumRequirement :: Integer
numberOfVotesThatExceedsTheMinimumRequirement =
  untag (def @ProposalThresholds).execute + 1

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

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

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

-- * 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 ->
  -- | The initial proposal state, should not be 'Finished'.
  ProposalStatus ->
  ParameterBundle
mkValidToNextStateBundle _ _ Finished =
  error "Cannot advance from Finished"
mkValidToNextStateBundle nCosigners nEffects from =
  let next = getNextState from
      effects = mkMockEffects $ fromIntegral nEffects
      winner = defaultWinnerIdx

      template =
        ParameterBundle
          { proposalParameters =
              ProposalParameters
                { fromStatus = from
                , toStatus = next
                , effectList = effects
                , winnerAndVotes = Nothing
                , numCosigners = fromIntegral nCosigners
                , invalidProposalOutputDatum = False
                }
          , stakeParameters =
              StakeParameters
                { numStake = 1
                , perStakeGTs =
                    compPerStakeGTsForDraft $
                      fromIntegral nCosigners
                , transactionSignedByOwners = False
                , invalidStakeOutputDatum = False
                }
          , governorParameters = Nothing
          , authorityTokenParameters = Nothing
          , 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 =
                  AuthorityTokenParameters
                    { mintGATsFor = AssocMap.keys $ effects !! winner
                    , carryDatum = Just dummyDatum
                    , invalidTokenName = False
                    }
                gov =
                  GovernorParameters
                    { invalidGovernorOutputDatum = False
                    }
             in b
                  { governorParameters = Just gov
                  , authorityTokenParameters = Just aut
                  }
   in execState modifyTemplate template

mkValidToNextStateBundles ::
  -- | Number of cosigners
  Word ->
  -- | Number of effects
  Word ->
  [ParameterBundle]
mkValidToNextStateBundles nCosigners nEffects =
  mkValidToNextStateBundle nCosigners nEffects
    <$> [ Draft
        , VotingReady
        , Locked
        ]

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

-- * Illegal

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

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

mkInvalidOutputStakeBundles :: Word -> Word -> [ParameterBundle]
mkInvalidOutputStakeBundles nCosigners nEffects =
  mkBundle <$> [Draft, VotingReady, Locked]
  where
    mkBundle from =
      let template = mkValidToNextStateBundle nCosigners nEffects from
       in template
            { stakeParameters =
                template.stakeParameters
                  { invalidStakeOutputDatum = True
                  }
            }

-- * From Draft

mkInsufficientCosignsBundle :: Word -> Word -> ParameterBundle
mkInsufficientCosignsBundle nCosigners nEffects =
  template
    { stakeParameters =
        template.stakeParameters
          { perStakeGTs = insuffcientPerStakeGTs
          }
    }
  where
    insuffcientPerStakeGTs =
      untag (def :: ProposalThresholds).vote
        `div` fromIntegral nCosigners - 1
    template = mkValidToNextStateBundle nCosigners nEffects 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 VotingReady
    `setWinnerAndVotes` Nothing

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

-- * From Locked

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

mkMintGATsForWrongEffectsBundle ::
  Word ->
  Word ->
  ParameterBundle
mkMintGATsForWrongEffectsBundle nCosigners nEffects =
  template
    { authorityTokenParameters =
        ( \aut ->
            aut
              { mintGATsFor =
                  [ validatorHashes !! 1
                  , validatorHashes !! 3
                  , validatorHashes !! 5
                  , validatorHashes !! 7
                  ]
              }
        )
          <$> template.authorityTokenParameters
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects

mkNoGATMintedBundle ::
  Word ->
  Word ->
  ParameterBundle
mkNoGATMintedBundle nCosigners nEffects =
  template
    { authorityTokenParameters = Nothing
    }
  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 = Just newAut
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects
    aut = fromJust template.authorityTokenParameters
    newAut =
      AuthorityTokenParameters
        aut.mintGATsFor
        (Just (1 :: Integer))
        False

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