#!/usr/bin/env perl

# Copyright © 2006-2025 Jakub Wilk <jwilk@jwilk.net>
# SPDX-License-Identifier: MIT

# cwd in @INC is harmful:
# https://www.nntp.perl.org/group/perl.perl5.porters/2010/08/msg162729.html
no lib '.';

use v5.14;

use strict;
use warnings (
    NONFATAL => qw(all),
    FATAL => qw(numeric)
);
use charnames ':full';
use re '/a';
no encoding;

BEGIN { $::loading_modules = 1; }  ## no critic (PackageVars)

END {
    if ($::loading_modules) {  ## no critic (PackageVars)
        exit(-1);
    }
}

# core modules:
use Carp ();
use Encode ();
use English qw(-no_match_vars);
use File::Basename qw(dirname);
use File::Path ();
use FindBin ();
use Getopt::Long qw(:config gnu_compat permute no_getopt_compat no_ignore_case);
use JSON::PP ();
use Module::Loaded ();
use POSIX ();
use Symbol ();
use Term::ReadLine ();
use Text::ParseWords ();
use Time::HiRes ();
use Time::Local ();
use Time::Piece ();
use Time::Seconds ();
use re qw(is_regexp regexp_pattern);

# Work-around for HTTP::Cookies not catching write errors:
# https://bugs.debian.org/750850
BEGIN {
    *CORE::GLOBAL::close = sub(;*) {
        if (not @_) {
            return CORE::close();
        }
        my ($fh) = @_;
        $fh = Symbol::qualify_to_ref($fh, caller);
        my ($module) = caller;
        if (($module eq 'HTTP::Cookies') and not defined(wantarray)) {
            return (
                CORE::close($fh)
                or die $ERRNO  ## no critic (Carping)
            );
        } else {
            return CORE::close($fh);
        }
    };
}

# 3rd-party modules:
use Encode::Locale ();
use HTML::Form ();
use HTML::TreeBuilder 5 ();
use HTTP::Cookies ();
use HTTP::Date ();
use HTTP::Message 5.802 ();
use HTTP::Request::Common qw(GET POST);
use IO::Socket::SSL 1.81 ();
use LWP::UserAgent 6 ();
use LWP::Protocol::https ();
use Net::HTTPS ();  # must be loaded after IO::Socket::SSL
use Net::SSLeay 1.43 ();
use URI::Escape qw(uri_escape_utf8);

BEGIN { $::loading_modules = 0; }  ## no critic (PackageVars)

# ==========================
# logging and error handling
# ==========================

my $opt_verbose = 0;
my $opt_debug_dir = undef;
my $opt_debug_interactive = 0;
my $bugtracker = 'https://github.com/jwilk/mbank-cli/issues';
my $bugreport_url_tmpl = "$bugtracker/%d";
my $bugreport_request = "Please file a bug at <$bugtracker>.";

sub write_log
{
    my ($message) = @_;
    defined($opt_debug_dir) or return;
    my $path = "$opt_debug_dir/log";
    open(my $log, '>>', $path)
        or os_error("$path: $ERRNO");
    say {$log} $message;
    close($log)
        or os_error("$path: $ERRNO");
    return;
}

sub debug
{
    my ($message) = @_;
    $message = "* $message";
    write_log($message);
    if ($opt_verbose) {
        say {*STDERR} $message;
    }
    return;
}

sub warning
{
    my ($message) = @_;
    if (defined($message)) {
        write_log($message);
        say {*STDERR} "mbank-cli: $message";
    }
    return;
}

sub user_error
{
    my ($message) = @_;
    warning($message);
    exit(1);
}

sub server_error
{
    my ($message) = @_;
    warning($message);
    exit(2);
}

sub http_error
{
    my ($request, $response) = @_;
    my $message = sprintf(
        'HTTP error %d while processing request <%s %s>',
        $response->code,
        $request->method,
        $request->uri
    );
    my $client_warning = $response->header('Client-Warning') // '';
    if (($response->code == 500) and ($client_warning eq 'Internal response')) {
        my $extra = $response->content;
        $extra =~ s/\n+$//;
        $extra =~ s/\n+/\n/g;
        if ($extra !~ /[(]/ and $IO::Socket::SSL::SSL_ERROR) {
            # If IO::Socket::IP is installed, LWP produces unhelpful error
            # messages for certificate verification failures:
            # https://bugs.debian.org/746686
            # As a work-around, append $IO::Socket::SSL::SSL_ERROR to the error
            # message.
            $extra .= "\n$IO::Socket::SSL::SSL_ERROR";
        }
        $extra =~ s/\n+$//;
        $extra =~ s/^/| /gm;
        $message .= "\n$extra\n";
    }
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    return server_error();
}

sub http_decoding_error
{
    my ($request) = @_;
    my $message = sprintf(
        'HTTP decoding error while processing request <%s %s>',
        $request->method,
        $request->uri,
    );
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    return server_error();
}

sub scraping_error
{
    my ($message) = @_;
    my $file = __FILE__;
    $message =~ s/ at \Q$file\E line \d+[.]\n+//;
    $message = "Scraping error: $message";
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    say {*STDERR} $bugreport_request;
    exit(3);
}

sub normalize_whitespace
{
    my ($s) = @_;
    $s =~ s/\s+/ /g;
    $s =~ s/\A\s+|\s+\z//g;
    return $s;
}

sub quote
{
    my ($x) = @_;
    if (is_regexp($x)) {
        my ($pattern, $flags) = regexp_pattern($x);
        $pattern =~ s{(\\.)|/}{ $1 // "\\/" }sge;
        return "/$pattern/$flags";
    } else {
        ## no critic (LongChainsOfMethodCalls);
        state $json_encoder = JSON::PP->new->canonical->ascii->allow_nonref;
        return $json_encoder->encode($x);
    }
}

=begin comment

match(TEXT, qr/REGEXP/, context => CONTEXT) -> TEXT
match(TEXT, TEXT, context => CONTEXT) -> TEXT

=end comment
=cut

sub match
{
    my ($text, $pattern, %options) = @_;
    kwargs(\%options, context => \my $context);
    if (ref($pattern) eq '') {
        $pattern = qr/\Q$pattern\E/;
    }
    is_regexp($pattern)
        or internal_error('match(): invalid argument', 1);
    defined($text) and ref($text) eq ''
        or do {
            my $qtext = quote($text);
            scraping_error("$context: $qtext is not a string");
        };
    $text =~ m/\A(?:$pattern)\z/
        or do {
            my $qtext = quote($text);
            my $qpattern = quote($pattern);
            my $message = "$qtext does not match $qpattern";
            if ($qpattern eq quote(qr/(*FAIL)/)) {
                $message =~ s/\s+\S+$//;
            }
            scraping_error("$context: $message");
        };
    return $text;
}

sub no_match
{
    my ($text, %options) = @_;
    return match($text, qr/(*FAIL)/, %options);
}

=begin comment

check_type(LIST, [], context => CONTEXT) => LIST
check_type(HASH, {}, context => CONTEXT) => HASH

=end comment
=cut

sub check_type
{
    my ($obj, $type, %options) = @_;
    kwargs(\%options,
        context => \my $context,
    );
    $type = ref($type);
    my %atypes = (
        HASH => 'an object',
        ARRAY => 'an array',
    );
    my $atype = $atypes{$type}
        // internal_error('check_type(): unknown type', 1);
    ref($obj) eq $type
        or scraping_error("$context: not $atype");
    return $obj;
}

=begin comment

unpack_list(ARRAY_OF_REFS, ARRAY, context => CONTEXT)

=end comment
=cut

sub unpack_list
{
    my ($dst, $src, %options) = @_;
    kwargs(\%options, context => \my $context);
    ref($dst) eq 'ARRAY'
        or internal_error('unpack_list(): invalid argument', 1);
    my @dst = @{$dst};
    ref($src) eq 'ARRAY'
        or scraping_error("$context: not an array");
    my @src = @{$src};
    my $n = scalar(@dst);
    my $m = scalar(@src);
    my $s = $n == 1 ? '' : 's';
    $n == $m
        or scraping_error("$context: expected $n element$s, got $m");
    for my $i (0..$n-1) {
        my $var = pop @dst;
        my $val = pop @src;
        defined($var)
            or next;
        if (ref($var) eq '') {
            internal_error('unpack_list(): invalid argument', 1);
        }
        ${$var} = $val;
    }
    return;
}

sub os_error
{
    my ($message) = @_;
    my $file = __FILE__;
    $message =~ s/ at \Q$file\E line \d+[.]\n+//;
    my $caller_name = (caller(1))[3] // '';
    if ($caller_name eq 'main::write_log') {
        # avoid infinite recursion
    } else {
        write_log($message);
    }
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(4);
}

sub internal_error
{
    my ($message, $level) = @_;
    $level //= 0;
    $message = "Internal error: $message";
    write_log($message);
    local $Carp::CarpLevel = $level + 1;
    Carp::cluck($message);
    say {*STDERR} $bugreport_request;
    exit(-1);
}

sub known_bug
{
    my ($bugno, $message) = @_;
    my $url = sprintf($bugreport_url_tmpl, $bugno);
    $message .= "; see <$url>";
    warning($message);
    exit(-1);
}

=begin comment

kwargs(HASHREF, NAME1 => \$VAR1, NAME2 => [\$VAR2, DEFAULT2], ...)

=end comment
=cut

sub kwargs
{
    my ($kwargs, %args) = @_;
    ref($kwargs) eq 'HASH'
        or internal_error('kwargs(): invalid argument', 1);
    my $caller = (caller(1))[3];
    $caller =~ s/^main:://;
    while (my ($name, $var) = each %args) {
        ref($name) eq ''
            or internal_error('kwargs(): invalid argument', 1);
        my $value;
        my $has_default = 0;
        if (ref($var) eq 'ARRAY') {
            scalar @{$var} == 2
                or internal_error('kwargs(): invalid argument', 1);
            ($var, $value) = @{$var};
            $has_default = 1;
        }
        ref($var) eq 'SCALAR' and not defined(${$var})
            or internal_error('kwargs(): invalid argument', 1);
        if (exists $kwargs->{$name}) {
            $value = delete $kwargs->{$name};
        } else {
            $has_default or
                internal_error("$caller(): missing keyword argument: $name", 1);
        }
        ${$var} = $value;
    }
    if (%{$kwargs}) {
        local $LIST_SEPARATOR = ', ';
        my @names = sort(keys(%{$kwargs}));
        my $s = 's' x (scalar @names > 1);
        my $message = "$caller(): invalid keyword argument$s: @names";
        internal_error($message, 1);
    }
    return;
}

# ====================
# internationalization
# ====================

my %_encoding_fallback = (
    0x104 => 'A', 0x105 => 'a', # letter A with ogonek
    0x0C1 => 'A', 0x0E1 => 'a', # letter A with acute
    0x0C4 => 'A', 0x0E4 => 'a', # letter A with diaeresis
    0x106 => 'C', 0x107 => 'c', # letter C with acute
    0x10C => 'C', 0x10D => 'c', # letter C with caron
    0x10E => 'D', 0x10F => 'd', # letter D with caron
    0x118 => 'E', 0x119 => 'e', # letter E with ogonek
    0x0C9 => 'E', 0x0E9 => 'e', # letter E with acute
    0x11A => 'E', 0x11B => 'e', # letter E with caron
    0x0CD => 'I', 0x0ED => 'i', # letter I with acute
    0x141 => 'L', 0x142 => 'l', # letter L with stroke
    0x139 => 'L', 0x13A => 'l', # letter L with acute
    0x13D => 'L', 0x13E => 'l', # letter L with caron
    0x143 => 'N', 0x144 => 'n', # letter N with acute
    0x147 => 'N', 0x148 => 'n', # letter N with caron
    0x0D3 => 'O', 0x0F3 => 'o', # letter O with acute
    0x0D4 => 'O', 0x0F4 => 'o', # letter O with circumflex
    0x154 => 'R', 0x155 => 'r', # letter R with acute
    0x158 => 'R', 0x159 => 'r', # letter R with caron
    0x15A => 'S', 0x15B => 's', # letter S with acute
    0x160 => 'S', 0x161 => 's', # letter S with caron
    0x164 => 'T', 0x165 => 't', # letter T with caron
    0x0DA => 'U', 0x0FA => 'u', # letter U with acute
    0x16E => 'U', 0x16F => 'u', # letter U with ring above
    0x0DD => 'Y', 0x0FD => 'y', # letter Y with acute
    0x179 => 'Z', 0x17A => 'z', # letter Z with acute
    0x17B => 'Z', 0x17C => 'z', # letter Z with dot above
    0x17D => 'Z', 0x17E => 'z', # letter Z with caron
);

sub _encoding_fallback
{
    my ($u) = @_;
    return
        $_encoding_fallback{$u}
        // sprintf('<U+%04X>', $u);
}

sub bytes_to_unicode
{
    my ($u, $encoding) = @_;
    $encoding //= 'locale';
    return Encode::decode($encoding, $u);
}

sub unicode_to_bytes
{
    my ($s, $encoding) = @_;
    $encoding //= 'locale';
    return Encode::encode($encoding, $s, \&_encoding_fallback);
}

my %country_to_language = (
    cz => 'cs',  # Czech Republic => Czech
    pl => 'pl',  # Poland => Polish
    sk => 'sk',  # Slovakia => Slovak
);

my %language_to_country = reverse(%country_to_language);

my %locale_aliases = (
    'polish' => 'pl',
    'czech' => 'cs',
    'slovak' => 'sk',
);

my %tz_to_language = (
    'Europe/Bratislava' => 'sk',
    'Europe/Prague' => 'cz',
    'Europe/Warsaw' => 'pl',
);

my @known_countries = sort(keys(%country_to_language));

sub get_tz
{
    my $tz = $ENV{TZ};
    if (defined($tz)) {
        $tz =~ s/\A://;
        return $tz;
    }
    if ($tz = readlink('/etc/localtime')) {
        $tz =~ s{.*/zoneinfo/}{};
        return $tz;
    }
    my $path = '/etc/timezone';
    open(my $fh, '<', $path)
        or return;
    $tz = <$fh>;
    close($fh)
        or os_error("$path: $ERRNO");
    chomp($tz);
    return $tz;
}

sub guess_country
{
    my %cc = ();
    my $locales = POSIX::setlocale(POSIX::LC_ALL);
    my @locales;
    if ($locales =~ m/=/) {
        @locales = $locales =~ m/(?:^|;)LC_[A-Z_]+=([^;\s]+)/g;  ## no critic (EnumeratedClasses)
    } else {
        @locales = ($locales);
    }
    for my $locale (@locales) {
        $locale = $locale_aliases{$locale} // ${locale};
        my $lang = $locale =~ s/_.*//r;
        my $cc = $language_to_country{$lang};
        if (defined($cc)) {
            $cc{$cc} = 1;
        }
    }
    my @cc = keys(%cc);
    if (scalar(@cc) == 1) {
        my ($cc) = @cc;
        return $cc;
    }
    if (scalar(@cc) == 0) {
        my $tz = get_tz();
        my $cc = $tz_to_language{$tz};
        return $cc;
    }
    return;
}

# ====================
# HTTP client identity
# ====================

# Extracted from Tor Browser 14.5.7 (based on Firefox 128 ESR):

# » navigator.userAgent
my $browser_user_agent = 'Mozilla/5.0 (X11; Linux x86_64; rv:128.0) Gecko/20100101 Firefox/128';
my ($browser_name, $browser_version) = $browser_user_agent =~ m{(\S+)/(\d+)$};

# » window.Dfp.GetCurrentDfp().then(console.log) && null
my $browser_dfp = 'eJyFkT1MFEEUx/dm/NhsUJcj4PmZDYUxJOgFDSEkhg89UDmQ4AfEZpzdnbubcXdnM7MHh9XaGSs7LCwsKYkVJYUFhSaUlMTExMpYUFyns3u35AiiL9ndt//fe/PmvWf0Gl1lGtQbVmNkGA3fzsOnczMFLX9NbxrmPiw0DWsfXm8axX04mi96OHClg0MyGArqY7F68YQBSNA/pX/eBXmdNEKPOjQqAAsM6DIk+CURspgb0UqasvuxOR/rS99+ty334sOB63/9Uh4buDOudcUqckv7v8VHlCFj/t6U9YySFSKGuu/WBPeJ1SH1pBKt+53ihVnqCC55JbJKbvVw/CKxZ2hk2XXqRYM0SNioNv56be3TmYendM3UCtoCnLs5kb6e543Ts/wV9TyczxxbY30Tc9PlEqKBjHDgEBdhIfCqZGZp6QmyPRK4yKeBjxvsUqI43OMC2fVKhQhUw14FVTyOI3YuganbSmJnU0HgKnJJGNVYX/Iva9hVeRFpRHVBkMddpqf6wvQku5x4GXK4HwoiJeUBssPIOZ6KqqJXO2lFjUNVwQGVPBI8pA7re1R6jIhHfBJEqleXNFCdBhHrTfSKzZFQd1Y5Pg19HLJCIicDcbFwVQOCLuOILhPJuhNyUChtvXBEQh4NCBatqhnpGNaVv+tZ2vkELxOhIlrbQNxmxFGVFkuT0+XDO2ifmJHWXNQas+OxTIZ3LCaKHp8sbync/0+MpKjarKcVk646wyzfFgVead9WZprHZbLFIAkVD9aBvgH0TaBvAX0bFHaAtgticw+YP9TnF9jLNYEew9h8A/V30HwP9Y8wBuswtwFzmzC3Bce2YWztqOdt7uT3n3Dzxh8LG3RL';

# =========
# HTTP, TLS
# =========

my $ua = undef;

my $http_read_size_hint = 1 << 20;  # 1 MiB
my $http_timeout = 60;

sub http_init
{
    my %options = @_;
    kwargs(\%options,
        cookie_jar => \my $cookie_jar_path,
        ca => \my $ca_path,
    );
    if ($Net::HTTPS::SSL_SOCKET_CLASS ne 'IO::Socket::SSL') {
        # This should not happen, but better safe than sorry.
        # We absolutely do not want Net::SSL (from the Crypt-SSLeay
        # distribution) as the TLS backend.
        internal_error("\$Net::HTTPS::SSL_SOCKET_CLASS == $Net::HTTPS::SSL_SOCKET_CLASS")
    };
    for my $key (grep { m/^HTTPS_/ } keys(%ENV)) {
        # HTTPS_CA_DIR and HTTPS_CA_FILE environment variables may disable or
        # cripple certificate validation:
        # https://bugs.debian.org/746579
        # https://bugs.debian.org/788698
        delete $ENV{$key};
    }
    my @ssl_options = (
        SSL_version => 'SSLv23:!SSLv2:!SSLv3',
        SSL_cipher_list => 'HIGH:!aNULL:!eNULL',
        SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER,
        SSL_verifycn_scheme => {
            check_cn => 0,
            wildcards_in_alt => 0,
            wildcards_in_cn => 0,
            ip_in_cn => 0,
        },
    );
    if (defined($ca_path)) {
        push(@ssl_options,
            SSL_ca_file => $ca_path,
            SSL_ca_path => undef,
            # If SSL_ca_path is not set explicitly to undef,
            # IO::Socket::SSL::set_args_filter_hack('use_defaults') fails to
            # correctly restore SSL_ca_* settings:
            # https://bugs.debian.org/750642
        );
    }
    my @cookie_jar_options = (
        ignore_discard => 1,
        hide_cookie2 => 1,
    );
    if ($cookie_jar_path ne '/dev/null') {
        # TODO: implement auto-logout if cookie jar is /dev/null
        push(@cookie_jar_options,
            file => $cookie_jar_path,
            autosave => 0,
        );
    };
    my $cookie_jar = HTTP::Cookies->new(@cookie_jar_options);
    my $ua = LWP::UserAgent->new(  ## no critic (ReusedNames)
        agent => $browser_user_agent,
        cookie_jar => $cookie_jar,
        protocols_allowed => ['https'],
        timeout => $http_timeout,
        keep_alive => 1,
        parse_head => 0,  # <head> parsing doesn't work with compressed responses anyway:
                          # https://github.com/libwww-perl/libwww-perl/issues/216
    );
    if ($IO::Socket::SSL::VERSION >= 1.969) {
        # LWP::protocol::https (>= 6.0) stomps on SSL_verifycn_scheme, and
        # possibly also other settings: https://bugs.debian.org/747225
        IO::Socket::SSL::set_defaults(@ssl_options);
        IO::Socket::SSL::set_args_filter_hack('use_defaults');
        # TODO: Work around the bug also for earlier versions of
        # IO::Socket::SSL, which don't support set_args_filter_hack().
    }
    $ua->ssl_opts(
        @ssl_options,
    );
    $ua->default_header(
        'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
        'Accept-Encoding' => 'gzip, deflate',
        'Accept-Language' => 'en-US,en;q=0.5',
    );
    return $ua;
}

sub download
{
    my ($request, %options) = @_;
    kwargs(\%options,
        ignore_errors => [\my $ignore_errors, 0],
        redact => [\my $redact, undef],
    );
    my $message = sprintf(
        '%s %s',
        $request->method,
        $request->uri
    );
    if ($opt_debug_interactive) {
        print {*STDERR} $request->dump(maxlength => 0);
        my $term = term_new();
        my $ok = $term->readline('Proceed? ', 'y') // '';
        if ($ok ne 'y') {
            user_error('aborted by user');
        }
    }
    debug($message);
    my $response = $ua->request($request, undef, $http_read_size_hint);
    $response->decode()
        // http_decoding_error($request);
    my $content = $response->content;
    $content =~ s/\r//g;
    if (defined($opt_debug_dir)) {
        my $is_json = $response->headers->content_type() eq 'application/json';
        my $default_ext = $is_json ? 'json' : 'html';
        my $path = $request->uri;
        $path =~ s{^\w+://.*?/}{};
        $path =~ s/[?].*//;
        $path =~ s/[^[:alnum:].]/_/g;
        $path =~ s/(?:[.]\w+)?$/.$default_ext/;
        if ($path eq '.html') {
            $path = 'index.html';
        }
        $path = "$opt_debug_dir/$path";
        open(my $fh, '>', "$path")
            or os_error("$path: $ERRNO");
        print {$fh} $content;
        close($fh)
            or os_error("$path: $ERRNO");
        my $rpath = "${path}.request";
        open($fh, '>', $rpath)
            or os_error("$rpath: $ERRNO");
        my $request_dump = $request->dump(maxlength => 0);
        if (defined($redact)) {
            $request_dump =~ s/$redact/<redacted>/;
        }
        print {$fh} $request_dump;
        close($fh)
            or os_error("$rpath: $ERRNO");
        $rpath = "${path}.headers";
        open($fh, '>', $rpath)
            or os_error("$rpath: $ERRNO");
        my $response_dump = $response->dump(maxlength => 1);
        $response_dump =~ s/\n\n.*\z//s;
        print {$fh} $response_dump;
        close($fh)
            or os_error("$rpath: $ERRNO");
    }
    if (ref($ignore_errors) eq 'ARRAY') {
        my %ignored_errors = map { $_ => 1 } @{$ignore_errors};
        $ignore_errors = $ignored_errors{$response->code};
    }
    if (not $response->is_success and not $ignore_errors) {
        http_error($request, $response);
    }
    $content = $response->decoded_content()
        // http_decoding_error($request);
    my $url = $response->request->uri;
    return {
        response => $response,
        content => $content,
        url => $url,
    };
}

sub simple_download
{
    my ($request) = @_;
    my $message = sprintf(
        'simple %s %s',
        $request->method,
        $request->uri
    );
    debug($message);
    my $response = $ua->simple_request($request, undef, $http_read_size_hint);
    if ($response->is_error) {
        http_error($request, $response);
    }
    $response->decode()
        // http_decoding_error($request);
    return $response;
}

sub _get_openssl_version
{
    my $version_info = Net::SSLeay::SSLeay_version();
    my ($version) = $version_info =~ m/\AOpenSSL (\S+)/
        or return;
    return $version;
}

my $openssl_version = _get_openssl_version();

sub _get_openssl_dir
{
    defined($openssl_version)
        or return;
    my $SSLEAY_DIR;
    if ($openssl_version =~ m/\A(?:0[.]|1[.]0[.])/) {
        # OpenSSL << 1.1
        $SSLEAY_DIR = 5;
    } else {
        # OpenSSL >= 1.1
        $SSLEAY_DIR = 4;
    }
    my $openssl_info = Net::SSLeay::SSLeay_version($SSLEAY_DIR);
    my ($openssl_dir) = $openssl_info =~ m/\AOPENSSLDIR: "(.*)"\Z/;
    return $openssl_dir;
}

my $openssl_dir = _get_openssl_dir();

sub get_default_ca_path
{
    my ($name, @hashes) = @_;
    my $filename = "$name.crt";
    $filename =~ y/ /_/;
    my $path = "/usr/share/ca-certificates/mozilla/$filename";
    if (-r $path) {
        return $path;
    }
    my $ssl_cert_dir = $ENV{SSL_CERT_DIR};
    if (defined($openssl_dir)) {
        $ssl_cert_dir //= "$openssl_dir/certs";
    }
    if (defined($ssl_cert_dir)) {
        for my $hash (@hashes) {
            $path = "$ssl_cert_dir/$hash.0";
            # TODO: actually check if this is the certificate we want
            # hash collisions are unlikely, but not impossible
            -r $path or next;
            my $rpath = readlink($path) or next;
            $rpath =~ m{\A/}
                or $rpath = "$ssl_cert_dir/$rpath";
            return $rpath;
        }
    }
    return "$FindBin::Bin/ca.crt";
}

# ===========================
# configuration file handling
# ===========================

my $global_config = undef;

my @gpg_cmdline =
    Text::ParseWords::shellwords($ENV{MBANK_CLI_GPG} // 'gpg') or
    user_error('cannot parse $MBANK_CLI_GPG');  ## no critic (InterpolationOfMetachars)

$ENV{GPG_TTY} //= POSIX::ttyname(POSIX::STDIN_FILENO);

sub read_config
{
    my ($path) = @_;
    open(my $fh, '<', $path)
        or os_error("$path: $ERRNO");
    my $config = _read_config($fh, $path);
    close($fh)
        or os_error("$path: $ERRNO");
    return $config;
}

sub _read_config
{
    my ($fh, $path) = @_;
    my $pgp = undef;
    my $config = {
        __pgp__ => [],
        __path__ => $path,
    };
    while (<$fh>) {
        chomp;
        if (defined($pgp)) {
            $pgp .= "$_\n";
            if ($_ eq '-----END PGP MESSAGE-----') {
                push(@{$config->{__pgp__}}, $pgp);
                $pgp = undef;
            }
        } elsif ($_ eq '-----BEGIN PGP MESSAGE-----') {
            $pgp = "$_\n";
        } elsif (m/^(?:#|\s*$)/) {
            next;
        } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
            my ($key, $value) = ($1, $2);
            $key = lc($key);
            ($value) = Text::ParseWords::parse_line('^$', 0, $value);
            $config->{$key} = $value;
        } else {
            config_error("syntax error: $_", config => $path);
        }
    }
    return $config;
}

sub _decrypt_config
{
    my ($config) = @_;
    my $pgp_chunks = $config->{__pgp__};
    $config->{__pgp__} = [];
    scalar(@{$pgp_chunks}) > 0 or return;
    eval {
        require IPC::Run;
    } // user_error('IPC::Run is required to decrypt the configuration file');
    for my $encrypted_data (@{$pgp_chunks}) {
        my $decrypted_data;
        eval {
            local $SIG{CHLD} = sub {
                # https://github.com/cpan-authors/IPC-Run/issues/166
                # ("delay after child exit")
            };
            IPC::Run::run(
                [@gpg_cmdline, '-d'],
                '<', \$encrypted_data,
                '>', \$decrypted_data,
            ) or os_error("@gpg_cmdline -d failed");
        } // do {
            os_error($EVAL_ERROR);
        };
        my @decrypted_data = split(/\n/, $decrypted_data);
        for (@decrypted_data) {
            if (m/^(?:#|\s*)$/) {
                next;
            } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
                my ($key, $value) = ($1, $2);
                $key = lc($key);
                ($value) = Text::ParseWords::parse_line('^$', 0, $value);
                $config->{$key} = $value;
            } else {
                config_error("syntax error in encrypted part: $_", config => $config);
            }
        }
    }
    return $config;
}

sub get_config_var
{
    my ($var, $default) = @_;
    my $config = $global_config;
    if (exists($config->{$var}) or defined($default)) {
        if (ref($default)) {
            $default = ${$default};
        }
        return $config->{$var} // $default;
    }
    _decrypt_config($config);
    return $config->{$var};
}

sub config_error
{
    my ($message, %options) = @_;
    kwargs(\%options,
        config => [\my $config, $global_config],
    );
    my $config_path;
    if (ref $config) {
        $config_path = $config->{__path__};
    } else {
        $config_path = $config;
    }
    $message = "$config_path: $message";
    return user_error($message);
}

# ===========================
# misc parsing and formatting
# ===========================

my $account_number_re = qr{
  \d{2}(?:[ ]\d{4}){6}  # Polish IBAN (without the country code)
| CZ\d{2}(?:[ ]\d{4}){5}  # Czech IBAN: https://www.cnb.cz/en/payments/iban/iban-international-bank-account-number-basic-information/
| SK\d{2}(?:[ ]\d{4}){5}  # Slovak IBAN: https://www.nbs.sk/en/payment-systems/iban/iban-slovak-republic
| (?:\d{1,6}-)?\d{2,10}/\d{4}  # Slovak national format: https://www.nbs.sk/en/payment-systems/iban/iban-slovak-republic
}x;

sub format_amount
{
    my ($s, %options) = @_;
    kwargs(\%options,
        fp => [\my $fp, 0],
        plus => [\my $use_plus, 0],
        currency => [\my $currency, undef],
    );
    if ($fp) {
        if (not defined($currency)) {
            internal_error('floating-point number, but no currency');
        }
        $s = format_number('%.2f', $s);
    }
    my $sign_re;
    $s =~ s/(\s|\xA0)+(?=\d)//g;
    if ($use_plus) {
        $sign_re = qr/[+-]?/;
    } else {
        $sign_re = qr/-?/;
    }
    my $amount_re = qr/($sign_re\d+[.,]\d{2})/;
    my $currency_re;
    if (defined $currency) {
        $currency =~ m/\A[A-Z]{3}\z/  ## no critic (EnumeratedClasses)
            or return;
        $currency_re = qr//;
    } else {
        $currency_re = qr/\s+([A-Z]{3})/;  ## no critic (EnumeratedClasses)
    }
    my ($amount, $parsed_currency) = ($s =~ m/\A$amount_re$currency_re\z/)
        or return;
    $amount =~ y/,/./;
    $currency //= $parsed_currency;
    return sprintf('%10s %s', $amount, $currency);
}

sub format_money
{
    my ($number, $currency, %options) = @_;
    kwargs(\%options,
        context => \my $context
    );
    match($number, qr/-?[\d ]+(?:[.,]\d+)?/, context => "$context.number");
    $number =~ s/ //g;
    $number =~ tr/,/./;
    match($currency, qr/[A-Z]{3}/, context => "$context.currency");  ## no critic (EnumeratedClasses)
    my $s = eval {
        sprintf('%10.2f %s', $number, $currency);
    } // do {
        my $qnumber = quote($number);
        my $qcurrency = quote($currency);
        scraping_error("$context: $qnumber, $qcurrency");
    };
    return $s;
}

sub format_number
{
    my ($format, $n) = @_;
    my $s;
    eval {
        $s = sprintf($format, $n);
    } // return;
    return $s;
}

sub wildcards_to_regexp
{
    my (@wildcards) = @_;
    my $re = join('|',
        map { quotemeta } @wildcards
    );
    $re =~ s/\\[*]/.*/g;
    $re = qr{^(?i:($re))$};
    return $re;
}

# =============
# date and time
# =============

=begin comment

timestamp_to_date(TIMESTAMP, [time_must_be => 0])

    >>> timestamp_to_date('2006-07-30T14:47:03')
    '2006-07-30'

    >>> timestamp_to_date('2006-02-30T14:47:03')
    undef

    >>> timestamp_to_date('2006-07-30T14:47:03', time_must_be => 0)
    undef

    >>> timestamp_to_date('2006-07-30T00:00:00', time_must_be => 0)
    '2006-07-30'

=end comment
=cut

sub timestamp_to_date
{
    my ($timestamp, %options) = @_;
    kwargs(\%options,
        time_must_be => [\my $time_must_be, undef],
    );
    my $time_re = qr/\A/;
    if (defined($time_must_be)) {
        if ($time_must_be == 0) {
            $time_re = qr/\A[0:.]+\z/;
        } else {
            internal_error('invalid time_must_be');
        }
    }
    $timestamp //= '';
    my ($date, $time) = ($timestamp =~ m/\A(\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d(?:[.]\d+)?)(?:[+-]\d\d:\d\d)?\z/)
        or return;
    $time =~ $time_re
        or return;
    my $pdate;
    eval {
        $pdate = Time::Piece->strptime($date, '%Y-%m-%d')->ymd;
    } or return;
    $date eq $pdate
        or return;
    return $date;
}

sub match_ymd_date
{
    my ($timestamp, %options) = @_;
    kwargs(\%options,
        context => \my $context,
        time_must_be => [\my $time_must_be, undef],
    );
    return timestamp_to_date($timestamp, time_must_be => $time_must_be)
        // no_match($timestamp, context => $context);
}

=begin comment

parse_dmy_date(MONTH_DAY_YEAR_DATE, context => CONTEXT)

    >>> parse_dmy_date('30-07-2006', context => 'foo')
    '2006-07-30'

    >>> parse_dmy_date('30.07.2006', context => 'foo')
    '2006-07-30'

    >>> parse_dmy_date('30.02.2006', context => 'foo')
    Scraping error: foo: "30.02.2006" is not a valid day-month-year date

=end comment
=cut

sub parse_dmy_date
{
    my ($orig_date, %options) = @_;
    kwargs(\%options, context => \my $context);
    my $date;
    if (ref($orig_date) eq '') {
        $date = _parse_dmy_date($orig_date);
    }
    if (not defined($date)) {
        my $qdate = quote($orig_date);
        scraping_error("$context: $qdate is not a valid day-month-year date");
    }
    return $date;
}

sub _parse_dmy_date
{
    my ($date) = @_;
    my ($d, undef, $m, $y) = ($date =~ m/\A(\d\d)([.-])(\d\d)\2(\d\d\d\d)\z/)
        or return;
    $date = "$y-$m-$d";
    my $pdate;
    eval {
        $pdate = Time::Piece->strptime($date, '%Y-%m-%d')->ymd;
    } or return;
    $date eq $pdate
        or return;
    return $date;
}

sub shift_date
{
    my ($date, $offset) = @_;
    my $new_date = _shift_date($date, $offset);
    if (not defined($new_date)) {
        internal_error("shift_date(): could not shift $date by $offset days");
    }
    return $new_date;
}

sub _shift_date
{
    my ($date, $offset) = @_;
    my $tp;
    eval {
        $tp = Time::Piece->strptime($date, '%Y-%m-%d');
    } or return;
    $tp += $offset * Time::Seconds::ONE_DAY;
    $date = $tp->ymd;
    $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
        or return;
    return $date;
}

=begin comment

parse_http_date(HTTP_DATE_HEADER, context => CONTEXT) -> Time::Piece object

=end comment
=cut

sub parse_http_date
{
    my ($s, %options) = @_;
    kwargs(\%options, context => \my $context);
    match($s, qr/.+/, context => $context);
    my $uts = HTTP::Date::str2time($s)
        // no_match($s, context => $context);
    return Time::Piece->gmtime($uts)
}

=begin comment

local_date(TIME_PIECE_OBJECT) -> DATE

=end comment
=cut

sub local_date
{
    my ($tp) = @_;
    ref($tp) eq 'Time::Piece'
        or internal_error('local_date(): invalid argument');
    my $uts = $tp->epoch;
    local $ENV{TZ} = ':Europe/Warsaw';
    $tp = Time::Piece->localtime($uts);
    if ($tp->tzoffset == 0) {
        # Polish time zone offset is never 0,
        # so something must have gone awry.
        internal_error("local_midnight_to_utc(): cloud not set TZ=$ENV{TZ}");
    }
    return $tp->ymd;
}

=begin comment

local_midnight_to_utc(DATE) -> UTC_TIMESTAMP

    >>> local_midnight_to_utc('2006-07-30')
    2006-07-29T22:00:00.000Z

    >>> local_midnight_to_utc('2009-12-08')
    2009-12-07T23:00:00.000Z

=end comment
=cut

sub local_midnight_to_utc
{
    my ($date) = @_;
    local $ENV{TZ} = ':Europe/Warsaw';
    my $tp = Time::Piece->strptime($date, '%Y-%m-%d');
    my $localtime = Time::Local::timelocal(0, 0, 0, $tp->mday, $tp->_mon, $tp->year);
    $tp = Time::Piece->gmtime($localtime);
    my $datetime = $tp->datetime;
    if ($datetime =~ /T[0:]+\z/) {
        # Polish time zone offset is never 0,
        # so something must have gone awry.
        internal_error("local_midnight_to_utc(): cloud not set TZ=$ENV{TZ}");
    }
    return "$datetime.000Z";
}

=begin comment

js_time() -> number of milliseconds since the Unix epoch

This is equivalent to the following JavaScript code:

    (new Date).getTime()

Like Tor Browser, we support only 100ms accuracy:

    >>> js_time()
    1570127042900

=end comment
=cut

sub js_time
{
    my $t = Time::HiRes::time();
    $t = sprintf('%.1f00', $t);
    $t =~ s/[.]//;
    return 0 + $t;
}

# ============
# HTML parsing
# ============

# TreeBuilder needs some nudging to understand newfangled HTML 5 tags
# https://github.com/kentfredric/HTML-Tree/pull/3
$HTML::TreeBuilder::isBodyElement{header} = 1;  ## no critic (PackageVars)

sub html_new
{
    my ($s) = @_;
    return HTML::TreeBuilder->new_from_content($s);
}

sub html_class_regexp
{
    my ($class) = @_;
    return qr/(?:\A|\s)\Q$class\E(?:\s|\z)/;
}

sub has_html_class
{
    my ($element, $class) = @_;
    my $element_class = $element->attr('class') // '';
    return $element_class =~ html_class_regexp($class);
}

=begin comment

html_find([ATTR => VALUE, ...] [class => CLASSES,] [n => N, context => CONTEXT,]) -> (ELEM_1, ..., ELEM_N)

In scalar context, n = 1 by default.

=end comment
=cut

sub html_find
{
    my ($root_elt, %options) = @_;
    my @anames = qw(id name type);
    my %attrs = ();
    for my $aname (@anames) {
        my $avalue = delete $options{$aname};
        if (defined($avalue)) {
            $attrs{$aname} = $avalue;
        }
    }
    kwargs(\%options,
        tag => [\my $tag, undef],
        class => [\my $classes, []],
        n => [\my $n, undef],
        context => [\my $context, undef],
    );
    my @classes;
    if (ref($classes) eq 'ARRAY') {
        @classes = @{$classes};
    } elsif (ref($classes) eq '') {
        @classes = split(' ', $classes);
    } else {
        internal_error('html_find(): invalid argument', 1);
    }
    my @result = $root_elt->look_down(sub {
        my ($elt) = @_;
        for my $class (@classes) {
            has_html_class($elt, $class)
                or return 0;
        }
        if (defined($tag)) {
            ($elt->tag() eq $tag)
                or return 0;
        }
        for my $aname (keys %attrs) {
            ($elt->attr($aname) // '') eq $attrs{$aname}
                or return 0;
        }
        return 1;
    });
    if (not wantarray) {
        $n //= 1;
    }
    if (defined($n)) {
        defined($context)
            or internal_error('html_find(): missing keyword argument: context', 1);
        unpack_list([(undef) x $n], [@result], context => $context);
    }
    if (wantarray) {
        return @result;
    } else {
        my ($result) = @result;
        return $result;
    }
}

# ====
# JSON
# ====

sub encode_json
{
    goto &JSON::PP::encode_json
}

=begin comment

decode_json(JSON_OBJECT, context => CONTEXT) -> hash ref
decode_json(JSON_ARRAY, type => [], context => CONTEXT) -> array ref

=end comment
=cut

sub decode_json
{
    my ($json, %options) = @_;
    kwargs(\%options,
        context => \my $context,
        type => [\my $type, {}],
    );
    my $obj = eval {
        JSON::PP::decode_json($json);
    } // do {
        scraping_error("$context: $EVAL_ERROR");
    };
    return check_type($obj, $type, context => $context);
}

sub json_content
{
    my ($obj) = @_;
    wantarray
        or internal_error('json_content() called in non-array context', 1);
    return (
        'Content' => encode_json($obj),
        'Content-Type' => 'application/json; charset=UTF-8',
    );
}

# =====
# UUIDs
# =====

my $uuid_template = 'XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX';

sub parse_uuid
{
    my ($s) = @_;
    my $uuid_regexp = $uuid_template =~ s/X/[0-9a-fA-F]/rg;
    $s =~ m/\A$uuid_regexp\z/
        or return;
    return $s;
}

sub gen_uuid
{
    my $nbytes = () = $uuid_template =~ m/XX/g;
    Net::SSLeay::RAND_bytes(my $uuid, $nbytes);
    length($uuid) == $nbytes
        or internal_error('RNG failure');
    my @uuid = unpack('C*', $uuid);
    # RFC 9562 §4.1 Variant:
    $uuid[8] = ($uuid[8] & 0b00_111111) | 0b10_000000; # DCE
    # RFC 9562 §4.2 Version:
    $uuid[6] = ($uuid[6] & 0b0000_1111) | 0b0100_0000; # v4 (random)
    my $template = $uuid_template =~ s/XX/%02x/rg;
    $uuid = sprintf $template, @uuid;
    parse_uuid($uuid)
        or internal_error('UUID generation failed');
    return $uuid;
}

sub match_uuid
{
    my ($uuid, %options) = @_;
    kwargs(\%options,
        context => \my $context,
    );
    return parse_uuid($uuid)
        // no_match($uuid, context => $context);
}

# ================
# terminal support
# ================

sub term_new
{
    my %options = @_;
    kwargs(\%options,
        readpasswd => [\my $readpasswd, 0],
    );
    state $term = Term::ReadLine->new('mbank-cli');
    if ($readpasswd) {
        if ($OSNAME eq 'MSWin32') {
            # We normally require Term::ReadLine::Gnu, so that it's possible to
            # ask for password without displaying it on the screen. But this
            # module is difficult to port to Windows. Oh well.
        } elsif (not defined($term->Attribs->{shadow_redisplay})) {
            debug("Term::ReadLine = $Term::ReadLine::ISA[0]");
            user_error('Term::ReadLine::Gnu is required for password prompt');
        }
    }
    return $term;
}

sub term_readpasswd
{
    my ($term, $prompt) = @_;
    local $term->Attribs->{redisplay_function} =  ## no critic (LocalVars)
        $term->Attribs->{shadow_redisplay};
    return $term->readline($prompt);
}

# =======================
# command implementations
# =======================

my $mbank_host = undef;
my $root_url = undef;
my $base_url = undef;
my $csite_url = undef;

my @header_xhr = (
    'X-Requested-With' => 'XMLHttpRequest',
);

my @header_accept_json = (
    'Accept' => 'application/json, text/javascript, */*; q=0.01',
);

sub _extract_login_menu
{
    my ($html) = @_;
    my %menu = ();
    my $load_menu;
    $load_menu = sub {
        my ($item) = @_;
        my $key = match($item->{'UniqueIdentifier'}, qr/\S+/, context => 'login.menu.key');
        my $url = $item->{'FullUrl'};
        defined($url) or next;
        match($url, qr{/\S+}, context => 'login.menu.url');
        my $children = $item->{'Children'};
        ref $children eq 'ARRAY'
            or scraping_error('login.menu.children: not an array');
        for my $subitem (@{$children}) {
            $load_menu->($subitem);
        }
        $menu{$key} = $url;
    };
    for my $e_script (html_find($html, tag => 'script')) {
        my @content = $e_script->content_list;
        scalar(@content) == 1
            or next;
        my ($content) = @content;
        if (ref $content) {
            next;
        }
        my ($json) = ($content =~ m/^\s*Ebre[.]Venezia[.]MenuItems\s*=\s*(\[.+\]);\s+$/m)
            or next;
        $json = Encode::encode('UTF-8', $json);
        $json = decode_json($json, type => [], context => 'login.menu.json');
        for my $item (@{$json}) {
            $load_menu->($item);
        }
        last;
    }
    (keys %menu > 0)
        or scraping_error('login.menu.missing');
    return %menu;
}

sub _extract_login_profiles
{
    my ($html) = @_;
    my %profiles = (
        personal => [],
        business => [],
    );
    for my $e_script (html_find($html, tag => 'script')) {
        my @content = $e_script->content_list;
        scalar(@content) == 1
            or next;
        my ($content) = @content;
        if (ref $content) {
            next;
        }
        my ($js) = ($content =~ m/^\s*Ebre[.]Venezia[.]ProfileData\s*=\s*([{].+[}]);\s*$/m)
            or next;
        $js = unicode_to_bytes($js, 'UTF-8');
        my $json = decode_json($js, context => 'login.profiles.json');
        while (my ($key, $value) = each %{$json}) {
            if ($key eq 'iProfiles') {
                $key = 'personal';
            } elsif ($key eq 'fProfiles') {
                $key = 'business';
            } else {
                no_match($key, context => 'login.profiles.key');
            }
            my @js_profiles = @{$value->{profiles}};
            my $n = 0;
            for my $js_profile (@js_profiles) {
                my $code = match($js_profile->{profileCode}, qr/.+/, context => 'login.profiles.profile-code');
                push(@{$profiles{$key}}, $code);
                $n++;
                my $name;
                if ($key eq 'business') {
                    $name = match($js_profile->{firmName}, qr/.+/, context => 'login.profiles.company-name');
                } else {
                    $name = "$key/$code";
                }
                push(@{$profiles{$name}}, $code);
            }
            if ($n > 1) {
                delete $profiles{$key};
            }
        }
        last;
    }
    return %profiles;
}

sub get_cookie_info
{
    my ($name) = @_;
    my @info;
    $ua->cookie_jar->scan(
        sub {
            my ($ver, $key, $value, $path, $domain) = @_;
            if (($domain eq $mbank_host) and ($key eq $name)) {
                @info = @_;
            }
        }
    );
    return @info;
}

sub get_tabid
{
    (undef, undef, my $tabid) = get_cookie_info('mBank_tabId');
    defined($tabid)
        or scraping_error('login.tabid');
    match_uuid($tabid, context => 'login.tabid');
    return $tabid;
}

sub _ask_for_sms_password
{
    my ($date, $n, $try) = @_;
    my ($y, $m, $d) = split /-/, $date;
    my $inbox = get_config_var('smsinbox');
    if (defined $inbox) {
        $inbox = expand_tilde($inbox);
        $inbox =~ s{[^/]\K/+\z}{};  # strip trailing slash
        $inbox .= '/';
        stat $inbox or os_error("$inbox: $ERRNO");
        eval {
            require Filesys::Notify::Simple;
        } // user_error('Filesys::Notify::Simple is required to read SMS messages');
        if ($try == 0) {
            return;
        } elsif ($try > 1) {
            internal_error('SMS retrieval failed?');
        }
        my $watcher = Filesys::Notify::Simple->new([$inbox]);
        debug('waiting for SMS password');
        while (1) {
            my $passwd;
            $watcher->wait(sub {
                for my $event (@_) {
                    local $INPUT_RECORD_SEPARATOR = undef;
                    my $path = $event->{path};
                    open(my $fh, '<', $path) or do {
                        if ($ERRNO{ENOENT}) {
                            next;
                        } else {
                            os_error("$path: $ERRNO");
                        }
                    };
                    my $text = <$fh>;
                    close($fh) or os_error("$path: $ERRNO");
                    # FIXME: this only works for Polish
                    ($passwd) = $text =~ m{! Operacja nr $n z dn[.] $d-$m-$y\b.*\bhaslo: (\d{8}) mBank\b};
                    if (defined($passwd)) {
                        last;
                    }
                }
            });
            if (defined($passwd)) {
                return $passwd
            }
        }
    } elsif (-t STDIN) {
        if ($try == 0) {
            return;
        }
        my $term = term_new();
        while (1) {
            my $passwd = $term->readline("SMS password ($y-$m-$d, #$n): ") // '';
            if ($passwd =~ m/\A\d{8}\z/) {
                return $passwd;
            }
        };
    } else {
        user_error('unable to ask for SMS password');
    }
    return;
}

sub unexpire_cookie
{
    my ($name, %options) = @_;
    kwargs(\%options, context => \my $context);
    my @cookie_args = get_cookie_info($name);
    if (@cookie_args) {
        if (not defined($cookie_args[8])) {
            # HTTP::Cookies doesn't handle the max-age parameter correctly:
            # https://github.com/libwww-perl/HTTP-Cookies/issues/69
            # Let's restore the expiry info if it was lost.
            debug("setting expiration date for cookie $name");
            $cookie_args[8] = 1E10;  # ~317 years
            $ua->cookie_jar->set_cookie(@cookie_args);
        }
    } else {
        scraping_error("$context: cookie $name missing");
    }
    @cookie_args = get_cookie_info($name);
    my $expires = $cookie_args[8];
    defined($expires)
        or internal_error("cookie $name does not expire");
    $expires = HTTP::Date::time2isoz($expires);
    debug("cookie $name expires on $expires");
    return;
}

sub _do_2fa  ## no critic (ExcessComplexity)
{
    my ($device_to_add) = @_;
    my @headers_api_auth = (
        'Origin' => $root_url,
        'Referer' => "$root_url/connect/Login",
    );
    my $dfp = get_config_var('dfp') // $browser_dfp;
    my $request = POST(
        "$root_url/signin/connect/api/sca",
        @headers_api_auth,
        json_content({dfp => $dfp})
    );
    my $doc = download($request);
    unexpire_cookie('mBank8', context => 'login.sca.cookie');
    my $data = decode_json($doc->{content}, context => 'login.sca');
    my $sca_status = match($data->{imsStatus}, qr/(Is|Not)Trusted|Suspicious/, context => 'login.sca.status');
    debug("SCA status: $sca_status");
    my $sca_limit_exceeded = $data->{maximumNumberOfDevicesExceeded};
    JSON::PP::is_bool($sca_limit_exceeded)
        or no_match($sca_limit_exceeded, context => 'login.sca.limit');
    if ($sca_status eq 'IsTrusted') {
        # yay, no 2FA
        if (defined($device_to_add)) {
            user_error('device already registered');
        }
        return match_uuid($data->{token}, context => 'login.sca.token');
    }
    my $mod_data = {
        'authorizationAction' => 1, # OneTimeLogin
        'browserName' => $browser_name,
        'browserVersion' => $browser_version,
        'deviceName' => "Komputer Linux $browser_name",
        'osName' => 'Linux',
        'dfp' => $dfp,
    };
    if (defined($device_to_add)) {
        if ($sca_limit_exceeded) {
            user_error('too many registered devices')
        }
        while (1) {
            $request = POST(
                "$root_url/signin/connect/api/sca/uniqueDevice",
                @headers_api_auth,
                json_content({'deviceName' => $device_to_add}),
            );
            $doc = download($request);
            $data = decode_json($doc->{content}, context => 'login.sca.unique-dev');
            if ($data->{isUnique}) {
                last;
            }
            say {*STDERR} 'Device name has been rejected. Try another one.';
            my $term = term_new();
            my $name = '';
            until (length($name) > 1) {  ## no critic (Until)
                $name = $term->readline('Device name: ', unicode_to_bytes($device_to_add)) // '';
                $name = bytes_to_unicode($name);
            }
            $device_to_add = $name;
        }
        $mod_data->{authorizationAction} = 2; # AddTrusted
        $mod_data->{deviceName} = $device_to_add;
    }
    $request = POST(
        "$root_url/signin/connect/api/mediator/initialize",
        @headers_api_auth,
        json_content({
            'moduleData' => $mod_data,
            'moduleId' => 'IB20',
        })
    );
    $doc = download($request);
    $data = decode_json($doc->{content}, context => 'login.2fa.init');
    $data = $data->{authorizationData};
    my $auth_mode = match($data->{authorizationType}, qr/\w+/, context => 'login.2fa.init.auth-type');
    my $auth_id = match_uuid($data->{authorizationId}, context => 'login.2fa.init.auth-id');
    my $auth_date = $data->{authorizationDate} // '';
    $auth_date = timestamp_to_date($auth_date)
        // scraping_error("login.2fa.init.operation-date: $auth_date");
    my $auth_no = match($data->{authorizationNumber} // '', qr/\d+/, context => 'login.2fa.init.operation-no');
    my $token = undef;
    if ($auth_mode eq 'MA') {
        say {*STDERR} "Waiting for confirmation of operation no $auth_no from $auth_date in the mobile app...";
        while (1) {
            $request = POST(
                "$root_url/signin/connect/api/mediator/status",
                @headers_api_auth,
                json_content({
                    'authorizationId' => $auth_id,
                })
            );
            $doc = download($request);
            my $status;
            $data = {};
            if ($doc->{response}->code == 204) {
                $status = '_';
            } else {
                $data = decode_json($doc->{content}, context => 'login.2fa.status');
                $status = $data->{authorizationStatus} // '';
            }
            debug("2FA mobile auth: $status");
            if ($status eq '_') {
                sleep(1)
                    or os_error("sleep(): $ERRNO");
            } elsif ($status eq 'Authorized') {
                $token = $data->{postResult}->{token};
                return match_uuid($token, context => 'login.2fa.status.token');
            } elsif ($status eq 'Canceled') {
                user_error('login failed: rejected mobile authentication request');
            } elsif ($status eq 'TimeOut') {
                user_error('login failed: mobile authentication request timed out');
            } else {
                scraping_error("login.2fa.status.status: $status")
            }
        }
    } elsif ($auth_mode eq 'SMS') {
        for (my $try = 1; ; $try++) {  ## no critic (CStyleForLoop)
            my $sms_password = _ask_for_sms_password($auth_date, $auth_no, $try);
            $request = POST(
                "$root_url/signin/connect/api/mediator/authorize",
                @headers_api_auth,
                json_content({
                    'authorizationCode' => $sms_password,
                    'authorizationId' => $auth_id,
                    'authorizationType' => $auth_mode,
                })
            );
            $doc = download($request, ignore_errors => [422]);
            $data = decode_json($doc->{content}, context => 'login.2fa.exec');
            $token = $data->{postResult}->{token};
            if (defined($token)) {
                return match_uuid($token, context => 'login.2fa.exec.token');
            } else {
                my $error_code = $data->{type};
                if (($error_code // '') eq 'AuthApi-SMS014') {
                    say {*STDERR} 'Incorrect SMS password';
                    next;
                } else {
                    no_match($error_code, context => 'login.2fa.exec.error');
                }
            }
        }
    } else {
        no_match($auth_mode, context => 'login.2fa.init.auth-mode');
    }
    return;
}

sub clear_temp_cookies
{
    debug('clearing temporary cookies');
    $ua->cookie_jar->clear_temporary_cookies();
    my @cookies;
    $ua->cookie_jar->scan(
        sub {
            my ($ver, $key, $value, $path, $domain, undef, undef, undef, $expires) = @_;
            if (($domain eq $mbank_host)) {
                my $expinfo = defined($expires)
                    ? 'exp ' . HTTP::Date::time2isoz($expires)
                    : 'no exp';
                push @cookies, "$key ($expinfo)";
            }
        }
    );
    my $cookies = do {
        local $LIST_SEPARATOR = ', ';
        "@cookies";
    };
    debug("remaining cookies: $cookies");
    return;
}

sub do_login
{
    my %options = @_;
    kwargs(\%options,
        probe => [\my $probe, 0],
        register_device => [\my $register_device, undef],
    );
    my $request = GET($base_url);
    my $doc = download($request);
    if ($doc->{url} =~ m{/Login$}) {
        if ($probe) {
            debug('not logged in');
            return;
        }
        clear_temp_cookies();
        debug('logging in...');
        my ($lang) = ($base_url =~ m{/(\w\w)$});
        my ($return_url) = ($doc->{content} =~ m{'/signin/connect/authorize[?]ui_locales=$lang&(request_uri=urn%3aietf%3aparams%3aoauth%3arequest_uri%3a[0-9A-F]+&client_id=Ib)'})  ## no critic (ComplexRegex, EnumeratedClasses)
            or scraping_error('login.return-url');
        $return_url =~ s/%3a/%3A/g;
        $return_url = "/signin/connect/authorize/callback?$return_url&suppressed_prompt=login";
        my $login_url = $doc->{url};
        my $login = get_config_var('login')
            // config_error('missing login');
        my $password;
        my $password_manager = get_config_var('passwordmanager');
        if (defined($password_manager)) {
            eval {
                require IPC::Run;
            } // user_error('IPC::Run is required to retrieve password');
            eval {
                local $SIG{CHLD} = sub {
                    # https://github.com/cpan-authors/IPC-Run/issues/166
                    # ("delay after child exit")
                };
                IPC::Run::run(
                    ['sh', '-c', $password_manager],
                    '>', \$password
                ) or os_error('password manager failed');
            } // do {
                os_error($EVAL_ERROR);
            };
            $password =~ s/\n.*//s;
        } else {
            $password = get_config_var('password');
            if (not defined($password)) {
                if (-t STDIN) {
                    my $term = term_new(readpasswd => 1);
                    $password = term_readpasswd($term, 'Password: ');
                    $password //= '';
                } else {
                    config_error('missing password');
                }
            }
        }
        length($password) > 0
            or user_error('login failed: empty password');
        if (defined(get_config_var('smsinbox'))) {
            # Make sure the SMSInbox feature is configured properly before we
            # try to log in:
            _ask_for_sms_password('2006-07-30', 1, 0);
        }
        my @headers = (
            'Origin' => $root_url,
            'Referer' => "$root_url/connect/Login",
        );
        $request = POST(
            "$root_url/signin/connect/api/users/prelogin",
            @headers,
            json_content({
                'language' => $lang,
                'login' => $login,
                'password' => $password,
                'returnUrl' => $return_url,
            })
        );
        $doc = download($request,
            redact => qr/"password"\s*:\s*\K"(?:[^\\"]|\\.)*"/,
            ignore_errors => [422],
        );
        my $data = decode_json($doc->{content}, context => 'login.prelogin.json');
        if ($data->{type} ne 'PreLoginResponse') {
            my $message = $data->{detail} // '';
            $message = unicode_to_bytes($message);
            user_error("login failed: $message");
        }
        my $token = _do_2fa($register_device);
        $request = POST(
            "$root_url/signin/connect/api/users/finallogin",
            @headers,
            json_content({
                'language' => ucfirst $lang,
                'returnUrl' => $return_url,
                'token' => $token,
            })
        );
        $doc = download($request);
        $data = decode_json($doc->{content}, context => 'login.final');
        $return_url = match($data->{returnUrl}, qr{/.+}, context => 'login.final.return-url');
        $request = GET("$root_url$return_url");
        $doc = download($request);
        $request = GET($base_url);
        $doc = download($request);
    }
    my $tabid = get_tabid();
    my $html = html_new($doc->{content});
    my ($e_tech_break) = html_find($html,
        tag => 'header',
        class => 'tech-break',
        context => 'login.tech-break'
    );
    if (defined($e_tech_break)) {
        server_error('service is temporarily unavailable');
    }
    my $e_meta = html_find($html,
        tag => 'meta',
        name => '__AjaxRequestVerificationToken',
        context => 'login.csrf-token',
    );
    my $csrf_token = match($e_meta->attr('content'), qr{[\w/+=]{20,}}, context => 'login.csrf-token');
    my %menu = _extract_login_menu($html);
    my %profiles = _extract_login_profiles($html);
    debug('logged in');
    return {
        headers => [
            'Referer' => $doc->{url},
            'X-Tab-Id' => $tabid,
            'X-Request-Verification-Token' => $csrf_token,
            @header_xhr,
        ],
        csrf_token => $csrf_token,
        menu => \%menu,
        profiles => \%profiles,
        url => $doc->{url},
    };
}

sub do_register_device
{
    my %options = @_;
    kwargs(\%options,
        args => \my $args,
    );
    my @args = @{$args};
    scalar(@args) <= 1
        or user_error('register-device: too many arguments');
    my ($name) = @args;
    $name //= 'CLI';
    $name = bytes_to_unicode($name);
    { # Sanity check: fully functional cookie jar is needed for this command
        my $uuid = gen_uuid();
        my $cookie_jar_path = $ua->cookie_jar->{file} // '/dev/null';
        $ua->cookie_jar->set_cookie(0, 'UUID', $uuid, '/cookie-jar', 'mbank-cli.test', undef, undef, undef, 60);
        eval {
            $ua->cookie_jar->save();
            1;
        } // os_error("$cookie_jar_path: $ERRNO");
        $ua->cookie_jar->set_cookie(0, 'UUID', $uuid, '/cookie-jar', 'mbank-cli.test', undef, undef, undef, -1);
        open (my $fh, '<', $cookie_jar_path)
            or os_error("$cookie_jar_path: $ERRNO");
        my $found = grep { /\b\Q$uuid\E\b/ } <$fh>;
        close($fh)
            or os_error("$cookie_jar_path: $ERRNO");
        if (not $found) {
            user_error("$cookie_jar_path: unwritable cookie file");
        }
    }
    do_logout(maybe => 1);
    do_login(register_device => $name);
    return;
}

sub do_list
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        quiet => [\my $quiet, 0],
    );
    my $request = POST(
        "$base_url/MyDesktop/Desktop/GetAccountsList",
        @{$login_info->{headers}},
        @header_accept_json,
        json_content({})
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'list.json');
    my @accounts = @{$json->{accountDetailsList}};
    my @result;
    for my $account (@accounts) {
        my $name = match($account->{ProductName}, qr/.+/, context => 'list.product-name');
        my $subtitle = $account->{SubTitle} // '';
        if ($subtitle ne '') {
            $name .= " - $subtitle";
        }
        my $number = match($account->{AccountNumber}, $account_number_re, context => 'list.account-number');
        push(@result, {
            name => $name,
            number => $number,
        });
        next if $quiet;
        my $currency = $account->{Currency};
        my $balance = format_money($account->{Balance}, $currency, context => 'list.balance');
        my $available = format_money($account->{AvailableBalance}, $currency, context => 'list.available');
        $name = unicode_to_bytes($name);
        print("$name\t$number\t$balance\t$available\n");
    }
    return [@result];
}

sub select_accounts
{
    my ($account_info, @selection) = @_;
    my $regexp = wildcards_to_regexp(
        map { bytes_to_unicode $_ } @selection
    );
    my %result = ();
    for my $account (@{$account_info}) {
        my $name = $account->{name};
        my $number = $account->{number};
        if ($name =~ $regexp) {
            debug("selected account: $number");
            $result{$number} = $name;
        } else {
            debug("deselected account: $number");
        }
    }
    return %result;
}

sub parse_csv_line
{
    my ($line, %options) = @_;
    kwargs(\%options,
        columns => \my $columns,
        context => \my $context,
    );
    my @columns = reverse @{$columns};
    my %item;
    while ($line =~ m/\G([^;"]+|(?:"[^"]*")+);/gc) {
        my $s = $1;
        $s =~ s/\A"|"\Z//g;
        $s =~ s/""/"/g;
        my $column = pop @columns;
        defined($column)
            or no_match($line, context => "$context.line.extra-col");
        $item{$column} = $s;
    }
    if ($line =~ m/\G(.+)\z/s) {
        no_match($line, context => "$context.line.junk");
    }
    return \%item;
}

sub do_history  ## no critic (RequireArgUnpacking)
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        accounts => \my $account_info,
        selection => \my $selection,
        display_name => \my $display_name,
        display_id => \my $display_id,
        start_date => [\my $start_date, undef],
        end_date => [\my $end_date, undef],
        export => [\my $export, undef],
    );
    my $convert_csv = sub {
        my %soptions = @_;
        kwargs(\%soptions,
            account_no => \my $account_no,
            account_name => \my $account_name,
            csv => \my $csv,
        );
        $csv =~ s/\r\n/\n/g;
        $csv =~ s/.*[0-9] ([A-Z]{3});\n\n#[^\n]+;\n//sm  ## no critic (EnumeratedClasses)
            or scraping_error('history.csv.currency');
        my $currency = $1;
        $csv = Encode::decode('Windows-1250', $csv);
        my @csv = split(/\n/, $csv); # assume no embedded newlines
        $csv = undef;
        my @lines;
        for my $line (@csv) {
            my $item = parse_csv_line($line,
                columns => [qw(bk_date op_date desc title peer peer_account_no amount balance)],
                context => 'history.csv'
            );
            if (not scalar keys %{$item}) {
                last;
            }
            my @dates;
            for my $key (qw(op_date bk_date)) {
                my $date = $item->{$key};
                $date = match_ymd_date("${date}T00:00:00", context => "history.$key");
                push @dates, $date;
            }
            my @amounts;
            for my $key (qw(amount balance)) {
                my $amount = $item->{$key};
                $amount = format_money($amount, $currency, context => "history.$key");
                push @amounts, $amount;
            }
            my @details;
            push @details, normalize_whitespace($item->{desc});
            push @details, normalize_whitespace($item->{peer});
            my $peer_account_no = $item->{peer_account_no};
            if ($peer_account_no =~ m/\A'([^']*)'\z/) {
                $peer_account_no = $1;
            }
            push @details, $peer_account_no;
            push @details, normalize_whitespace($item->{title});
            {
                local $LIST_SEPARATOR = "\t";
                my $line = "@dates\t@amounts\t@details";
                if ($display_name) {
                    $line = "$account_name\t$line";
                }
                if ($display_id) {
                    known_bug(102, 'history --with-id is not implemented')
                }
                $line = unicode_to_bytes($line);
                push @lines, $line;
            }
        }
        for my $line (reverse @lines) {
            say $line;
        }
    };
    if (not defined($export)) {
        push @_, (export => $convert_csv);
    }
    push @_, (command_name => 'history');
    goto &do_history2019;
}

sub do_blocked
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        accounts => \my $account_info,
        selection => \my $selection,
        display_name => \my $display_name,
    );
    my %selected_accounts = select_accounts($account_info, @{$selection})
        or user_error('blocked: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    my @headers = (
        @header_xhr,
        Referer => "$root_url/history/locks",
        'X-Tab-Id' => get_tabid(),
        'Accept' => '*/*',
    );
    my $request = GET(
        "$base_url/Pfm/HistoryApi/GetLocksFilters",
        @headers,
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'blocked2019.filters');
    my $products = check_type($json->{products}, [], context => 'blocked2019.products');
    my %products = ();
    for my $product (@{$products}) {
        my $contract_no = match($product->{contractNumber}, qr{[\w/-]+}, context => 'blocked2019.product.contract-no');
        my $alias = match($product->{contractAlias}, qr{[\w/+=]+}, context => 'blocked2019.product.alias');
        my $currency = match($product->{contractCurrency}, qr/(?:[A-Z]{3})?/, context => 'blocked2019.product.currency');  ## no critic (EnumeratedClasses)
        $products{$contract_no} = {
            alias => $alias,
            currency => $currency,
        }
    }
    for my $number (sort keys %selected_accounts) {
        $number =~ tr/ //d;
        my $product = $products{$number};
        if (not defined($product)) {
            no_match($number, context => 'blocked2019.product.for');
        }
        my $currency = $product->{currency};
        my $qalias = uri_escape_utf8($product->{alias});
        my $query = "accountNumber=$qalias&accountCurrency=$currency";
        $request = GET(
            "$base_url/Pfm/HistoryApi/GetLocksOperations?$query",
            @headers,
        );
        $doc = download($request);
        my $ops = decode_json($doc->{content}, context => 'blocked2019.ops');
        my $blocked_ops = check_type($ops->{transactionsBlocked}, [], context => 'blocked2019.ops.blocked');
        for my $op (@{$blocked_ops}) {
            my $date1 = match_ymd_date($op->{registerDate}, context => 'blocked2019.op.date1');
            my $date2 = match_ymd_date($op->{endDate}, context => 'blocked2019.op.date2');
            my $amount = format_money($op->{amount}, $op->{currency}, context => 'blocked2019.op.amount');
            my $description = match($op->{description}, qr/.+/, context => 'blocked2019.op.description');
            $description = unicode_to_bytes($description);
            my $type = match($op->{lockType}, qr/.+/, context => 'blocked2019.op.type');
            # FIXME? There's both "type" and "lockType".
            # What's the difference? Should we show both?
            say("$date1\t$date2\t$amount\t$description\t$type");
        }
    }
    return;
}

sub do_history2019
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        accounts => \my $account_info,
        selection => \my $selection,
        display_name => \my $display_name,
        display_id => \my $display_id,
        start_date => [\my $start_date, undef],
        end_date => [\my $end_date, undef],
        export => [\my $export, undef],
        command_name => [\my $command_name, 'history2019'],
    );
    my %selected_accounts = select_accounts($account_info, @{$selection})
        or user_error("$command_name: no matching accounts");
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    my @headers = (
        @header_xhr,
        'X-Tab-Id' => get_tabid(),
        'Referer' => "$root_url/history",  # must be last!
    );
    my @export_headers = @headers;
    $export_headers[-1] .= '/operationsSummary';
    my $request = GET(
        "$base_url/Pfm/HistoryApi/GetHistoryModeInfo?shouldOverWriteFilters=true",
        @headers,
        'Accept' => '*/*',
    );
    my $doc = download($request);
    my $mode_info = decode_json($doc->{content}, context => 'history2019.mode-info');
    my $min_date = match_ymd_date($mode_info->{pfmStartDate}, time_must_be => 0, context => 'history2019.min-date');
    debug("min-date: $min_date");
    my $server_datetime = $doc->{response}->headers->header('Date');
    $server_datetime = parse_http_date($server_datetime, context => 'history2019.max-date');
    my $max_date = local_date($server_datetime);
    debug("max-date: $max_date");
    my $paging = 1;
    if (not defined($start_date) and not defined($end_date)) {
        $paging = 0;
        $end_date = $max_date;
        if (defined($export)) {
            $start_date = shift_date($max_date, -30);
        } else {
            $start_date = $min_date;
        }
    }
    if (($start_date // '') lt $min_date) {
        $start_date = $min_date;
    }
    if (($end_date // 'z') gt $max_date) {
        $end_date = $max_date;
    }
    defined($start_date) and defined($end_date)
        or internal_error('missing date definitions');
    debug("start-date = $start_date");
    debug("end-date = $end_date");
    if (ref($export) eq 'CODE') {
        for my $account_no (sort(keys(%selected_accounts))) {
            my $account_name = $selected_accounts{$account_no};
            my $csv = _do_history2019_export(
                login => $login_info,
                headers => [@export_headers],
                account_no => $account_no,
                start_date => $start_date,
                end_date => $end_date,
                export => 'CSV',
            );
            $export->(
                account_no => $account_no,
                account_name => $account_name,
                csv => $csv,
            )
        }
        return;
    }
    if (defined($export)) {
        my @accounts = keys(%selected_accounts);
        if (@accounts != 1) {
            user_error("$command_name: exactly one account required for --export");
        }
        my ($account_no) = @accounts;
        my $export = _do_history2019_export(
            login => $login_info,
            headers => [@export_headers],
            account_no => $account_no,
            start_date => $start_date,
            end_date => $end_date,
            export => $export,
        );
        print {*STDOUT} $export;
        return;
    }
    $request = GET(
        "$base_url/Pfm/HistoryApi/GetPfmInitialData?shouldOverWriteFilters=true",
        @headers,
        'Accept' => '*/*',
    );
    $doc = download($request);
    my $pfm_data = decode_json($doc->{content}, context => 'history2019.pfm-data');
    my $products = check_type($pfm_data->{pfmProducts}, [], context => 'history2019.products');
    my %products;
    for my $product (@{$products}) {
        my $contract_no = match($product->{contractNumber}, qr{[\w/-]+}, context => 'history2019.product.contract-no');
        my $alias = match($product->{id}, qr{\d+}, context => 'history2019.product.id');
        $products{$contract_no} = $alias;
    }
    for my $account_no (sort(keys(%selected_accounts))) {
        my $account_name = $selected_accounts{$account_no};
        $account_no =~ tr/ //d;
        my $product_id = $products{$account_no};
        if (not defined($product_id)) {
            no_match($account_no, context => 'history2019.product.for');
        }
        _do_history2019_account(
            headers => [@headers],
            account_name => $account_name,
            product_id => $product_id,
            start_date => $start_date,
            end_date => $end_date,
            paging => $paging,
            display_name => $display_name,
            display_id => $display_id,
        )
    }
    return;
}

sub _do_history2019_account
{
    my %options = @_;
    kwargs(\%options,
        headers => \my $headers,
        product_id => \my $product_id,
        account_name => \my $account_name,
        start_date => \my $start_date,
        end_date => \my $end_date,
        paging => \my $paging,
        display_name => \my $display_name,
        display_id => \my $display_id,
    );
    $account_name = unicode_to_bytes($account_name);
    my @headers = @{$headers};
    my @params = (
        productIds => $product_id,
        amountFrom => 'null',
        amountTo => 'null',
        useAbsoluteSearch => 'false',
        currency => '',
        categories => '',
        operationTypes => '',
        searchText => '',
        dateFrom => local_midnight_to_utc($start_date),
        dateTo => local_midnight_to_utc($end_date),
        standingOrderId => '',
        showDebitTransactionTypes => 'false',
        showCreditTransactionTypes => 'false',
        showIrrelevantTransactions => 'true',
        showSavingsAndInvestments => 'true',
        saveShowIrrelevantTransactions => 'false',
        saveShowSavingsAndInvestments => 'false',
        selectedSuggestionId => '',
        selectedSuggestionType => '',
        showUncategorizedTransactions => 'false',
        debitCardNumber => '',
        counterpartyAccountNumbers => '',
        sortingOrder => 'ByDate',
    );
    my $query = '';
    while (my ($k, $v) = splice(@params, 0, 2)) {
        $query .= "&$k=" . uri_escape_utf8($v);
    }
    $query =~ s/\A&//;
    my $url = "$base_url/Pfm/HistoryApi/GetOperationsPfm?$query";
    PAGE: while(1) {
        my $request = GET(
            $url,
            @headers,
            'Accept' => '*/*',
        );
        my $doc = download($request);
        my $ops = decode_json($doc->{content}, context => 'history2019.ops');
        exists($ops->{nextPageUrl})
            or scraping_error('history2019.ops.next-page');
        my $next_page_url = $ops->{nextPageUrl};
        $ops = check_type($ops->{transactions}, [], context => 'history2019.ops.list');
        for my $op (@{$ops}) {
            my $id = match($op->{operationNumber}, qr/\d+/, context => 'history2019.op.id');
            my $type = match($op->{operationType}, qr/\S+/, context => 'history2019.op.type');
            if ($type eq 'NotBookedCardPayment') {
                # Apparently pending card payment identifiers belong in a
                # different namespace than other operation identifiers.
                # They are unlikely to be useful, so hide them.
                $id = '';
            }
            my $date = match_ymd_date($op->{transactionDate}, time_must_be => 0, context => 'history2019.op.date');
            my $currency = $op->{currency};
            my $amount = format_money($op->{amount}, $currency, context => 'history2019.op.amount');
            my $balance = $op->{balance};
            if (defined($balance)) {
                $balance = format_money($balance, $currency, context => 'history2019.op.balance');
            } else {
                $balance = '';
            }
            my $description = match($op->{description}, qr/.+/, context => 'history2019.op.description');
            $description = unicode_to_bytes($description);
            my $comment = $op->{comment};
            if (defined($comment)) {
                match($comment, qr/.+/, context => 'history2019.op.comment');
                $comment = unicode_to_bytes($comment);
            };
            my $line = '';
            if ($display_name) {
                $line .= "$account_name\t";
            }
            if ($display_id) {
                $line .= "$id\t";
            }
            $line .= "$type\t$date\t$amount\t$balance\t$description";
            if (defined($comment)) {
                $line .= "\t$comment";
            }
            say $line;
        }
        defined($next_page_url)
            or return;
        match($next_page_url, qr{Pfm/HistoryApi/GetOperationsPfm[?]\S+}, context => 'history2019.ops.next-page');
        if ($paging) {
            $url = "$base_url/$next_page_url";
            next PAGE;
        } else {
            return;
        }
    }
    return;
}

sub _do_history2019_export
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        headers => \my $headers,
        account_no => \my $account_no,
        start_date => \my $start_date,
        end_date => \my $end_date,
        export => \my $export,
    );
    my @headers = @{$headers};
    my $request = GET(
        "$base_url/Pfm/HistoryApi/GetHostInitialData",
        @headers,
        'Accept' => '*/*',
    );
    my $doc = download($request);
    my $host_data = decode_json($doc->{content}, context => 'history2019.host-data');
    my $products = check_type($host_data->{hostProducts}, [], context => 'history2019.products');
    my %products;
    for my $product (@{$products}) {
        my $contract_no = match($product->{contractNumber}, qr{[\w/-]+}, context => 'history2019.product.contract-no');
        my $alias = match($product->{contractAlias}, qr{[\w/+=]+}, context => 'history2019.product.alias');
        $products{$contract_no} = $alias;
    }
    $account_no =~ tr/ //d;
    my $product = $products{$account_no};
    if (not defined($product)) {
        no_match($account_no, context => 'history2019.product.for');
    }
    $request = POST(
        "$base_url/Pfm/HistoryApi/GetHostTransactionsSummary",
        @headers,
        'X-Request-Verification-Token' => $login_info->{csrf_token},
        'Accept' => 'application/json, text/plain, */*',
        json_content({
            accountNumber => $product,
            dateFrom => local_midnight_to_utc($start_date),
            dateTo => local_midnight_to_utc($end_date),
            saveFileType => $export,
            operationType => 'ALL000000',
        })
    );
    my $response = simple_download($request);
    # FIXME: The whole file is loaded into memory.
    # Instead, we should read and write it in chunks.
    return $response->content;
}

sub do_future
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        accounts => \my $account_info,
        selection => \my $selection,
        display_name => \my $display_name,
        start_date => [\my $start_date, undef],
        end_date => [\my $end_date, undef],
    );
    my $tabid = get_tabid();
    my @headers_xhr = (
        @header_xhr,
        'X-Tab-Id' => $tabid,
    );
    my $request = GET(
        "$root_url/api/app/setup/data",
        @headers_xhr,
        'Accept' => '*/*',
        'Referer' => "$root_url/dashboard",
    );
    my $doc = download($request);
    my $data = decode_json($doc->{content}, context => 'future.app-setup');
    my $csrf_token = match($data->{antiForgeryToken}, qr{[\w/+=]{20,}}, context => 'future.app-setup.csrf-token');
    @headers_xhr = (
        @headers_xhr,
        'X-Request-Verification-Token' => $csrf_token,
    );
    my @headers = (
        @headers_xhr,
        'Accept' => 'application/json, text/plain, */*',
        'Origin' => $root_url,
        'Referer' => "$root_url/futurepaymentsnew",
    );
    $request = POST(
        "$root_url/api/operations/futureOperations/filters",
        @headers,
        json_content({'accounts' => []}),
    );
    $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'future.filters');
    my $masked_number_re = qr/(\d\d)(\d\d) \Q...\E (\d\d\d\d)/;
    my %filter_accounts;
    my $i = 0;
    for my $account (@{$account_info}) {
        my $filter_account = $json->{filters}->{filterAccounts}[$i];
        my $masked_number = match($filter_account->{maskedNumber}, $masked_number_re, context => 'future.filters.masked.format');
        $masked_number =~ m/\A$masked_number_re\z/
            or die;  ## no critic (Carping)
        match($account->{number}, qr/$1 $2[ \d]+$3/, context => 'future.filters.masked.consistency');
        $filter_accounts{$account->{number}} = $filter_account;
        $i++;
    }
    my $filter_dates = $json->{filters}->{filterPeriod};
    my @dates;
    for my $key (qw(minFrom maxTo defaultFrom defaultTo)) {
        my $date = match_ymd_date($filter_dates->{$key}, time_must_be => 0, context => 'future.filters.dates');
        push @dates, $date;
    }
    my ($min_date, $max_date, $def_start_date, $def_end_date) = @dates;
    debug("min-date = $min_date");
    debug("max-date = $max_date");
    $min_date le $max_date
        or no_match($max_date, context => 'future.filters.min-max-date');
    $def_start_date le $def_end_date
        or no_match($def_end_date, context => 'future.filters.def-start-end-date');
    $min_date le $def_start_date and $def_start_date le $max_date
        or no_match($def_start_date, context => 'future.filters.def-start-date');
    $min_date le $def_end_date and $def_end_date le $max_date
        or no_match($def_end_date, context => 'future.filters.def-end-date');
    $start_date //= $def_start_date;
    if ($start_date lt $min_date) {
        $start_date = $min_date;
    } elsif ($start_date gt $max_date) {
        debug('start-date < max-date');
        # FIXME?
        return;
    }
    $end_date //= $def_end_date;
    debug("start-date = $start_date");
    if ($end_date gt $max_date) {
        $end_date = $max_date;
    } elsif ($end_date lt $min_date) {
        debug('end-date < min-date');
        # FIXME?
        return;
    }
    debug("end-date = $end_date");
    if ($start_date gt $end_date) {
        debug('start-date > end-date');
        # FIXME?
        return;
    }
    my $transfers = $json->{transferInfos};
    my %selected_accounts = select_accounts($account_info, @{$selection})
        or user_error('future: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    while (my ($number, $name) = each %selected_accounts) {
        # FIXME! Looping over the account numbers is wasteful.
        # How to extract account numbers from /futureOperations output?
        my $filter_account = $filter_accounts{$number};
        $json = {
            from => "${start_date}T00:00:00.000",
            to => "${end_date}T00:00:00.000",
            searchFilter => '',
            accountNumbers => [$filter_account],
        };
        $request = POST(
            "$root_url/api/operations/futureOperations",
            @headers,
            json_content($json),
        );
        $doc = download($request);
        $json = decode_json($doc->{content}, context => 'future.json');
        my $transfer_info = $json->{transferInfos}
            // scraping_error('future.transfer');
        for my $transfer (@{$transfer_info}) {
            if ($display_name) {
                print("$name\t");
            }
            my $timestamp = $transfer->{date} // '';
            my $date = timestamp_to_date($timestamp, time_must_be => 0)
                // scraping_error("future.transfer.date: $timestamp");
            my $recipient = match($transfer->{benef}, qr/.+/, context => 'future.transfer.recipient');
            for my $key (qw(benefAddress benefCity)) {
                my $recipient_loc = $transfer->{$key} // '';
                if (length($recipient_loc) > 0) {
                    $recipient .= "; $recipient_loc";
                }
            }
            $recipient = unicode_to_bytes($recipient);
            my $description = match($transfer->{description}, qr/.+/, context => 'future.transfer.description');
            $description = unicode_to_bytes($description);
            my $amount = format_money($transfer->{amount}, $transfer->{currency}, context => 'future.transfer.amount');
            my $type = match($transfer->{transferType}, qr/\w+/, context => 'future.transfer.type');
            print("$date\t$recipient\t$description\t$amount\t$type\n");
        }
    }
    return;
}

sub do_deposits
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/Savings/Deposits/getDepositsList",
        @{$login_info->{headers}},
        @header_accept_json,
        'Content-Type' => 'application/json',
        'Content' => '',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'deposits.json');
    $json = $json->{properties}
        // scraping_error('deposits.properties');
    $json->{footer}->{isListComplete}
        or scraping_error('deposits.incomplete');
    my $deposits = $json->{deposits};
    for my $deposit (@{$deposits}) {
        my $title = match($deposit->{title}, qr/.+/, context => 'deposits.title');
        $title = unicode_to_bytes($title);
        my $type = match($deposit->{type}, qr/.+/, context => 'deposits.type');
        $type = unicode_to_bytes($type);
        my $end_date = $deposit->{endDate} // '';
        $end_date = timestamp_to_date($end_date, time_must_be => 0)
            // scraping_error("deposits.end-date: $end_date");
        my $length = match($deposit->{depositLength}, qr/\d+/, context => 'deposits.length');
        my $start_date = shift_date($end_date, -$length);
        my $duration = match($deposit->{period}, qr/.+/, context => 'deposits.duration');
        $duration = unicode_to_bytes($duration);
        my $interest = $deposit->{interestRate} // '';
        $interest = format_number('%.2f', $interest)
            // scraping_error("deposits.interest: $interest");
        my $amount = $deposit->{startValue} // '';
        my $currency = $deposit->{currency} // '';
        $amount = format_amount($amount, fp => 1, currency => $currency)
            // scraping_error("deposits.amount: $amount $currency");
        # FIXME: the pre-1.0 interface had also “status”
        print("$title\t$type\t$start_date\t$end_date\t$duration\t$interest%\t$amount\n");
    }
    return;
}

sub do_cards
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/Cards/Cards/IndexData",
        @{$login_info->{headers}},
        'Accept' => 'text/html, */*; q=0.01',
        'Content' => '',
    );
    my $doc = download($request);
    my $html = html_new($doc->{content});
    my @e_cards = html_find($html, class => 'card-properties');
    for my $e_card (@e_cards) {
        my $e_name = html_find($e_card, class => 'card-name', context => 'cards.name');
        my $name = $e_name->as_trimmed_text();
        my $e_number = html_find($e_card, class => 'card-number', context => 'cards.number');
        my $number = $e_number->as_trimmed_text();
        my $e_owner = html_find($e_card, class => 'card-owner', context => 'cards.owner');
        my $owner = $e_owner->as_trimmed_text();
        my $e_amount = html_find($e_card, class => 'card-amount', context => 'cards.amount');
        my $amount = $e_amount->as_trimmed_text();
        $amount = format_amount($amount)
            or scraping_error("cards.amount: $amount");
        print("$name\t$number\t$owner\t$amount\n");
    }
    return;
}

sub do_funds
{
    my %options = @_;
    _do_funds(%options, 'type' => 'Normal');
    return;
}

sub do_pension
{
    my %options = @_;
    _do_funds(%options, 'type' => 'ike');
    return;
}

sub _do_funds
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        type => \my $type,
    );
    my $request = POST(
        "$base_url/InvestmentFunds/Dashboard/Dashboard",
        @{$login_info->{headers}},
        'Accept' => 'text/html, */*; q=0.01',
        'Content' => ['type' => $type]
    );
    my $doc = download($request);
    my $html = html_new($doc->{content});
    my @e_funds = html_find($html, class => 'investment-properties');
    for my $e_fund (@e_funds) {
        if (has_html_class($e_fund->parent, 'bestFunds')) {
            next;
        }
        if (has_html_class($e_fund, 'wallet-properties')) {
            next;
        }
        my $e_name = html_find($e_fund, class => 'investment-name-group', context => 'funds.name');
        my $name = $e_name->as_trimmed_text();
        $name = unicode_to_bytes($name);
        my $e_amounts = html_find($e_fund, class => 'investment-actual', context => 'funds.amount');
        my @e_amounts = html_find($e_amounts, tag => 'span');
        my $n_amounts = scalar(@e_amounts);
        ($n_amounts == 1) or ($n_amounts == 2)
            or scraping_error("funds.amount#: expected 1 or 2 instances, got $n_amounts");
        my ($e_current_amount, $e_planned_amount) = @e_amounts;
        my $current_amount_raw = $e_current_amount->as_trimmed_text();
        my $current_amount = format_amount($current_amount_raw)
            or scraping_error("funds.amount.current: $current_amount_raw");
        my $planned_amount = undef;
        if (defined($e_planned_amount)) {
            has_html_class($e_planned_amount, 'gray')
                or scraping_error('funds.amount.planned.gray');
            $planned_amount = $e_planned_amount->as_trimmed_text();
            $planned_amount = format_amount($planned_amount, plus => 1)
                or scraping_error("funds.amount.planned: $planned_amount");
        }
        my $line = "$name\t$current_amount";
        if (defined($planned_amount)) {
            $line .= "\t$planned_amount";
        }
        print("$line\n");
    }
    return;
}

sub do_notices
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/Adv/AdvPlaceholder/GetUpdates",
        @{$login_info->{headers}},
        @header_accept_json,
        json_content({
            placeholderIdList => undef,
            timestamp => -1
        })
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'notices.json');
    my $elements = $json->{Elements}
        // scraping_error('notices.elements');
    for my $element (@{$elements}) {
        my $template_path = $element->{TemplatePath}
            // scraping_error('notices.template-path');
        my $message = $element->{Message}
            // scraping_error('notices.message');
        my $is_hidden = $message->{IsHidden}
            // scraping_error('notices.is-hidden');
        my $is_visible = (
            $template_path =~ m{/MessageBox/|/TopAdmin/}
            and not $is_hidden
        );
        $is_visible or next;
        my $is_read = $message->{IsRead}
            // scraping_error('notices.is-read');
        my $new_flag = $is_read ? '' : 'N';
        my $timestamp = $message->{StartDate};
        my $date = timestamp_to_date($timestamp)
            // scraping_error("notices.date: $timestamp");
        my $title = $message->{Title}
            // scraping_error('notices.title');
        $title = unicode_to_bytes($title);
        print("$new_flag\t$date\t$title\n");
    }
    return;
}

sub do_activate_profile
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        args => \my $args,
    );
    my @args = @{$args};
    scalar(@args) > 0
        or user_error('activate-profile: no profile selected');
    scalar(@args) <= 1
        or user_error('activate-profile: too many arguments');
    my ($name) = @args;
    $name = bytes_to_unicode($name);
    my %profiles = %{$login_info->{profiles}};
    my $sortkey = sub {
        my ($key) = @_;
        $key =~ s{\Apersonal(?:/?|\z)}{\000};
        if ($key eq 'business') {
            $key = "\001";
        }
        return $key;
    };
    if (not exists($profiles{$name})) {
        my $profiles = join(', or ',
            map { "\"$_\"" }
            sort { $sortkey->($a) cmp $sortkey->($b) }
            keys(%profiles)
        );
        $profiles = unicode_to_bytes($profiles);
        user_error("activate-profile: invalid profile name (should be $profiles)");
    }
    my @codes = @{$profiles{$name}};
    if (scalar @codes == 0) {
        user_error("activate-profile: $name profile not available");
    } elsif (scalar @codes > 1) {
        internal_error('activate-profile: ambiguous profile name');
    };
    my ($code) = @codes;
    if ($code eq 'T') {
        # ‘I’ (“individual profile”) is a superset of ‘T’ (“own products”),
        # so let's use the latter:
        $code = 'I';
    }
    debug("activating profile $code...");
    my $request = POST(
        "$base_url/LoginMain/Account/JsonActivateProfile",
        @{$login_info->{headers}},
        'Accept' => '*/*',
        'Content' => ['profileCode' => $code],
    );
    my $doc = download($request);
    # It's tempting to do decode_json() here, but actually,
    # despite the Content-Type, the response is not valid JSON.
    # Yay...
    _do_lazy_logout(login => $login_info);
    return;
}

sub _do_lazy_logout
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/LoginMain/Account/LazyLogout",
        @{$login_info->{headers}},
        @header_accept_json,
        'Content' => '',
        'Content-Type' => 'application/json',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'logout.json');
    $json->{lazy}
        or scraping_error('logout.lazy');
    return;
}

sub do_logout
{
    my %options = @_;
    kwargs(\%options,
        maybe => [\my $maybe, 0],
    );
    my $login_info = do_login(probe => 1);
    if (not defined($login_info)) {
        clear_temp_cookies();
        if ($maybe) {
            return;
        } else {
            user_error('logout: the user was not logged in')
        }
    } else {
        debug('logging out...');
        _do_lazy_logout(login => $login_info);
        my $request = GET(
            "$base_url/LoginMain/Account/Logout",
            'Referer' => $login_info->{url},
        );
        my $response = simple_download($request);
        $response->is_redirect
            or scraping_error('logout.redirect');
        debug('successful logout');
    }
    clear_temp_cookies();
    return;
}

sub do_debug_noop
{
    # Nothing to do!
}

sub do_debug_https_get
{
    my %options = @_;
    kwargs(\%options,
        args => \my $urls,
    );
    my @urls = @{$urls};
    if (not @urls) {
        push(@urls, $base_url);
    }
    for my $url (@urls) {
        my $request = GET($url);
        my $doc = simple_download($request);
        print($doc->content());
    }
    return;
}

sub do_debug_sms_password
{
    my %options = @_;
    kwargs(\%options,
        args => \my $args,
    );
    my ($date, $n, $tries) = @{$args};
    $date //= '';
    my ($y, $m, $d) = $date =~ m/\A(\d\d\d\d)-(\d\d)-(\d\d)\z/
        or user_error("SMS date not in the YYYY-MM-DD format: $date");
    eval {
        Time::Piece->strptime($date, '%Y-%m-%d');
    } or user_error("invalid SMS date: $date");
    $n //= '';
    eval {
        $n >= 1;
    } or user_error("invalid SMS number: $n");
    $tries //= '1';
    eval {
        $tries >= 0;
    } or user_error("invalid number of tries: $tries");
    _ask_for_sms_password($date, $n, 0);
    for my $try (1..$tries) {
        say "(try #$try)";
        say _ask_for_sms_password($date, $n, $try);
    }
    return;
}

sub _make_config_line
{
    my ($key, $value) = @_;
    my $escaped_value = $value;
    if ($value !~ m{\A[/\w.~-]+\z}) {
        $value =~ s/["\\]/\\$1/;
        $value = qq("$value");
    }
    return "$key $value\n";
}

sub _configure_overwrite
{
    my ($term, $config_path) = @_;
    if (-e $config_path) {
        my $overwrite = '';
        until ($overwrite =~ m/\A[yYnN]\z/) {  ## no critic (Until)
            $overwrite = $term->readline(
                unexpand_tilde($config_path) . ' already exists. Overwrite (y/n)? '
            );
            $overwrite //= '';
        }
        if ($overwrite =~ m/[nN]/) {
            user_error();
        }
    }
    return;
}

sub _configure_country
{
    my ($term) = @_;
    my $guessed_cc = guess_country() // '';
    my $cc = '';
    until (exists($country_to_language{$cc})) {  ## no critic (Until)
        my $countries = join(', or ', map { uc } @known_countries);
        $cc = $term->readline("Country ($countries): ", uc($guessed_cc));
        $cc = lc($cc // '');
    }
    return $cc;
}

sub _configure_login
{
    my ($term) = @_;
    my $login = '';
    until (length($login) > 0) {  ## no critic (Until)
        $login = $term->readline('Login: ');
        $login //= '';
    }
    return $login;
}

sub _configure_password
{
    my ($term) = @_;
    my $password = '';
    until (length($password) > 0) {  ## no critic (Until)
        $password = term_readpasswd($term, 'Password: ');
        $password //= '';
    }
    my $use_gpg = '';
    until ($use_gpg =~ m/\A[yYnN]\z/) {  ## no critic (Until)
        $use_gpg = $term->readline('Encrypt password with GnuPG (y/n)? ', 'y');
        $use_gpg //= '';
    }
    $use_gpg = ($use_gpg =~ m/[yY]/);
    my $encrypted_password;
    ENCRYPT: while ($use_gpg) {
        my $password_line = _make_config_line('Password', $password);
        eval {
            require IPC::Run;
            my $secret_keys;
            local $SIG{CHLD} = sub {
                # https://github.com/cpan-authors/IPC-Run/issues/166
                # ("delay after child exit")
            };
            IPC::Run::run(
                [@gpg_cmdline, qw(--batch --list-secret-keys)],
                '>', \$secret_keys,
            );
            if (not scalar($secret_keys)) {
                die(  ## no critic (Carping)
                    "No secret keys in the GnuPG keyring.\n" .
                    "Use \"@gpg_cmdline --gen-key\" to generate a key pair."
                );
            }
            IPC::Run::run(
                [@gpg_cmdline, qw(--armor --encrypt --default-recipient-self)],
                '<', \$password_line,
                '>', \$encrypted_password,
            )
        } or do {
            if ($EVAL_ERROR) {
                my $message = $EVAL_ERROR;
                my $file = __FILE__;
                $message =~ s/ at \Q$file\E line \d+[.]\n+//;
                say {*STDERR} $message;
            }
            my $retry = '';
            until ($retry =~ m/\A[yYnN]\z/) {  ## no critic (Until)
                $retry = $term->readline('GnuPG encryption failed. Retry (y/n)? ');
                $retry //= '';
            }
            if ($retry =~ m/[yY]/) {
                next ENCRYPT;
            } else {
                user_error();
            }
        };
        last ENCRYPT;
    }
    return ($password, $encrypted_password);
}

sub _configure_cookie_jar
{
    my ($term, $login, $default_cookie_jar_path) = @_;
    my $sanitized_login = $login =~ s/\W/_/rg;
    my $xdg_data_home = xdg_data_home();
    my $cookie_home = unexpand_tilde($xdg_data_home) . '/mbank-cli';
    $default_cookie_jar_path //= "$cookie_home/$sanitized_login.cookies";
    my $cookie_jar_path = '';
    until (length($cookie_jar_path) > 1) {  ## no critic (Until)
        $cookie_jar_path = $term->readline(
            'Session cookie store: ',
            $default_cookie_jar_path
        );
        $cookie_jar_path //= '';
    }
    return $cookie_jar_path;
}

sub makedirs
{
    my ($path) = @_;
    eval {
        File::Path::make_path($path);
    } // os_error($EVAL_ERROR);
    return;
}

sub do_configure
{
    my %options = @_;
    kwargs(\%options,
        config_path => \my $config_path,
        cookie_jar_path => [\my $cookie_jar_path, undef],
    );
    my $term = term_new(readpasswd => 1);
    _configure_overwrite($term, $config_path);
    my $cc = _configure_country($term);
    my $login = _configure_login($term);
    my ($password, $encrypted_password) = _configure_password($term);
    $cookie_jar_path = _configure_cookie_jar($term, $login, $cookie_jar_path);
    my $cookie_dir = dirname(expand_tilde($cookie_jar_path));
    if (not -d $cookie_dir) {
        makedirs($cookie_dir);
        print(
            'Created directory for session cookie store: ',
            unexpand_tilde($cookie_dir),
            "\n"
        );
    }
    my $config_dir = dirname($config_path);
    makedirs($config_dir);
    open(my $fh, '>', "$config_path.new")  ## no critic (BriefOpen)
        or os_error("$config_path.new: $ERRNO");
    print {$fh} _make_config_line('CookieJar', $cookie_jar_path);
    print {$fh} _make_config_line('Country', uc($cc));
    print {$fh} _make_config_line('Login', $login);
    if ($encrypted_password) {
        print {$fh} "# Password (encrypted):\n";
        print {$fh} $encrypted_password;
    } else {
        print {$fh} _make_config_line('Password', $password);
    }
    close($fh)
        or os_error("$config_path.new: $ERRNO");
    if (rename($config_path, "$config_path.bak")) {
        print(
            'Backup copy: ',
            unexpand_tilde("$config_path.bak"),
            "\n"
        );
    } elsif ($ERRNO{ENOENT}) {
        # okay
    } else {
        os_error("$config_path: $ERRNO");
    };
    rename("$config_path.new", $config_path)
        or os_error("$config_path: $ERRNO");
    print(
        'Created configuration file: ',
        unexpand_tilde($config_path),
        "\n"
    );
    return;
}

# ============================================
# filesystem; XDG Base Directory Specification
# ============================================

sub expand_tilde
{
    my ($path) = @_;
    $path =~ s{\A(~[^/]*)}{($_) = glob($1); $_}e;
    return $path;
}

sub unexpand_tilde
{
    my ($path) = @_;
    my ($HOME) = <~>;
    $path =~ s{\A\Q$HOME\E/}{~/};
    return $path;
}

sub _xdg_home
{
    my ($key, $default) = @_;
    my $home = $ENV{"XDG_${key}_HOME"} // '';
    if ($home !~ m{\A/}) {
        # “All paths […] must be absolute.
        # If an implementation encounters a relative path […]
        # it should consider the path invalid and ignore it.
        my ($HOME) = <~>;
        $home = "$HOME/$default";
    }
    $home =~ s{[^/]\K/+\z}{};  # strip trailing slashes
    return $home;
}

sub xdg_config_home
{
    return _xdg_home('CONFIG', '.config');
}

sub xdg_data_home
{
    return _xdg_home('DATA', '.local/share');
}

# ============
# main program
# ============

our $VERSION = '2.6.3';

umask(
    umask() | oct('077')
);

my $xdg_config_home = xdg_config_home();
my $opt_config = "$xdg_config_home/mbank-cli/config";
my $opt_cookie_jar = undef;
my $opt_start_date = undef;
my $opt_end_date = undef;
my $opt_with_id = 0;
my $opt_all = 0;
my $opt_multi = 0;
my $opt_export = undef;

sub show_help
{
    print <<'EOF' ;
Usage:
  mbank-cli [list]
  mbank-cli history [--from <start-date> [--to <end-date>]] [--with-id] [--export <format>] {<account> | -M <account>... | -A}
  mbank-cli future [[--from <start-date>] --to <end-date>] {<account> | -M <account>... | -A}
  mbank-cli blocked {<account> | -M <account>... | -A}
  mbank-cli deposits
  mbank-cli funds
  mbank-cli pension
  mbank-cli cards
  mbank-cli notices
  mbank-cli logout
  mbank-cli activate-profile {personal | business | <company-name>}
  mbank-cli register-device [<device-name>]
  mbank-cli configure

Common options:
  --verbose
  --debug <debug-directory>
  --config <config-file>
  --cookie-jar <cookie-jar-file>
  --help
EOF
    exit();
}

sub show_version
{
    say "mbank-cli $VERSION";
    say "+ Perl $PERL_VERSION";
    for my $module (qw(LWP::UserAgent LWP::Protocol::https IO::Socket::SSL Net::SSLeay)) {
        Module::Loaded::is_loaded($module)
            // internal_error("$module not loaded");
        my $version = $module->VERSION // '(no version information)';
        say("+ $module $version");
    }
    if (defined $openssl_version) {
        say("  * OpenSSL $openssl_version");
    }
    exit();
}

sub check_user_date
{
    my ($option, $date) = @_;
    $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
        or user_error("--$option date not in the YYYY-MM-DD format: $date");
    eval {
        Time::Piece->strptime($date, '%Y-%m-%d');
    } or user_error("invalid --$option date: $date");
    return $date;
}

sub check_export_format
{
    my ($option, $format) = @_;
    $format = uc($format);
    my @valid_formats = qw(CSV HTML PDF);
    if (not grep { $format eq $_ } @valid_formats) {  ## no critic (BooleanGrep)
        local $LIST_SEPARATOR = ', ';
        user_error("--$option format not in {@valid_formats}")
    }
    return $format;
}

sub initialize
{
    if (not -e $opt_config) {
        user_error(
            "missing configuration file: $opt_config\n" .
            'Run "mbank-cli configure" or create the configuration file manually.'
        );
    }
    $global_config = read_config($opt_config);
    my $cookie_jar_path;
    if (defined($opt_cookie_jar)) {
        $cookie_jar_path = $opt_cookie_jar;
    } else {
        $cookie_jar_path = get_config_var('cookiejar')
            // config_error('missing cookiejar');
        $cookie_jar_path = expand_tilde($cookie_jar_path);
    }
    debug("cookiejar = $cookie_jar_path");
    my $ca_path = get_config_var('cafile', \undef);
    if (defined($ca_path)) {
        $ca_path = expand_tilde($ca_path);
        if (not -r $ca_path) {
            os_error("$ca_path: $ERRNO");
        }
        debug("cafile = $ca_path");
    };
    my $tld = get_config_var('country')
        // config_error('missing country');
    $tld = lc $tld;
    my $lang = $country_to_language{$tld};
    if (not defined($lang)) {
        local $LIST_SEPARATOR = ', ';
        my $known_countries = "{@known_countries}";
        config_error("unknown country \U$tld\E, not in \U$known_countries\E");
    }
    $mbank_host = "online.mbank.$tld";
    $root_url = "https://$mbank_host";
    $base_url = "https://$mbank_host/$lang";
    $csite_url = "https://$mbank_host/csite";
    $ua = http_init(
        cookie_jar => $cookie_jar_path,
        ca => $ca_path,
    );
    return;
}

sub parse_args
{
    local $SIG{__WARN__} = sub {
        my ($message) = @_;
        $message = lcfirst($message);
        $message =~ s/\n+\z//;
        user_error($message);
    };
    my $debug_dir;
    GetOptions(
        'verbose' => \$opt_verbose,
        'debug=s' => \$debug_dir,
        'debug-interactive' => \$opt_debug_interactive,
        'config=s' => \$opt_config,
        'cookie-jar=s' => \$opt_cookie_jar,
        'from=s' => sub {
            my ($option, $date) = @_;
            $opt_start_date = check_user_date($option, $date);
        },
        'to=s' => sub {
            my ($option, $date) = @_;
            $opt_end_date = check_user_date($option, $date);
        },
        'with-id' => \$opt_with_id,
        'export=s' => sub {
            my ($option, $format) = @_;
            $opt_export = check_export_format($option, $format);
        },
        'M|multiple-accounts' => \$opt_multi,
        'A|all-accounts' => \$opt_all,
        'h|help' => \&show_help,
        'version' => \&show_version,
    ) or user_error();
    if (defined($debug_dir)) {
        if ($debug_dir =~ /\A-/) {
            user_error("suspicious directory name for --debug: $debug_dir");
        }
        makedirs($debug_dir);
    }
    $opt_debug_dir = $debug_dir;
    if (defined($opt_export) and -t STDOUT) {
        user_error('export data cannot be written to a terminal; please redirect stdout to a file');
    }
    return @ARGV;
}

sub main
{
    my ($command_name, @args) = parse_args();
    $command_name //= 'list';
    debug("selected command: $command_name");

    my %commands = (
        'debug-noop' => {},
        'debug-https-get' => { args => 1 },
        'debug-sms-password' => { args => 1 },
        'list' => {},
        'history' => { accounts => 1, dates => 1, ids => 1, export => 1 },
        'history2019' => { accounts => 1, dates => 1, ids => 1, export => 1 },
        'future' => { accounts => 1, dates => 1 },
        'blocked' => { accounts => 1 },
        'deposits' => {},
        'cards' => {},
        'funds' => {},
        'pension' => {},
        'notices' => {},
        'logout' => { login => 0 },
        'register-device' => { login => 0, args => 1 },
        'activate-profile' => { args => 1 },
        'configure' => { login => 0, config => 0 },
    );

    my $command_info = $commands{$command_name};
    if (not defined $command_info) {
        user_error("$command_name: invalid command");
    }
    my $command;
    {
        my $sub_name = "do_$command_name";
        $sub_name =~ y/-/_/;
        $command = $::{$sub_name};
    }
    my $need_login = $command_info->{login} // 1;
    my @cmd_options;
    if ($command_name =~ m/^debug-/) {
        $need_login = 0;
    }
    if ($command_info->{config} // 1) {
        initialize();
    } else {
        push(@cmd_options,
            config_path => $opt_config,
            cookie_jar_path => $opt_cookie_jar,
        );
    }
    if ($command_info->{todo} ) {
        user_error("$command_name: command not implemented");
    }
    if ($command_info->{accounts}) {
        my @selection = @args;
        if ($opt_all) {
            @selection = '*';
        }
        if (scalar(@selection) < 1) {
            user_error("$command_name: no account selected");
        }
        push(@cmd_options,
            selection => [@selection],
            display_name => $opt_all || $opt_multi,
        );
    }
    if ($command_info->{args}) {
        push(@cmd_options,
            args => [@args],
        );
    }
    if ($need_login) {
        my $login_info = do_login();
        push(@cmd_options, login => $login_info);
        if ($command_info->{accounts}) {
            my $account_info = do_list(
                login => $login_info,
                quiet => 1,
            );
            push(@cmd_options, accounts => $account_info);
        }
    }
    if ($command_info->{dates}) {
        push(@cmd_options,
            start_date => $opt_start_date,
            end_date => $opt_end_date,
        );
    }
    if ($command_info->{ids}) {
        push(@cmd_options,
            display_id => $opt_with_id,
        );
    }
    if ($command_info->{export}) {
        push(@cmd_options, export => $opt_export);
    }
    $command->(@cmd_options);
    return;
}

if (not defined(caller)) {
    main()
}

END {
    # catch write errors:
    local $ERRNO = 0;
    close(STDOUT) or os_error("stdout: $ERRNO");
    close(STDERR) or os_error("stderr: $ERRNO");
}

END {
    # save cookies:
    if (defined($ua)) {
        my $cookie_jar_path = $ua->cookie_jar->{file};
        eval {
            $ua->cookie_jar->save();
            1;
        } // os_error("$cookie_jar_path: $ERRNO");
    }
}

1;

# vim:ts=4 sts=4 sw=4 et
