content: {- |
  Module     : Sample.Proposal.Vote
  Maintainer : connor@mlabs.city
  Description: Generate sample data for testing the functionalities of voting on proposals.
  Sample and utilities for testing the functionalities of voting on proposals.
  -}
  module Sample.Proposal.Vote (
    ParameterBundle (..),
    VoteParameters (..),
    StakeParameters (..),
    StakeInputParameters (..),
    StakeOutputParameters (..),
    NumProposals (..),
    ProposalParameters (..),
    TransactionParameters (..),
    Validity (..),
    vote,
    mkTestTree,
    mkValidOwnerVoteBundle,
    mkValidDelegateeVoteBundle,
    delegateeVoteWithOwnAndDelegatedStakeBundle,
    transparentAssets,
    transactionNotAuthorized,
    voteForNonexistentOutcome,
    noProposal,
    moreThanOneProposals,
    invalidLocks,
    destroyStakes,
    insufficientAmount,
    insufficientAmount1,
  ) where
  
  import Agora.Governor (Governor (..))
  import Agora.Proposal (
    ProposalDatum (..),
    ProposalId (ProposalId),
    ProposalRedeemer (Vote),
    ProposalStatus (VotingReady),
    ProposalThresholds (vote),
    ProposalVotes (ProposalVotes),
    ResultTag (ResultTag),
   )
  import Agora.Proposal.Time (
    ProposalStartingTime (ProposalStartingTime),
    ProposalTimingConfig (draftTime, votingTime),
   )
  import Agora.SafeMoney (GTTag)
  import Agora.Stake (
    ProposalAction (Voted),
    ProposalLock (ProposalLock),
    StakeDatum (..),
    StakeRedeemer (Destroy, PermitVote),
   )
  import Data.Default (Default (def))
  import Data.Map.Strict qualified as StrictMap
  import Data.Maybe (catMaybes)
  import Data.Tagged (Tagged, untag)
  import Plutarch.Context (
    input,
    mint,
    normalizeValue,
    output,
    script,
    signedWith,
    timeRange,
    withInlineDatum,
    withRedeemer,
    withRef,
    withValue,
   )
  import Plutarch.Extra.AssetClass (adaClass, assetClassValue)
  import PlutusLedgerApi.V2 (Credential (PubKeyCredential), Interval, POSIXTime, PubKeyHash)
  import PlutusLedgerApi.V2.Contexts (TxOutRef (TxOutRef))
  import Sample.Proposal.Shared (proposalTxRef)
  import Sample.Shared (
    governor,
    minAda,
    proposalAssetClass,
    proposalScriptHash,
    proposalValidator,
    stakeAssetClass,
    stakeScriptHash,
    stakeValidator,
   )
  import Test.Specification (SpecificationTree, group, testValidator)
  import Test.Util (
    CombinableBuilder,
    closedBoundedInterval,
    mkSpending,
    pubKeyHashes,
   )
  
  data ParameterBundle = ParamerterBundle
    { voteParameters :: VoteParameters
    , stakeParameters :: StakeParameters
    , proposalParameters :: ProposalParameters
    , transactionParameters :: TransactionParameters
    }
  
  newtype VoteParameters = VoteParameters {voteFor :: ResultTag}
  
  data StakeParameters = StakeParameters
    { numStakes :: Integer
    , mixInDelegateeAsOwner :: Bool
    , stakeInputParameters :: StakeInputParameters
    , stakeOutputParameters :: StakeOutputParameters
    }
  
  newtype StakeInputParameters = StakeInputParameters
    { perStakeGTs :: Tagged GTTag Integer
    }
  
  data StakeOutputParameters = StakeOutputParameters
    { burnStakes :: Bool
    , dontAddNewLock :: Bool
    , changeGTAmount :: Bool
    , changeAdaAmount :: Bool
    }
  
  data NumProposals = NoProposal | OneProposal | MoreThanOneProposals
  
  data ProposalParameters = ProposalParameters
    { wrongAddedVotes :: Bool
    , numProposals :: NumProposals
    }
  
  data SignedBy = Owner | Delegatee | Unknown
  
  newtype TransactionParameters = TransactionParameters
    { signedBy :: SignedBy
    }
  
  data Validity = Validity
    { forProposalValidator :: Bool
    , forStakeValidator :: Bool
    }
  
  --------------------------------------------------------------------------------
  
  stakeOwner :: PubKeyHash
  stakeOwner = head pubKeyHashes
  
  delegatee :: PubKeyHash
  delegatee = pubKeyHashes !! 1
  
  unknownSig :: PubKeyHash
  unknownSig = pubKeyHashes !! 2
  
  validTimeRangeLowerBound :: POSIXTime
  validTimeRangeLowerBound =
    0
      + (def :: ProposalTimingConfig).draftTime
      + 1
  
  validTimeRangeUpperBound :: POSIXTime
  validTimeRangeUpperBound =
    validTimeRangeLowerBound
      + (def :: ProposalTimingConfig).votingTime
      - 2
  
  validTimeRange :: Interval POSIXTime
  validTimeRange =
    closedBoundedInterval
      validTimeRangeLowerBound
      validTimeRangeUpperBound
  
  --------------------------------------------------------------------------------
  
  initialVotes :: StrictMap.Map ResultTag Integer
  initialVotes =
    StrictMap.fromList
      [ (ResultTag 0, 114)
      , (ResultTag 1, 514)
      ]
  
  proposalInputDatum :: ProposalDatum
  proposalInputDatum =
    ProposalDatum
      { proposalId = ProposalId 22
      , effects =
          StrictMap.fromList
            [ (ResultTag 0, StrictMap.empty)
            , (ResultTag 1, StrictMap.empty)
            ]
      , status = VotingReady
      , cosigners = [PubKeyCredential stakeOwner]
      , thresholds = def
      , votes = ProposalVotes initialVotes
      , timingConfig = def
      , startingTime = ProposalStartingTime 0
      }
  
  mkProposalRedeemer :: VoteParameters -> ProposalRedeemer
  mkProposalRedeemer v = Vote v.voteFor
  
  mkProposalRef :: Integer -> TxOutRef
  mkProposalRef = TxOutRef proposalTxRef
  
  numProposals :: NumProposals -> Integer
  numProposals NoProposal = 0
  numProposals OneProposal = 1
  numProposals MoreThanOneProposals = 2
  
  --------------------------------------------------------------------------------
  
  mkStakeRedeemer :: StakeOutputParameters -> StakeRedeemer
  mkStakeRedeemer params =
    if params.burnStakes
      then Destroy
      else PermitVote
  
  mkStakeInputDatum :: StakeInputParameters -> StakeDatum
  mkStakeInputDatum params =
    StakeDatum
      { stakedAmount = params.perStakeGTs
      , owner = PubKeyCredential stakeOwner
      , delegatedTo = Just (PubKeyCredential delegatee)
      , lockedBy =
          [ ProposalLock (ProposalId 0) $ Voted (ResultTag 0) 100
          , ProposalLock (ProposalId 1) $ Voted (ResultTag 2) 200
          ]
      }
  
  mkStakeRef :: Integer -> Integer -> TxOutRef
  mkStakeRef o i = TxOutRef proposalTxRef $ o + i
  
  --------------------------------------------------------------------------------
  
  vote :: forall b. CombinableBuilder b => ParameterBundle -> b
  vote params =
    let pst = assetClassValue proposalAssetClass 1
        sst = assetClassValue stakeAssetClass 1
  
        ---
  
        stakeInputDatum =
          mkStakeInputDatum
            params.stakeParameters.stakeInputParameters
  
        stakeInputValue =
          normalizeValue $
            sst
              <> assetClassValue
                governor.gtClassRef
                params.stakeParameters.stakeInputParameters.perStakeGTs
              <> minAda
  
        newLock =
          ProposalLock
            proposalInputDatum.proposalId
            $ Voted
              params.voteParameters.voteFor
              validTimeRangeUpperBound
  
        updatedLocks =
          if params.stakeParameters.stakeOutputParameters.dontAddNewLock
            then stakeInputDatum.lockedBy
            else newLock : stakeInputDatum.lockedBy
  
        stakeOutputDatum = stakeInputDatum {lockedBy = updatedLocks}
  
        stakeOutputValue =
          let changeAmount cond = if cond then (* 100) else id
              gtAmount =
                changeAmount
                  params.stakeParameters.stakeOutputParameters.changeGTAmount
                  params.stakeParameters.stakeInputParameters.perStakeGTs
              adaAmount =
                changeAmount
                  params.stakeParameters.stakeOutputParameters.changeAdaAmount
                  10_000_000
           in normalizeValue $
                sst
                  <> assetClassValue
                    governor.gtClassRef
                    gtAmount
                  <> minAda
                  <> assetClassValue adaClass adaAmount
  
        stakeRedeemer =
          mkStakeRedeemer params.stakeParameters.stakeOutputParameters
  
        mixOwner i datum =
          if params.stakeParameters.mixInDelegateeAsOwner
            && i == 2
            then
              datum
                { owner = PubKeyCredential delegatee
                , delegatedTo = Nothing
                }
            else datum
  
        stakeBuilder :: b
        stakeBuilder =
          foldMap
            ( \i ->
                mconcat
                  [ input $
                      mconcat
                        [ script stakeScriptHash
                        , withValue stakeInputValue
                        , withInlineDatum $ mixOwner i stakeInputDatum
                        , withRedeemer stakeRedeemer
                        , withRef $ mkStakeRef numProposals' i
                        ]
                  , if params.stakeParameters.stakeOutputParameters.burnStakes
                      then mint $ assetClassValue stakeAssetClass (-1)
                      else
                        output $
                          mconcat
                            [ script stakeScriptHash
                            , withValue stakeOutputValue
                            , withInlineDatum $ mixOwner i stakeOutputDatum
                            ]
                  ]
            )
            [1 .. params.stakeParameters.numStakes]
  
        --------------------------------------------------------------------------
  
        numProposals' = numProposals params.proposalParameters.numProposals
  
        updatedVotes =
          StrictMap.adjust
            ( ( if params.proposalParameters.wrongAddedVotes
                  then (* 10)
                  else id
              )
                . ( +
                      untag params.stakeParameters.stakeInputParameters.perStakeGTs
                        * params.stakeParameters.numStakes
                  )
            )
            params.voteParameters.voteFor
            initialVotes
  
        proposalOutputDatum =
          proposalInputDatum
            { votes = ProposalVotes updatedVotes
            }
  
        proposalRedeemer = mkProposalRedeemer params.voteParameters
  
        proposalValue =
          normalizeValue $
            pst
              <> minAda
  
        proposalBuidler :: b
        proposalBuidler =
          foldMap
            ( \i ->
                mconcat
                  [ input $
                      mconcat
                        [ script proposalScriptHash
                        , withValue proposalValue
                        , withRedeemer proposalRedeemer
                        , withInlineDatum proposalInputDatum
                        , withRef $ mkProposalRef i
                        ]
                  , output $
                      mconcat
                        [ script proposalScriptHash
                        , withValue proposalValue
                        , withInlineDatum proposalOutputDatum
                        ]
                  ]
            )
            [1 .. numProposals']
  
        --------------------------------------------------------------------------
  
        sig = case params.transactionParameters.signedBy of
          Owner -> stakeOwner
          Delegatee -> delegatee
          Unknown -> unknownSig
  
        --------------------------------------------------------------------------
  
        miscBuilder :: b
        miscBuilder =
          mconcat
            [ signedWith sig
            , timeRange validTimeRange
            ]
  
        --------------------------------------------------------------------------
  
        builder :: b
        builder =
          mconcat
            [ stakeBuilder
            , proposalBuidler
            , miscBuilder
            ]
     in builder
  
  --------------------------------------------------------------------------------
  
  mkTestTree :: String -> ParameterBundle -> Validity -> SpecificationTree
  mkTestTree name ps val = group name $ catMaybes [proposal, stake]
    where
      spend = mkSpending vote ps
  
      numProposals' = numProposals ps.proposalParameters.numProposals
  
      proposal =
        case ps.proposalParameters.numProposals of
          NoProposal -> Nothing
          _ ->
            Just $
              testValidator
                val.forProposalValidator
                "proposal"
                proposalValidator
                proposalInputDatum
                (mkProposalRedeemer ps.voteParameters)
                (spend $ mkProposalRef 1)
  
      stake =
        case ps.stakeParameters.numStakes of
          0 -> error "At least one stake"
          _ ->
            let stakeRef = mkStakeRef numProposals' 1
             in Just $
                  testValidator
                    val.forStakeValidator
                    "stake"
                    stakeValidator
                    (mkStakeInputDatum ps.stakeParameters.stakeInputParameters)
                    (mkStakeRedeemer ps.stakeParameters.stakeOutputParameters)
                    (spend stakeRef)
  
  --------------------------------------------------------------------------------
  
  -- TODO(Connor) Use optics
  
  mkValidOwnerVoteBundle :: Integer -> ParameterBundle
  mkValidOwnerVoteBundle stakes =
    ParamerterBundle
      { voteParameters =
          VoteParameters
            { voteFor = ResultTag 0
            }
      , stakeParameters =
          StakeParameters
            { numStakes = stakes
            , mixInDelegateeAsOwner = False
            , stakeInputParameters =
                StakeInputParameters
                  { perStakeGTs = (def :: ProposalThresholds).vote
                  }
            , stakeOutputParameters =
                StakeOutputParameters
                  { burnStakes = False
                  , dontAddNewLock = False
                  , changeGTAmount = False
                  , changeAdaAmount = False
                  }
            }
      , proposalParameters =
          ProposalParameters
            { wrongAddedVotes = False
            , numProposals = OneProposal
            }
      , transactionParameters =
          TransactionParameters
            { signedBy = Owner
            }
      }
  
  mkValidDelegateeVoteBundle :: Integer -> ParameterBundle
  mkValidDelegateeVoteBundle stakes =
    let template = mkValidOwnerVoteBundle stakes
     in template
          { transactionParameters =
              template.transactionParameters
                { signedBy = Delegatee
                }
          }
  
  delegateeVoteWithOwnAndDelegatedStakeBundle :: ParameterBundle
  delegateeVoteWithOwnAndDelegatedStakeBundle =
    let template = mkValidDelegateeVoteBundle 5
     in template
          { stakeParameters =
              template.stakeParameters
                { mixInDelegateeAsOwner = True
                }
          }
  
  ownerVoteWithSignleStake :: ParameterBundle
  ownerVoteWithSignleStake = mkValidOwnerVoteBundle 1
  
  transparentAssets :: ParameterBundle
  transparentAssets =
    ownerVoteWithSignleStake
      { stakeParameters =
          ownerVoteWithSignleStake.stakeParameters
            { stakeOutputParameters =
                ownerVoteWithSignleStake.stakeParameters.stakeOutputParameters
                  { changeAdaAmount = True
                  }
            }
      }
  
  transactionNotAuthorized :: ParameterBundle
  transactionNotAuthorized =
    ownerVoteWithSignleStake
      { transactionParameters =
          ownerVoteWithSignleStake.transactionParameters
            { signedBy = Unknown
            }
      }
  
  voteForNonexistentOutcome :: ParameterBundle
  voteForNonexistentOutcome =
    ownerVoteWithSignleStake
      { voteParameters =
          ownerVoteWithSignleStake.voteParameters
            { voteFor = ResultTag 1919810
            }
      }
  
  noProposal :: ParameterBundle
  noProposal =
    ownerVoteWithSignleStake
      { proposalParameters =
          ownerVoteWithSignleStake.proposalParameters
            { numProposals = NoProposal
            }
      }
  
  moreThanOneProposals :: ParameterBundle
  moreThanOneProposals =
    ownerVoteWithSignleStake
      { proposalParameters =
          ownerVoteWithSignleStake.proposalParameters
            { numProposals = MoreThanOneProposals
            }
      }
  
  ownerVoteWithMultipleStakes :: ParameterBundle
  ownerVoteWithMultipleStakes = mkValidOwnerVoteBundle 5
  
  invalidLocks :: ParameterBundle
  invalidLocks =
    ownerVoteWithMultipleStakes
      { stakeParameters =
          ownerVoteWithMultipleStakes.stakeParameters
            { stakeOutputParameters =
                ownerVoteWithMultipleStakes.stakeParameters.stakeOutputParameters
                  { dontAddNewLock = True
                  }
            }
      }
  
  destroyStakes :: ParameterBundle
  destroyStakes =
    ownerVoteWithMultipleStakes
      { stakeParameters =
          ownerVoteWithMultipleStakes.stakeParameters
            { stakeOutputParameters =
                ownerVoteWithMultipleStakes.stakeParameters.stakeOutputParameters
                  { burnStakes = True
                  }
            }
      }
  
  insufficientAmount :: ParameterBundle
  insufficientAmount =
    ownerVoteWithSignleStake
      { stakeParameters =
          ownerVoteWithSignleStake.stakeParameters
            { stakeInputParameters =
                ownerVoteWithSignleStake.stakeParameters.stakeInputParameters
                  { perStakeGTs = 1
                  }
            }
      }
  
  insufficientAmount1 :: ParameterBundle
  insufficientAmount1 =
    ownerVoteWithMultipleStakes
      { stakeParameters =
          ownerVoteWithMultipleStakes.stakeParameters
            { stakeInputParameters =
                ownerVoteWithMultipleStakes.stakeParameters.stakeInputParameters
                  { perStakeGTs = 1
                  }
            }
      }
  