3973b5f6a14dcc321ec0d0f9bce49d9e4055dc1b
[catagits/Catalyst-Authentication-Credential-HTTP.git] / t / basic.t
1 #!/usr/bin/perl
2 use strict;
3 use warnings;
4 use Test::More tests => 22;
5 use Test::MockObject::Extends;
6 use Test::MockObject;
7 use Test::Exception;
8 use HTTP::Headers;
9
10 my $m; BEGIN { use_ok($m = "Catalyst::Authentication::Credential::HTTP") }
11 can_ok( $m, "authenticate" );
12 can_ok( $m, "authorization_required_response" );
13 my $req = Test::MockObject->new;
14 my $req_headers = HTTP::Headers->new;
15 $req->set_always( headers => $req_headers );
16 my $res = Test::MockObject->new;
17 my $status;
18 $res->mock(status => sub { $status = $_[1] });
19 my $content_type;
20 $res->mock(content_type => sub { $content_type = $_[1] });
21 my $body;
22 my $headers;
23 #$res->mock(headers => sub { use Data::Dumper; warn Dumper(\@_); $headers = $_[1]; });
24 $res->mock(body => sub { $body = $_[1] });
25 my $res_headers = HTTP::Headers->new;
26 $res->set_always( headers => $res_headers );
27 my $realm = Test::MockObject->new;
28 my $find_user_opts;
29 my $user = Test::MockObject->new;
30 my $user_pw;
31 $user->mock( check_password => sub { $user_pw = $_[1]; return 1; } );
32 $realm->mock( find_user => sub { $find_user_opts = $_[1]; return $user; });
33 $realm->mock( name => sub { 'foo' } );
34 my $c = Test::MockObject->new;
35 my $cache = Test::MockObject->new;
36 $cache->mock(set => sub { shift->{$_[0]} = $_[1] });
37 $cache->mock(get => sub { return shift->{$_[0]} });
38 $c->mock(cache => sub { $cache });
39 $c->mock(debug => sub { 0 });
40 my @login_info;
41 $c->mock( login => sub { shift; @login_info = @_; 1 } );
42 my $authenticated = 0;
43 $c->mock( set_authenticated => sub { $authenticated++; } );
44 $c->set_always( config => {} );
45 $c->set_always( req => $req );
46 $c->set_always( res => $res );
47 $c->set_always( request => $req );
48 $c->set_always( response => $res );
49 my $config = { type => 'any' };
50 my $raw_self = $m->new($config, $c, $realm);
51 my $self = Test::MockObject::Extends->new( $raw_self );
52 eval {
53     $self->authenticate($c, $realm);
54 };
55 is($@, $Catalyst::DETACH, 'Calling authenticate for http auth without header detaches');
56 $req_headers->authorization_basic( qw/foo bar/ );
57 ok($self->authenticate($c, $realm), "auth successful with header");
58 is($authenticated, 1, 'authenticated once');
59 is($user_pw, 'bar', 'password delegated');
60 is_deeply( $find_user_opts, { username => 'foo'}, "login delegated");
61 $req_headers->clear;
62 $c->clear;
63 throws_ok {
64     $self->authenticate( $c, $realm );
65 } qr/^ $Catalyst::DETACH $/x, "detached on no authorization required with bad auth";
66 is( $status, 401, "401 status code" );
67 is( $content_type, 'text/plain' );
68 is( $body, 'Authorization required.' );
69 like( ($res_headers->header('WWW-Authenticate'))[0], qr/^Digest/, "WWW-Authenticate header set: digest");
70 like( ($res_headers->header('WWW-Authenticate'))[0], qr/realm="foo"/, "WWW-Authenticate header set: digest realm");
71 like( ($res_headers->header('WWW-Authenticate'))[1], qr/^Basic/, "WWW-Authenticate header set: basic");
72 like( ($res_headers->header('WWW-Authenticate'))[1], qr/realm="foo"/, "WWW-Authenticate header set: basic realm");
73
74 throws_ok {
75     $self->authenticate( $c, $realm, { realm => 'myrealm' }); # Override realm object's name method by doing this.
76 } qr/^ $Catalyst::DETACH $/x, "detached on no authorization required with bad auth";
77 is( $status, 401, "401 status code" );
78 is( $content_type, 'text/plain' );
79 is( $body, 'Authorization required.' );
80 TODO: {
81     local $TODO = 'This should work, it (or something very like it) used to work';
82     like( ($res_headers->header('WWW-Authenticate'))[0], qr/realm="myrealm"/, "WWW-Authenticate header set: digest realm overridden");
83     like( ($res_headers->header('WWW-Authenticate'))[1], qr/realm="myrealm"/, "WWW-Authenticate header set: basic realm overridden");
84 }