#  Copyright 2018 - present MongoDB, Inc.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#  http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.
use strict;
use warnings;
use Test::More 0.96;
use Test::Fatal;
use Test::Deep qw/!blessed/;
use UUID::URandom qw/create_uuid/;
use boolean;
use utf8;
use Tie::IxHash;
use MongoDB;
use MongoDB::Error;
use lib "t/lib";
use MongoDBTest qw/
    build_client
    skip_unless_mongod
    skip_unless_sessions
    get_test_db
    server_version
    server_type
    clear_testdbs
    get_unique_collection
    uuid_to_string
/;
skip_unless_mongod();
skip_unless_sessions();
my @events;
sub clear_events { @events = () }
sub event_count { scalar @events }
sub event_cb { push @events, $_[0] }
my $conn           = build_client(
    monitoring_callback => \&event_cb,
);
my $testdb         = get_test_db($conn);
my $server_version = server_version($conn);
my $server_type    = server_type($conn);
my $coll           = $testdb->get_collection('test_collection');
subtest 'endSession closes sessions on server' => sub {
    my $session_count = 10;
    my @sessions;
    # for checking later that they've all been culled
    my %session_ids;
    # create all the sessions early so we end up with different ID's for each
    # of them instead of re-using the same session ID for multiple from the
    # pool
    for ( 0 .. $session_count - 1 ) {
        my $session = $conn->start_session;
        $session_ids{ uuid_to_string( $session->_server_session->session_id->{id}->data ) } = 1;
        push @sessions, $session;
    }
    for my $i ( 0 .. $session_count - 1 ) {
        $coll->insert_one( { '_id' => $i + 1 }, { session => $sessions[$i] } );
    }
    $_->end_session for @sessions;
    my $s_count = count_sessions_in_hash (
        [ map { $_->session_id } @{ $conn->_server_session_pool->_server_session_pool } ],
        \%session_ids,
    );
    is $s_count, $session_count, 'All sessions in pool';
    # called in destruction of client normally
    $conn->_server_session_pool->end_all_sessions;
    my $response = $events[-1];
    is $response->{reply}->{ok}, 1, 'Got ok 1 from ending all sessions';
};
subtest 'expiry of old sessions on retire' => sub {
    my $session_count = 10;
    my @sessions;
    my %session_ids;
    for ( 0 .. $session_count - 1 ) {
        my $session = $conn->start_session;
        $session_ids{ uuid_to_string( $session->_server_session->session_id->{id}->data ) } = 1;
        push @sessions, $session;
    }
    is scalar( keys %session_ids ), $session_count, 'got enough unique sessions';
    for my $i ( 0 .. $session_count - 1 ) {
        # force last used to actually be set
        $sessions[$i]->_server_session->update_last_use;
        $sessions[$i]->end_session;
    }
    my $before_retire_count = count_sessions_in_hash (
        [ map { $_->session_id } @{ $conn->_server_session_pool->_server_session_pool } ],
        \%session_ids,
    );
    is $before_retire_count, $session_count, 'All sessions in pool';
    my @to_reorganise;
    # find all sessions to modify
    for my $i ( 0 .. $#{ $conn->_server_session_pool->_server_session_pool } ) {
        my $uuid = uuid_to_string( $conn->_server_session_pool->_server_session_pool->[$i]->session_id->{id}->data );
        if ( $session_ids{ $uuid } ) {
            push @to_reorganise, $i;
        }
    }
    # reverse sort array, so that we move the furthest in the list first
    @to_reorganise = sort { $b <=> $a } @to_reorganise;
    # modify and move all known sessions from highest index to lowest
    for my $i ( @to_reorganise ) {
        my $move_sess = splice @{ $conn->_server_session_pool->_server_session_pool }, $i, 1;
        $move_sess->_set_last_use( $move_sess->last_use - ( 40 * 60 ) );
        # send this session to the end of the array
        push @{ $conn->_server_session_pool->_server_session_pool }, $move_sess;
    }
    my $new_session = $conn->start_session;
    # this should trigger a retiring of sessions from the back of the pool
    $new_session->end_session;
    my $after_retire_count = count_sessions_in_hash (
        [ map { $_->session_id } @{ $conn->_server_session_pool->_server_session_pool } ],
        \%session_ids,
    );
    is $after_retire_count, 0, 'All sessions retired from pool';
};
sub count_sessions_in_hash {
    my ( $sessions, $session_ids ) = @_;
    my $s_count = 0;
    for my $session ( @$sessions ) {
        my $s_uuid = uuid_to_string ( $session->{id}->data );
        if ( exists $session_ids->{ $s_uuid } ) {
            $s_count++;
        }
    }
    return $s_count;
}
clear_testdbs;
done_testing;