incorporate user auth functionality

[scpubgit/stemmatology.git] / lib / Text / Tradition / UserStore.pm

package Text::Tradition::UserStore;

use strict;
use warnings;

use Moose;
use KiokuX::User::Util qw(crypt_password);

extends 'Text::Tradition::Directory';
# extends 'KiokuX::Model';

use Text::Tradition::User;

=head1 NAME

Text::Tradition::UserStore - KiokuDB storage management for Users

=head1 SYNOPSIS

    my $userstore = Text::Tradition::UserStore->new(dsn => 'dbi:SQLite:foo.db');
    my $newuser = $userstore->add_user({ username => 'fred',
                                         password => 'somepassword' });

    my $fetchuser = $userstore->find_user({ username => 'fred' });
    if($fetchuser->check_password('somepassword')) { 
       ## login user or .. whatever
    }

    my $user = $userstore->deactivate_user({ username => 'fred' });
    if(!$user->active) { 
      ## shouldnt be able to login etc
    }

=head1 DESCRIPTION

A L<KiokuX::Model> for managing the storage and creation of
L<Text::Tradition::User> objects. Subclass or replace this module in
order to use a different source for stemmaweb users.

=head2 ATTRIBUTES

=head3 dsn

Inherited from KiokuX::Model - dsn for the data store we are using. 

=head3 MIN_PASS_LEN

Constant for the minimum password length when validating passwords,
defaults to "8".

=cut

has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } );

# has 'directory' => ( 
#     is => 'rw', 
#     isa => 'KiokuX::Model',
#     handles => []
#     );

## TODO: Some of these methods should probably optionally take $user objects
## instead of hashrefs.

## It also occurs to me that all these methods don't need to be named
## XX_user, but leaving that way for now incase we merge this code
## into ::Directory for one-store.

## To die or not to die, on error, this is the question.

=head2 METHODS

=head3 add_user

Takes a hashref of C<username>, C<password>.

Create a new user object, store in the KiokuDB backend, and return it.

=cut

sub add_user {
    my ($self, $userinfo) = @_;
    my $username = $userinfo->{url} || $userinfo->{username};
    my $password = $userinfo->{password};

    return unless ($username =~ /^https?:/ 
                   || ($username && $self->validate_password($password))) ;

    my $user = Text::Tradition::User->new(
        id => $username,
        password => ($password ? crypt_password($password) : ''),
    );

    my $scope = $self->new_scope;
    $self->store($user->kiokudb_object_id, $user);

    return $user;
}

sub create_user {
    my $self = shift;
    return $self->add_user(@_);
}

=head3 find_user

Takes a hashref of C<username>, optionally C<openid_identifier>.

Fetches the user object for the given username and returns it.

=cut

sub find_user {
    my ($self, $userinfo) = @_;
    ## url or display?
    # 'display' => 'castaway.myopenid.com',
    # 'url' => 'http://castaway.myopenid.com/',
    my $username = $userinfo->{url} || $userinfo->{username};

    my $scope = $self->new_scope;
    return $self->lookup(Text::Tradition::User->id_for_user($username));
    
}

=head3 modify_user

Takes a hashref of C<username> and C<password> (same as add_user).

Retrieves the user, and updates it with the new information. Username
changing is not currently supported.

Returns the updated user object, or undef if not found.

=cut

sub modify_user {
    my ($self, $userinfo) = @_;
    my $username = $userinfo->{username};
    my $password = $userinfo->{password};

    return unless $username && $self->validate_password($password);

    my $user = $self->find_user({ username => $username });
    return unless $user;

    my $scope = $self->new_scope;
    $user->password(crypt_password($password));

    $self->update($user);

    return $user;
}

=head3 deactivate_user

Takes a hashref of C<username>.

Sets the users C<active> flag to false (0), and sets all traditions
assigned to them to non-public, updates the storage and returns the
deactivated user.

Returns undef if user not found.

=cut

sub deactivate_user {
    my ($self, $userinfo) = @_;
    my $username = $userinfo->{username};

    return if !$username;

    my $user = $self->find_user({ username => $username });
    return if !$user;

    $user->active(0);
    foreach my $tradition (@{ $user->traditions }) {
        ## Not implemented yet
        # $tradition->public(0);
    }
    my $scope = $self->new_scope;

    ## Should we be using Text::Tradition::Directory also?
    $self->update(@{ $user->traditions });

    $self->update($user);

    return $user;
}

=head3 reactivate_user

Takes a hashref of C<username>.

Returns the user object if already activated. Activates (sets the
active flag to true (1)), updates the storage and returns the user.

Returns undef if the user is not found.

=cut

sub reactivate_user {
    my ($self, $userinfo) = @_;
    my $username = $userinfo->{username};

    return if !$username;

    my $user = $self->find_user({ username => $username });
    return if !$user;

    return $user if $user->active;

    $user->active(1);
    my $scope = $self->new_scope;
    $self->update($user);

    return $user;    
}

=head3 delete_user

CAUTION: Delets actual data!

Takes a hashref of C<username>.

Returns undef if the user doesn't exist.

Removes the user from the store and returns 1.

=cut

sub delete_user {
    my ($self, $userinfo) = @_;
    my $username = $userinfo->{username};

    return if !$username;

    my $user = $self->find_user({ username => $username });
    return if !$user;

    my $scope = $self->new_scope;

    ## Should we be using Text::Tradition::Directory for this bit?
    $self->delete( @{ $user->traditions });

    ## Poof, gone.
    $self->delete($user);

    return 1;
}

=head3 validate_password

Takes a password string. Returns true if it is longer than
L</MIN_PASS_LEN>, false otherwise.

Used internally by L</add_user>.

=cut

sub validate_password {
    my ($self, $password) = @_;

    return if !$password;
    return if length($password) < $self->MIN_PASS_LEN;

    return 1;
}

1;