use strict;
use warnings;
use English qw(-no_match_vars);
use FindBin qw($Bin);
use lib "$Bin/mock_libs";
use Apache2::RequestRec;    # from mocks
use Apache2::Const -compile => qw( OK HTTP_FORBIDDEN );
use Crypt::CBC;                   # from mocks
use Digest::MD5 qw( md5_hex );    # from mocks
use Digest::SHA;
use Data::Dumper;
use Mock::Tieable;

use Test::More tests => 71;

use constant CLASS_UNDER_TEST => 'Apache2::AuthCookieDBI';
use constant EMPTY_STRING     => q{};
use constant TRUE             => 1;

use_ok(CLASS_UNDER_TEST);
test_authen_cred();
test_check_password();
test_defined_or_empty();
test_decrypt_session_key();
test_encrypt_session_key();
test_dir_config_var();
test_authen_ses_key();
test_get_cipher_for_type();
test_group();
test__dbi_connect();
test_get_crypted_password();
test_user_is_active();
test__get_new_session();

exit;

sub set_up {
    my $auth_name   = shift;
    my $mock_config = shift || _mock_config_for_auth_name($auth_name);
    my $r           = Apache2::RequestRec->new(
        auth_name   => $auth_name,
        mock_config => $mock_config
    );    # from mock_libs
    return $r;
}

sub _mock_config_for_auth_name {
    my ($auth_name) = @_;
    my %mock_config = (
        "${auth_name}DBI_DSN"             => 'test_DBI_DSN',
        "${auth_name}DBI_User"            => 'test_DBI_User',
        "${auth_name}DBI_Password"        => 'test_DBI_Password',
        "${auth_name}DBI_SecretKey"       => 'test_DBI_SecretKey',
        "${auth_name}DBI_PasswordField"   => 'test_DBI_PasswordField',
        "${auth_name}DBI_UsersTable"      => 'test_DBI_Userstable',
        "${auth_name}DBI_UserField"       => 'test_DBI_UserField',
        "${auth_name}DBI_UserActiveField" => EMPTY_STRING,
    );
    return \%mock_config;
}

sub test_authen_cred {
    my $auth_name   = 'testing_authen_cred';
    my $secret_key  = 'test secret key';
    my $mock_config = {
        $auth_name . 'DBI_DSN'             => 'test DSN',
        $auth_name . 'DBI_SecretKey'       => $secret_key,
        $auth_name . 'DBI_User'            => $auth_name,
        $auth_name . 'DBI_Password'        => 'test DBI password',
        $auth_name . 'DBI_UsersTable'      => 'users',
        $auth_name . 'DBI_UserField'       => 'user',
        $auth_name . 'DBI_passwordfield'   => 'password',
        $auth_name . 'DBI_crypttype'       => 'none',
        $auth_name . 'DBI_groupstable'     => 'groups',
        $auth_name . 'DBI_groupfield'      => 'grp',
        $auth_name . 'DBI_groupuserfield'  => 'user',
        $auth_name . 'DBI_encryptiontype'  => 'none',
        $auth_name . 'DBI_sessionlifetime' => '00-24-00-00',
        $auth_name . 'DBI_sessionmodule'   => 'none',
    };
    my $r             = set_up( $auth_name, $mock_config );
    my $empty_user    = EMPTY_STRING;
    my $test_password = 'test password';
    my @extra_data    = qw(extra_1 extra_2);
    my $got_session_key
        = CLASS_UNDER_TEST->authen_cred( $r, $empty_user, $test_password,
        @extra_data );
    Test::More::is( $got_session_key, undef,
        'authen_cred returns undef when user is an empty string.' );

    my $test_user      = 'username';
    my $empty_password = EMPTY_STRING;
    $got_session_key
        = CLASS_UNDER_TEST->authen_cred( $r, $test_user, $empty_password,
        @extra_data );
    Test::More::is( $got_session_key, undef,
        'authen_cred returns undef when password is an empty string.' );

    $r = set_up( $auth_name, $mock_config );
    {
        my $stub_get_crypted_password = sub { return $test_password };
        no warnings qw(redefine);
        local *Apache2::AuthCookieDBI::_get_crypted_password
            = $stub_get_crypted_password;
        $got_session_key
            = CLASS_UNDER_TEST->authen_cred( $r, $test_user, $test_password,
            @extra_data );
    }
    Test::More::like(
        $got_session_key,
        qr/\A ${test_user}:/x,
        'authen_cred returns session key starting with username when all OK.'
        )
        || Test::More::diag( 'Mock request object contains: ',
        Data::Dumper::Dumper($r) );
}

sub test_authen_ses_key {
    my $auth_name   = 'testing_authen_ses_key';
    my $secret_key  = 'test secret key';
    my $mock_config = {
        $auth_name . 'DBI_DSN'             => 'test DSN',
        $auth_name . 'DBI_SecretKey'       => $secret_key,
        $auth_name . 'DBI_User'            => $auth_name,
        $auth_name . 'DBI_Password'        => 'test DBI password',
        $auth_name . 'DBI_UsersTable'      => 'users',
        $auth_name . 'DBI_UserField'       => 'user',
        $auth_name . 'DBI_passwordfield'   => 'password',
        $auth_name . 'DBI_crypttype'       => 'none',
        $auth_name . 'DBI_groupstable'     => 'groups',
        $auth_name . 'DBI_groupfield'      => 'grp',
        $auth_name . 'DBI_groupuserfield'  => 'user',
        $auth_name . 'DBI_encryptiontype'  => 'none',
        $auth_name . 'DBI_sessionlifetime' => '00-24-00-00',
        $auth_name . 'DBI_sessionmodule'   => 'Mock::Tieable',
    };
    my $r                  = set_up( $auth_name, $mock_config );
    my $expected_user      = 'expected_username';
    my $issue_time         = '2006-02-04-10-34-23';
    my $expire_time        = '9999-02-04-10-45-00';
    my $session_id         = 'test_session_id';
    my $extra_session_info = 'extra:info';
    my $hashed_string = 'bad-key-stored-in-ticket';   # not a 32 char hex string
    my $encrypted_session_key = join( q{:},
        $expected_user, $issue_time, $expire_time,
        $session_id,    $hashed_string );

    CLASS_UNDER_TEST->authen_ses_key( $r, $encrypted_session_key );
    like(
        $r->log->error->[-1],
        qr/ bad \s encrypted \s session_key /xm,
        'authen_ses_key() on bad encrypted key'
    ) || Test::More::diag( '$r contains: ', Data::Dumper::Dumper($r) );

    $r = set_up( $auth_name, $mock_config );

    my $seperator   = q{:};
    my $public_part = join( $seperator,
        $expected_user, $issue_time, $expire_time,
        $session_id,    $extra_session_info );

    my $plaintext_key = join( $seperator, $public_part, $secret_key );

    my $md5_hash = md5_hex($plaintext_key);

    $hashed_string = md5_hex( join( $seperator, $secret_key, $md5_hash ) );

    $encrypted_session_key = join( q{:}, $public_part, $hashed_string );

    my $got_user
        = CLASS_UNDER_TEST->authen_ses_key( $r, $encrypted_session_key )
        ;
    is( $got_user, $expected_user, 'authen_ses_key() on plaintext key' )
        || diag join( "\n", @{ $r->log->error() } );

    $mock_config->{ $auth_name . 'DBI_sessionmodule' } = 'Missing::Class';
    $r = set_up( $auth_name, $mock_config );
    $got_user = CLASS_UNDER_TEST->authen_ses_key( $r, $encrypted_session_key );
    Test::More::ok( !$got_user,
        'authen_ses_key() returns false on failure to tie session.' )
        || Test::More::diag("Expected a false value, got: '$got_user'");
    my $class = CLASS_UNDER_TEST;
    Test::More::like(
        $r->log->error->[0],
        qr/${class}\tfailed to tie session hash/,
        'authen_ses_key() logs failure to tie session hash.'
    );
    return TRUE;
}

sub test_check_password {
    test_check_password_digest_none();
    test_check_password_digest_crypt();
    test_check_password_digest_md5();
    test_check_password_digest_sha256();
     test_check_password_digest_sha384();
      test_check_password_digest_sha512();
    return TRUE;
}

sub test_check_password_digest_none {
    my $plaintext_password = 'plaintext password';

    Test::More::ok(
        !CLASS_UNDER_TEST->_check_password(
            $plaintext_password, undef, 'any'
        ),
        '_check_password() return false when encrypted password is undef'
    );
    Test::More::ok(
        CLASS_UNDER_TEST->_check_password(
            $plaintext_password, $plaintext_password, 'none'
        ),
        '_check_password() success case with no encryption'
    );

    Test::More::ok(
        !CLASS_UNDER_TEST->_check_password(
            $plaintext_password, 'no match', 'none'
        ),
        '_check_password() failure case with no encryption'
    );

    return TRUE;
}

sub test_check_password_digest_crypt {
    my $plaintext_password = 'plaintext password';
    my $salt = join('',
        (('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
    my $crypted_password = crypt( $plaintext_password, $salt );
    Test::More::ok(
        CLASS_UNDER_TEST->_check_password(
            $plaintext_password, $crypted_password, 'crypt'
        ),
        '_check_password() success case with crypt'
    );

    Test::More::ok(
        !CLASS_UNDER_TEST->_check_password(
            $plaintext_password, 'no match', 'crypt'
        ),
        '_check_password() failure case with crypt'
    );

    return TRUE;
}

sub test_check_password_digest_md5 {
    my $plaintext_password = 'plaintext password';
    my $md5_encrypted      = Digest::MD5::md5_hex($plaintext_password);
    Test::More::ok(
        CLASS_UNDER_TEST->_check_password(
            $plaintext_password, $md5_encrypted, 'md5'
        ),
        '_check_password() success case with md5 encryption'
    );

    Test::More::ok(
        !CLASS_UNDER_TEST->_check_password(
            $plaintext_password, 'no match', 'md5'
        ),
        '_check_password() failure case with md5 encryption'
    );

    return TRUE;
}

sub test_check_password_digest_sha256 {
    my $plaintext_password   = 'plaintext password';
    my $sha256_hex_encrypted = Digest::SHA::sha256_hex($plaintext_password);
    Test::More::ok(
        CLASS_UNDER_TEST->_check_password(
            $plaintext_password, $sha256_hex_encrypted, 'sha256'
        ),
        '_check_password() success case with sha256 encryption'
    );

    Test::More::ok(
        !CLASS_UNDER_TEST->_check_password(
            $plaintext_password, 'no match', 'sha256'
        ),
        '_check_password() failure case with sha256 encryption'
    );

    return TRUE;
}

sub test_check_password_digest_sha384 {
    my $plaintext_password   = 'plaintext password';
    my $sha384_hex_encrypted = Digest::SHA::sha384_hex($plaintext_password);
    Test::More::ok(
        CLASS_UNDER_TEST->_check_password(
            $plaintext_password, $sha384_hex_encrypted, 'sha384'
        ),
        '_check_password() success case with sha384 encryption'
    );

    Test::More::ok(
        !CLASS_UNDER_TEST->_check_password(
            $plaintext_password, 'no match', 'sha384'
        ),
        '_check_password() failure case with sha384 encryption'
    );

    return TRUE;
}

sub test_check_password_digest_sha512 {
    my $plaintext_password   = 'plaintext password';
    my $sha512_hex_encrypted = Digest::SHA::sha512_hex($plaintext_password);
    Test::More::ok(
        CLASS_UNDER_TEST->_check_password(
            $plaintext_password, $sha512_hex_encrypted, 'sha512'
        ),
        '_check_password() success case with sha512 encryption'
    );

    Test::More::ok(
        !CLASS_UNDER_TEST->_check_password(
            $plaintext_password, 'no match', 'sha512'
        ),
        '_check_password() failure case with sha512 encryption'
    );

    return TRUE;
}

sub test_dir_config_var {
    my $auth_name       = 'testing_dir_config_var';
    my $variable_wanted = 'Arbitrary_Variable_Name';
    my $config_key      = $auth_name . $variable_wanted;
    my $mock_config
        = { $config_key => 'Value for this configuration variable.', };
    my $r = set_up( $auth_name, $mock_config );

    is( CLASS_UNDER_TEST->_dir_config_var( $r, $variable_wanted ),
        $mock_config->{$config_key},
        '_dir_config_var() passes correct args to $r->dir_config()'
    );
    return TRUE;
}

sub test_decrypt_session_key {
    my $auth_name = 'testing_decrypt_session_key';

    my $r = set_up($auth_name);

    my %encryption_types = (
        none        => {},
        des         => {},
        idea        => {},
        blowfish    => {},
        blowfish_pp => {},
    );

    my $secret_key  = $r->{'mock_config'}->{"${auth_name}DBI_SecretKey"};
    my $session_key = 'mock_session_key';
    foreach my $encryption_type ( sort keys %encryption_types ) {
        my @args = ( $session_key, $secret_key, $auth_name, $encryption_type );
        my $encrypted_key = CLASS_UNDER_TEST->_encrypt_session_key(@args);

 #Test::More::diag("Encryption type: '$encryption_type' key: '$encrypted_key'");

        my $decrypted_key
            = CLASS_UNDER_TEST->decrypt_session_key( $r, $encryption_type,
            $encrypted_key, $secret_key );
        Test::More::ok( defined $decrypted_key,
            "Got decrypted key for '$encryption_type'" )
            || Test::More::diag( join "\n", @{ $r->log->error() } );
        $r->{'_error_messages'} = [];

    }

}

sub test_defined_or_empty {
    my $user = 'matisse';
    my $password;    # undef
    my @other_stuff = qw( a b c );
    my @args = ( $user, $password, @other_stuff );
    my $expected = scalar @args + 1;    # Add 1 for the class argument
    is( CLASS_UNDER_TEST->_defined_or_empty( $user, $password, @other_stuff ),
        $expected, '_defined_or_empty returns expected number of items.' );
    return TRUE;
}

sub test_encrypt_session_key {
    my $session_key = 'mock_session_key';
    my $secret_key  = 'mock secret key';
    my $auth_name   = 'test_encrypt_session_key';
    my $expected    = {
        none        => $session_key,
        des         => "DES:$secret_key:$session_key",
        idea        => "IDEA:$secret_key:$session_key",
        blowfish    => "Blowfish:$secret_key:$session_key",
        blowfish_pp => "Blowfish_PP:$secret_key:$session_key",
    };

    # These tests will use a fake version of Crypt::CBC -- see set_up()
    # We are just testing that the expecyed methods got called with the
    # expected parameters. Basically we arre using the mock CBC object as
    # a "sensor" object. Look in t/mock_libs/ to see the mock object code.
    #
    foreach my $encryption_type ( sort keys %{$expected} ) {
        my @args = ( $session_key, $secret_key, $auth_name, $encryption_type );
        my $mock_crypt_text = CLASS_UNDER_TEST->_encrypt_session_key(@args);
        my $un_hexified     = $mock_crypt_text;
        if ( $encryption_type ne 'none' ) {
            $un_hexified = pack 'H*', $mock_crypt_text;
        }

        is( $un_hexified, $expected->{$encryption_type},
            "_encrypt_session_key() using '$encryption_type' (returned '$mock_crypt_text')"
        );
    }
    return TRUE;
}

sub test_get_cipher_for_type {

    # ( $dbi_encryption_type, $auth_name, $secret_key )
    my $auth_name  = 'Sample Auth Name';
    my $secret_key = 'Sample Secret Key String';
    my @test_cases = (
        {   dbi_encryption_type  => 'des',
            expected_cipher_type => 'DES',
        },
        {   dbi_encryption_type  => 'idea',
            expected_cipher_type => 'IDEA',
        },
        {   dbi_encryption_type  => 'blowfish',
            expected_cipher_type => 'Blowfish',
        },
        {   dbi_encryption_type  => 'blowfish_pp',
            expected_cipher_type => 'Blowfish_PP',
        },
        {   dbi_encryption_type  => 'BLOWFISH_PP',    # verify case-insensitive
            expected_cipher_type => 'Blowfish_PP',
        },
    );
    foreach my $case (@test_cases) {
        my $dbi_encryption_type = $case->{'dbi_encryption_type'};
        my $mock_cbc
            = CLASS_UNDER_TEST->_get_cipher_for_type( $dbi_encryption_type,
            $auth_name, $secret_key, );
        Test::More::is( $mock_cbc->{'-key'}, $secret_key,
            "_get_cipher_for_type() for $dbi_encryption_type - secret_key" );

        my $expected_cipher_type = $case->{'expected_cipher_type'};
        Test::More::is( $mock_cbc->{'-cipher'},
            $expected_cipher_type,
            "_get_cipher_for_type() for $dbi_encryption_type - cipher_type" );

        my $second_mock_from_same_args
            = CLASS_UNDER_TEST->_get_cipher_for_type( $dbi_encryption_type,
            $auth_name, $secret_key, );

        Test::More::is( $second_mock_from_same_args, $mock_cbc,
            "_get_cipher_for_type($dbi_encryption_type,$auth_name, $secret_key) cached CBC object"
        );
    }

    my $unsupported_type = 'BunnyRabbits';
    eval {
        CLASS_UNDER_TEST->_get_cipher_for_type( $unsupported_type, $auth_name,
            $secret_key, );
    };
    Test::More::like(
        $EVAL_ERROR,
        qr/Unsupported encryption type: '$unsupported_type'/,
        '_get_cipher_for_type() throws exception on unsupported encryption type.'
    );
    return TRUE;
}

sub test_get_crypted_password {
    my $auth_name         = 'test_get_crypted_password';
    my $user              = 'test_user';
    my $r                 = set_up($auth_name);
    my $expected_password = 'mock_crypted_password';
    my $got_password;
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return ($expected_password);
        };
        $got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
    }

    Test::More::is( $got_password, $expected_password,
        '_get_crypted_password() with default config.' );

    # Simulate password not found
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return ()    # empty array, password not found;
        };
        $got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
    }
    Test::More::ok( !$got_password,
        '_get_crypted_password() with password not found' );
    my $got_errrors = $r->log->error();    # from the mock request object
    Test::More::is( scalar @$got_errrors,
        1, '_get_crypted_password() logs password not found' );

    my $class = CLASS_UNDER_TEST;
    Test::More::like(
        $got_errrors->[0],
        qr/\A${class}\tCould not select password/,
        '_get_crypted_password() error message for password not found'
    );

    return TRUE;
}

sub test_group {
    my $auth_name = 'test_group';
    my $r         = set_up($auth_name);
    my $user      = 'test_user';
    $r->{'user'} = $user;
    my $mock_config = $r->{'mock_config'};
    my @groups      = qw(group_one group_two);

    my @database_queries;
    my $got_result;
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::execute = sub {
            my ( $sth, @args ) = @_;
            push @database_queries, \@args;
        };
        $got_result = CLASS_UNDER_TEST->group( $r, "@groups" );
    }
    Test::More::is(
        $got_result,
        Apache2::Const::HTTP_FORBIDDEN,
        'group() returns FORBIDDEN when user not in any group.'
    );

    for ( my $i = 0; $i < scalar @groups; $i++ ) {
        my ( $got_group, $got_user ) = @{ $database_queries[$i] };
        my $expected_group = $groups[$i];
        Test::More::is( $got_group, $expected_group,
            "group() checked DB for '$expected_group'" );
        Test::More::is( $got_user, $user, "group() checked DB for '$user'" );
    }
    Test::More::like(
        $r->log->info->[2],    # there are 2 prior messages from _dbi_connect
        qr/user $user was not a member of any of the required groups @groups/,
        'group() logs expected info message for user not in any group.'
        )
        || Test::More::diag( 'Mock request object contains: ',
        Data::Dumper::Dumper($r) );

    # Test what happens when the user is in a group
    my $group = 'some_group';
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub { return TRUE };
        $got_result = CLASS_UNDER_TEST->group( $r, $group );
    }
    Test::More::is( $got_result, Apache2::Const::OK,
        'group() returns OK if user is in a group.' );

    Test::More::is_deeply(
        $r->{'subprocess_env'},
        { AUTH_COOKIE_DBI_GROUP => $group },
        'group() sets AUTH_COOKIE_DBI_GROUP when OK'
    );

    # test failure to connect to database
    {
        no warnings qw(once redefine);
        local *DBI::connect_cached = sub {return};
        $got_result = CLASS_UNDER_TEST->group( $r, $group );
    }
    Test::More::is( $got_result, Apache2::Const::SERVER_ERROR,
        'group() returns SERVER_ERROR on DB connect failure.' );
    return TRUE;
}

sub test__dbi_connect {
    my $auth_name = 'testing__dbi_connect';

    my $r           = set_up($auth_name);
    my $mock_config = $r->{'mock_config'};

    my $mock_dbh = CLASS_UNDER_TEST->_dbi_connect($r);
    my $expected = [
        $mock_config->{"${auth_name}DBI_DSN"},
        $mock_config->{"${auth_name}DBI_User"},
        $mock_config->{"${auth_name}DBI_Password"}
    ];
    Test::More::is_deeply( $mock_dbh->{'connect_cached_args'},
        $expected,
        '_dbi_connect() calls connect_cached() with expected arguments.' )
        || Test::More::diag( 'Sensor object contains: ',
        Data::Dumper::Dumper($mock_dbh) );

    Test::More::is_deeply( $r->log->error(), [],
        '_dbi_connect() - no unexpected errors.' );

    my $test_dsn = $mock_config->{"${auth_name}DBI_DSN"};

    my @expected_error_messages
        = ( qq{couldn't connect to $test_dsn for auth realm $auth_name}, );

    my @expected_info_messages = (
        q{_dbi_connect called in main::test__dbi_connect},
        qq{connect to test_DBI_DSN for auth realm $auth_name},
    );

    {
        no warnings qw(once);
        local $DBI::CONNECT_CACHED_FORCE_FAIL = 1;
        CLASS_UNDER_TEST->_dbi_connect($r);
    }

    my @got_info_messages  = @{ $r->log->info };
    my @got_error_messages = @{ $r->log->error };
    my $got_failures       = 0;

    for ( my $i = 0; $i <= $#expected_error_messages; $i++ ) {
        my $got            = $got_error_messages[$i];
        my $expected_regex = qr/$expected_error_messages[$i]/;
        Test::More::like( $got, $expected_regex,
            qq{_dbi_connect() logs info for "$expected_error_messages[$i]"} )
            || $got_failures++;
    }

    for ( my $i = 0; $i <= $#expected_info_messages; $i++ ) {
        my $got            = $got_info_messages[$i];
        my $expected_regex = qr/$expected_info_messages[$i]/;
        Test::More::like( $got, $expected_regex,
            qq{_dbi_connect() logs info for "$expected_info_messages[$i]"} )
            || $got_failures++;
    }

    if ($got_failures) {
        Test::More::diag( 'Mock request object contains: ',
            Data::Dumper::Dumper($r) );
    }
    return TRUE;
}

sub test_user_is_active {
    my $auth_name = 'test_user_is_active';
    my $r         = set_up($auth_name);
    my $user      = 'TestUser';

    # The default config has an empty string for DBI_UserActiveField
    my $is_active = CLASS_UNDER_TEST->user_is_active( $r, $user );
    Test::More::ok( $is_active, 'test_user_is_active() for default config' );

    # Now set DBI_UserActiveField so that user status is determined by
    # a call to the database (we'll intercept here using mocks.)
    $r->{'mock_config'}->{"${auth_name}DBI_UserActiveField"} = 'active';
    my $not_active;

    # Simulate a user the database says is not active.
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return;    # simulates user is not active
        };
        $not_active = CLASS_UNDER_TEST->user_is_active( $r, $user );
    }
    Test::More::ok( !$not_active,
        'test_user_is_active() inactive user using DBI_UserActiveField' )
        || Test::More::diag("Expected a non-true value, got '$not_active'");

    # Now simulate an active user whose status is fetch from the database
    my $active_user;
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return 'yes';    # simulates an active user
        };
        $active_user = CLASS_UNDER_TEST->user_is_active( $r, $user );
    }
    Test::More::ok( $active_user,
        'test_user_is_active() with active user using DBI_UserActiveField' );

    return TRUE;
}

sub test__get_new_session {
    my $auth_name      = 'test__get_new_session';
    my $r              = set_up($auth_name);
    my $user           = 'TestUser';
    my $session_module = 'Mock::Tieable';
    my $extra_data     = 'extra data';

    my $got_session = CLASS_UNDER_TEST->_get_new_session( $r, $user, $auth_name,
        $session_module, $extra_data );

    Test::More::is_deeply(
        $got_session,
        { user => $user, extra_data => $extra_data },
        q{_get_new_session() ties 'user' and 'extra_data' args.}
    );
    return TRUE;
}
