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                 # Failure. Clear the job ID so that the user can try again.
 221                 $tradition->_clear_stemweb_jobid;
 222                 $m->save( $tradition );
 223                 $c->stash->{'result'} = { 'status' => 'failed', 'message' => $answer->{result} };
 224         }
 225         $c->forward('View::JSON');
 226 }
 227
 228 =head2 request
 229
 230  GET stemweb/request/?
 231         tradition=<tradition ID> &
 232         algorithm=<algorithm ID> &
 233         [<algorithm parameters>]
 234
 235 Send a request for the given tradition with the given parameters to Stemweb.
 236 Processes and returns the JSON response given by the Stemweb server.
 237
 238 =cut
 239
 240 sub request :Local :Args(0) {
 241         my( $self, $c ) = @_;
 242         # Look up the relevant tradition and check permissions.
 243         my $reqparams = $c->req->params;
 244         my $tid = delete $reqparams->{tradition};
 245         my $t = $c->model('Directory')->tradition( $tid );
 246         my $ok = _check_permission( $c, $t );
 247         return unless $ok;
 248         return( _json_error( $c, 403,
 249                         'You do not have permission to update stemmata for this tradition' ) )
 250                 unless $ok eq 'full';
 251
 252         my $algorithm = delete $reqparams->{algorithm};
 253         my $mergetypes = delete $reqparams->{merge_reltypes};
 254         if( $self->_has_pars && $algorithm == $self->pars_pk ) {
 255                 my $start_time = scalar( gmtime( time() ) );
 256                 $t->set_stemweb_jobid( 'local' );
 257                 my $cdata = character_input( $t, { collapse => $mergetypes } );
 258                 my $newick;
 259                 try {
 260                         $newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
 261                 } catch ( Text::Tradition::Error $e ) {
 262                         return _json_error( $c, 503, "Parsimony tree generation failed: "
 263                                 . $e->message );
 264                 }
 265                 # We have a result, so form an answer to process.
 266                 my $answer = {
 267                         status => 0,
 268                         algorithm => 'pars',
 269                         'format' => 'newick',
 270                         textid => $tid,
 271                         jobid => 'local',
 272                         result => $newick,
 273                         start_time => $start_time
 274                 };
 275                 return _process_stemweb_result( $c, $answer );
 276         } else {
 277                 # Form the request for Stemweb.
 278                 my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
 279                 my $tsv_options = { noac => 1, ascii => 1 };
 280                 if( $mergetypes && @$mergetypes ) {
 281                         $tsv_options->{mergetypes} = $mergetypes;
 282                 }
 283                 my $stemweb_request = {
 284                         return_path => $return_uri->path,
 285                         return_host => $return_uri->host_port,
 286                         data => $t->collation->as_tsv( $tsv_options ),
 287                         userid => $c->user->get_object->email,
 288                         textid => $tid,
 289                         parameters => _cast_nonstrings( $reqparams ) };
 290
 291                 # Call to the appropriate URL with the request parameters.
 292                 my $ua = LWP::UserAgent->new();
 293                 # $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
 294                 my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
 295                         'Content-Type' => 'application/json; charset=utf-8',
 296                         'Content' => encode_json( $stemweb_request ) );
 297                 if( $resp->is_success ) {
 298                         # Process it
 299                         $c->log->debug( 'Got a response from the server: '
 300                                 . decode_utf8( $resp->content ) );
 301                         my $stemweb_response = decode_json( $resp->content );
 302                         try {
 303                                 $t->set_stemweb_jobid( $stemweb_response->{jobid} );
 304                         } catch( Text::Tradition::Error $e ) {
 305                                 return _json_error( $c, 429, $e->message );
 306                         }
 307                         $c->model('Directory')->save( $t );
 308                         $c->stash->{'result'} = $stemweb_response;
 309                         $c->forward('View::JSON');
 310                 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
 311                         && $resp->header('Client-Warning') eq 'Internal response' ) {
 312                         # The server was unavailable.
 313                         return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
 314                 } else {
 315                         return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
 316                                 . $resp->content );
 317                 }
 318         }
 319 }
 320
 321 # Helper to check what permission, if any, the active user has for
 322 # the given tradition
 323 sub _check_permission {
 324         my( $c, $tradition ) = @_;
 325     my $user = $c->user_exists ? $c->user->get_object : undef;
 326     if( $user ) {
 327         return 'full' if ( $user->is_admin ||
 328                 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
 329     }
 330         # Text doesn't belong to us, so maybe it's public?
 331         return 'readonly' if $tradition->public;
 332
 333         # ...nope. Forbidden!
 334         return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
 335 }
 336
 337 # QUICK HACK to deal with strict Stemweb validation.
 338 sub _cast_nonstrings {
 339         my $params = shift;
 340         foreach my $k ( keys %$params ) {
 341                 my $v = $params->{$k};
 342                 if( looks_like_number( $v ) ) {
 343                         $params->{$k} = $v * 1;
 344                 } elsif ( !defined $v || $v eq 'true' ) {
 345                         $params->{$k} = _json_bool( $v );
 346                 }
 347         }
 348         return $params;
 349 }
 350
 351 # Helper to throw a JSON exception
 352 sub _json_error {
 353         my( $c, $code, $errmsg ) = @_;
 354         $c->response->status( $code );
 355         $c->stash->{'result'} = { 'error' => $errmsg };
 356         $c->forward('View::JSON');
 357         return 0;
 358 }
 359
 360 sub _json_bool {
 361         return $_[0] ? JSON::true : JSON::false;
 362 }
 363
 364 sub _has_pars {
 365         my $self = shift;
 366         return $self->pars_path || which('pars');
 367 }
 368
 369
 370 1;