package Terse;
our $VERSION = '0.01';
use 5.006;
use strict;
use warnings;
use Plack::Request;
use Plack::Response;
use JSON;
use Scalar::Util qw/reftype/;
use Time::HiRes qw(gettimeofday);
use Want qw/want/;
use Digest::SHA;

our $JSON;
BEGIN {
	$JSON = JSON->new->utf8->allow_blessed->convert_blessed;
}

sub new {
	my ($pkg, %args) = @_;
       
	if (delete $args{private}) {
		for my $key (keys %args) {
			if ($key !~ m/^_/) {
	       			$args{"_$key"} = delete $args{$key};
			}
		}
	} 

	return bless \%args, $pkg;
}

sub run {
	my ($pkg, %args) = @_;

	my $j = $pkg->new(
		private => 1,
		login => 'login',
		logout => 'logout',
		auth => 'auth',
		insecure_session => 0,
		%args
	);

	$j->request = Plack::Request->new($args{plack_env});
	$j->response = $pkg->new(
		authenticated => 0,
		error => \0,
		errors => [],
	);

	if (! $j->{_application}) {
		$j->response->raiseError('No application passed to run', 500);
		return $j->error_response($j->response);
	}

	my $content_type = $j->request->content_type;
	if ($content_type && $content_type =~ m/application\/json/) {
		$j->graft('params', $j->request->raw_body || "{}");
	} else {
		$j->params = {%{$j->request->parameters || {}}};
	}

	unless ((reftype($j->params) || "") eq 'HASH') {
		$j->response->raiseError('Invalid parameters', 400);
		return $j->error_response($j->response);
	}

	$j->sid = $j->request->cookies->{sid};

	unless ($j->sid) {
		my $h = Digest::SHA->new(256);
		my @us = gettimeofday;
		push @us, map { $j->request->env->{$_} } grep {
			$_ =~ /^HTTP(?:_|$)/;
		} keys %{ $j->request->env };
		$h->add(@us);
		$j->sid = $h->hexdigest;
	}

	my $auth = $j->{_auth};
	my $session = $j->{_application}->$auth($j, $pkg->new());
	my $req = $j->params->req;
	$req =~ /^([a-z][0-9a-zA-Z_]{1,31})$/; $req = $1 // '';
	if (!$req || !$session) {
		$j->response->raiseError('Invalid request', 400);
		return $j->error_response($j->response);
	}

	$j->response->authenticated = \1;
	$j->session = $session;

	unless ($j->{_application}->can($req)) {
		$j->response->raiseError('Invalid request', 400);
		return $j->error_response($j->response);
	}

	my ($login, $logout) = (
		$j->{_login} eq $req,
		$j->{_logout} eq $req
	);

	my $out = eval { $j->{_application}->$req($j) };
	if ($@) {
		$j->response->raiseError(['Unclassified Error', $@], 400);
		return $j->error_response($j->response);
	}
	$j->session = $out if ( $login || $logout );

	$j->session = $j->{_application}->$auth($j, $j->session) if $j->response->authenticated;

	if ((!$j->response->authenticated || !$j->session) && !($login || $logout)) {
		$j->response->raiseError('Unauthenticated during the request', 400);
		return $j->error_response($j->response);
	}

	my $cookie = {
		value => $j->sid,
		path  => $j->request->request_uri,
		secure => !$j->{_insecure_session},
		expires => (ref $j->session && $j->session->expires) || time + 24 * 60 * 60,
	};

	return $j->okay_response($j->response, $logout ? {} : $cookie);
}

sub okay_response {
	my ($self, $response_body, $cookie, $status) = @_;
	my $res = $self->request->new_response($response_body->status_code ||= $status ||= 200);
	$res->cookies->{sid} = $cookie if $cookie;
	$res->content_type('application/json');
	$res->body($response_body->serialize());
	return $res->finalize;
}

sub error_response {
	my ($self, $response_body, $status) = @_;
	my $res = $self->request->new_response($status || $response_body->status_code);
	$res->content_type('application/json');
	$res->body($response_body->serialize());
	return $res->finalize;
}

sub logger {
	my ($self, $logger) = @_;
	$self->{_logger} = $logger if ($logger);
	return $self->{_logger};
}

sub logError {
	my ($self, $message, $status) = @_;
	$self->raiseError($message, $status);
	$message = { message => $message } if (!ref $message);
	$message = $self->{_application}->logError($message, $status)
		if ($self->{_application} && $self->{_application}->can('logError'));
	$self->{_logger}->err($message) if $self->{_logger};
	return $self;
}

sub logInfo {
	my ($self, $message) = @_;
	$message = { message => $message } if (!ref $message);
	$message = $self->{_application}->logInfo($message)
		if ($self->{_application} && $self->{_application}->can('logInfo'));
	$self->{_logger}->info($message) if $self->{_logger};
}

sub raiseError {
	my ($self, $message, $code) = @_;
	$self->{error} = \1;
	if ((reftype($message) || '') eq 'ARRAY') {
		push @{$self->{errors}}, @{$message};
	} else {
		push @{$self->{errors}}, $message;
	}
	$self->{status_code} = $code if ($code);
	return $self;
}

sub graft {
	my ($self, $name, $json) = @_;

	$self->{$name} = eval {
		$JSON->decode($json);
	};

	return 0 if $@;

	return $self->_bless_tree($self->{$name});
}

sub pretty { $_[0]->{_pretty} = 1; $_[0]; }

sub serialize {
	my ($self, $die) = @_;
	my $pretty = !!(reftype $self eq 'HASH' && $self->{_pretty});
	my $out = eval {
		$JSON->pretty($pretty)->encode($self);
	};
	die $@ if ($@ && $die);
	return $out || $@;
}

sub _bless_tree {
	my ($self, $node) = @_;
	my $refnode = ref $node;
	return unless $refnode eq 'HASH' || $refnode eq 'ARRAY';
	bless $node, ref $self;
	if ($refnode eq 'HASH'){
		$self->_bless_tree($node->{$_}) for keys %$node;
	}
	if ($refnode eq 'ARRAY'){
		$self->_bless_tree($_) for @$node;
	}
	$node;
}

sub TO_JSON {
	my $self = shift;
	return [@$self] if reftype $self eq 'ARRAY';
	return 'cannot stringify application object' if $self->{_application};
	my $output = {};
	my $nodebug = ! $self->{_debug};
	for(keys %$self){
		my $skip;
		$skip++ if $_ =~ /^_/ && $nodebug;
		next if $skip;
		$output->{$_} = $self->{$_};
	}
	return $output;
}

sub DESTROY {}

sub AUTOLOAD : lvalue {
	my $classname =  ref $_[0];
	my $validname = '[a-zA-Z][a-zA-Z0-9_]*';
	our $AUTOLOAD =~ /^${classname}::($validname)$/;
	my $key = $1;
	die "illegal key name, must be of $validname form\n$AUTOLOAD" unless $key;
	my $miss = Want::want('REF OBJECT') ? {} : '';
	my $retval = $_[0]->{$key};
	my $isBool = Want::want('SCALAR BOOL') && ((reftype($retval) // '') eq 'SCALAR');
	$retval = $$retval if $isBool;
	$_[0]->{$key} = $_[1] // $retval // $miss;
	$_[0]->_bless_tree($_[0]->{$key}) if ref $_[0]->{$key} eq 'HASH' || ref $_[0]->{$key} eq 'ARRAY';
	$_[0]->{$key};
}

1;

__END__

=head1 NAME

Terse - lightweight JSON APIs.

=head1 VERSION

Version 0.01

=cut

=head1 SYNOPSIS

	package MyAPI;

	use base 'Terse';

	sub auth {
		my ($self, $t, $session) = @_;
		return 0 if $t->params->not;
		return $session;
	}

	sub hello_world {
		my ($self, $t) = @_;

		$t->response->hello = "world";
	}


	.... MyAPI.psgi ...

	use Terse;
	use MyAPI;

	our $api = MyAPI->new();

	sub {
		my ($env) = (shift);
		Terse->run(
			plack_env => $env,
			application => $api,
		);
	};

	....

	plackup MyAPI.psgi

	GET http://localhost:5000/?req=hello_world # {"hello":"world","errors":[],"authenticated":1,"error":false,"status_code":200}
	GET http://localhost:5000/?req=hello_world&not=1 # {"status_code":400,"error":true,"errors":["Invalid request"],"authenticated":0}

=cut

=head1 AUTHOR

LNATION, C<< <email at lnation.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-terse at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Terse>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Terse


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Terse>

=item * CPAN Ratings

L<https://cpanratings.perl.org/d/Terse>

=item * Search CPAN

L<https://metacpan.org/release/Terse>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2022 by LNATION.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)


=cut

1; # End of Terse
