-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.App.CLI
  ( argParser
  ) where

import Data.Default (def)
import Data.Singletons (demote)
import Data.Text.Lazy.IO.Utf8 qualified as Utf8 (writeFile)
import Fmt (pretty, prettyText, unlinesF)
import Named (paramF)
import Options.Applicative (help, long, short, subparser, switch)
import Options.Applicative qualified as Opt
import Text.Hex (encodeHex)

import Morley.App.REPL
import Morley.CLI
import Morley.Michelson.Analyzer (analyze)
import Morley.Michelson.Interpret (RemainingSteps(..))
import Morley.Michelson.Optimizer (OptimizerConf(..), optimizeVerboseWithConf)
import Morley.Michelson.Printer (printSomeContract, printTypedContract, printUntypedContract)
import Morley.Michelson.Runtime
import Morley.Michelson.Runtime.GState (genesisAddress)
import Morley.Michelson.TypeCheck (tcVerbose, typeCheckContract, typeCheckValue, typeCheckingWith)
import Morley.Michelson.TypeCheck qualified as TypeCheck
import Morley.Michelson.Typed (Contract'(..), SomeContract(..), unContractCode)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Contract (mapContractCodeM)
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (Mutez, tz)
import Morley.Tezos.Crypto.Timelock (chestBytes, chestKeyBytes, createChestAndChestKey)
import Morley.Util.CLI (mkCLOptionParser, mkCommandParser, outputOption)
import Morley.Util.Named

data DryRunOrWrite = DryRun | Write

mkCommandParser' :: String -> String -> Opt.Parser a -> Opt.Mod Opt.CommandFields a
mkCommandParser' :: forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' = (Parser a -> String -> Mod CommandFields a)
-> String -> Parser a -> Mod CommandFields a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Parser a -> String -> Mod CommandFields a)
 -> String -> Parser a -> Mod CommandFields a)
-> (String -> Parser a -> String -> Mod CommandFields a)
-> String
-> String
-> Parser a
-> Mod CommandFields a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser a -> String -> Mod CommandFields a
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser

argParser :: Opt.Parser (IO ())
argParser :: Parser (IO ())
argParser = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields (IO ())] -> Mod CommandFields (IO ())
forall a. Monoid a => [a] -> a
mconcat
  [ Mod CommandFields (IO ())
printSubCmd
  , Mod CommandFields (IO ())
typecheckSubCmd
  , Mod CommandFields (IO ())
emulateSubCmd
  , Mod CommandFields (IO ())
optimizeSubCmd
  , Mod CommandFields (IO ())
analyzeSubCmd
  , Mod CommandFields (IO ())
createChestSubCmd
  , Mod CommandFields (IO ())
replSubCmd
  ]

--------------------------------------------------------------------------------
-- Subcommands
--------------------------------------------------------------------------------

-- NB: in case this looks mysterious, in IOCmd functions, outer 'do' is
-- Opt.Parser using ApplicativeDo, which then returns an IO action, i.e. inner
-- 'do' is 'IO ()'. -- @lierdakil

type IOCmd = Opt.Mod Opt.CommandFields (IO ())

typecheckSubCmd :: IOCmd
typecheckSubCmd :: Mod CommandFields (IO ())
typecheckSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"typecheck" String
"Typecheck passed contract." do
  Maybe String
contractFile <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
contractFileOption
  TypeCheckOptions
tcOptions <- Parser TypeCheckOptions
typeCheckOptionsOption
  pure do
    Contract
morleyContract <- Maybe String -> IO Contract
prepareContract Maybe String
contractFile
    -- At the moment of writing, 'tcStrict' option does not change anything
    -- because it affects only values parsing; but this may change
    SomeContract
contract <- (TcError' ExpandedOp -> IO SomeContract)
-> (SomeContract -> IO SomeContract)
-> Either (TcError' ExpandedOp) SomeContract
-> IO SomeContract
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError' ExpandedOp -> IO SomeContract
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeContract -> IO SomeContract
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TcError' ExpandedOp) SomeContract -> IO SomeContract)
-> (TypeCheckResult ExpandedOp SomeContract
    -> Either (TcError' ExpandedOp) SomeContract)
-> TypeCheckResult ExpandedOp SomeContract
-> IO SomeContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult ExpandedOp SomeContract
-> Either (TcError' ExpandedOp) SomeContract
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
tcOptions
      (TypeCheckResult ExpandedOp SomeContract -> IO SomeContract)
-> TypeCheckResult ExpandedOp SomeContract -> IO SomeContract
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult ExpandedOp SomeContract
typeCheckContract Contract
morleyContract
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TypeCheckOptions -> Bool
TypeCheck.tcVerbose TypeCheckOptions
tcOptions) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> SomeContract -> Text
printSomeContract Bool
False SomeContract
contract
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"Contract is well-typed"

printSubCmd :: IOCmd
printSubCmd :: Mod CommandFields (IO ())
printSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"print"
  String
"Parse a Morley contract and print corresponding Michelson \
  \contract that can be parsed by the OCaml reference client: octez-client."
  do
    Maybe String
mInputFile <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
contractFileOption
    Maybe String
mOutputFile <- Parser (Maybe String)
outputOption
    Bool
forceSingleLine <- Parser Bool
onelineOption
    pure do
      Contract
contract <- Maybe String -> IO Contract
prepareContract Maybe String
mInputFile
      let write :: Text -> IO ()
write = (Text -> IO ())
-> (String -> Text -> IO ()) -> Maybe String -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn String -> Text -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> Text -> m ()
Utf8.writeFile Maybe String
mOutputFile
      Text -> IO ()
write (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Contract -> Text
forall op. RenderDoc op => Bool -> Contract' op -> Text
printUntypedContract Bool
forceSingleLine Contract
contract

emulateSubCmd :: IOCmd
emulateSubCmd :: Mod CommandFields (IO ())
emulateSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"emulate" String
"Set of commands to run in an emulated environment." (Parser (IO ()) -> Mod CommandFields (IO ()))
-> Parser (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$
  Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields (IO ())] -> Mod CommandFields (IO ())
forall a. Monoid a => [a] -> a
mconcat
    [ Mod CommandFields (IO ())
runSubCmd
    , Mod CommandFields (IO ())
originateSubCmd
    , Mod CommandFields (IO ())
transferSubCmd
    , Mod CommandFields (IO ())
transferTicketSubCmd
    , Mod CommandFields (IO ())
runViewSubCmd
    ]

runSubCmd :: IOCmd
runSubCmd :: Mod CommandFields (IO ())
runSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"run"
  String
"Run passed contract. It's originated first and then a transaction is sent to it." do
    TxData
txData <- Parser TxData
txDataOption
    ContractSimpleOriginationData (Maybe String)
contract <- Parser (ContractSimpleOriginationData (Maybe String))
contractSimpleOriginationDataOption
    CommonRunOptions
cro <- DryRunOrWrite -> Parser CommonRunOptions
commonRunOptions DryRunOrWrite
Write
    pure do
      ContractSimpleOriginationData Contract
michelsonContract <- (Maybe String -> IO Contract)
-> ContractSimpleOriginationData (Maybe String)
-> IO (ContractSimpleOriginationData Contract)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSimpleOriginationData a
-> f (ContractSimpleOriginationData b)
traverse Maybe String -> IO Contract
prepareContract ContractSimpleOriginationData (Maybe String)
contract
      IO SomeStorage -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SomeStorage -> IO ()) -> IO SomeStorage -> IO ()
forall a b. (a -> b) -> a -> b
$ CommonRunOptions
-> ContractSimpleOriginationData Contract
-> TxData
-> IO SomeStorage
runContract CommonRunOptions
cro ContractSimpleOriginationData Contract
michelsonContract TxData
txData

runViewSubCmd :: IOCmd
runViewSubCmd :: Mod CommandFields (IO ())
runViewSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"view"
  String
"Run some view on a contract either supplied directly or identified \
  \by an address. It's originated first if supplied directly." do
    CommonRunOptions
cro <- DryRunOrWrite -> Parser CommonRunOptions
commonRunOptions DryRunOrWrite
Write
    ContractSpecification
  (ContractSimpleOriginationData (Maybe String))
addressOrContract <-
      AddressOrAlias 'AddressKindContract
-> ContractSpecification
     (ContractSimpleOriginationData (Maybe String))
forall a.
AddressOrAlias 'AddressKindContract -> ContractSpecification a
ContractSpecAddressOrAlias (AddressOrAlias 'AddressKindContract
 -> ContractSpecification
      (ContractSimpleOriginationData (Maybe String)))
-> Parser (AddressOrAlias 'AddressKindContract)
-> Parser
     (ContractSpecification
        (ContractSimpleOriginationData (Maybe String)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AddressOrAlias 'AddressKindContract)
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser (AddressOrAlias 'AddressKindContract)
forall (kind :: AddressKind).
(SingI kind, L1AddressKind kind) =>
Maybe (AddressOrAlias kind)
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser (AddressOrAlias kind)
addressOrAliasOption Maybe (AddressOrAlias 'AddressKindContract)
forall a. Maybe a
Nothing
        (NamedF Identity String "name"
 -> NamedF Identity String "help"
 -> Parser (AddressOrAlias 'AddressKindContract))
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser (AddressOrAlias 'AddressKindContract)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"contract-addr"
        (NamedF Identity String "help"
 -> Parser (AddressOrAlias 'AddressKindContract))
-> Param (NamedF Identity String "help")
-> Parser (AddressOrAlias 'AddressKindContract)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Contract address to call view on."
      Parser
  (ContractSpecification
     (ContractSimpleOriginationData (Maybe String)))
-> Parser
     (ContractSpecification
        (ContractSimpleOriginationData (Maybe String)))
-> Parser
     (ContractSpecification
        (ContractSimpleOriginationData (Maybe String)))
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ContractSimpleOriginationData (Maybe String)
-> ContractSpecification
     (ContractSimpleOriginationData (Maybe String))
forall a. a -> ContractSpecification a
ContractSpecOrigination (ContractSimpleOriginationData (Maybe String)
 -> ContractSpecification
      (ContractSimpleOriginationData (Maybe String)))
-> Parser (ContractSimpleOriginationData (Maybe String))
-> Parser
     (ContractSpecification
        (ContractSimpleOriginationData (Maybe String)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ContractSimpleOriginationData (Maybe String))
contractSimpleOriginationDataOption
    ViewName
viewName <- Maybe ViewName
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser ViewName
forall a.
(Buildable a, HasCLReader a) =>
Maybe a
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser a
mkCLOptionParser Maybe ViewName
forall a. Maybe a
Nothing
      (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser ViewName)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser ViewName
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"name"
      (NamedF Identity String "help" -> Parser ViewName)
-> Param (NamedF Identity String "help") -> Parser ViewName
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"View name."
    SomeAddressOrAlias
sender <- Maybe SomeAddressOrAlias
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser SomeAddressOrAlias
someAddressOrAliasOption
        (SomeAddressOrAlias -> Maybe SomeAddressOrAlias
forall a. a -> Maybe a
Just (SomeAddressOrAlias -> Maybe SomeAddressOrAlias)
-> SomeAddressOrAlias -> Maybe SomeAddressOrAlias
forall a b. (a -> b) -> a -> b
$ AddressOrAlias 'AddressKindImplicit -> SomeAddressOrAlias
forall (kind :: AddressKind).
AddressOrAlias kind -> SomeAddressOrAlias
SAOAKindSpecified (AddressOrAlias 'AddressKindImplicit -> SomeAddressOrAlias)
-> AddressOrAlias 'AddressKindImplicit -> SomeAddressOrAlias
forall a b. (a -> b) -> a -> b
$ KindedAddress 'AddressKindImplicit
-> AddressOrAlias 'AddressKindImplicit
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> AddressOrAlias kind
AddressResolved KindedAddress 'AddressKindImplicit
genesisAddress)
      (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser SomeAddressOrAlias)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser SomeAddressOrAlias
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"sender"
      (NamedF Identity String "help" -> Parser SomeAddressOrAlias)
-> Param (NamedF Identity String "help")
-> Parser SomeAddressOrAlias
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Sender address."
    TxParam
viewArg <- Value -> TxParam
TxUntypedParam (Value -> TxParam) -> Parser Value -> Parser TxParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser Value
valueOption Maybe Value
forall a. Maybe a
Nothing
      (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Value)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Value
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"arg"
      (NamedF Identity String "help" -> Parser Value)
-> Param (NamedF Identity String "help") -> Parser Value
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"View call argument."
    pure do
      ContractSpecification (ContractSimpleOriginationData Contract)
contractSpec <- ((ContractSimpleOriginationData (Maybe String)
 -> IO (ContractSimpleOriginationData Contract))
-> ContractSpecification
     (ContractSimpleOriginationData (Maybe String))
-> IO
     (ContractSpecification (ContractSimpleOriginationData Contract))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSpecification a -> f (ContractSpecification b)
traverse ((ContractSimpleOriginationData (Maybe String)
  -> IO (ContractSimpleOriginationData Contract))
 -> ContractSpecification
      (ContractSimpleOriginationData (Maybe String))
 -> IO
      (ContractSpecification (ContractSimpleOriginationData Contract)))
-> ((Maybe String -> IO Contract)
    -> ContractSimpleOriginationData (Maybe String)
    -> IO (ContractSimpleOriginationData Contract))
-> (Maybe String -> IO Contract)
-> ContractSpecification
     (ContractSimpleOriginationData (Maybe String))
-> IO
     (ContractSpecification (ContractSimpleOriginationData Contract))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> IO Contract)
-> ContractSimpleOriginationData (Maybe String)
-> IO (ContractSimpleOriginationData Contract)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSimpleOriginationData a
-> f (ContractSimpleOriginationData b)
traverse) Maybe String -> IO Contract
prepareContract ContractSpecification
  (ContractSimpleOriginationData (Maybe String))
addressOrContract
      IO SomeValue -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SomeValue -> IO ()) -> IO SomeValue -> IO ()
forall a b. (a -> b) -> a -> b
$ CommonRunOptions
-> ContractSpecification (ContractSimpleOriginationData Contract)
-> ViewName
-> SomeAddressOrAlias
-> TxParam
-> IO SomeValue
runView CommonRunOptions
cro ContractSpecification (ContractSimpleOriginationData Contract)
contractSpec ViewName
viewName SomeAddressOrAlias
sender TxParam
viewArg

replSubCmd :: IOCmd
replSubCmd :: Mod CommandFields (IO ())
replSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"repl" String
"Start a Morley REPL." (Parser (IO ()) -> Mod CommandFields (IO ()))
-> Parser (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ IO () -> Parser (IO ())
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO ()
runRepl

originateSubCmd :: IOCmd
originateSubCmd :: Mod CommandFields (IO ())
originateSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"originate" String
"Originate passed contract. Add it to passed DB." do
  ContractSimpleOriginationData (Maybe String)
simpleOriginationData <- Parser (ContractSimpleOriginationData (Maybe String))
contractSimpleOriginationDataOption
  String
dbPath <- Parser String
dbPathOption
  TypeCheckOptions
tcOptions <- Parser TypeCheckOptions
typeCheckOptionsOption
  Bool
verbose <- Parser Bool
verboseFlag
  KindedAddress 'AddressKindImplicit
originator <- Maybe (KindedAddress 'AddressKindImplicit)
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser (KindedAddress 'AddressKindImplicit)
forall (kind :: AddressKind).
SingI kind =>
Maybe (KindedAddress kind)
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser (KindedAddress kind)
addressOption (KindedAddress 'AddressKindImplicit
-> Maybe (KindedAddress 'AddressKindImplicit)
forall a. a -> Maybe a
Just KindedAddress 'AddressKindImplicit
genesisAddress)
    (NamedF Identity String "name"
 -> NamedF Identity String "help"
 -> Parser (KindedAddress 'AddressKindImplicit))
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser (KindedAddress 'AddressKindImplicit)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"originator"
    (NamedF Identity String "help"
 -> Parser (KindedAddress 'AddressKindImplicit))
-> Param (NamedF Identity String "help")
-> Parser (KindedAddress 'AddressKindImplicit)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Contract's originator."
  Maybe (Alias 'AddressKindContract)
alias <- Parser (Alias 'AddressKindContract)
-> Parser (Maybe (Alias 'AddressKindContract))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Parser (Alias 'AddressKindContract)
forall (kind :: AddressKind).
(SingI kind, L1AddressKind kind) =>
String -> Parser (Alias kind)
aliasOption String
"alias")
  Maybe KeyHash
delegate <- Parser KeyHash -> Parser (Maybe KeyHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser KeyHash -> Parser (Maybe KeyHash))
-> Parser KeyHash -> Parser (Maybe KeyHash)
forall a b. (a -> b) -> a -> b
$ Maybe KeyHash
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser KeyHash
keyHashOption Maybe KeyHash
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser KeyHash)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser KeyHash
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"delegate"
    (NamedF Identity String "help" -> Parser KeyHash)
-> Param (NamedF Identity String "help") -> Parser KeyHash
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Contract's optional delegate."
  pure do
    ContractSimpleOriginationData Contract
michelsonContract <- (Maybe String -> IO Contract)
-> ContractSimpleOriginationData (Maybe String)
-> IO (ContractSimpleOriginationData Contract)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSimpleOriginationData a
-> f (ContractSimpleOriginationData b)
traverse Maybe String -> IO Contract
prepareContract ContractSimpleOriginationData (Maybe String)
simpleOriginationData
    ContractAddress
addr <-
      NamedF Identity String "dbPath"
-> NamedF Maybe TypeCheckOptions "tcOpts"
-> NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator"
-> NamedF Maybe (Alias 'AddressKindContract) "alias"
-> NamedF Maybe KeyHash "delegate"
-> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
-> NamedF Maybe Bool "verbose"
-> IO ContractAddress
originateContract
        (NamedF Identity String "dbPath"
 -> NamedF Maybe TypeCheckOptions "tcOpts"
 -> NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator"
 -> NamedF Maybe (Alias 'AddressKindContract) "alias"
 -> NamedF Maybe KeyHash "delegate"
 -> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
 -> NamedF Maybe Bool "verbose"
 -> IO ContractAddress)
-> Param (NamedF Identity String "dbPath")
-> NamedF Maybe TypeCheckOptions "tcOpts"
-> NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator"
-> NamedF Maybe (Alias 'AddressKindContract) "alias"
-> NamedF Maybe KeyHash "delegate"
-> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
-> NamedF Maybe Bool "verbose"
-> IO ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "dbPath")
forall (x :: Symbol) a. IsLabel x a => a
#dbPath String
dbPath
        (NamedF Maybe TypeCheckOptions "tcOpts"
 -> NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator"
 -> NamedF Maybe (Alias 'AddressKindContract) "alias"
 -> NamedF Maybe KeyHash "delegate"
 -> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
 -> NamedF Maybe Bool "verbose"
 -> IO ContractAddress)
-> Param (NamedF Maybe TypeCheckOptions "tcOpts")
-> NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator"
-> NamedF Maybe (Alias 'AddressKindContract) "alias"
-> NamedF Maybe KeyHash "delegate"
-> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
-> NamedF Maybe Bool "verbose"
-> IO ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! TypeCheckOptions -> Param (NamedF Maybe TypeCheckOptions "tcOpts")
forall (x :: Symbol) a. IsLabel x a => a
#tcOpts TypeCheckOptions
tcOptions
        (NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator"
 -> NamedF Maybe (Alias 'AddressKindContract) "alias"
 -> NamedF Maybe KeyHash "delegate"
 -> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
 -> NamedF Maybe Bool "verbose"
 -> IO ContractAddress)
-> Param
     (NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator")
-> NamedF Maybe (Alias 'AddressKindContract) "alias"
-> NamedF Maybe KeyHash "delegate"
-> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
-> NamedF Maybe Bool "verbose"
-> IO ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! KindedAddress 'AddressKindImplicit
-> Param
     (NamedF Maybe (KindedAddress 'AddressKindImplicit) "originator")
forall (x :: Symbol) a. IsLabel x a => a
#originator KindedAddress 'AddressKindImplicit
originator
        (NamedF Maybe (Alias 'AddressKindContract) "alias"
 -> NamedF Maybe KeyHash "delegate"
 -> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
 -> NamedF Maybe Bool "verbose"
 -> IO ContractAddress)
-> Param (NamedF Maybe (Alias 'AddressKindContract) "alias")
-> NamedF Maybe KeyHash "delegate"
-> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
-> NamedF Maybe Bool "verbose"
-> IO ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Name "alias"
-> Maybe (Alias 'AddressKindContract)
-> Param (NamedF Maybe (Alias 'AddressKindContract) "alias")
forall (name :: Symbol) (f :: * -> *) a.
Name name -> f a -> Param (NamedF f a name)
paramF Name "alias"
#alias Maybe (Alias 'AddressKindContract)
alias
        (NamedF Maybe KeyHash "delegate"
 -> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
 -> NamedF Maybe Bool "verbose"
 -> IO ContractAddress)
-> Param (NamedF Maybe KeyHash "delegate")
-> NamedF Identity (ContractSimpleOriginationData Contract) "csod"
-> NamedF Maybe Bool "verbose"
-> IO ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Name "delegate"
-> Maybe KeyHash -> Param (NamedF Maybe KeyHash "delegate")
forall (name :: Symbol) (f :: * -> *) a.
Name name -> f a -> Param (NamedF f a name)
paramF Name "delegate"
#delegate Maybe KeyHash
delegate
        (NamedF Identity (ContractSimpleOriginationData Contract) "csod"
 -> NamedF Maybe Bool "verbose" -> IO ContractAddress)
-> Param
     (NamedF Identity (ContractSimpleOriginationData Contract) "csod")
-> NamedF Maybe Bool "verbose"
-> IO ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! ContractSimpleOriginationData Contract
-> Param
     (NamedF Identity (ContractSimpleOriginationData Contract) "csod")
forall (x :: Symbol) a. IsLabel x a => a
#csod ContractSimpleOriginationData Contract
michelsonContract
        (NamedF Maybe Bool "verbose" -> IO ContractAddress)
-> Param (NamedF Maybe Bool "verbose") -> IO ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Bool -> Param (NamedF Maybe Bool "verbose")
forall (x :: Symbol) a. IsLabel x a => a
#verbose Bool
verbose
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Originated contract " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty ContractAddress
addr

transferSubCmd :: IOCmd
transferSubCmd :: Mod CommandFields (IO ())
transferSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"transfer" String
"Transfer tokens to given address." do
  SomeAddressOrAlias
destination <- Maybe SomeAddressOrAlias
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser SomeAddressOrAlias
someAddressOrAliasOption Maybe SomeAddressOrAlias
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser SomeAddressOrAlias)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser SomeAddressOrAlias
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"to"
    (NamedF Identity String "help" -> Parser SomeAddressOrAlias)
-> Param (NamedF Identity String "help")
-> Parser SomeAddressOrAlias
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Address or alias of the transfer's destination."
  TxData
txData <- Parser TxData
txDataOption
  CommonRunOptions
cro <- DryRunOrWrite -> Parser CommonRunOptions
commonRunOptions DryRunOrWrite
DryRun
  pure $ CommonRunOptions -> SomeAddressOrAlias -> TxData -> IO ()
transfer CommonRunOptions
cro SomeAddressOrAlias
destination TxData
txData

transferTicketSubCmd :: IOCmd
transferTicketSubCmd :: Mod CommandFields (IO ())
transferTicketSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"transfer-ticket" String
"Transfer ticket to given address." do
  SomeAddressOrAlias
destination <- Maybe SomeAddressOrAlias
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser SomeAddressOrAlias
someAddressOrAliasOption Maybe SomeAddressOrAlias
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser SomeAddressOrAlias)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser SomeAddressOrAlias
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"to"
    (NamedF Identity String "help" -> Parser SomeAddressOrAlias)
-> Param (NamedF Identity String "help")
-> Parser SomeAddressOrAlias
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Address or alias of the transfer's destination."
  L1Address
tdSenderAddress :: L1Address <- KindedAddress 'AddressKindImplicit -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained (KindedAddress 'AddressKindImplicit -> L1Address)
-> Parser (KindedAddress 'AddressKindImplicit) -> Parser L1Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (KindedAddress 'AddressKindImplicit)
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser (KindedAddress 'AddressKindImplicit)
forall (kind :: AddressKind).
SingI kind =>
Maybe (KindedAddress kind)
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser (KindedAddress kind)
addressOption (KindedAddress 'AddressKindImplicit
-> Maybe (KindedAddress 'AddressKindImplicit)
forall a. a -> Maybe a
Just KindedAddress 'AddressKindImplicit
genesisAddress)
    (NamedF Identity String "name"
 -> NamedF Identity String "help"
 -> Parser (KindedAddress 'AddressKindImplicit))
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser (KindedAddress 'AddressKindImplicit)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"sender" (NamedF Identity String "help"
 -> Parser (KindedAddress 'AddressKindImplicit))
-> Param (NamedF Identity String "help")
-> Parser (KindedAddress 'AddressKindImplicit)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Sender address"
  Address
ticketer <- forall a.
(Buildable a, HasCLReader a) =>
Maybe a
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser a
mkCLOptionParser @Address Maybe Address
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Address)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Address
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"ticketer" (NamedF Identity String "help" -> Parser Address)
-> Param (NamedF Identity String "help") -> Parser Address
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Ticketer"
  Value
value <- Maybe Value
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser Value
valueOption Maybe Value
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Value)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Value
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"value" (NamedF Identity String "help" -> Parser Value)
-> Param (NamedF Identity String "help") -> Parser Value
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Ticket value"
  Ty
ty <- Maybe Ty
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser Ty
forall a.
(Buildable a, HasCLReader a) =>
Maybe a
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser a
mkCLOptionParser Maybe Ty
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Ty)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Ty
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"type" (NamedF Identity String "help" -> Parser Ty)
-> Param (NamedF Identity String "help") -> Parser Ty
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Ticket argument type"
  Natural
tAmount <- forall a.
(Buildable a, HasCLReader a) =>
Maybe a
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser a
mkCLOptionParser @Natural Maybe Natural
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Natural)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Natural
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"amount" (NamedF Identity String "help" -> Parser Natural)
-> Param (NamedF Identity String "help") -> Parser Natural
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Amount of tickets"
  Mutez
tdAmount <- Maybe Mutez
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser Mutez
mutezOption (Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just Mutez
forall a. Bounded a => a
minBound)
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Mutez)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Mutez
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"mutez" (NamedF Identity String "help" -> Parser Mutez)
-> Param (NamedF Identity String "help") -> Parser Mutez
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Mutez amount additionally sent by a transaction. \
    \Note that on network, as of Mumbai, implicit accounts can't send tickets \
    \and mutez in the same operation, however the Morley emulator allows it."
  EpName
tdEntrypoint <- NamedF Identity String "name"
-> NamedF Identity String "help" -> Parser EpName
entrypointOption
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser EpName)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser EpName
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"entrypoint" (NamedF Identity String "help" -> Parser EpName)
-> Param (NamedF Identity String "help") -> Parser EpName
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Entrypoint to call"
  CommonRunOptions
cro <- DryRunOrWrite -> Parser CommonRunOptions
commonRunOptions DryRunOrWrite
DryRun
  pure $ Ty -> (forall (t :: T). SingI t => Notes t -> IO ()) -> IO ()
forall r. Ty -> (forall (t :: T). SingI t => Notes t -> r) -> r
T.withUType Ty
ty \(Notes t
_ :: T.Notes t) -> do
    Value t
tValue <- (TcError' ExpandedOp -> IO (Value t))
-> (Value t -> IO (Value t))
-> Either (TcError' ExpandedOp) (Value t)
-> IO (Value t)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError' ExpandedOp -> IO (Value t)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Value t -> IO (Value t)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TcError' ExpandedOp) (Value t) -> IO (Value t))
-> (TypeCheckResult ExpandedOp (Value t)
    -> Either (TcError' ExpandedOp) (Value t))
-> TypeCheckResult ExpandedOp (Value t)
-> IO (Value t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value t)
-> Either (TcError' ExpandedOp) (Value t)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith (CommonRunOptions -> TypeCheckOptions
croTCOpts CommonRunOptions
cro) (TypeCheckResult ExpandedOp (Value t) -> IO (Value t))
-> TypeCheckResult ExpandedOp (Value t) -> IO (Value t)
forall a b. (a -> b) -> a -> b
$
      forall (t :: T).
SingI t =>
Value -> TypeCheckResult ExpandedOp (Value t)
typeCheckValue @t Value
value
    Dict (ParameterScope t, Comparable t)
T.Dict <- (BadTypeForScope -> IO (Dict (ParameterScope t, Comparable t)))
-> (Dict (ParameterScope t, Comparable t)
    -> IO (Dict (ParameterScope t, Comparable t)))
-> Either BadTypeForScope (Dict (ParameterScope t, Comparable t))
-> IO (Dict (ParameterScope t, Comparable t))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TcTypeError -> IO (Dict (ParameterScope t, Comparable t))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TcTypeError -> IO (Dict (ParameterScope t, Comparable t)))
-> (BadTypeForScope -> TcTypeError)
-> BadTypeForScope
-> IO (Dict (ParameterScope t, Comparable t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> BadTypeForScope -> TcTypeError
TypeCheck.UnsupportedTypeForScope (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @t)) Dict (ParameterScope t, Comparable t)
-> IO (Dict (ParameterScope t, Comparable t))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BadTypeForScope (Dict (ParameterScope t, Comparable t))
 -> IO (Dict (ParameterScope t, Comparable t)))
-> Either BadTypeForScope (Dict (ParameterScope t, Comparable t))
-> IO (Dict (ParameterScope t, Comparable t))
forall a b. (a -> b) -> a -> b
$
      forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
T.checkScope @(T.ParameterScope t, T.Comparable t)
    let tdParameter :: TxParam
tdParameter = Value ('TTicket t) -> TxParam
forall (t :: T). ParameterScope t => Value t -> TxParam
TxTypedParam (Value ('TTicket t) -> TxParam) -> Value ('TTicket t) -> TxParam
forall a b. (a -> b) -> a -> b
$ Address -> Value t -> Natural -> Value ('TTicket t)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
T.VTicket Address
ticketer Value t
tValue Natural
tAmount
    CommonRunOptions -> SomeAddressOrAlias -> TxData -> IO ()
transfer CommonRunOptions
cro SomeAddressOrAlias
destination TxData{L1Address
EpName
Mutez
TxParam
tdSenderAddress :: L1Address
tdAmount :: Mutez
tdEntrypoint :: EpName
tdParameter :: TxParam
tdSenderAddress :: L1Address
tdParameter :: TxParam
tdEntrypoint :: EpName
tdAmount :: Mutez
..}

optimizeSubCmd :: IOCmd
optimizeSubCmd :: Mod CommandFields (IO ())
optimizeSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"optimize" String
"Optimize the contract." do
  Maybe String
contractFile <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
contractFileOption
  Maybe String
output <- Parser (Maybe String)
outputOption
  Bool
singleLine <- Parser Bool
onelineOption
  Word
maxStageIterations <- Maybe Word
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser Word
forall a.
(Buildable a, HasCLReader a) =>
Maybe a
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser a
mkCLOptionParser (Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ OptimizerConf -> Word
ocMaxIterations OptimizerConf
forall a. Default a => a
def)
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Word)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Word
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"max-stage-iterations"
    (NamedF Identity String "help" -> Parser Word)
-> Param (NamedF Identity String "help") -> Parser Word
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Maximum number of iterations per optimizer stage. \
        \The default is usually adequate, but you want to try raising it \
        \to see if it affects the result."
  Bool
verbose <- Parser Bool
verboseFlag
  pure do
    Contract
untypedContract <- Maybe String -> IO Contract
prepareContract Maybe String
contractFile
    SomeContract Contract cp st
checkedContract <-
      (TcError' ExpandedOp -> IO SomeContract)
-> (SomeContract -> IO SomeContract)
-> Either (TcError' ExpandedOp) SomeContract
-> IO SomeContract
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError' ExpandedOp -> IO SomeContract
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeContract -> IO SomeContract
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TcError' ExpandedOp) SomeContract -> IO SomeContract)
-> (TypeCheckResult ExpandedOp SomeContract
    -> Either (TcError' ExpandedOp) SomeContract)
-> TypeCheckResult ExpandedOp SomeContract
-> IO SomeContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult ExpandedOp SomeContract
-> Either (TcError' ExpandedOp) SomeContract
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
laxTcOptions (TypeCheckResult ExpandedOp SomeContract -> IO SomeContract)
-> TypeCheckResult ExpandedOp SomeContract -> IO SomeContract
forall a b. (a -> b) -> a -> b
$
        Contract -> TypeCheckResult ExpandedOp SomeContract
typeCheckContract Contract
untypedContract
    let ([OptimizerStageStats]
logs, Contract cp st
optimizedContract) =
          (forall (i :: [T]) (o :: [T]).
 Instr i o -> ([OptimizerStageStats], Instr i o))
-> Contract cp st -> ([OptimizerStageStats], Contract cp st)
forall (m :: * -> *) (instr :: [T] -> [T] -> *) (cp :: T)
       (st :: T).
Monad m =>
(forall (i :: [T]) (o :: [T]). instr i o -> m (instr i o))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractCodeM (OptimizerConf -> Instr i o -> ([OptimizerStageStats], Instr i o)
forall (inp :: [T]) (out :: [T]).
OptimizerConf
-> Instr inp out -> ([OptimizerStageStats], Instr inp out)
optimizeVerboseWithConf OptimizerConf
conf) Contract cp st
checkedContract
        conf :: OptimizerConf
conf = OptimizerConf
forall a. Default a => a
def { ocMaxIterations :: Word
ocMaxIterations = Word
maxStageIterations }
    (Text -> IO ())
-> (String -> Text -> IO ()) -> Maybe String -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn String -> Text -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> Text -> m ()
Utf8.writeFile Maybe String
output (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Contract cp st -> Text
forall (p :: T) (s :: T). Bool -> Contract p s -> Text
printTypedContract Bool
singleLine Contract cp st
optimizedContract
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Text
forall a. Buildable a => a -> Text
prettyText (Doc -> Text) -> Doc -> Text
forall a b. (a -> b) -> a -> b
$ [OptimizerStageStats] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF [OptimizerStageStats]
logs

analyzeSubCmd :: IOCmd
analyzeSubCmd :: Mod CommandFields (IO ())
analyzeSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"analyze" String
"Analyze the contract." do
  Maybe String
contractFile <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
contractFileOption
  pure do
    Contract
untypedContract <- Maybe String -> IO Contract
prepareContract Maybe String
contractFile
    SomeContract Contract cp st
contract <-
      (TcError' ExpandedOp -> IO SomeContract)
-> (SomeContract -> IO SomeContract)
-> Either (TcError' ExpandedOp) SomeContract
-> IO SomeContract
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError' ExpandedOp -> IO SomeContract
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeContract -> IO SomeContract
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TcError' ExpandedOp) SomeContract -> IO SomeContract)
-> (TypeCheckResult ExpandedOp SomeContract
    -> Either (TcError' ExpandedOp) SomeContract)
-> TypeCheckResult ExpandedOp SomeContract
-> IO SomeContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult ExpandedOp SomeContract
-> Either (TcError' ExpandedOp) SomeContract
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
laxTcOptions (TypeCheckResult ExpandedOp SomeContract -> IO SomeContract)
-> TypeCheckResult ExpandedOp SomeContract -> IO SomeContract
forall a b. (a -> b) -> a -> b
$
        Contract -> TypeCheckResult ExpandedOp SomeContract
typeCheckContract Contract
untypedContract
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ AnalyzerRes -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty (AnalyzerRes -> Text) -> AnalyzerRes -> Text
forall a b. (a -> b) -> a -> b
$ Instr (ContractInp cp st) (ContractOut st) -> AnalyzerRes
forall (inp :: [T]) (out :: [T]). Instr inp out -> AnalyzerRes
analyze (ContractCode' Instr cp st
-> Instr (ContractInp cp st) (ContractOut st)
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
ContractCode' instr cp st
-> instr (ContractInp cp st) (ContractOut st)
unContractCode (ContractCode' Instr cp st
 -> Instr (ContractInp cp st) (ContractOut st))
-> ContractCode' Instr cp st
-> Instr (ContractInp cp st) (ContractOut st)
forall a b. (a -> b) -> a -> b
$ Contract cp st -> ContractCode' Instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cCode Contract cp st
contract)

createChestSubCmd :: IOCmd
createChestSubCmd :: Mod CommandFields (IO ())
createChestSubCmd = String -> String -> Parser (IO ()) -> Mod CommandFields (IO ())
forall a. String -> String -> Parser a -> Mod CommandFields a
mkCommandParser' String
"create_chest" String
"Create a timelocked chest and key." do
  ByteString
payload <- Parser ByteString
payloadOption
  TLTime
time <- Parser TLTime
timeOption
  pure do
    (Chest
chest, ChestKey
key) <- ByteString -> TLTime -> IO (Chest, ChestKey)
createChestAndChestKey ByteString
payload TLTime
time
    Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Chest: 0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
encodeHex (Chest -> ByteString
chestBytes Chest
chest)
    Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Key: 0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
encodeHex (ChestKey -> ByteString
chestKeyBytes ChestKey
key)

--------------------------------------------------------------------------------
-- Parsers
--------------------------------------------------------------------------------

verboseFlag :: Opt.Parser Bool
verboseFlag :: Parser Bool
verboseFlag = Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
  Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbose" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
  String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Whether output should be verbose."

typeCheckOptionsOption :: Opt.Parser TypeCheck.TypeCheckOptions
typeCheckOptionsOption :: Parser TypeCheckOptions
typeCheckOptionsOption = do
  Bool
tcVerbose <- Parser Bool
verboseFlag
  Bool
tcStrict <- (Bool -> Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
forall a. Boolean a => a -> a
not (Parser Bool -> Parser Bool)
-> (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool
-> Parser Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"typecheck-lax" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Whether actions permitted in `octez-client run` but forbidden in \
          \e.g. `octez-client originate` should be allowed here."
  return TypeCheck.TypeCheckOptions{Bool
tcVerbose :: Bool
tcVerbose :: Bool
tcStrict :: Bool
tcStrict :: Bool
..}

commonRunOptions :: DryRunOrWrite -> Opt.Parser CommonRunOptions
commonRunOptions :: DryRunOrWrite -> Parser CommonRunOptions
commonRunOptions DryRunOrWrite
defaultDryRun = do
  Maybe Timestamp
croNow <- Parser (Maybe Timestamp)
nowOption
  Natural
croLevel <- Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (CommonRunOptions -> Natural
croLevel CommonRunOptions
forall a. Default a => a
def) (Maybe Natural -> Natural)
-> Parser (Maybe Natural) -> Parser Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Natural)
levelOption
  Natural
croMinBlockTime <- Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (CommonRunOptions -> Natural
croMinBlockTime CommonRunOptions
forall a. Default a => a
def) (Maybe Natural -> Natural)
-> Parser (Maybe Natural) -> Parser Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Natural)
minBlockTimeOption
  RemainingSteps
croMaxSteps <- Word64 -> RemainingSteps
RemainingSteps (Word64 -> RemainingSteps)
-> Parser Word64 -> Parser RemainingSteps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word64
maxStepsOption
  String
croDBPath <- Parser String
dbPathOption
  TypeCheckOptions
croTCOpts <- Parser TypeCheckOptions
typeCheckOptionsOption
  Bool
croVerbose <- Parser Bool
verboseFlag
  Bool
croDryRun <- case DryRunOrWrite
defaultDryRun of
    DryRunOrWrite
Write -> (Bool -> Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
forall a. Boolean a => a -> a
not (Parser Bool -> Parser Bool)
-> (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool
-> Parser Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
      String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"write" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Write updated DB to the DB file."
    DryRunOrWrite
DryRun -> Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
      String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dry-run" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Do not write updated DB to the DB file."
  pure CommonRunOptions{Bool
Natural
String
Maybe Timestamp
TypeCheckOptions
RemainingSteps
croTCOpts :: TypeCheckOptions
croNow :: Maybe Timestamp
croLevel :: Natural
croLevel :: Natural
croMinBlockTime :: Natural
croMinBlockTime :: Natural
croMaxSteps :: RemainingSteps
croDBPath :: String
croTCOpts :: TypeCheckOptions
croVerbose :: Bool
croDryRun :: Bool
croNow :: Maybe Timestamp
croMaxSteps :: RemainingSteps
croDBPath :: String
croVerbose :: Bool
croDryRun :: Bool
..}

contractSimpleOriginationDataOption :: Opt.Parser (ContractSimpleOriginationData (Maybe FilePath))
contractSimpleOriginationDataOption :: Parser (ContractSimpleOriginationData (Maybe String))
contractSimpleOriginationDataOption = do
  Value
csodStorage <- Maybe Value
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser Value
valueOption Maybe Value
forall a. Maybe a
Nothing
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Value)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Value
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"storage"
    (NamedF Identity String "help" -> Parser Value)
-> Param (NamedF Identity String "help") -> Parser Value
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Initial storage of the contract."
  Maybe String
csodContract <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
contractFileOption
  Mutez
csodBalance <- Maybe Mutez
-> NamedF Identity String "name"
-> NamedF Identity String "help"
-> Parser Mutez
mutezOption (Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just Mutez
defaultBalance)
    (NamedF Identity String "name"
 -> NamedF Identity String "help" -> Parser Mutez)
-> Param (NamedF Identity String "name")
-> NamedF Identity String "help"
-> Parser Mutez
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "name")
forall (x :: Symbol) a. IsLabel x a => a
#name String
"balance"
    (NamedF Identity String "help" -> Parser Mutez)
-> Param (NamedF Identity String "help") -> Parser Mutez
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! String -> Param (NamedF Identity String "help")
forall (x :: Symbol) a. IsLabel x a => a
#help String
"Initial balance of the contract."
  pure ContractSimpleOriginationData{Maybe String
Mutez
Value
csodStorage :: Value
csodContract :: Maybe String
csodBalance :: Mutez
csodContract :: Maybe String
csodStorage :: Value
csodBalance :: Mutez
..}

--------------------------------------------------------------------------------
-- Constants
--------------------------------------------------------------------------------

defaultBalance :: Mutez
defaultBalance :: Mutez
defaultBalance = [tz|4|]

-- | Most permitting options, when we don't care much about typechecking.
laxTcOptions :: TypeCheck.TypeCheckOptions
laxTcOptions :: TypeCheckOptions
laxTcOptions = TypeCheck.TypeCheckOptions
  { tcVerbose :: Bool
TypeCheck.tcVerbose = Bool
False
  , tcStrict :: Bool
TypeCheck.tcStrict = Bool
False
  }