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

module Morley.Client.Parser
  ( ClientArgs (..)
  , ClientArgsRaw (..)
  , OriginateArgs (..)
  , TransferArgs (..)
  , GetScriptSizeArgs (..)
  , TicketBalanceArgs (..)
  , TransferTicketArgs (..)
  , addressOrAliasOption
  , clientConfigParser
  , morleyClientInfo
  , parserInfo

  , originateArgsOption
  , mbContractFileOption
  , contractNameOption

    -- * Parser utilities
  , baseUrlReader
  ) where

import Options.Applicative
  (ReadM, eitherReader, help, long, metavar, option, short, strOption, subparser, value)
import Options.Applicative qualified as Opt
import Options.Applicative.Help.Pretty (Doc, linebreak)
import Servant.Client (BaseUrl(..), parseBaseUrl)

import Morley.CLI
  (addressOrAliasOption, keyHashOption, mutezOption, parserInfo, someAddressOrAliasOption,
  valueOption)
import Morley.Client.Init
import Morley.Client.RPC.Types (BlockId(HeadId))
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Core
import Morley.Tezos.Crypto
import Morley.Util.CLI (mkCLOptionParser, mkCommandParser)
import Morley.Util.Named

data ClientArgs
  = ClientArgs MorleyClientConfig ClientArgsRaw

data ClientArgsRaw where
  Originate :: OriginateArgs -> ClientArgsRaw
  GetScriptSize :: GetScriptSizeArgs -> ClientArgsRaw
  Transfer :: TransferArgs -> ClientArgsRaw
  TransferTicket :: TransferTicketArgs -> ClientArgsRaw
  GetBalance :: L1AddressKind kind => AddressOrAlias kind -> ClientArgsRaw
  GetBlockHeader :: BlockId -> ClientArgsRaw
  GetBlockOperations :: BlockId -> ClientArgsRaw
  TicketBalance :: SomeAddressOrAlias -> TicketBalanceArgs -> ClientArgsRaw
  AllTicketBalances :: ContractAddressOrAlias -> ClientArgsRaw

data OriginateArgs = OriginateArgs
  { oaMbContractFile :: Maybe FilePath
  , oaContractName   :: ContractAlias
  , oaInitialBalance :: Mutez
  , oaInitialStorage :: U.Value
  , oaOriginateFrom  :: ImplicitAddressOrAlias
  , oaMbFee :: Maybe Mutez
  , oaDelegate :: Maybe KeyHash
  }

data GetScriptSizeArgs = GetScriptSizeArgs
  { ssScriptFile :: FilePath
  , ssStorage    :: U.Value
  }

data TransferArgs = TransferArgs
  { taSender      :: ImplicitAddressOrAlias
  , taDestination :: SomeAddressOrAlias
  , taAmount      :: Mutez
  , taParameter   :: U.Value
  , taMbFee :: Maybe Mutez
  }

data TransferTicketArgs = TransferTicketArgs
  { ttaSender         :: ImplicitAddressOrAlias
  , ttaTicketContents :: U.Value
  , ttaTicketType     :: U.Ty
  , ttaTicketTicketer :: ContractAddressOrAlias
  , ttaTicketAmount   :: Natural
  , ttaDestination    :: SomeAddressOrAlias
  , ttaMbFee          :: Maybe Mutez
  }

morleyClientInfo :: Opt.ParserInfo ClientArgs
morleyClientInfo =
  parserInfo
    (#usage :! usageDoc)
    (#description :! "Morley Client: RPC client for interaction with tezos node")
    (#header :! "Morley Client")
    (#parser :! clientParser)

-- | Parser for the @morley-client@ executable.
clientParser :: Opt.Parser ClientArgs
clientParser = ClientArgs <$> clientConfigParser <*> argsRawParser

clientConfigParser :: Opt.Parser MorleyClientConfig
clientConfigParser = do
  let mccSecretKey = Nothing
  mccEndpointUrl <- endpointOption
  mccTezosClientPath <- pathOption
  mccMbTezosClientDataDir <- dataDirOption
  mccVerbosity <- genericLength <$> many verboseSwitch
  pure MorleyClientConfig{..}
  where
    verboseSwitch :: Opt.Parser ()
    verboseSwitch = Opt.flag' () . mconcat $
      [ short 'V'
      , help "Increase verbosity (pass several times to increase further)."
      ]

-- | Parses URL of the Tezos node.
endpointOption :: Opt.Parser (Maybe BaseUrl)
endpointOption = optional . option baseUrlReader $
  long "endpoint"
  <> short 'E'
  <> help "URL of the remote Tezos node."
  <> metavar "URL"

pathOption :: Opt.Parser FilePath
pathOption = strOption $
  mconcat [ short 'I', long "client-path", metavar "PATH"
          , help "Path to `octez-client` binary."
          , value "octez-client"
          , Opt.showDefault
          ]

dataDirOption :: Opt.Parser (Maybe FilePath)
dataDirOption = optional $ strOption $
  mconcat [ short 'd', long "data-dir", metavar "PATH"
          , help "Path to `octez-client` data directory."
          ]

feeOption :: Opt.Parser (Maybe Mutez)
feeOption = optional $ mutezOption
            Nothing
            (#name :! "fee")
            (#help :! "Fee that is going to be used for the transaction. \
                      \By default fee will be computed automatically."
            )

data TicketBalanceArgs = TicketBalanceArgs
  { tbaTicketer :: ContractAddress
  , tbaContent :: U.Value
  , tbaContentType :: U.Ty
  }

getTicketBalanceOption :: Opt.Parser TicketBalanceArgs
getTicketBalanceOption = do
  tbaTicketer <- mkCLOptionParser Nothing
    (#name :! "ticketer")
    (#help :! "The contract that issued the ticket.")
  tbaContentType <- mkCLOptionParser Nothing
    (#name :! "content-type")
    (#help :! "Content type.")
  tbaContent <- valueOption Nothing
    (#name :! "content")
    (#help :! "Ticket content.")
  pure TicketBalanceArgs{..}

-- | Generic parser to read an option of 'BlockId' type.
blockIdOption
  :: Maybe BlockId
  -> "name" :! String
  -> "help" :! String
  -> Opt.Parser BlockId
blockIdOption = mkCLOptionParser

argsRawParser :: Opt.Parser ClientArgsRaw
argsRawParser = subparser $ mconcat
  [ originateCmd
  , transferCmd
  , transferTicketCmd
  , getBalanceCmd
  , getScriptSizeCmd
  , getBlockHeaderCmd
  , getBlockOperationsCmd
  , getTicketBalanceCmd
  , getAllTicketBalancesCmd
  ]
  where
    ownerOption f = f
      Nothing
      (#name :! "owner")
      (#help :! "Ticket owner")
    getTicketBalanceCmd =
      mkCommandParser "ticket-balance"
      (TicketBalance <$> ownerOption someAddressOrAliasOption <*> getTicketBalanceOption)
      "Get ticket balance for specific tickets"
    getAllTicketBalancesCmd =
      mkCommandParser "all-ticket-balances"
      (AllTicketBalances <$> ownerOption addressOrAliasOption)
      "Get all ticket balances"
    originateCmd =
      mkCommandParser "originate"
      (Originate <$> originateArgsOption)
      "Originate passed contract on real network."
    transferCmd =
      mkCommandParser "transfer"
      (Transfer <$> transferArgsOption)
      "Perform a transfer to the given contract with given amount and parameter."
    transferTicketCmd =
      mkCommandParser "transfer-ticket"
      (TransferTicket <$> transferTicketArgsOption)
      "Perform a ticket transfer to the given contract with given amount and parameter."
    getBalanceCmd =
      mkCommandParser "get-balance"
      ((GetBalance <$>
        addressOrAliasOption @'AddressKindContract
          Nothing
          (#name :! "contract-addr")
          (#help :! "Contract address or alias to get balance for."))
      <|> (GetBalance <$> addressOrAliasOption @'AddressKindImplicit
          Nothing
          (#name :! "implicit-addr")
          (#help :! "Implicit address or alias to get balance for."))
      )
      "Get balance for given address"
    getBlockHeaderCmd =
      mkCommandParser "get-block-header"
      (GetBlockHeader <$> blockIdOption
        (Just HeadId)
        (#name :! "block-id")
        (#help :! "Id of the block whose header will be queried.")
      )
      "Get header of a block"
    getBlockOperationsCmd =
      mkCommandParser "get-block-operations"
      (GetBlockOperations <$> blockIdOption
        (Just HeadId)
        (#name :! "block-id")
        (#help :! "Id of the block whose operations will be queried.")
      )
      "Get operations contained in a block"
    getScriptSizeCmd =
      mkCommandParser "compute-script-size"
      (GetScriptSize <$> getScriptSizeArgsOption)
      "Compute script size"

originateArgsOption :: Opt.Parser OriginateArgs
originateArgsOption = do
  oaMbContractFile <- mbContractFileOption
  oaContractName <- contractNameOption
  oaInitialBalance <-
    mutezOption
      (Just zeroMutez)
      (#name :! "initial-balance")
      (#help :! "Inital balance of the contract.")
  oaInitialStorage <-
    valueOption
      Nothing
      (#name :! "initial-storage")
      (#help :! "Initial contract storage value.")
  oaOriginateFrom <-
    addressOrAliasOption
      Nothing
      (#name :! "from")
      (#help :! "Address or alias of address from which origination is performed.")
  oaMbFee <- feeOption
  oaDelegate <- optional $
    keyHashOption
      Nothing
      (#name :! "delegate")
      (#help :! "Key hash of the contract's delegate")
  pure $ OriginateArgs {..}

getScriptSizeArgsOption :: Opt.Parser GetScriptSizeArgs
getScriptSizeArgsOption = GetScriptSizeArgs <$> scriptFileOption
  <*> valueOption Nothing (#name :! "storage")
                          (#help :! "Contract storage value.")

mbContractFileOption :: Opt.Parser (Maybe FilePath)
mbContractFileOption = optional . strOption $ mconcat
  [ long "contract", metavar "FILEPATH"
  , help "Path to contract file."
  ]

scriptFileOption :: Opt.Parser FilePath
scriptFileOption = strOption $ mconcat
  [ long "script", metavar "FILEPATH"
  , help "Path to script file."
  ]

contractNameOption :: Opt.Parser ContractAlias
contractNameOption = fmap ContractAlias . strOption $ mconcat
  [ long "contract-name"
  , value "stdin"
  , help "Alias of originated contract."
  ]

transferArgsOption :: Opt.Parser TransferArgs
transferArgsOption = do
  taSender <-
    addressOrAliasOption
      Nothing
      (#name :! "from")
      (#help :! "Address or alias from which transfer is performed.")
  taDestination <-
    someAddressOrAliasOption
      Nothing
      (#name :! "to")
      (#help :! "Address or alias of the transfer's destination.")
  taAmount <-
    mutezOption
      (Just zeroMutez)
      (#name :! "amount")
      (#help :! "Transfer amount.")
  taParameter <-
    valueOption
      Nothing
      (#name :! "parameter")
      (#help :! "Transfer parameter.")
  taMbFee <- feeOption
  pure $ TransferArgs {..}

transferTicketArgsOption :: Opt.Parser TransferTicketArgs
transferTicketArgsOption = do
  ttaSender <- addressOrAliasOption Nothing
    ! #name "from"
    ! #help "Address or alias from which transfer is performed."
  ttaTicketAmount <- mkCLOptionParser Nothing
    ! #name "amount"
    ! #help "Ticket amount."
  ttaTicketContents <- mkCLOptionParser Nothing
    ! #name "value"
    ! #help "Ticket value."
  ttaTicketType <- mkCLOptionParser Nothing
    ! #name "type"
    ! #help "Ticket type."
  ttaTicketTicketer <- mkCLOptionParser Nothing
    ! #name "ticketer"
    ! #help "Ticketer address or alias."
  ttaDestination <- someAddressOrAliasOption Nothing
    ! #name "to"
    ! #help "Address or alias of the transfer's destination."
  ttaMbFee <- feeOption
  pure $ TransferTicketArgs {..}

usageDoc :: Doc
usageDoc = mconcat
  [ "You can use help for specific COMMAND", linebreak
  , "EXAMPLE:", linebreak
  , "morley-client originate --help"
  , "USAGE EXAMPLE:", linebreak
  , "morley-client -E florence.testnet.tezos.serokell.team:8732 originate \\", linebreak
  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak
  , "  --contract ../contracts/tezos_examples/attic/add1.tz --initial-balance 1 --initial-storage 0", linebreak
  , linebreak
  , "  This command will originate contract with code stored in add1.tz", linebreak
  , "  on real network with initial balance 1 and initial storage set to 0", linebreak
  , "  and return info about operation: operation hash and originated contract address", linebreak
  , linebreak
  , "morley-client -E florence.testnet.tezos.serokell.team:8732 transfer \\", linebreak
  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak
  , "  --to KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW --amount 1 --parameter 0", linebreak
  , linebreak
  , "  This command will perform tranfer to contract with address on real network", linebreak
  , "  KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW with amount 1 and parameter 0", linebreak
  , "  as a result it will return operation hash"
  ]

--------------------------------------------------------------------------------
-- Parser utilities
--------------------------------------------------------------------------------

-- | Utility reader to use in parsing 'BaseUrl'.
baseUrlReader :: ReadM BaseUrl
baseUrlReader = eitherReader $ first displayException . parseBaseUrl