{-# LANGUAGE ApplicativeDo         #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module Plutus.PAB.Run.CommandParser (parseOptions, AppOpts(..)) where

import Cardano.Api (ChainPoint (..), deserialiseFromRawBytesHex, proxyToAsType)
import Cardano.BM.Data.Severity (Severity (..))
import Cardano.Slotting.Slot (SlotNo (..))
import Data.Either.Combinators (mapLeft, maybeToRight)
import Data.List (elemIndex)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text, pack)
import Data.Text.Encoding (encodeUtf8)
import Options.Applicative (CommandFields, Mod, Parser, ReadM, argument, auto, command, customExecParser, disambiguate,
                            eitherReader, flag, fullDesc, help, helper, idm, info, long, metavar, option, prefs,
                            progDesc, short, showHelpOnEmpty, showHelpOnError, str, subparser, value)
import Text.Read (readEither)
import Wallet.Types (ContractInstanceId (..))

import Plutus.ChainIndex.Compatibility (fromCardanoPoint)
import Plutus.ChainIndex.Types (Point (..))
import Plutus.PAB.App (StorageBackend (..))
import Plutus.PAB.Run.Command

data AppOpts = AppOpts { AppOpts -> Maybe Severity
minLogLevel     :: Maybe Severity
                       , AppOpts -> Maybe FilePath
logConfigPath   :: Maybe FilePath
                       , AppOpts -> Maybe FilePath
configPath      :: Maybe FilePath
                       , AppOpts -> Maybe Text
passphrase      :: Maybe Text
                       , AppOpts -> Maybe Int
rollbackHistory :: Maybe Int
                       , AppOpts -> Point
resumeFrom      :: Point
                       , AppOpts -> Bool
runEkgServer    :: Bool
                       , AppOpts -> StorageBackend
storageBackend  :: StorageBackend
                       , AppOpts -> ConfigCommand
cmd             :: ConfigCommand
                       }

parseOptions :: IO AppOpts
parseOptions :: IO AppOpts
parseOptions = ParserPrefs -> ParserInfo AppOpts -> IO AppOpts
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser
            (PrefsMod -> ParserPrefs
prefs (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$ PrefsMod
disambiguate PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnEmpty PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnError)
            (Parser AppOpts -> InfoMod AppOpts -> ParserInfo AppOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (AppOpts -> AppOpts)
forall a. Parser (a -> a)
helper Parser (AppOpts -> AppOpts) -> Parser AppOpts -> Parser AppOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AppOpts
commandLineParser) InfoMod AppOpts
forall m. Monoid m => m
idm)

logLevelFlag :: Parser (Maybe Severity)
logLevelFlag :: Parser (Maybe Severity)
logLevelFlag =
    Maybe Severity
-> Maybe Severity
-> Mod FlagFields (Maybe Severity)
-> Parser (Maybe Severity)
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
        Maybe Severity
forall a. Maybe a
Nothing
        (Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Debug)
        (Char -> Mod FlagFields (Maybe Severity)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod FlagFields (Maybe Severity)
-> Mod FlagFields (Maybe Severity)
-> Mod FlagFields (Maybe Severity)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe Severity)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbose" Mod FlagFields (Maybe Severity)
-> Mod FlagFields (Maybe Severity)
-> Mod FlagFields (Maybe Severity)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe Severity)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enable debugging output.")

ekgFlag :: Parser Bool
ekgFlag :: Parser Bool
ekgFlag =
    Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
        Bool
False
        Bool
True
        (Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ekg" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enable the EKG server")

inMemoryFlag :: Parser StorageBackend
inMemoryFlag :: Parser StorageBackend
inMemoryFlag =
    StorageBackend
-> StorageBackend
-> Mod FlagFields StorageBackend
-> Parser StorageBackend
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
        StorageBackend
BeamBackend
        StorageBackend
InMemoryBackend
        (Char -> Mod FlagFields StorageBackend
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' Mod FlagFields StorageBackend
-> Mod FlagFields StorageBackend -> Mod FlagFields StorageBackend
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields StorageBackend
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"memory" Mod FlagFields StorageBackend
-> Mod FlagFields StorageBackend -> Mod FlagFields StorageBackend
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields StorageBackend
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Use the memory-backed backend. If false, the beam backend is used.")

commandLineParser :: Parser AppOpts
commandLineParser :: Parser AppOpts
commandLineParser =
        Maybe Severity
-> Maybe FilePath
-> Maybe FilePath
-> Maybe Text
-> Maybe Int
-> Point
-> Bool
-> StorageBackend
-> ConfigCommand
-> AppOpts
AppOpts (Maybe Severity
 -> Maybe FilePath
 -> Maybe FilePath
 -> Maybe Text
 -> Maybe Int
 -> Point
 -> Bool
 -> StorageBackend
 -> ConfigCommand
 -> AppOpts)
-> Parser (Maybe Severity)
-> Parser
     (Maybe FilePath
      -> Maybe FilePath
      -> Maybe Text
      -> Maybe Int
      -> Point
      -> Bool
      -> StorageBackend
      -> ConfigCommand
      -> AppOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Severity)
logLevelFlag
                Parser
  (Maybe FilePath
   -> Maybe FilePath
   -> Maybe Text
   -> Maybe Int
   -> Point
   -> Bool
   -> StorageBackend
   -> ConfigCommand
   -> AppOpts)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe FilePath
      -> Maybe Text
      -> Maybe Int
      -> Point
      -> Bool
      -> StorageBackend
      -> ConfigCommand
      -> AppOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
logConfigFileParser
                Parser
  (Maybe FilePath
   -> Maybe Text
   -> Maybe Int
   -> Point
   -> Bool
   -> StorageBackend
   -> ConfigCommand
   -> AppOpts)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Point
      -> Bool
      -> StorageBackend
      -> ConfigCommand
      -> AppOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
configFileParser
                Parser
  (Maybe Text
   -> Maybe Int
   -> Point
   -> Bool
   -> StorageBackend
   -> ConfigCommand
   -> AppOpts)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Point -> Bool -> StorageBackend -> ConfigCommand -> AppOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Text)
passphraseParser
                Parser
  (Maybe Int
   -> Point -> Bool -> StorageBackend -> ConfigCommand -> AppOpts)
-> Parser (Maybe Int)
-> Parser
     (Point -> Bool -> StorageBackend -> ConfigCommand -> AppOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
rollbackHistoryParser
                Parser
  (Point -> Bool -> StorageBackend -> ConfigCommand -> AppOpts)
-> Parser Point
-> Parser (Bool -> StorageBackend -> ConfigCommand -> AppOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Point
chainPointParser
                Parser (Bool -> StorageBackend -> ConfigCommand -> AppOpts)
-> Parser Bool
-> Parser (StorageBackend -> ConfigCommand -> AppOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
ekgFlag
                Parser (StorageBackend -> ConfigCommand -> AppOpts)
-> Parser StorageBackend -> Parser (ConfigCommand -> AppOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StorageBackend
inMemoryFlag
                Parser (ConfigCommand -> AppOpts)
-> Parser ConfigCommand -> Parser AppOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfigCommand
commandParser

configFileParser :: Parser (Maybe FilePath)
configFileParser :: Parser (Maybe FilePath)
configFileParser =
    ReadM (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> ReadM FilePath -> ReadM (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
forall s. IsString s => ReadM s
str)
        (FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"config" Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"CONFIG_FILE" Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Config file location." Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<> Maybe FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe FilePath
forall a. Maybe a
Nothing)

logConfigFileParser :: Parser (Maybe FilePath)
logConfigFileParser :: Parser (Maybe FilePath)
logConfigFileParser =
    ReadM (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> ReadM FilePath -> ReadM (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
forall s. IsString s => ReadM s
str)
        (FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"log-config" Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LOG_CONFIG_FILE" Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Logging config file location." Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<> Maybe FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe FilePath
forall a. Maybe a
Nothing)

chainPointReader :: ReadM Point
chainPointReader :: ReadM Point
chainPointReader = (FilePath -> Either FilePath Point) -> ReadM Point
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((FilePath -> Either FilePath Point) -> ReadM Point)
-> (FilePath -> Either FilePath Point) -> ReadM Point
forall a b. (a -> b) -> a -> b
$
  \FilePath
chainPoint -> do
    Int
idx <- FilePath -> Maybe Int -> Either FilePath Int
forall b a. b -> Maybe a -> Either b a
maybeToRight (FilePath
"Failed to parse chain point specification. The format" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
                         FilePath
"should be HASH,SLOT") (Maybe Int -> Either FilePath Int)
-> Maybe Int -> Either FilePath Int
forall a b. (a -> b) -> a -> b
$
                        Char -> FilePath -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
',' FilePath
chainPoint
    let (FilePath
hash, FilePath
slot') = Int -> FilePath -> (FilePath, FilePath)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
idx FilePath
chainPoint
    Word64
slot <- FilePath -> Either FilePath Word64
forall a. Read a => FilePath -> Either FilePath a
readEither (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
slot')
    Hash BlockHeader
hsh  <- (RawBytesHexError -> FilePath)
-> Either RawBytesHexError (Hash BlockHeader)
-> Either FilePath (Hash BlockHeader)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (FilePath -> RawBytesHexError -> FilePath
forall a b. a -> b -> a
const (FilePath -> RawBytesHexError -> FilePath)
-> FilePath -> RawBytesHexError -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse hash " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
hash) (Either RawBytesHexError (Hash BlockHeader)
 -> Either FilePath (Hash BlockHeader))
-> Either RawBytesHexError (Hash BlockHeader)
-> Either FilePath (Hash BlockHeader)
forall a b. (a -> b) -> a -> b
$
        AsType (Hash BlockHeader)
-> ByteString -> Either RawBytesHexError (Hash BlockHeader)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Proxy (Hash BlockHeader) -> AsType (Hash BlockHeader)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy (Hash BlockHeader)
forall k (t :: k). Proxy t
Proxy) (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack FilePath
hash)
    pure $ ChainPoint -> Point
fromCardanoPoint (ChainPoint -> Point) -> ChainPoint -> Point
forall a b. (a -> b) -> a -> b
$ SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint (Word64 -> SlotNo
SlotNo Word64
slot) Hash BlockHeader
hsh

chainPointParser :: Parser Point
chainPointParser :: Parser Point
chainPointParser =
    ReadM Point -> Mod OptionFields Point -> Parser Point
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Point
chainPointReader
        (  FilePath -> Mod OptionFields Point
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"HASH,SLOT"
        Mod OptionFields Point
-> Mod OptionFields Point -> Mod OptionFields Point
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Point
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"resume-from"
        Mod OptionFields Point
-> Mod OptionFields Point -> Mod OptionFields Point
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Point
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Specify the hash and the slot where to start synchronisation"
        Mod OptionFields Point
-> Mod OptionFields Point -> Mod OptionFields Point
forall a. Semigroup a => a -> a -> a
<> Point -> Mod OptionFields Point
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Point
PointAtGenesis )

passphraseParser :: Parser (Maybe Text)
passphraseParser :: Parser (Maybe Text)
passphraseParser =
    ReadM (Maybe Text)
-> Mod OptionFields (Maybe Text) -> Parser (Maybe Text)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ReadM Text -> ReadM (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text
forall s. IsString s => ReadM s
str)
        (FilePath -> Mod OptionFields (Maybe Text)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"passphrase" Mod OptionFields (Maybe Text)
-> Mod OptionFields (Maybe Text) -> Mod OptionFields (Maybe Text)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe Text)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"WALLET_PASSPHRASE" Mod OptionFields (Maybe Text)
-> Mod OptionFields (Maybe Text) -> Mod OptionFields (Maybe Text)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe Text)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Wallet passphrase." Mod OptionFields (Maybe Text)
-> Mod OptionFields (Maybe Text) -> Mod OptionFields (Maybe Text)
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Mod OptionFields (Maybe Text)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe Text
forall a. Maybe a
Nothing)

{- Limit the number of blocks that we store for rollbacks. This options helps
   with the memory usage of the PAB and should be removed when we figure out
   an alternative to storing the UTXO in memory.
-}
rollbackHistoryParser :: Parser (Maybe Int)
rollbackHistoryParser :: Parser (Maybe Int)
rollbackHistoryParser =
    ReadM (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Parser (Maybe Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> ReadM Int -> ReadM (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int
forall a. Read a => ReadM a
auto)
        (FilePath -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"rollback-history" Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"ROLLBACK_HISTORY" Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"How many blocks are remembered when rolling back" Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<>
         Maybe Int -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe Int
forall a. Maybe a
Nothing)

commandParser :: Parser ConfigCommand
commandParser :: Parser ConfigCommand
commandParser =
    Mod CommandFields ConfigCommand -> Parser ConfigCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields ConfigCommand -> Parser ConfigCommand)
-> Mod CommandFields ConfigCommand -> Parser ConfigCommand
forall a b. (a -> b) -> a -> b
$
    [Mod CommandFields ConfigCommand]
-> Mod CommandFields ConfigCommand
forall a. Monoid a => [a] -> a
mconcat
        [ Mod CommandFields ConfigCommand
migrationParser
        , Mod CommandFields ConfigCommand
allServersParser
        , Mod CommandFields ConfigCommand
clientServicesParser
        , Mod CommandFields ConfigCommand
mockWalletParser
        , Mod CommandFields ConfigCommand
pabWebserverParser
        , Mod CommandFields ConfigCommand
mockNodeParser
        , Mod CommandFields ConfigCommand
chainIndexParser
        , FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command
              FilePath
"contracts"
              (Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
                   (Mod CommandFields ConfigCommand -> Parser ConfigCommand
forall a. Mod CommandFields a -> Parser a
subparser
                        ([Mod CommandFields ConfigCommand]
-> Mod CommandFields ConfigCommand
forall a. Monoid a => [a] -> a
mconcat
                             [ Mod CommandFields ConfigCommand
reportActiveContractsParser
                             , Mod CommandFields ConfigCommand
contractStateParser
                             , Mod CommandFields ConfigCommand
reportContractHistoryParser
                             , Mod CommandFields ConfigCommand
reportAvailableContractsParser
                             ]))
                   (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Manage your smart contracts."))
        ]

migrationParser :: Mod CommandFields ConfigCommand
migrationParser :: Mod CommandFields ConfigCommand
migrationParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"migrate" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    (Parser ConfigCommand
 -> InfoMod ConfigCommand -> ParserInfo ConfigCommand)
-> InfoMod ConfigCommand
-> Parser ConfigCommand
-> ParserInfo ConfigCommand
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Update the database with the latest schema.") (Parser ConfigCommand -> ParserInfo ConfigCommand)
-> Parser ConfigCommand -> ParserInfo ConfigCommand
forall a b. (a -> b) -> a -> b
$
        ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCommand
Migrate

mockNodeParser :: Mod CommandFields ConfigCommand
mockNodeParser :: Mod CommandFields ConfigCommand
mockNodeParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"node-server" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
        Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
            (ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCommand
StartNode)
            (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Run a mock version of the Cardano node API server.")

mockWalletParser :: Mod CommandFields ConfigCommand
mockWalletParser :: Mod CommandFields ConfigCommand
mockWalletParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"wallet-server" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCommand
MockWallet)
        (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Run a mock version of the Cardano wallet API server.")

chainIndexParser :: Mod CommandFields ConfigCommand
chainIndexParser :: Mod CommandFields ConfigCommand
chainIndexParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"chain-index" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCommand
ChainIndex) (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Run the chain index.")

allServersParser :: Mod CommandFields ConfigCommand
allServersParser :: Mod CommandFields ConfigCommand
allServersParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"all-servers" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    (Parser ConfigCommand
 -> InfoMod ConfigCommand -> ParserInfo ConfigCommand)
-> InfoMod ConfigCommand
-> Parser ConfigCommand
-> ParserInfo ConfigCommand
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Run all the mock servers needed.") (Parser ConfigCommand -> ParserInfo ConfigCommand)
-> Parser ConfigCommand -> ParserInfo ConfigCommand
forall a b. (a -> b) -> a -> b
$ do
        ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure  ([ConfigCommand] -> ConfigCommand
ForkCommands
                   [ ConfigCommand
StartNode
                   , ConfigCommand
MockWallet
                   , ConfigCommand
PABWebserver
                   , ConfigCommand
ChainIndex
                   ])

clientServicesParser :: Mod CommandFields ConfigCommand
clientServicesParser :: Mod CommandFields ConfigCommand
clientServicesParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"client-services" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ConfigCommand] -> ConfigCommand
ForkCommands
                    [ ConfigCommand
MockWallet
                    , ConfigCommand
PABWebserver
                    , ConfigCommand
ChainIndex
                    ]))
        (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Run the client services (all services except the mock node).")

contractStateParser :: Mod CommandFields ConfigCommand
contractStateParser :: Mod CommandFields ConfigCommand
contractStateParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"state" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (ContractInstanceId -> ConfigCommand
ContractState (ContractInstanceId -> ConfigCommand)
-> Parser ContractInstanceId -> Parser ConfigCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ContractInstanceId
contractIdParser)
        (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Show the current state of a contract.")

contractIdParser :: Parser ContractInstanceId
contractIdParser :: Parser ContractInstanceId
contractIdParser = (UUID -> ContractInstanceId)
-> Parser UUID -> Parser ContractInstanceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> ContractInstanceId
ContractInstanceId (Parser UUID -> Parser ContractInstanceId)
-> Parser UUID -> Parser ContractInstanceId
forall a b. (a -> b) -> a -> b
$
    ReadM UUID -> Mod ArgumentFields UUID -> Parser UUID
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument
        ReadM UUID
forall a. Read a => ReadM a
auto
        (FilePath -> Mod ArgumentFields UUID
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"ID of the contract. (See 'active-contracts' for a list.)")

reportAvailableContractsParser :: Mod CommandFields ConfigCommand
reportAvailableContractsParser :: Mod CommandFields ConfigCommand
reportAvailableContractsParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"available" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCommand
ReportAvailableContracts)
        (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Show all available contracts.")

reportActiveContractsParser :: Mod CommandFields ConfigCommand
reportActiveContractsParser :: Mod CommandFields ConfigCommand
reportActiveContractsParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"active" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCommand
ReportActiveContracts)
        (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Show all active contracts.")

pabWebserverParser :: Mod CommandFields ConfigCommand
pabWebserverParser :: Mod CommandFields ConfigCommand
pabWebserverParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"webserver" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCommand
PABWebserver)
        (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Start the PAB backend webserver.")

reportContractHistoryParser :: Mod CommandFields ConfigCommand
reportContractHistoryParser :: Mod CommandFields ConfigCommand
reportContractHistoryParser =
    FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"history" (ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand)
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a b. (a -> b) -> a -> b
$
    Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (ContractInstanceId -> ConfigCommand
ReportContractHistory (ContractInstanceId -> ConfigCommand)
-> Parser ContractInstanceId -> Parser ConfigCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ContractInstanceId
contractIdParser)
        (InfoMod ConfigCommand
forall a. InfoMod a
fullDesc InfoMod ConfigCommand
-> InfoMod ConfigCommand -> InfoMod ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Show the state history of a smart contract.")