lib/stemmaweb/Controller/Stemweb.pm

   1 package stemmaweb::Controller::Stemweb;
   2 use Moose;
   3 use namespace::autoclean;
   4 use Encode qw/ decode_utf8 /;
   5 use File::Which;
   6 use JSON;
   7 use List::Util qw/ max /;
   8 use LWP::UserAgent;
   9 use Safe::Isa;
  10 use Scalar::Util qw/ looks_like_number /;
  11 use Text::Tradition::StemmaUtil qw/ character_input phylip_pars /;
  12 use TryCatch;
  13 use URI;
  14
  15 BEGIN { extends 'Catalyst::Controller' }
  16
  17 has stemweb_url => (
  18         is => 'ro',
  19         isa => 'Str',
  20         default => 'http://slinkola.users.cs.helsinki.fi',
  21         );
  22
  23 has pars_path => (
  24         is => 'ro',
  25         isa => 'Str',
  26         );
  27
  28 has pars_pk => (
  29         is => 'rw',
  30         isa => 'Int',
  31         );
  32
  33 =head1 NAME
  34
  35 stemmaweb::Controller::Stemweb - Client listener for Stemweb results
  36
  37 =head1 DESCRIPTION
  38
  39 This is a client listener for the Stemweb API as implemented by the protocol defined at
  40 L<https://docs.google.com/document/d/1aNYGAo1v1WPDZi6LXZ30FJSMJwF8RQPYbOkKqHdCZEc/pub>.
  41
  42 =head1 METHODS
  43
  44 =head2 result
  45
  46  POST stemweb/result
  47  Content-Type: application/json
  48  (On success):
  49  { jobid: <ID number>
  50    status: 0
  51    format: <format>
  52    result: <data> }
  53  (On failure):
  54  { jobid: <ID number>
  55    status: >1
  56    result: <error message> }
  57
  58 Used by the Stemweb server to notify us that one or more stemma graphs
  59 has been calculated in response to an earlier request.
  60
  61 =cut
  62
  63 sub result :Local :Args(0) {
  64         my( $self, $c ) = @_;
  65         if( $c->request->method eq 'POST' ) {
  66                 # TODO: Verify the sender!
  67                 my $answer;
  68                 if( ref( $c->request->body ) eq 'File::Temp' ) {
  69                         # Read in the file and parse that.
  70                         $c->log->debug( "Request body is in a temp file" );
  71                         open( POSTDATA, $c->request->body )
  72                                 or return _json_error( $c, 500, "Failed to open post data file" );
  73                         binmode( POSTDATA, ':utf8' );
  74                         # JSON should be all one line
  75                         my $pdata = <POSTDATA>;
  76                         chomp $pdata;
  77                         close POSTDATA;
  78                         try {
  79                                 $answer = from_json( $pdata );
  80                         } catch {
  81                                 return _json_error( $c, 400,
  82                                         "Could not parse POST request '' $pdata '' as JSON: $@" );
  83                         }
  84                 } else {
  85                         $answer = from_json( $c->request->body );
  86                 }
  87                 $c->log->debug( "Received push notification from Stemweb: "
  88                         . to_json( $answer ) );
  89                 return _process_stemweb_result( $c, $answer );
  90         } else {
  91                 return _json_error( $c, 403, 'Please use POST!' );
  92         }
  93 }
  94
  95 =head2 available
  96
  97  GET algorithms/available
  98
  99 Queries the Stemweb server for available stemma generation algorithms and their
 100 parameters. Returns the JSON answer as obtained from Stemweb.
 101
 102 =cut
 103
 104 sub available :Local :Args(0) {
 105         my( $self, $c ) = @_;
 106         my $ua = LWP::UserAgent->new();
 107         my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' );
 108         if( $resp->is_success ) {
 109                 my $parameters = decode_json( $resp->content );
 110                 # Temporary hack: add Pars
 111                 if( $self->_has_pars ) {
 112                         # Use the highest passed primary key + 1
 113                         my $parspk = max( map { $_->{pk} }
 114                                 grep { $_->{model} eq 'algorithms.algorithm' } @$parameters ) + 1;
 115                         # Add Pars as an algorithm
 116                         $self->pars_pk( $parspk );
 117                         push( @$parameters, {
 118                                 pk => $parspk,
 119                                 model => 'algorithms.algorithm',
 120                                 fields => {
 121                                         args => [],
 122                                         name => 'Pars'
 123                                 }
 124                         });
 125                 }
 126                 $c->stash->{'result'} = $parameters;
 127         } else {
 128                 $c->stash->{'result'} = {};
 129         }
 130         $c->forward('View::JSON');
 131 }
 132
 133 =head2 query
 134
 135  GET stemweb/query/<jobid>
 136
 137 A backup method to query the stemweb server to check a particular job status.
 138 Returns a result as in /stemweb/result above, but status can also be -1 to
 139 indicate that the job is still running.
 140
 141 =cut
 142
 143 sub query :Local :Args(1) {
 144         my( $self, $c, $jobid ) = @_;
 145         my $ua = LWP::UserAgent->new();
 146         my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" );
 147         if( $resp->is_success ) {
 148                 # Process it
 149                 my $response = decode_utf8( $resp->content );
 150                 $c->log->debug( "Got a response from the server: $response" );
 151                 my $answer;
 152                 try {
 153                         $answer = from_json( $response );
 154                 } catch {
 155                         return _json_error( $c, 500,
 156                                 "Could not parse stemweb response '' $response '' as JSON: $@" );
 157                 }
 158                 return _process_stemweb_result( $c, $answer );
 159         } elsif( $resp->code == 500 && $resp->header('Client-Warning')
 160                 && $resp->header('Client-Warning') eq 'Internal response' ) {
 161                 # The server was unavailable.
 162                 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
 163         } else {
 164                 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
 165                         . $resp->content );
 166         }
 167 }
 168
 169
 170 ## Helper function for parsing Stemweb result data either by push or by pull
 171 sub _process_stemweb_result {
 172         my( $c, $answer ) = @_;
 173         # Find the specified tradition and check its job ID.
 174         my $m = $c->model('Directory');
 175         my $tradition = $m->tradition( $answer->{textid} );
 176         unless( $tradition ) {
 177                 return _json_error( $c, 400, "No tradition found with ID "
 178                         . $answer->{textid} );
 179         }
 180         if( $answer->{status} == 0 ) {
 181                 my $stemmata;
 182                 if( $tradition->has_stemweb_jobid
 183                         && $tradition->stemweb_jobid eq $answer->{jobid} ) {
 184                         try {
 185                                 $stemmata = $tradition->record_stemweb_result( $answer );
 186                                 $m->save( $tradition );
 187                         } catch( Text::Tradition::Error $e ) {
 188                                 return _json_error( $c, 500, $e->message );
 189                         } catch {
 190                                 return _json_error( $c, 500, $@ );
 191                         }
 192                 } else {
 193                         # It may be that we already received a callback meanwhile.
 194                         # Check all stemmata for the given jobid and return them.
 195                         @$stemmata = grep { $_->came_from_jobid && $_->from_jobid eq $answer->{jobid} } $tradition->stemmata;
 196                 }
 197                 if( @$stemmata ) {
 198                         # If we got here, success!
 199                         # TODO Use helper in Root.pm to do this
 200                         my @steminfo = map { {
 201                                         name => $_->identifier,
 202                                         directed => _json_bool( !$_->is_undirected ),
 203                                         svg => $_->as_svg() } }
 204                                 @$stemmata;
 205                         $c->stash->{'result'} = {
 206                                 'status' => 'success',
 207                                 'stemmata' => \@steminfo };
 208                 } else {
 209                         # Hm, no stemmata found on this tradition with this jobid.
 210                         # Clear the tradition jobid so that the user can try again.
 211                         if( $tradition->has_stemweb_jobid ) {
 212                                 $tradition->_clear_stemweb_jobid;
 213                                 $m->save( $tradition );
 214                         }
 215                         $c->stash->{'result'} = { status => 'notfound' };
 216                 }
 217         } elsif( $answer->{status} == -1 ) {
 218                 $c->stash->{'result'} = { 'status' => 'running' };
 219         } else {
 220                 return _json_error( $c, 500,
 221                         "Stemweb failure not handled: " . $answer->{result} );
 222         }
 223         $c->forward('View::JSON');
 224 }
 225
 226 =head2 request
 227
 228  GET stemweb/request/?
 229         tradition=<tradition ID> &
 230         algorithm=<algorithm ID> &
 231         [<algorithm parameters>]
 232
 233 Send a request for the given tradition with the given parameters to Stemweb.
 234 Processes and returns the JSON response given by the Stemweb server.
 235
 236 =cut
 237
 238 sub request :Local :Args(0) {
 239         my( $self, $c ) = @_;
 240         # Look up the relevant tradition and check permissions.
 241         my $reqparams = $c->req->params;
 242         my $tid = delete $reqparams->{tradition};
 243         my $t = $c->model('Directory')->tradition( $tid );
 244         my $ok = _check_permission( $c, $t );
 245         return unless $ok;
 246         return( _json_error( $c, 403,
 247                         'You do not have permission to update stemmata for this tradition' ) )
 248                 unless $ok eq 'full';
 249
 250         my $algorithm = delete $reqparams->{algorithm};
 251         my $mergetypes = delete $reqparams->{merge_reltypes};
 252         if( $self->_has_pars && $algorithm == $self->pars_pk ) {
 253                 my $start_time = scalar( gmtime( time() ) );
 254                 $t->set_stemweb_jobid( 'local' );
 255                 my $cdata = character_input( $t, { collapse => $mergetypes } );
 256                 my $newick;
 257                 try {
 258                         $newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
 259                 } catch ( Text::Tradition::Error $e ) {
 260                         return _json_error( $c, 503, "Parsimony tree generation failed: "
 261                                 . $e->message );
 262                 }
 263                 # We have a result, so form an answer to process.
 264                 my $answer = {
 265                         status => 0,
 266                         algorithm => 'pars',
 267                         'format' => 'newick',
 268                         textid => $tid,
 269                         jobid => 'local',
 270                         result => $newick,
 271                         start_time => $start_time
 272                 };
 273                 return _process_stemweb_result( $c, $answer );
 274         } else {
 275                 # Form the request for Stemweb.
 276                 my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
 277                 my $tsv_options = { noac => 1 };
 278                 if( $mergetypes && @$mergetypes ) {
 279                         $tsv_options->{mergetypes} = $mergetypes;
 280                 }
 281                 my $stemweb_request = {
 282                         return_path => $return_uri->path,
 283                         return_host => $return_uri->host_port,
 284                         data => $t->collation->as_tsv( $tsv_options ),
 285                         userid => $c->user->get_object->email,
 286                         textid => $tid,
 287                         parameters => _cast_nonstrings( $reqparams ) };
 288
 289                 # Call to the appropriate URL with the request parameters.
 290                 my $ua = LWP::UserAgent->new();
 291                 $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
 292                 my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
 293                         'Content-Type' => 'application/json; charset=utf-8',
 294                         'Content' => encode_json( $stemweb_request ) );
 295                 if( $resp->is_success ) {
 296                         # Process it
 297                         $c->log->debug( 'Got a response from the server: '
 298                                 . decode_utf8( $resp->content ) );
 299                         my $stemweb_response = decode_json( $resp->content );
 300                         try {
 301                                 $t->set_stemweb_jobid( $stemweb_response->{jobid} );
 302                         } catch( Text::Tradition::Error $e ) {
 303                                 return _json_error( $c, 429, $e->message );
 304                         }
 305                         $c->model('Directory')->save( $t );
 306                         $c->stash->{'result'} = $stemweb_response;
 307                         $c->forward('View::JSON');
 308                 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
 309                         && $resp->header('Client-Warning') eq 'Internal response' ) {
 310                         # The server was unavailable.
 311                         return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
 312                 } else {
 313                         return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
 314                                 . $resp->content );
 315                 }
 316         }
 317 }
 318
 319 # Helper to check what permission, if any, the active user has for
 320 # the given tradition
 321 sub _check_permission {
 322         my( $c, $tradition ) = @_;
 323     my $user = $c->user_exists ? $c->user->get_object : undef;
 324     if( $user ) {
 325         return 'full' if ( $user->is_admin ||
 326                 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
 327     }
 328         # Text doesn't belong to us, so maybe it's public?
 329         return 'readonly' if $tradition->public;
 330
 331         # ...nope. Forbidden!
 332         return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
 333 }
 334
 335 # QUICK HACK to deal with strict Stemweb validation.
 336 sub _cast_nonstrings {
 337         my $params = shift;
 338         foreach my $k ( keys %$params ) {
 339                 my $v = $params->{$k};
 340                 if( looks_like_number( $v ) ) {
 341                         $params->{$k} = $v * 1;
 342                 } elsif ( !defined $v || $v eq 'true' ) {
 343                         $params->{$k} = _json_bool( $v );
 344                 }
 345         }
 346         return $params;
 347 }
 348
 349 # Helper to throw a JSON exception
 350 sub _json_error {
 351         my( $c, $code, $errmsg ) = @_;
 352         $c->response->status( $code );
 353         $c->stash->{'result'} = { 'error' => $errmsg };
 354         $c->forward('View::JSON');
 355         return 0;
 356 }
 357
 358 sub _json_bool {
 359         return $_[0] ? JSON::true : JSON::false;
 360 }
 361
 362 sub _has_pars {
 363         my $self = shift;
 364         return $self->pars_path || which('pars');
 365 }
 366
 367
 368 1;