package Lemonldap::NG::Common::CliSessions;

use strict;
use Mouse;
use JSON;
use Lemonldap::NG::Common::Conf;
use Lemonldap::NG::Common::Logger::Std;
use Lemonldap::NG::Common::Apache::Session;
use Lemonldap::NG::Common::Session;
use Lemonldap::NG::Common::Util qw/getPSessionID genId2F/;

use constant BACKENDS       => qw(global persistent oidc saml cas);
use constant ISREFRESHTOKEN => '_type=refresh_token';

our $VERSION = '2.22.0';

has opts => ( is => 'rw' );

has stdout => (
    is      => 'ro',
    default => *STDOUT,
);

has stderr => (
    is      => 'ro',
    default => *STDERR,
);

has conf => (
    is      => 'ro',
    default => sub {
        my $ca = Lemonldap::NG::Common::Conf->new( { (
                    ref $_[0] && $_[0]->{iniFile}
                    ? ( confFile => $_[0]->{iniFile} )
                    : ()
                )
            }
        );
        die $Lemonldap::NG::Common::Conf::msg unless ($ca);
        my $res       = $ca->getConf('all');
        my $localConf = $ca->getLocalConf( 'all', $_[0]->{iniFile} );
        return { %$res, %$localConf };
    },
);

sub _to_json {
    my $self = shift;
    my $obj  = shift;
    return to_json( $obj, { pretty => 1, canonical => 1 } );
}

sub _search {
    my ($self) = shift;
    my $backendStorage =
      ( lc( $self->opts->{backend} || 'global' ) ) . "Storage";

    # Handle --persistent
    if ( $self->opts->{persistent} ) {
        $backendStorage = "persistentStorage";
    }
    elsif ( $self->opts->{refreshTokens} ) {
        $backendStorage = "oidcStorage";
        $self->opts->{where} ||= ISREFRESHTOKEN;
    }

    unless ( $self->conf->{$backendStorage} ) {
        print STDERR "Backend "
          . $self->opts->{backend}
          . " was not found, falling back to global\n";
        $backendStorage = "globalStorage";
    }

    my $args = $self->conf->{"${backendStorage}Options"};
    $args->{backend} = $self->conf->{$backendStorage};

    my @fields = @{ $self->opts->{select} || [] };
    if ( $self->opts->{idonly} ) {
        @fields = ('_session_id');
    }

    my $res;
    if ( $self->opts->{where} ) {

        # TODO fix regexp?
        if ( $self->opts->{where} =~ /^(\w+)\s*=\s*(.*)/ ) {
            my ( $selectField, $value ) = ( $1, $2 );
            $res = Lemonldap::NG::Common::Apache::Session->searchOn( $args,
                $selectField, $value, @fields );
        }
        elsif ( $self->opts->{where} =~ /^(\w+)\s*<\s*(.*)/ ) {
            $res = Lemonldap::NG::Common::Apache::Session->searchLt( $args,
                $1, $2, @fields );
        }
        elsif ( $self->opts->{where} =~ /^(\w+)\s*>\s*(.*)/ ) {
            $res = Lemonldap::NG::Common::Apache::Session->searchGt( $args,
                $1, $2, @fields );
        }
        else {
            die "Invalid --where option : " . $self->opts->{where};
        }
    }
    else {
        $res =
          Lemonldap::NG::Common::Apache::Session->get_key_from_all_sessions(
            $args, ( @fields ? [@fields] : () ) );
    }

    if (    $self->opts->{refreshTokens}
        and $self->opts->{where} ne ISREFRESHTOKEN )
    {
        foreach my $key (%$res) {
            delete $res->{$key}
              unless $res->{$key}->{_type}
              and $res->{$key}->{_type} eq 'refresh_token';
        }
    }

    return $res;
}

sub search {
    my ($self) = shift;
    my $res    = $self->_search();
    my $o      = $self->stdout;
    if ( $self->opts->{count} ) {
        my @tmp = keys %$res;
        print $o scalar(@tmp) . "\n";
    }
    else {
        if ( $self->opts->{idonly} ) {
            print $o map { $res->{$_}->{_session_id} . "\n" } keys %{$res};
        }
        else {
            print $o $self->_to_json( [ values %{$res} ] );
        }
    }
    return 0;

}

sub backup {
    my $self = shift;
    my $res  = {};
    if ( $self->opts->{persistent} ) {
        $res->{persistent} = $self->_search();
    }
    elsif ( $self->opts->{refreshTokens} ) {
        $res->{oidc} = $self->_search();
    }
    else {
        foreach my $backend (BACKENDS) {
            next unless $self->conf->{"${backend}Storage"};
            $self->opts->{backend} = $backend;
            my $_res = $self->_search();
            $res->{$backend} = $_res;
        }
    }
    my $o = $self->stdout;
    print $o to_json($res);
    return 0;
}

sub restore {
    my $self = shift;
    my $obj;
    {
        local $/ = undef;
        my $i = *STDIN;
        if (@_) {
            open( $i, '<', "$_[0]" ) or die $!;
        }
        while (<$i>) {
            $obj .= $_;
        }
    }
    eval {
        $obj = from_json($obj);
        no warnings;
        %$obj;
    };
    if ($@) {
        print STDERR "Given backup file looks bad: $@\n";
        return 1;
    }
    foreach my $backend ( keys %$obj ) {
        unless ( grep { $backend eq $_ } BACKENDS ) {
            print STDERR
              "Given backup file looks bad: unknpwn backend $backend\n";
        }
        $self->opts->{backend} = $backend;
        foreach my $_session_id ( keys %{ $obj->{$backend} } ) {
            $self->_insert( $_session_id, $obj->{$backend}->{$_session_id} );
        }
    }
    return 0;
}

sub _insert {
    my ( $self, $id, $content ) = @_;
    $id = id2storage($id) if $id and $self->opts->{hash};

    # Lookup backend storage from CLI options
    my $backendStorage =
      ( lc( $self->opts->{backend} || 'global' ) ) . "Storage";

    my $as = Lemonldap::NG::Common::Session->new( {
            hashStore            => 0,
            storageModule        => $self->conf->{$backendStorage},
            storageModuleOptions => $self->conf->{"${backendStorage}Options"},
            id                   => $id,
            force                => 1,
            info                 => $content,
        }
    );
    print STDERR "Unable to restore session $id in backend "
      . $self->opts->{backend} . "\n"
      unless $as;
    return $as;
}

# Returns the session object, so we can modify it
sub _get_one_session {
    my ( $self, $id, $backend ) = @_;

    $id = id2storage($id) if $id and $self->opts->{hash};

    # Lookup backend storage from CLI options
    my $backendStorage =
      ( lc( $self->opts->{backend} || 'global' ) ) . "Storage";

    # allow argument to overwrite the backend
    if ($backend) {
        $backendStorage = $backend . "Storage";
    }

    # Handle --persistent
    elsif ( $self->opts->{persistent} ) {
        $backendStorage = "persistentStorage";
        $id             = getPSessionID($id);
    }
    elsif ( $self->opts->{refreshTokens} ) {
        $backendStorage = "oidcStorage";
    }

    # In any case, fall back to global storage if we couldn't find the backend
    unless ( $self->conf->{$backendStorage} ) {
        print STDERR "Backend "
          . $self->opts->{backend}
          . " was not found, falling back to global\n";
        $backendStorage = "globalStorage";
    }

    my $as = Lemonldap::NG::Common::Session->new( {
            hashStore            => 0,
            storageModule        => $self->conf->{$backendStorage},
            storageModuleOptions => $self->conf->{"${backendStorage}Options"},
            id                   => $id,
        }
    );

    if ( $as->error ) {
        my $e = $self->stderr;
        print $e $as->error;
        return undef;
    }
    else {
        return $as;
    }
}

# Returns only session data
sub _get_one_data {
    my ( $self, $id ) = @_;
    my $as = $self->_get_one_session($id);
    if ($as) {
        my $new;

        # Filter
        if (    ( ref( $self->opts->{select} ) eq 'ARRAY' )
            and ( scalar @{ $self->opts->{select} } > 0 ) )
        {
            for ( @{ $self->opts->{select} } ) {
                $new->{$_} = $as->data->{$_} if defined $as->data->{$_};
            }
        }
        else {
            $new = $as->data;
        }
        return $new;
    }
    return undef;
}

sub delete {
    my ($self) = shift;
    my $result = 0;
    my @sessions;

    # Run search if a where option was provided
    if ( $self->opts->{where} ) {
        my $res = $self->_search();
        @sessions = keys %{$res};
    }
    else {
        @sessions = @_;
    }

    my @result;
    for my $id (@sessions) {
        my $as = $self->_get_one_session($id);
        if ($as) {
            unless ( $as->remove ) {
                my $e = $self->stderr;
                print $e $as->error;
                $result = 1;
            }
        }
    }
    return $result;
}

sub get {
    my $self = shift;
    my $o    = $self->stdout;

    my @result;
    for my $id (@_) {
        my $new = $self->_get_one_data($id);
        push @result, $new if $new;
    }
    print $o $self->_to_json( \@result );
    return 0;
}

sub _get_psession {
    my ( $self, $uid ) = @_;
    my $psession_id = getPSessionID($uid);
    my $res         = $self->_get_one_session( $psession_id, 'persistent' );
    die "Could not get psession for user $uid" unless $res;
    return $res;
}

sub _get_psession_data {
    my ( $self, $uid ) = @_;
    my $ps = $self->_get_psession($uid);
    return $ps->data;
}

# This method takes a special psession key (oidcConsents, 2fDevices..)
# and returns the expected JSON object
# idBuilder is a sub that gets applied to every object in the array, yielding the key of
# this object in the resulting hash
sub _get_psession_special {
    my ( $self, $target, $keyName, $idBuilder ) = @_;
    my $psession = $self->_get_psession_data($target);
    my $res      = {};
    my $special  = $psession->{$keyName} || "[]";
    $special = from_json($special);
    die "Expecting JSON array in $keyName" unless ref($special) eq "ARRAY";
    for my $item ( @{$special} ) {
        my $id = $idBuilder->($item);
        $res->{$id} = $item;
    }
    return $res;
}

# This method deletes all matching items from an array psession key (oidcConsents, 2fDevices..)
# keyBuilder is a sub that gets applied to every object in the array, yielding the value to be
# compared against
sub _del_psession_special {
    my ( $self, $target, $specialKeyName, $itemKeyBuilder, @todelete ) = @_;
    my $psession = $self->_get_psession($target);
    my $data     = $psession->data;
    my $deleted  = 0;

    my $special = $data->{$specialKeyName} || "[]";
    $special = from_json($special);

    die "Expecting JSON array in $specialKeyName"
      unless ref($special) eq "ARRAY";

    my @new;
    for my $item ( @{$special} ) {
        my $id = $itemKeyBuilder->($item);
        if ( $id and grep { $_ eq $id } @todelete ) {
            $deleted = $deleted + 1;
        }
        else {
            push @new, $item;
        }
    }
    if ($deleted) {
        $data->{$specialKeyName} = to_json( [@new] );
    }

    # TODO should this be in the if???
    $psession->update($data);
}

sub _migrateu2f_device {
    my ( $self, $device ) = @_;

    my $credential_id = $device->{_keyHandle};
    my $_userKey      = $device->{_userKey};

    eval { require Authen::WebAuthn };
    if ($@) {
        die "Missing Authen::WebAuthn dependency: $@";
    }

    my $credential_pubkey =
      Authen::WebAuthn::convert_raw_ecc_to_cose($_userKey);

    return {
        type                 => "WebAuthn",
        name                 => "$device->{name}",
        _credentialId        => "$credential_id",
        _credentialPublicKey => "$credential_pubkey",
        _signCount           => 0,
        epoch                => "$device->{epoch}",
    };
}

sub _migrateu2f {
    my $self   = shift;
    my $target = shift;

    my $psession = $self->_get_psession($target);
    my $data     = $psession->data;
    my $migrated = 0;

    my $_2fDevices = $data->{_2fDevices} || "[]";
    $_2fDevices = from_json($_2fDevices);

    die "Expecting JSON array in _2fDevices"
      unless ref($_2fDevices) eq "ARRAY";

    my @new_2fDevices = @{$_2fDevices};
    my @u2f_devices   = grep { $_->{type} eq "U2F" } @{$_2fDevices};

    my %migrated_devices;
    for my $u2f_device (@u2f_devices) {
        my $migrated_device = $self->_migrateu2f_device($u2f_device);
        $migrated_devices{ $migrated_device->{_credentialId} } =
          $migrated_device;
    }

    for my $migrated_device ( keys %migrated_devices ) {

        # If credentialId is not already present
        unless (
            grep {
                      $_->{type} eq "WebAuthn"
                  and $_->{_credentialId} eq $migrated_device
            } @new_2fDevices
          )
        {
            push @new_2fDevices, $migrated_devices{$migrated_device};
            $migrated = 1;
        }
    }

    if ($migrated) {
        $data->{_2fDevices} = to_json( [@new_2fDevices] );
        $psession->update($data);
    }

}

sub consents_get {
    my $self   = shift;
    my $target = shift;
    return 0 unless $target;

    my $o        = $self->stdout;
    my $consents = $self->_get_psession_special( $target, '_oidcConsents',
        sub { $_[0]->{rp} } );
    print $o $self->_to_json($consents);
    return 0;
}

sub secondfactors_get {
    my $self   = shift;
    my $target = shift;
    return 0 unless $target;

    my $o        = $self->stdout;
    my $consents = $self->_get_psession_special( $target, '_2fDevices',
        sub { genId2F( $_[0] ) } );
    print $o $self->_to_json($consents);
    return 0;
}

sub consents_delete {
    my $self   = shift;
    my $target = shift;
    return 0 unless $target;

    my @ids = @_;
    return 0 unless @ids;

    $self->_del_psession_special( $target, '_oidcConsents',
        sub { $_[0]->{rp} }, @ids );
    return 0;
}

sub secondfactors_delete {
    my $self   = shift;
    my $target = shift;
    return 0 unless $target;

    my @ids = @_;
    return 0 unless @ids;
    $self->_del_psession_special( $target, '_2fDevices',
        sub { genId2F( $_[0] ) }, @ids );
    return 0;
}

sub _get_psession_targets {
    my ( $self, @args ) = @_;

    if ( $self->opts->{where} or $self->opts->{all} ) {
        $self->opts->{persistent} = 1;

        if ( $self->opts->{all} ) {
            delete $self->opts->{where};
        }

        my $res = $self->_search();
        return ( map { $res->{$_}->{_session_uid} } keys %{$res} );
    }
    else {
        return @args;
    }
}

sub secondfactors_delType {
    my $self = shift;

    my $target;
    unless ( $self->opts->{where} or $self->opts->{all} ) {
        $target = shift;
    }

    my @types = @_;
    return 0 unless @types;

    my @targets = $self->_get_psession_targets($target);
    for my $target (@targets) {
        $self->_del_psession_special( $target, '_2fDevices',
            sub { $_[0]->{type} }, @types );
    }

    return 0;
}

sub secondfactors_migrateu2f {
    my ( $self, @ids ) = @_;
    my $result   = 0;
    my @sessions = $self->_get_psession_targets(@ids);

    for my $id (@sessions) {
        if ( !$self->_migrateu2f($id) ) {
            $result = 1;
        }
    }
    return $result;
}

sub setKey {
    my $self = shift;
    my $id   = shift;
    die "Unever number of arguments" unless ( @_ % 2 ) == 0;
    my %newvalues = (@_);
    die "Session ID and new values not provided" unless $id and %newvalues;

    my $as = $self->_get_one_session($id);
    die unless $as;

    my $data = $as->data;

    for ( keys %newvalues ) {
        $data->{$_} = $newvalues{$_};
    }

    $as->update($data);
    return 0;
}

sub delKey {
    my $self     = shift;
    my $id       = shift;
    my @todelete = @_;
    die "Session ID and key names not provided" unless $id and @todelete;

    my $as = $self->_get_one_session($id);
    die unless $as;

    my $data = $as->data;

    for (@todelete) {

        # Weird, I know. But that's how
        # Lemonldap::NG::Common::Session::update works
        $data->{$_} = undef;
    }

    $as->update($data);
    return 0;
}

sub run {
    my $self   = shift;
    my $action = shift;
    my $opts   = shift;

    unless ( ref $self ) {
        $self = $self->new;
    }
    unless ($action) {
        die 'nothing to do, aborting';
    }
    $self->opts($opts);

    # Simple commands
    if ( $action =~ /^(?:get|search|delete|setKey|delKey|backup|restore)$/ ) {
        return $self->$action(@_);
    }

    # Subcommands and target
    elsif ( $action =~ /^(?:secondfactors|consents)$/ ) {
        my $subcommand = shift;
        unless ($subcommand) {
            die "Missing subcommand $action";
        }
        my $func = "${action}_${subcommand}";
        if ( $self->can($func) ) {
            return $self->$func(@_);
        }
        else {
            die "Unknown subcommand $subcommand for action $action";
        }
    }
    else {
        die "unknown action $action. Only get or search are allowed";
    }
}

1;
