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