Articulate

 view release on metacpan or  search on metacpan

lib/Articulate/Authentication.pm  view on Meta::CPAN

package Articulate::Authentication;
use strict;
use warnings;

use Moo;
with 'Articulate::Role::Component';

use Articulate::Syntax qw(new_credentials instantiate_array);

=head1 NAME

Articulate::Authentication - determine if a user who they claim to be

=head1 SYNOPSIS

  # in config:
  components:
    authentication:
      Articulate::Authentication:
        providers:
          - Articulate::Authentication::AlwaysAllow

  # then any component can dp
  $component->authentication->login($credentials);
  $component->authentication->login($user_id, $password);

=head1 ATTRIBUTE

=head3 providers

A list of providers which can respond to C<login>.

=cut

has providers => (
  is      => 'rw',
  default => sub { [] },
  coerce  => sub { instantiate_array(@_) },
);

=head3 login

  $authentication->login($credentials);
  $authentication->login( $user_id, $password );

Asks each provider if the credentials supplied match a known user.
Credentials may be in whatever form will satisfy the C<credentials>
function in L<Articulate::Credentials> (username and password, hashref
or credentials object).

Each provider must respond true, false, or undef. A true value means
the user is authenticated. A false value means that the user exists but
is explicitly refused access (this should only be used in exceptional
circumstances) and an undef value means the user cannot be
authenticated by the provider (but could be authenticated by some other
provider).

=cut

sub login {
  my $self        = shift;
  my $credentials = new_credentials @_;
  foreach my $provider ( @{ $self->providers } ) {
    return $credentials if $provider->authenticate($credentials);
    return $credentials if $credentials->rejected;
  }
  return $credentials->deny('No provider authenticated these credentials');
}

=head3 create_user

  $authentication->create_user( $user_id, $password );

Requests that a new user is created. Each provider must respond true,
false, or undef.

=cut

lib/Articulate/Authentication/Internal.pm  view on Meta::CPAN

Articulate::Authentication::Internal

=cut

=head1 METHODS

=cut

=head3 authenticate

  $self->authenticate( $credentials );

Accepts and returns the credentials if the C<password> matches the C<user_id>. Always returns the credentials passed in.

=cut

has extra_salt => (
  is      => 'rw',
  default => "If you haven't already, try powdered vegetable bouillon"
);

sub authenticate {
  my $self        = shift;
  my $credentials = shift;
  my $user_id     = $credentials->fields->{user_id} // return;
  my $password    = $credentials->fields->{password} // return;

  if ( $self->verify_password( $user_id, $password ) ) {
    return $credentials->accept('Passwords match');
  }

  # if we ever need to know if the user does not exist, now is the time to ask,
  # but we do not externally expose the difference between
  # "user not found" and "password doesn't match"
  return $credentials;
}

sub _password_salt_and_hash {
  my $self = shift;
  return Digest::SHA::sha512_base64(
    $_[0] . $_[1] #:5.10 doesn't like shift . shift
  );
}

sub _generate_salt {

lib/Articulate/Authentication/Preconfigured.pm  view on Meta::CPAN

=cut

has passwords => (
  is      => 'rw',
  default => sub { {} },
);

=head3 authenticate

  $self->authenticate( $credentials );

Accepts and returns the credentials if the C<password> matches the C<user_id>. Always returns the credentials passed in.

=cut

sub authenticate {
  my $self        = shift;
  my $credentials = shift;
  my $user_id     = $credentials->fields->{user_id} // return;
  my $password    = $credentials->fields->{password} // return;

  if ( exists $self->passwords->{$user_id} ) {
    return $credentials->accept('Passwords match')
      if $password eq $self->passwords->{$user_id};
  }

  # if we ever need to know if the user does not exist, now is the time to ask,
  # but we do not externally expose the difference between
  # "user not found" and "password doesn't match"
  return $credentials;
}

1;

lib/Articulate/Credentials.pm  view on Meta::CPAN

use overload bool => sub { shift->accepted }, '0+' => sub { shift->rejected };

=head1 NAME

Articulate::Credentials - represent an authentication request/response

=cut

=head1 FUNCTIONS

=head3 new_credentials

  my $credentials = new_credentials $user_id, $password;
  my $credentials = new_credentials { email => $email, api_key => $key };

Creates a new request, using the user_id and password supplied as the
respective arguments; or other fields if they are supplied instead.

=cut

use Exporter::Declare;
default_exports qw(new_credentials);

sub new_credentials {
  return shift if ref $_[0] eq __PACKAGE__;
  __PACKAGE__->new(
    {
      fields => (
        ( ref $_[0] eq ref {} )
        ? $_[0]
        : {
          user_id  => shift,
          password => shift,
        }

lib/Articulate/Credentials.pm  view on Meta::CPAN

=head1 METHODS

=head3 new

An unremarkable Moo constructor.

=cut

=head3 accept

  $credentials->accept('Password matched');

Declares that the credentials are valid, for the reason given; sets
C<accpeted> and C<rejected> and populates the stack trace.

=cut

sub accept {
  my $self   = shift;
  my $reason = shift;

  # die if granted or denied are already set?
  $self->accepted(1);
  $self->reason($reason);
  $self->stack_trace( Devel::StackTrace->new );
  return $self;
}

=head3 reject

  $credentials->reject('User not found');

Declares that the credentials are invalid, for the reason given; sets
C<accpeted> and C<rejected> and populates the stack trace.

=cut

sub reject {
  my $self   = shift;
  my $reason = shift;

  # die if granted or denied are already set?
  $self->accepted(0);
  $self->rejected(1);
  $self->reason($reason);
  $self->stack_trace( Devel::StackTrace->new );
  return $self;
}

=head1 ATTRIBUTES

=head3 fields

The credentials provided, typically user_id and password.

=cut

has fields => (
  is      => 'rw',
  default => sub { {} },
);

=head3 accepted

Whether or not the credentials have been explicitly accepted. The value
of this is used for overload behaviour.

Please do not explicitly set this. Use C<accept> instead.

=cut

has accepted => (
  is      => 'rw',
  default => sub { 0 },
);

=head3 rejected

Whether the credentials have been explicitly rejected.

Please do not explicitly set this. Use C<reject> instead.

=cut

has rejected => (
  is      => 'rw',
  default => sub { 0 },
);

=head3 reason

The reason for the acceptance or rejection of credentials.

Please do not explicitly set this. Use C<accept> or C<reject> instead.

=cut

has reason => (
  is      => 'rw',
  default => sub { '' },
);

=head3 stack_trace

The stack trace at the point of acceptance or rejection of credentials.

Please do not explicitly set this. Use C<accept> or C<reject> instead.

=cut

has stack_trace => (
  is      => 'rw',
  default => sub { '' },
);

lib/Articulate/Service/Login.pm  view on Meta::CPAN

  my $user_id  = $request->data->{user_id};
  my $password = $request->data->{password};

  if ( defined $user_id ) {
    if ( $self->authentication->login( $user_id, $password ) ) {
      $self->framework->user_id($user_id);
      return new_response success => { user_id => $user_id };
    } # Can we handle all the exceptions with 403s?
    else {
      throw_error Forbidden => 'Incorrect credentials';
    }
  }
  else {
    # todo: see if we have email and try to identify a user and verify with that
    throw_error Forbidden => 'Missing user id';
  }

}

sub handle_logout {

lib/Articulate/Syntax.pm  view on Meta::CPAN

use strict;
use warnings;

use Scalar::Util qw(blessed);
use Module::Load ();

use Exporter::Declare;
default_exports qw(
  instantiate instantiate_array instantiate_selection instantiate_array_selection
  new_response    new_request
  new_credentials new_permission
  new_location    new_location_specification
  dpath_get   dpath_set
  hash_merge
  throw_error
  select_from
  is_single_key_hash
);

use Articulate::Error;
use Data::DPath qw(dpath dpathr);

lib/Articulate/Syntax.pm  view on Meta::CPAN

=head1 FUNCTIONS

=head3 new_response

See L<Artciulate::Response>.

=head3 new_request

See L<Artciulate::Request>.

=head3 new_credentials

See L<Artciulate::Credentials>.

=head3 new_permission

See L<Artciulate::Permission>.

=head3 new_location

See L<Artciulate::Location>.