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         my $parameters = [];
 109         if( $resp->is_success ) {
 110                 $parameters = decode_json( $resp->content );
 111         } # otherwise we have no available algorithms.
 112         ## Temporary HACK: run Pars too
 113         if( $self->_has_pars ) {
 114                 # Use the highest passed primary key + 1
 115                 my $parspk = max( map { $_->{pk} }
 116                         grep { $_->{model} eq 'algorithms.algorithm' } @$parameters ) + 1;
 117                 # Add Pars as an algorithm
 118                 $self->pars_pk( $parspk );
 119                 push( @$parameters, {
 120                         pk => $parspk,
 121                         model => 'algorithms.algorithm',
 122                         fields => {
 123                                 args => [],
 124                                 name => 'Pars',
 125                                 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.'
 126                         }
 127                 });
 128         }
 129         $c->stash->{result} = $parameters;
 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;