view release on metacpan or  search on metacpan

lib/App/cryp/arbit.pm  view on Meta::CPAN

        );
    };

    my $code_update_sell_filled_base_size = sub {
        my ($id, $size, $summary) = @_;
        local $dbh->{RaiseError};
        $dbh->do(
            "UPDATE order_pair SET sell_filled_base_size=? WHERE id=?",
            {},
            $size,
            $id,
        ) or do {
            log_warn "Couldn't update sell filled base size for order pair #%d: %s",
                $id, $dbh->errstr;
            return;
        };
        $dbh->do(
            "INSERT INTO arbit_order_log (order_pair_id, type, summary) VALUES (?,?,?)",
            {},
            $id, 'sell', "filled_base_size changed to $size" . ($summary ? ": $summary" : ""),
        );
    };

    my @open_order_pairs;
    my $sth = $dbh->prepare(
        "SELECT
           op.id id,
           op.ctime ctime,
           CONCAT(op.base_currency, '/', op.buy_quote_currency) buy_pair,
           op.buy_status buy_status,
           (SELECT safename FROM exchange WHERE id=op.buy_exchange_id) buy_exchange,
           (SELECT nickname FROM account WHERE id=op.buy_account_id) buy_account,
           op.buy_order_id buy_order_id,

           op.sell_status sell_status,
           CONCAT(op.base_currency, '/', op.sell_quote_currency) sell_pair,
           (SELECT safename FROM exchange WHERE id=op.sell_exchange_id) sell_exchange,
           (SELECT nickname FROM account WHERE id=op.sell_account_id) sell_account,
           op.sell_order_id sell_order_id
         FROM order_pair op
         WHERE
           (op.buy_order_id IS NOT NULL AND
            op.buy_status  NOT IN ('done','filled','cancelled')) OR
           (op.sell_order_id IS NOT NULL AND
            op.sell_status NOT IN ('done','filled','cancelled'))
         ORDER BY op.ctime");
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        push @open_order_pairs, $row;
    }

    my $time = time();
    for my $op (@open_order_pairs) {
        log_debug "Checking order pair #%d (buy status=%s, sell status=%s) ...",
            $op->{id}, $op->{buy_status}, $op->{sell_status};

      CHECK_BUY_ORDER: {
            last if $op->{buy_status} =~ /\A(done|cancelled)\z/;
            my $client = _get_exchange_client($r, $op->{buy_exchange}, $op->{buy_account});
            my $res = $client->get_order(pair=>$op->{buy_pair}, type=>'buy', order_id=>$op->{buy_order_id});
            if ($res->[0] == 404) {
                # assume 404 as order which was never filled and got cancelled.
                # some exchanges, e.g. coinbase-pro returns 404 for such orders
                $code_update_buy_status->($op->{id}, 'cancelled', 'not found via get_order(), assume cancelled without being filled');
                last;
            } elsif ($res->[0] != 200) {
                log_error "Couldn't get buy order %s (pair %s): %s",
                    $op->{buy_order_id}, $op->{buy_pair}, $res;
                last;
            } else {
                my $status = $res->[2]{status};
                $code_update_buy_filled_base_size->($op->{id}, $res->[2]{filled_base_size});
                $code_update_buy_status->($op->{id}, $status);

                if ($status eq 'open' && $time - $op->{ctime} > $r->{args}{max_order_age}) {
                    log_info "Order %s (buy) has been open for too long (>%d secs), cancelling ...";
                    my $cancelres = $client->cancel_order(pair=>$op->{buy_pair}, type=>'buy', order_id=>$op->{buy_order_id});
                    if ($cancelres->[0] != 200) {
                        log_error "Couldn't cancel order %s (buy): %s", $op->{buy_order_id}, $cancelres;
                    } else {
                        $code_update_buy_status->($op->{id}, "cancelled");
                    }
                }
            }
        } # CHECK_BUY_ORDER

      CHECK_SELL_ORDER: {
            last if $op->{sell_status} =~ /\A(done|cancelled)\z/;
            my $client = _get_exchange_client($r, $op->{sell_exchange}, $op->{sell_account});
            my $res = $client->get_order(pair=>$op->{sell_pair}, type=>'sell', order_id=>$op->{sell_order_id});
            if ($res->[0] == 404) {
                # assume 404 as order which was never filled and got cancelled.
                # some exchanges, e.g. coinbase-pro returns 404 for such orders
                $code_update_sell_status->($op->{id}, 'cancelled', 'not found via get_order(), assume cancelled without being filled');
                last;
            } elsif ($res->[0] != 200) {
                log_error "Couldn't get sell order %s (pair %s): %s",
                    $op->{sell_order_id}, $op->{sell_pair}, $res;
                last;
            } else {
                my $status = $res->[2]{status};
                $code_update_sell_filled_base_size->($op->{id}, $res->[2]{filled_base_size});
                $code_update_sell_status->($op->{id}, $status);

                if ($status eq 'open' && $time - $op->{ctime} > $r->{args}{max_order_age}) {
                    log_info "Order %s (sell) has been open for too long (>%d secs), cancelling ...";
                    my $cancelres = $client->cancel_order(pair=>$op->{sell_pair}, type=>'sell', order_id=>$op->{sell_order_id});
                    if ($cancelres->[0] != 200) {
                        log_error "Couldn't cancel order %s (sell): %s", $op->{sell_order_id}, $cancelres;
                    } else {
                        $code_update_sell_status->($op->{id}, "cancelled");
                    }
                }
            }
        } # CHECK_SELL_ORDER
    }
}

$SPEC{check_orders} = {
    v => 1.1,
    summary => 'Check the orders that have been created',
    description => <<'_',

This subcommand will check the orders that have been created previously by
`arbit` subcommand. It will update the order status and filled size (if still
open). It will cancel (give up) the orders if deemed too old.

_
    args => {
        %args_db,
        %arg_max_order_age,
    },
};
sub check_orders {
    my %args = @_;

    my $r = $args{-cmdline_r};

    my $res;

    # [ux] remove extraneous arguments supplied by config
    delete $r->{args}{accounts};

    $res = _init($r); return $res unless $res->[0] == 200;

    _check_orders($r);
    [200];
}

$SPEC{list_order_pairs} = {
    v => 1.1,
    summary => 'List created order pairs',
    args => {