(**************************************************************************)
(*                                                                        *)
(*    Copyright (c) 2014 - 2016.                                          *)
(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
(*                                                                        *)
(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
(*                                                                        *)
(**************************************************************************)

open Tezos_micheline
open Client_proto_context
open Client_proto_contracts
open Client_proto_programs
open Client_keys
open Client_proto_args

let get_pkh cctxt = function
  | None -> return None
  | Some x -> Public_key_hash.find_opt cctxt x

let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_commands.logger) = function
  | Error errs ->
      cctxt#warning "%a"
        (Michelson_v1_error_reporter.report_errors
           ~details:(not no_print_source)
           ~show_source: (not no_print_source)
           ?parsed:None) errs >>= fun () ->
      cctxt#error "%s" msg >>= fun () ->
      Lwt.return None
  | Ok data ->
      Lwt.return (Some data)


let group =
  { Cli_entries.name = "context" ;
    title = "Block contextual commands (see option -block)" }

let commands () =
  let open Cli_entries in
  let open Client_commands in
  [
    command ~group ~desc: "access the timestamp of the block"
      no_options
      (fixed [ "get" ; "timestamp" ])
      begin fun () (cctxt : Client_commands.full_context) ->
        Client_node_rpcs.Blocks.timestamp
          cctxt cctxt#block >>=? fun v ->
        cctxt#message "%s" (Time.to_notation v) >>= fun () ->
        return ()
      end ;

    command ~group ~desc: "lists all non empty contracts of the block"
      no_options
      (fixed [ "list" ; "contracts" ])
      begin fun () (cctxt : Client_commands.full_context) ->
        list_contract_labels cctxt cctxt#block >>=? fun contracts ->
        Lwt_list.iter_s
          (fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias)
          contracts >>= fun () ->
        return ()
      end ;

    command ~group ~desc: "get the balance of a contract"
      no_options
      (prefixes [ "get" ; "balance" ; "for" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
      begin fun () (_, contract) (cctxt : Client_commands.full_context) ->
        get_balance cctxt cctxt#block contract >>=? fun amount ->
        cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym >>= fun () ->
        return ()
      end ;

    command ~group ~desc: "get the storage of a contract"
      no_options
      (prefixes [ "get" ; "storage" ; "for" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
      begin fun () (_, contract) (cctxt : Client_commands.full_context) ->
        get_storage cctxt cctxt#block contract >>=? function
        | None ->
            cctxt#error "This is not a smart contract."
        | Some storage ->
            cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped storage >>= fun () ->
            return ()
      end ;

    command ~group ~desc: "get the manager of a contract"
      no_options
      (prefixes [ "get" ; "manager" ; "for" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
      begin fun () (_, contract) (cctxt : Client_commands.full_context) ->
        Client_proto_contracts.get_manager
          cctxt cctxt#block contract >>=? fun manager ->
        Public_key_hash.rev_find cctxt manager >>=? fun mn ->
        Public_key_hash.to_source cctxt manager >>=? fun m ->
        cctxt#message "%s (%s)" m
          (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () ->
        return ()
      end ;

    command ~group ~desc: "get the delegate of a contract"
      no_options
      (prefixes [ "get" ; "delegate" ; "for" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
      begin fun () (_, contract) (cctxt : Client_commands.full_context) ->
        Client_proto_contracts.get_delegate
          cctxt cctxt#block contract >>=? fun delegate ->
        Public_key_hash.rev_find cctxt delegate >>=? fun mn ->
        Public_key_hash.to_source cctxt delegate >>=? fun m ->
        cctxt#message "%s (%s)" m
          (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () ->
        return ()
      end ;

    command ~group ~desc: "set the delegate of a contract"
      (args2 fee_arg force_switch)
      (prefixes [ "set" ; "delegate" ; "for" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ prefix "to"
       @@ Public_key_hash.alias_param
         ~name: "mgr" ~desc: "New delegate of the contract"
       @@ stop)
      begin fun (fee, force) (_, contract) (_, delegate) cctxt ->
        source_to_keys cctxt cctxt#block contract >>=? fun (src_pk, manager_sk) ->
        set_delegate ~fee cctxt cctxt#block contract (Some delegate) ~src_pk ~manager_sk >>=? fun oph ->
        operation_submitted_message cctxt ~force oph
      end ;

    command ~group ~desc:"open a new account"
      (args4 fee_arg delegate_arg delegatable_switch force_switch)
      (prefixes [ "originate" ; "account" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~name: "mgr" ~desc: "manager of the new contract"
       @@ prefix "transferring"
       @@ tez_param
         ~name: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~name:"src" ~desc: "name of the source contract"
       @@ stop)
      begin fun (fee, delegate, delegatable, force)
        new_contract (_, manager_pkh) balance (_, source) (cctxt : Client_commands.full_context) ->
        RawContractAlias.of_fresh cctxt force new_contract >>=? fun alias_name ->
        source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
        get_pkh cctxt delegate >>=? fun delegate ->
        originate_account
          ~fee
          ?delegate
          ~delegatable
          ~force
          ~manager_pkh
          ~balance
          ~source
          ~src_pk
          ~src_sk
          cctxt#block
          cctxt
          () >>=? fun (oph, contract) ->
        save_contract ~force cctxt alias_name contract >>=? fun () ->
        operation_submitted_message ~force ~contracts:[ contract ] cctxt oph
      end ;

    command ~group ~desc: "Launch a smart contract on the blockchain"
      (args7
         fee_arg delegate_arg force_switch
         delegatable_switch spendable_switch init_arg no_print_source_flag)
      (prefixes [ "originate" ; "contract" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~name: "mgr" ~desc: "manager of the new contract"
       @@ prefix "transferring"
       @@ tez_param
         ~name: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~name:"src" ~desc: "name of the source contract"
       @@ prefix "running"
       @@ Program.source_param
         ~name:"prg" ~desc: "script of the account\n\
                             combine with -init if the storage type is not unit"
       @@ stop)
      begin fun (fee, delegate, force, delegatable, spendable, initial_storage, no_print_source)
        alias_name (_, manager) balance (_, source) program (cctxt : Client_commands.full_context) ->
        RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
        Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } ->
        source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
        get_pkh cctxt delegate >>=? fun delegate ->
        originate_contract ~fee ~delegate ~force ~delegatable ~spendable ~initial_storage
          ~manager ~balance ~source ~src_pk ~src_sk ~code cctxt >>= fun errors ->
        report_michelson_errors ~no_print_source ~msg:"origination simulation failed" cctxt errors >>= function
        | None -> return ()
        | Some (oph, contract) ->
            save_contract ~force cctxt alias_name contract >>=? fun () ->
            operation_submitted_message cctxt
              ~force ~contracts:[contract] oph
      end ;

    command ~group ~desc: "open a new (free) account"
      (args1 force_switch)
      (prefixes [ "originate" ; "free" ; "account" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~name: "mgr" ~desc: "manager of the new contract"
       @@ stop)
      begin fun force alias_name (_, manager_pkh) cctxt ->
        RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
        faucet ~force ~manager_pkh cctxt#block cctxt () >>=? fun (oph, contract) ->
        operation_submitted_message cctxt
          ~force ~contracts:[contract] oph >>=? fun () ->
        save_contract ~force cctxt alias_name contract
      end;

    command ~group ~desc: "transfer tokens"
      (args4 fee_arg arg_arg force_switch no_print_source_flag)
      (prefixes [ "transfer" ]
       @@ tez_param
         ~name: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~name: "src" ~desc: "name of the source contract"
       @@ prefix "to"
       @@ ContractAlias.destination_param
         ~name: "dst" ~desc: "name/literal of the destination contract"
       @@ stop)
      begin fun (fee, arg, force, no_print_source) amount (_, source) (_, destination) cctxt ->
        source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
        transfer ~force cctxt ~fee cctxt#block
          ~source ~src_pk ~src_sk ~destination ~arg ~amount () >>=
        report_michelson_errors ~no_print_source ~msg:"transfer simulation failed" cctxt >>= function
        | None -> return ()
        | Some (oph, contracts) ->
            operation_submitted_message cctxt ~force ~contracts oph 
      end;

    command ~desc: "Activate a protocol"
      (args1 force_switch)
      (prefixes [ "activate" ; "protocol" ]
       @@ Protocol_hash.param ~name:"version"
         ~desc:"Protocol version (b58check)"
       @@ prefixes [ "with" ; "key" ]
       @@ Environment.Ed25519.Secret_key.param
         ~name:"password" ~desc:"Dictator's key"
       @@ stop)
      begin fun force hash seckey cctxt ->
        dictate cctxt cctxt#block
          (Activate hash) seckey >>=? fun oph ->
        operation_submitted_message cctxt ~force:force oph
      end ;

    command ~desc: "Fork a test protocol"
      (args1 force_switch)
      (prefixes [ "fork" ; "test" ; "protocol" ]
       @@ Protocol_hash.param ~name:"version"
         ~desc:"Protocol version (b58check)"
       @@ prefixes [ "with" ; "key" ]
       @@ Environment.Ed25519.Secret_key.param
         ~name:"password" ~desc:"Dictator's key"
       @@ stop)
      begin fun force hash seckey cctxt ->
        dictate cctxt cctxt#block
          (Activate_testnet hash) seckey >>=? fun oph ->
        operation_submitted_message cctxt ~force:force oph
      end ;

  ]