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