content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DerivingVia #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE NumericUnderscores #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  
  module Cardano.Testnet.Test.Gov.TreasuryWithdrawal
    ( hprop_ledger_events_treasury_withdrawal
    ) where
  
  import           Cardano.Api hiding (txId)
  import           Cardano.Api.Ledger (Credential, EpochInterval (EpochInterval), KeyRole (Staking))
  
  import qualified Cardano.Ledger.BaseTypes as L
  import qualified Cardano.Ledger.Coin as L
  import qualified Cardano.Ledger.Conway.Governance as L
  import qualified Cardano.Ledger.Shelley.LedgerState as L
  import           Cardano.Testnet
  
  import           Prelude
  
  import           Control.Monad
  import           Control.Monad.State.Class
  import           Data.Bifunctor (Bifunctor (..))
  import           Data.Default.Class
  import           Data.Map (Map)
  import qualified Data.Map.Strict as M
  import qualified Data.Text as Text
  import           GHC.Stack
  import           Lens.Micro
  import           System.Directory (makeAbsolute)
  import           System.FilePath ((</>))
  
  import           Test.Cardano.CLI.Hash (serveFilesWhile)
  import           Testnet.Components.Query
  import           Testnet.Defaults
  import           Testnet.Process.Cli.Keys (cliStakeAddressKeyGen)
  import           Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate)
  import           Testnet.Process.Cli.Transaction (retrieveTransactionId)
  import           Testnet.Process.Run (addEnvVarsToConfig, execCli', mkExecConfig)
  import           Testnet.Property.Util (integrationRetryWorkspace)
  import           Testnet.Start.Types
  import           Testnet.Types
  
  import           Hedgehog
  import qualified Hedgehog.Extras as H
  
  hprop_ledger_events_treasury_withdrawal:: Property
  hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2  "treasury-withdrawal" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do
    conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath'
    let tempAbsPath' = unTmpAbsPath tempAbsPath
        tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath
  
    work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
  
    let ceo = ConwayEraOnwardsConway
        sbe = convert ceo
        era = toCardanoEra sbe
        eraName = eraToString era
  
        fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe }
        shelleyOptions = def { genesisEpochLength = 200
                             , genesisActiveSlotsCoeff = 0.3
                             }
  
    TestnetRuntime
      { testnetMagic
      , testnetNodes
      , wallets=wallet0:wallet1:_
      , configurationFile
      }
      <- createAndRunTestnet fastTestnetOptions shelleyOptions conf
  
    node@TestnetNode{nodeSprocket} <- H.headM testnetNodes
    poolSprocket1 <- H.noteShow nodeSprocket
    execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
    let socketPath = nodeSocketPath node
  
    epochStateView <- getEpochStateView configurationFile socketPath
  
    H.note_ $ "Sprocket: " <> show poolSprocket1
    H.note_ $ "Abs path: " <> tempAbsBasePath'
    H.note_ $ "Socketpath: " <> unFile socketPath
    H.note_ $ "Foldblocks config file: " <> unFile configurationFile
  
    gov <- H.createDirectoryIfMissing $ work </> "governance"
  
    let proposalAnchorDataIpfsHash = "QmexFJuEn5RtnHEqpxDcqrazdHPzAwe7zs2RxHLfMH5gBz"
    proposalAnchorFile <- H.noteM $ liftIO $ makeAbsolute $ "test" </> "cardano-testnet-test" </> "files" </> "sample-proposal-anchor"
  
    treasuryWithdrawalActionFp <- H.note $ work </> gov </> "treasury-withdrawal.action"
  
    proposalAnchorDataHash <- execCli' execConfig
      [ "hash", "anchor-data", "--file-binary", proposalAnchorFile
      ]
  
    txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1
  
    -- {{{ Register stake address
    let stakeCertFp = gov </> "stake.regcert"
        stakeKeys =  KeyPair { verificationKey = File $ gov </> "stake.vkey"
                             , signingKey = File $ gov </> "stake.skey"
                             }
    cliStakeAddressKeyGen stakeKeys
    keyDeposit <- getKeyDeposit epochStateView ceo
    createStakeKeyRegistrationCertificate
      tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp
  
  
    stakeCertTxBodyFp <- H.note $ work </> "stake.registration.txbody"
    stakeCertTxSignedFp <- H.note $ work </> "stake.registration.tx"
  
    void $ execCli' execConfig
      [ eraName, "transaction", "build"
      , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1
      , "--tx-in", Text.unpack $ renderTxIn txin2
      , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 10_000_000
      , "--certificate-file", stakeCertFp
      , "--witness-override", show @Int 2
      , "--out-file", stakeCertTxBodyFp
      ]
  
    void $ execCli' execConfig
      [ eraName, "transaction", "sign"
      , "--tx-body-file", stakeCertTxBodyFp
      , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1
      , "--signing-key-file", signingKeyFp stakeKeys
      , "--out-file", stakeCertTxSignedFp
      ]
  
    void $ execCli' execConfig
      [ eraName, "transaction", "submit"
      , "--tx-file", stakeCertTxSignedFp
      ]
    -- }}}
  
    -- {{{ Create treasury withdrawal
    let withdrawalAmount = 3_300_777 :: Integer
    govActionDeposit <- getMinDRepDeposit epochStateView ceo
  
    let relativeUrl = ["ipfs", proposalAnchorDataIpfsHash]
  
    txbodyFp <- H.note $ work </> "tx.body"
    txbodySignedFp <- H.note $ work </> "tx.body.signed"
  
  
    -- Create temporary HTTP server with files required by the call to `cardano-cli`
    -- In this case, the server emulates an IPFS gateway
    serveFilesWhile
      [(relativeUrl, proposalAnchorFile)]
      ( \port -> do
        let execConfig' = addEnvVarsToConfig execConfig [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")]
        void $ execCli' execConfig'
          [ eraName, "governance", "action", "create-treasury-withdrawal"
          , "--testnet"
          , "--anchor-url", "ipfs://" ++ proposalAnchorDataIpfsHash
          , "--anchor-data-hash", proposalAnchorDataHash
          , "--governance-action-deposit", show govActionDeposit
          , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys
          , "--transfer", show withdrawalAmount
          , "--funds-receiving-stake-verification-key-file", verificationKeyFp stakeKeys
          , "--out-file", treasuryWithdrawalActionFp
          ]
  
        -- wait for one block before using wallet0 again
        _ <- waitForBlocks epochStateView 1
  
        txin3 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
  
        void $ execCli' execConfig'
          [ eraName, "transaction", "build"
          , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
          , "--tx-in", Text.unpack $ renderTxIn txin3
          , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show @Int 5_000_000
          , "--proposal-file", treasuryWithdrawalActionFp
          , "--out-file", txbodyFp
          ]
      )
  
    void $ execCli' execConfig
      [ eraName, "transaction", "sign"
      , "--tx-body-file", txbodyFp
      , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet0
      , "--out-file", txbodySignedFp
      ]
  
    void $ execCli' execConfig
      [ eraName, "transaction", "submit"
      , "--tx-file", txbodySignedFp
      ]
  -- }}}
  
    txId <- H.noteShowM $ retrieveTransactionId execConfig (File txbodySignedFp)
  
    currentEpoch <- getCurrentEpochNo epochStateView
    let terminationEpoch = succ . succ $ currentEpoch
    L.GovActionIx governanceActionIndex <- fmap L.gaidGovActionIx . H.nothingFailM $
      getTreasuryWithdrawalProposal configurationFile socketPath terminationEpoch
  
    let voteFp :: Int -> FilePath
        voteFp n = work </> gov </> "vote-" <> show n
  
    -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
    H.forConcurrently_ [1..3] $ \n -> do
      execCli' execConfig
        [ eraName, "governance", "vote", "create"
        , "--yes"
        , "--governance-action-tx-id", prettyShow txId
        , "--governance-action-index", show governanceActionIndex
        , "--drep-verification-key-file", verificationKeyFp $ defaultDRepKeyPair n
        , "--out-file", voteFp n
        ]
  
    txin4 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1
  
    voteTxFp <- H.note $ work </> gov </> "vote.tx"
    voteTxBodyFp <- H.note $ work </> gov </> "vote.txbody"
    -- {{{ Submit votes
    void $ execCli' execConfig
      [ eraName, "transaction", "build"
      , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1
      , "--tx-in", Text.unpack $ renderTxIn txin4
      , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 3_000_000
      , "--vote-file", voteFp 1
      , "--vote-file", voteFp 2
      , "--vote-file", voteFp 3
      , "--witness-override", show @Int 4
      , "--out-file", voteTxBodyFp
      ]
  
    void $ execCli' execConfig
      [ eraName, "transaction", "sign"
      , "--tx-body-file", voteTxBodyFp
      , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1
      , "--signing-key-file", signingKeyFp $ defaultDRepKeyPair 1
      , "--signing-key-file", signingKeyFp $ defaultDRepKeyPair 2
      , "--signing-key-file", signingKeyFp $ defaultDRepKeyPair 3
      , "--out-file", voteTxFp
      ]
  
    void $ execCli' execConfig
      [ eraName, "transaction", "submit"
      , "--tx-file", voteTxFp
      ]
    -- }}}
  
    withdrawals <- H.nothingFailM $
      getCurrentEpochNo epochStateView >>=
        getAnyWithdrawals configurationFile socketPath . (`L.addEpochInterval` EpochInterval 5)
  
    H.noteShow_ withdrawals
    (L.unCoin . snd <$> M.toList withdrawals) === [withdrawalAmount]
  
  
  getAnyWithdrawals
    :: HasCallStack
    => MonadIO m
    => MonadTest m
    => NodeConfigFile In
    -> SocketPath
    -> EpochNo
    -> m (Maybe (Map (Credential Staking) Coin))
  getAnyWithdrawals nodeConfigFile socketPath maxEpoch = withFrozenCallStack $ do
    fmap snd . H.leftFailM . evalIO . runExceptT $ foldEpochState nodeConfigFile socketPath FullValidation maxEpoch Nothing
      $ \(AnyNewEpochState actualEra newEpochState _) ->
        caseShelleyToBabbageOrConwayEraOnwards
          (error $ "Expected Conway era onwards, got state in " <> docToString (pretty actualEra))
          (\cEra _ _ -> conwayEraOnwardsConstraints cEra $ do
            let withdrawals = newEpochState
                  ^. L.newEpochStateGovStateL
                  . L.drepPulsingStateGovStateL
                  . to L.extractDRepPulsingState
                  . L.rsEnactStateL
                  . L.ensWithdrawalsL
            if M.null withdrawals
              then pure ConditionNotMet
              else do
                put $ Just withdrawals
                pure ConditionMet
          ) actualEra
  
  
  getTreasuryWithdrawalProposal
    :: HasCallStack
    => MonadIO m
    => MonadTest m
    => NodeConfigFile In
    -> SocketPath
    -> EpochNo -- ^ The termination epoch: the withdrawal proposal must be found *before* this epoch
    -> m (Maybe L.GovActionId)
  getTreasuryWithdrawalProposal nodeConfigFile socketPath maxEpoch = withFrozenCallStack $ do
    fmap snd . H.leftFailM . evalIO . runExceptT $ foldEpochState nodeConfigFile socketPath QuickValidation maxEpoch Nothing
        $ \(AnyNewEpochState actualEra newEpochState _) ->
          caseShelleyToBabbageOrConwayEraOnwards
            (error $ "Expected Conway era onwards, got state in " <> docToString (pretty actualEra))
            (\cEra _ _ -> conwayEraOnwardsConstraints cEra $ do
              let proposals = newEpochState
                        ^. L.newEpochStateGovStateL
                        . L.cgsProposalsL
                  govActions = M.toList $ L.proposalsActionsMap proposals
              case map (second L.gasAction) govActions of
                (govActionId, L.TreasuryWithdrawals _ _): _ -> do
                  put $ Just govActionId
                  pure ConditionMet
                _ ->
                  pure ConditionNotMet
            ) actualEra
  