Catalyst::Plugin::Authentication::Credential::TypeKey - TypeKey Authentication

    use Catalyst qw/Authentication::Credential::TypeKey/;

    MyApp->config->{authentication}{typekey} = {
        token => 'xxxxxxxxxxxxxxxxxxxx',
    };

    sub foo : Local {
		my ( $self, $c ) = @_;

		if ( $c->authenticate_typekey ) {

		# you can also specify the params manually: $c->authenticate_typekey(
		#	name => $name,
		#	email => $email,
		#	...
		#)

			# successful autentication

			$c->user; # this is set
		}
	}




	sub auto : Private {
		my ( $self, $c ) = @_;

		$c->authenticate_typekey; # uses $c->req

		return 1;
	}

package Catalyst::Plugin::Authentication::Credential::TypeKey;
use base qw/Class::Accessor/;

use strict;
use warnings;

use Authen::TypeKey;
use File::Spec;
use Catalyst::Utils ();
use NEXT;
use Scalar::Util ();
use Storable     ();
use Carp qw/croak/;

our $VERSION = '0.4';

# Authen::TypeKey's configuration parameters
# FIXME these might change in future versions of Authen::Typekey
my @typekey_config_fields = qw/
  expires key_cache key_url token
  version skip_expiry_check
  /;

# our configuration parameters
# typekey_object is missing for a reason - it has defaulting behavior
my @config_fields = qw/user_class auth_store/;

__PACKAGE__->mk_accessors(qw/last_typekey_object/);

sub setup {
    my $c = shift;

    my $config = $c->config->{authentication}{typekey} ||= {};

    $config->{user_class} ||= "Catalyst::Plugin::Authentication::User::Hash";
    Catalyst::Utils::ensure_class_loaded( $config->{user_class} );

    $config->{key_cache} ||=
      File::Spec->catfile( Catalyst::Utils::class2tempdir( $c, 1 ),
        'regkeys.txt' );

    $config->{typekey_object} ||= do {
        my $typekey = Authen::TypeKey->new;

        for ( grep { exists $config->{$_} } @typekey_config_fields ) {
            $typekey->$_( $config->{$_} );
        }

        $typekey;
    };

    $c->NEXT::setup(@_);
}

sub _munge_typekey_params {
    my ( $c, @params ) = @_;

    my %ret;

    if ( @params % 2 == 1 ) {

        # either it's a user object or a hash ref of credentials
        # if it's a user object the credentials are pulled out of it
        # otherwise a user will be found/made for the credentials
        if ( Scalar::Util::blessed( $params[0] ) ) {
            my $user = $ret{user_object} = shift @params;

            croak "Attempted to authenticate user object, but "
              . "user doesnt't support 'typekey_credentials'"
              unless $user->supports(qw/typekey_credentials/);

            $ret{credentials} = $user->typekey_credentials;

        } elsif ( @params == 1 and ref( $params[0] ) eq "HASH" ) {
            $ret{credentials} = shift @params;
        } else {
            croak "Invalid parameters";
        }
    }

    # now that @params has been munged if needed we can make it into a hash   
    my %params = @params;

    my $config = $c->config->{authentication}{typekey};

    # separate the rest of our params from Authen::TypeKey's
    foreach my $key (@config_fields) {
        # if it was passed as a parameter then move it to the right place
        $ret{$key} = delete $params{$key} || $config->{$key};
    }

    # separate TypeKey's config from credentials
    # these options override config
    $ret{typekey_config} = {};
    foreach my $key (grep { exists $params{$_} } @typekey_config_fields) {
        $ret{typekey_config}{$key} = delete $params{$key};
    }

    # get the object from config and apply local overrides
    $ret{typekey_object} = delete $params{typekey_object} || $c->get_typekey_object( %{ $ret{typekey_config} } );

    # Authen::TypeKey can also take CGI compatible objects
    if ( keys %params ) {
        $ret{credentials} = \%params;
    } else {
        $ret{credentials} = $c->request if not($ret{credentials}) or not( keys %{ $ret{credentials} } );
    }

    return \%ret;
}

sub get_typekey_object {
    my ( $c, %config ) = @_;

    my $object = $c->config->{authentication}{typekey}{typekey_object};

    if ( keys %config ) {
        $object = Storable::dclone($object);
        $object->$_( $config{$_} ) for keys %config;
    }

    return $object;
}

sub authenticate_typekey {
    my ( $c, @params ) = @_;

    my $params = $c->_munge_typekey_params(@params);

    my $typekey    = $params->{typekey_object};
    my $cred       = $params->{credentials};
    my $user       = $params->{user_object};      # probably undef
    my $user_class = $params->{user_class};
    my $auth_store = $params->{auth_store};

    $c->last_typekey_object($typekey);

    if ( my $res = $typekey->verify($cred) ) {
        $c->log->debug("Successfully authenticated user '$res->{name}'.")
          if $c->debug;

        # if a user object was supplied then it has been verified and we're done

        # if not, try to find one in the auth_store (if any)
        if ( !$user and $auth_store ) {
            $auth_store = $c->get_auth_store($auth_store)
              unless ref $auth_store;
            $user = $auth_store->get_user( $res->{name}, $cred, $res );
        }

        # and as a last resort use user_class to create a temporary one
        $user ||= $user_class->new($res);

        $c->set_authenticated($user);

        return $user;
    } else {
        $c->log->debug(
            sprintf "Failed to authenticate user '%s'. Reason: '%s'",
            (
                Scalar::Util::blessed($cred)
                ? $cred->param("name")
                : $cred->{name}
            ),
            $typekey->errstr
          )
          if $c->debug;

        return;
    }
}

sub last_typekey_error {
    my $c = shift;
    $c->last_typekey_object->errstr;
}

1;

__END__