Authen-SCRAM

 view release on metacpan or  search on metacpan

t/round_trip.t  view on Meta::CPAN

use 5.008001;
use strict;
use warnings;
use Test::More 0.96;
use Test::FailWarnings -allow_deps => 1;
use Test::Fatal;
binmode( Test::More->builder->$_, ":utf8" )
  for qw/output failure_output todo_output/;

use lib 't/lib';
use TestSCRAM qw/get_client get_server/;

subtest "RFC 5802 example" => sub {
    my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" } );
    my $server = get_server;

    my ( $c1, $c2, $s1, $s2 );

    is( exception { $c1 = $client->first_msg() },    undef, "client first message" );
    is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" );
    is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" );
    is( exception { $s2 = $server->final_msg($c2) }, undef, "server final message" );
    is( exception { $client->validate($s2) }, undef, "client validation" );
    is( $server->authorization_id, 'user', "server authz" );
};

subtest "generated example" => sub {
    my $client = get_client( username => 'johndoe', password => 'passPASSpass' );
    my $server = get_server;

    my ( $c1, $c2, $s1, $s2 );

    is( exception { $c1 = $client->first_msg() },    undef, "client first message" );
    is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" );
    is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" );
    is( exception { $s2 = $server->final_msg($c2) }, undef, "server final message" );
    is( exception { $client->validate($s2) }, undef, "client validation" );
    is( $server->authorization_id, 'johndoe', "server authz" );
};

subtest "generated example with authz" => sub {
    my $client = get_client(
        username         => 'johndoe',
        password         => 'passPASSpass',
        authorization_id => 'admin'
    );
    my $server = get_server;

    my ( $c1, $c2, $s1, $s2 );

    is( exception { $c1 = $client->first_msg() },    undef, "client first message" );
    is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" );
    is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" );
    is( exception { $s2 = $server->final_msg($c2) }, undef, "server final message" );
    is( exception { $client->validate($s2) }, undef, "client validation" );
    is( $server->authorization_id, 'admin', "server authz" );
};

subtest "generated example with Unicode user/pass/authz" => sub {
    my $client = get_client(
        username         => "johnd\N{U+110B}oe",
        password         => "pass\N{U+110B}PASSpass",
        authorization_id => "admi\N{U+110B}n"
    );
    my $server = get_server;



( run in 1.870 second using v1.01-cache-2.11-cpan-54e63673c56 )