Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}

module Main (main) where

-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

import Cardano.Api (IsPlutusScriptLanguage)
import Control.Monad (when)
import Data.Function ((&))
import Data.String (IsString (..))
import Data.Time.Clock.POSIX (getPOSIXTime)
import Export (writePlutusScript)
import Onchain.V2.Escrow (EscrowParams (..))
import Onchain.V2.Simple (CompiledCodeLang)
import Options.Applicative hiding (str)
import Populate
import Streamly.Console.Stdio qualified as Console
import Streamly.FileSystem.FileIO qualified as File
import Streamly.FileSystem.Path qualified as Path
import Streamly.System.Command qualified as Cmd
import Streamly.Unicode.String (str)
import System.Environment (setEnv)
import System.FilePath ((</>))
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)

import Onchain.V2.Debug qualified as DebugV2
import Onchain.V2.Release qualified as ReleaseV2
import Onchain.V3.Debug qualified as DebugV3
import Onchain.V3.Release qualified as ReleaseV3

-------------------------------------------------------------------------------
-- CLI
-------------------------------------------------------------------------------

data PopulateCommand
    = PCTriggerTest
    | PCEscrow
    | PCFanout

data Command
    = StartLocalTestnet
    | Clean
    | Populate PopulateCommand
    | TriggerRollback
    | Setup
    | SyncNode2

populateCommandParser :: Parser PopulateCommand
populateCommandParser =
    hsubparser
        ( command
            "trigger-test"
            ( info
                (pure PCTriggerTest)
                (progDesc "Run the trigger test")
            )
            <> command
                "escrow"
                ( info
                    (pure PCEscrow)
                    (progDesc "Run the escrow scenario")
                )
            <> command
                "fanout"
                ( info
                    (pure PCFanout)
                    (progDesc "Run the fanout scenario")
                )
        )
commandParser :: Parser Command
commandParser =
    hsubparser
        ( command
            "start-local-testnet"
            ( info
                (pure StartLocalTestnet)
                (progDesc "Start the local development network")
            )
            <> command
                "clean"
                ( info
                    (pure Clean)
                    (progDesc "Clean all local state")
                )
            <> command
                "populate"
                ( info
                    (Populate <$> populateCommandParser)
                    (progDesc "Populate the local network with initial data")
                )
            <> command
                "setup"
                ( info
                    (pure Setup)
                    (progDesc "Setup the initial config files")
                )
            <> command
                "trigger-rollback"
                ( info
                    (pure TriggerRollback)
                    (progDesc "Trigger rollback")
                )
            <> command
                "sync-node2"
                ( info
                    (pure SyncNode2)
                    (progDesc "Sync Node 2")
                )
        )

opts :: ParserInfo Command
opts =
    info
        (commandParser <**> helper)
        ( fullDesc
            <> progDesc "Local development management tool"
        )

--------------------------------------------------------------------------------
-- Create config
--------------------------------------------------------------------------------

-- TODO: Abstract escrow into v2 and v3.

tracingYamlContents :: String -> IO String
tracingYamlContents scriptsDirName = do
    let scriptsDirPath = env_LOCAL_CONFIG_DIR </> scriptsDirName

    policyPolicyId <- getPolicyId $ scriptsDirPath </> "policy.plutus"
    validatorPolicyId <- getPolicyId $ scriptsDirPath </> "validator.plutus"
    policyDebugPolicyId <- getPolicyId $ scriptsDirPath </> "policy-debug.plutus"
    validatorDebugPolicyId <- getPolicyId $ scriptsDirPath </> "validator-debug.plutus"

    -- NOTE: This seems hacky but I can't think of a clean way to abstract
    -- common functionality.
    let validatorPrefix =
            if policyPolicyId == validatorPolicyId
                then ""
                else
                    [str|
  - hash: "#{validatorPolicyId}"
    shadows:
|]
    pure
        [str|
  - hash: "#{policyPolicyId}"
    shadows:
      - name: "Local Policy"
        hash: "#{policyDebugPolicyId}"
        source:
          file_path: "#{scriptsDirName}/policy-debug.plutus"
#{validatorPrefix}
      - name: "Local Validator"
        hash: "#{validatorDebugPolicyId}"
        source:
          file_path: "#{scriptsDirName}/validator-debug.plutus"
      - name: "Always failing script"
        hash: "793f8c8cffba081b2a56462fc219cc8fe652d6a338b62c7b134876e7"
        source:
          inline:
              type: "PlutusScriptV2"
              description: "Always failing script"
              cborHex: "4e4d01000033222220051200120011"
|]

escrowYamlContents :: IO String
escrowYamlContents = do
    escrowPolicyId <- getPolicyId $ env_LOCAL_CONFIG_DIR </> "escrow.plutus"
    escrowDebugPolicyId <- getPolicyId $ env_LOCAL_CONFIG_DIR </> "escrow-debug.plutus"
    pure
        [str|
  - hash: "#{escrowPolicyId}"
    shadows:
      - name: "Escrow"
        hash: "#{escrowDebugPolicyId}"
        source:
          file_path: "./escrow-debug.plutus"
|]

createScriptsYaml :: IO ()
createScriptsYaml = do
    tracingV2 <- tracingYamlContents "tracing-plutus-v2"
    tracingV3 <- tracingYamlContents "tracing-plutus-v3"
    escrowV2 <- escrowYamlContents
    writeFile
        (env_LOCAL_CONFIG_DIR </> "scripts.yaml")
        [str|
running_mode: sync_initial_local_state
confirmation_depth: 100
scripts:
#{tracingV2}
#{tracingV3}
#{escrowV2}
|]

createTracingConfig ::
    (IsPlutusScriptLanguage lang) =>
    String ->
    CompiledCodeLang lang pol ->
    CompiledCodeLang lang val ->
    CompiledCodeLang lang pol ->
    CompiledCodeLang lang val ->
    IO ()
createTracingConfig scriptsDirName relP relV debP debV = do
    runCmd_ [str|mkdir -p #{env_LOCAL_CONFIG_DIR}/#{scriptsDirName}|]

    let scriptsDirPath = env_LOCAL_CONFIG_DIR </> scriptsDirName

    writePlutusScript (scriptsDirPath </> "policy.plutus") relP
    writePlutusScript (scriptsDirPath </> "validator.plutus") relV
    writePlutusScript (scriptsDirPath </> "policy-debug.plutus") debP
    writePlutusScript (scriptsDirPath </> "validator-debug.plutus") debV

    buildStakeAddress
        [ opt "stake-script-file" (scriptsDirPath </> "policy.plutus")
        , opt "out-file" (scriptsDirPath </> "script.stake.addr")
        ]
    -- 400_000 here comes from:
    -- cardano-cli conway query protocol-parameters
    --    \ --testnet-magic 42
    --    \ --socket-path "devnet-env/socket/node1/sock"
    --    \ | jq .stakeAddressDeposit
    genRegCertStakeAddress
        [ opt "stake-script-file" (scriptsDirPath </> "policy.plutus")
        , opt "out-file" (scriptsDirPath </> "registration.cert")
        , opt "key-reg-deposit-amt" (400_000 :: Int)
        ]
    genDeregCertStakeAddress
        [ opt "stake-script-file" (scriptsDirPath </> "policy.plutus")
        , opt "out-file" (scriptsDirPath </> "deregistration.cert")
        , opt "key-reg-deposit-amt" (400_000 :: Int)
        ]

createEscrowConfig :: IO ()
createEscrowConfig = do
    -- Config for Escrow
    alice <- mkWallet env_LOCAL_CONFIG_DIR "alice"
    bob <- mkWallet env_LOCAL_CONFIG_DIR "bob"
    alicePkh <- fromString <$> walletKeyHash alice
    bobPkh <- fromString <$> walletKeyHash bob
    now <- getPOSIXTime
    let deadline = floor $ (now + 30) * 1000
    let escrowParams = EscrowParams alicePkh bobPkh deadline
    writePlutusScript
        (env_LOCAL_CONFIG_DIR </> "escrow.plutus")
        (ReleaseV2.escrowValidator escrowParams)
    writePlutusScript
        (env_LOCAL_CONFIG_DIR </> "escrow-debug.plutus")
        (DebugV2.escrowValidator escrowParams)
    -- Finally create the scripts.yaml file
    createScriptsYaml

createConfig :: IO ()
createConfig = do
    runCmd_ [str|mkdir -p #{env_LOCAL_CONFIG_DIR}|]

    createTracingConfig
        "tracing-plutus-v3"
        ReleaseV3.tracingScript
        ReleaseV3.tracingScript
        DebugV3.tracingScript
        DebugV3.tracingScript

    createTracingConfig
        "tracing-plutus-v2"
        ReleaseV2.tracingPolicy
        ReleaseV2.tracingValidator
        DebugV2.tracingPolicy
        DebugV2.tracingValidator

    createEscrowConfig

--------------------------------------------------------------------------------
-- Main
--------------------------------------------------------------------------------

changeSecurityParam :: Int -> IO ()
changeSecurityParam i = do
    -- NOTE: Using jq here fails because of runCmd. Need to investigate this
    -- later.
    -- TODO: Use jq instead of sed
    updateAndCheck
        shelly
        [str|s/"securityParam": [0-9]*/"securityParam": #{secParam}/|]
        ".securityParam"
    updateAndCheck byron [str|s/"k": [0-9]*/"k": #{secParam}/|] ".protocolConsts.k"
  where
    updateAndCheck fp sedQ jqQ = do
        runCmd_ [str|sed -i '#{sedQ}' #{fp}|]
        fpP <- Path.fromString fp
        updated <-
            File.readChunks fpP
                & Cmd.pipeChunks [str|jq -r "#{jqQ}"|]
                & firstNonEmptyLine "changeSecurityParam.updateAndCheck"
        when (updated /= secParam) . error $
            "changeSecurityParam: Unable to change security param: " ++ fp

    shelly = env_TESTNET_WORK_DIR </> "shelley-genesis.json"
    byron = env_TESTNET_WORK_DIR </> "byron-genesis.json"
    secParam = show i

createTestnetConfig :: IO ()
createTestnetConfig = do
    runCmd
        "cardano-testnet create-env"
        [ opt "num-pool-nodes" env_CARDANO_TESTNET_NUM_NODES
        , flg "enable-new-epoch-state-logging"
        , opt "output" env_TESTNET_WORK_DIR
        , opt "testnet-magic" env_CARDANO_TESTNET_MAGIC
        ]
        & Console.putChunks
    changeSecurityParam 100
    updateNode2Topology

startLocalTestnet :: IO ()
startLocalTestnet = do
    runCmd
        "cardano-testnet cardano"
        [ opt "num-pool-nodes" env_CARDANO_TESTNET_NUM_NODES
        , flg "enable-new-epoch-state-logging"
        , opt "node-env" env_TESTNET_WORK_DIR
        , opt "testnet-magic" env_CARDANO_TESTNET_MAGIC
        ]
        & Console.putChunks

clean :: IO ()
clean = do
    runCmd_ [str|rm -rf #{env_LOCAL_CONFIG_DIR}|]
    runCmd_ [str|rm -rf #{env_TESTNET_WORK_DIR}|]
    runCmd_ [str|rm -rf #{env_POPULATE_WORK_DIR}|]
    runCmd_ [str|sh -c 'mv #{db} #{dbPrev} || true'|]
    runCmd_ [str|sh -c 'mv #{ev} #{evPrev} || true'|]
  where
    db = "plutus-script-reexecutor.db"
    dbPrev = "plutus-script-reexecutor.prev.db"
    ev = "events.log"
    evPrev = "events.prev.log"

setup :: IO ()
setup = do
    clean
    createConfig
    createTestnetConfig

main :: IO ()
main = do
    hSetBuffering stdout LineBuffering
    hSetBuffering stderr LineBuffering
    cmd <- execParser opts

    setEnv "CARDANO_CLI" "cardano-cli"
    setEnv "CARDANO_NODE" "cardano-node"
    case cmd of
        StartLocalTestnet -> startLocalTestnet
        Clean -> clean
        Populate PCTriggerTest -> testScriptTrigger
        Populate PCEscrow -> escrow
        Populate PCFanout -> runFanout
        TriggerRollback -> triggerRollback
        SyncNode2 -> syncNode2
        Setup -> setup