Try out and debug interaction with Stemweb callbacks. Fixes #27
[scpubgit/stemmaweb.git] / 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 JSON;
6 use LWP::UserAgent;
7 use Safe::Isa;
8 use TryCatch;
9 use URI;
10
11 BEGIN { extends 'Catalyst::Controller' }
12
13 ## TODO Move the /algorithms/available function to the Stemweb module
14 my $STEMWEB_BASE_URL = 'http://slinkola.users.cs.helsinki.fi';
15
16 =head1 NAME
17
18 stemmaweb::Controller::Stemweb - Client listener for Stemweb results
19
20 =head1 DESCRIPTION
21
22 This is a client listener for the Stemweb API as implemented by the protocol defined at
23 L<https://docs.google.com/document/d/1aNYGAo1v1WPDZi6LXZ30FJSMJwF8RQPYbOkKqHdCZEc/pub>.
24
25 =head1 METHODS
26
27 =head2 result
28
29  POST stemweb/result
30  Content-Type: application/json
31  (On success):
32  { jobid: <ID number>
33    status: 0
34    format: <format>
35    result: <data> }
36  (On failure):
37  { jobid: <ID number>
38    status: >1
39    result: <error message> }
40    
41 Used by the Stemweb server to notify us that one or more stemma graphs
42 has been calculated in response to an earlier request.
43
44 =cut
45
46 sub result :Local :Args(0) {
47         my( $self, $c ) = @_;
48         if( $c->request->method eq 'POST' ) {
49                 # TODO: Verify the sender!
50                 my $answer;
51                 if( ref( $c->request->body ) eq 'File::Temp' ) {
52                         # Read in the file and parse that.
53                         $c->log->debug( "Request body is in a temp file" );
54                         open( POSTDATA, $c->request->body ) 
55                                 or return _json_error( 500, "Failed to open post data file" );
56                         binmode( POSTDATA, ':utf8' );
57                         # JSON should be all one line
58                         my $pdata = <POSTDATA>;
59                         chomp $pdata;
60                         close POSTDATA;
61                         try {
62                                 $answer = from_json( $pdata );
63                         } catch {
64                                 return _json_error( $c, 400, 
65                                         "Could not parse POST request '' $pdata '' as JSON: $@" );
66                         }
67                 } else {
68                         $answer = from_json( $c->request->body );
69                 }
70                 $c->log->debug( "Received push notification from Stemweb: "
71                         . to_json( $answer ) );
72                 return _process_stemweb_result( $c, $answer );
73         } else {
74                 return _json_error( $c, 403, 'Please use POST!' );
75         }
76 }
77
78 =head2 query
79
80  GET stemweb/query/<jobid>
81
82 A backup method to query the stemweb server to check a particular job status.
83 Returns a result as in /stemweb/result above, but status can also be -1 to 
84 indicate that the job is still running.
85
86 =cut
87
88 sub query :Local :Args(1) {
89         my( $self, $c, $jobid ) = @_;
90         my $ua = LWP::UserAgent->new();
91         my $resp = $ua->get( $STEMWEB_BASE_URL . "/algorithms/jobstatus/$jobid" );
92         if( $resp->is_success ) {
93                 # Process it
94                 my $response = decode_utf8( $resp->content );
95                 $c->log->debug( "Got a response from the server: $response" );
96                 my $answer;
97                 try {
98                         $answer = from_json( $response );
99                 } catch {
100                         return _json_error( $c, 500, 
101                                 "Could not parse stemweb response '' $response '' as JSON: $@" );
102                 }
103                 return _process_stemweb_result( $c, $answer );
104         } elsif( $resp->code == 500 && $resp->header('Client-Warning')
105                 && $resp->header('Client-Warning') eq 'Internal response' ) {
106                 # The server was unavailable.
107                 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
108         } else {
109                 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
110                         . $resp->content );
111         }
112 }
113
114
115 ## Helper function for parsing Stemweb result data either by push or by pull
116 sub _process_stemweb_result {
117         my( $c, $answer ) = @_;
118         # Find a tradition with the defined Stemweb job ID.
119         # TODO: Maybe get Stemweb to pass back the tradition ID...
120         my $m = $c->model('Directory');
121         my @traditions;
122         ## STUPID HACK: unless we load the possible tradition owners
123         ## within scope of the scan, they will not exist when the affected
124         ## tradition is saved.
125         my @users;
126         $m->scan( sub{ push( @traditions, $_[0] )
127                                         if $_[0]->$_isa('Text::Tradition')
128                                         && $_[0]->has_stemweb_jobid 
129                                         && $_[0]->stemweb_jobid eq $answer->{jobid}; 
130                         push( @users, $_[0] ) if $_[0]->$_isa('Text::Tradition::User');
131                                 } );
132         if( @traditions == 1 ) {
133                 my $tradition = shift @traditions;
134                 if( $answer->{status} == 0 ) {
135                         my $stemmata;
136                         try {
137                                 $stemmata = $tradition->record_stemweb_result( $answer );
138                                 $m->save( $tradition );
139                         } catch( Text::Tradition::Error $e ) {
140                                 return _json_error( $c, 500, $e->message );
141                         } catch {
142                                 return _json_error( $c, 500, $@ );
143                         }
144                         # If we got here, success!
145                         my @steminfo = map { { 
146                                         name => $_->identifier, 
147                                         directed => _json_bool( !$_->is_undirected ),
148                                         svg => $_->as_svg() } } 
149                                 @$stemmata;
150                         $c->stash->{'result'} = { 
151                                 'status' => 'success',
152                                 'stemmata' => \@steminfo };
153                 } elsif( $answer->{status} < 1 ) {
154                         $c->stash->{'result'} = { 'status' => 'running' };
155                 } else {
156                         return _json_error( $c, 500,
157                                 "Stemweb failure not handled: " . $answer->{result} );
158                 }
159         } elsif( @traditions ) {
160                 return _json_error( $c, 500, 
161                         "Multiple traditions with Stemweb job ID " . $answer->{jobid} . "!" );
162         } else {
163                 # Possible that the tradition got updated in the meantime...
164                 if( $answer->{status} == 0 ) {
165                         $c->stash->{'result'} = { 'status' => 'notfound' };
166                 } else {
167                         return _json_error( $c, 400, 
168                                 "No tradition found with Stemweb job ID " . $answer->{jobid} );
169                 }
170         }
171         $c->forward('View::JSON');
172 }
173
174 =head2 request
175
176  GET stemweb/request/?
177         tradition=<tradition ID> &
178         algorithm=<algorithm ID> &
179         [<algorithm parameters>]
180    
181 Send a request for the given tradition with the given parameters to Stemweb.
182 Processes and returns the JSON response given by the Stemweb server.
183
184 =cut
185
186 sub request :Local :Args(0) {
187         my( $self, $c ) = @_;
188         # Look up the relevant tradition and check permissions.
189         my $reqparams = $c->req->params;
190         my $tid = delete $reqparams->{tradition};
191         my $t = $c->model('Directory')->tradition( $tid );
192         my $ok = _check_permission( $c, $t );
193         return unless $ok;
194         return( _json_error( $c, 403, 
195                         'You do not have permission to update stemmata for this tradition' ) )
196                 unless $ok eq 'full';
197         
198         # Form the request for Stemweb.
199         my $algorithm = delete $reqparams->{algorithm};
200         my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
201         my $stemweb_request = {
202                 return_path => $return_uri->path,
203                 return_host => $return_uri->host_port,
204                 data => $t->collation->as_tsv({noac => 1}),
205                 userid => $c->user->get_object->email,
206                 textid => $tid,
207                 parameters => $reqparams };
208                 
209         # Call to the appropriate URL with the request parameters.
210         my $ua = LWP::UserAgent->new();
211         $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) ); 
212         my $resp = $ua->post( $STEMWEB_BASE_URL . "/algorithms/process/$algorithm/",
213                 'Content-Type' => 'application/json; charset=utf-8', 
214                 'Content' => encode_json( $stemweb_request ) ); 
215         if( $resp->is_success ) {
216                 # Process it
217                 $c->log->debug( 'Got a response from the server: '
218                         . decode_utf8( $resp->content ) );
219                 my $stemweb_response = decode_json( $resp->content );
220                 try {
221                         $t->set_stemweb_jobid( $stemweb_response->{jobid} );
222                 } catch( Text::Tradition::Error $e ) {
223                         return _json_error( $c, 429, $e->message );
224                 }
225                 $c->model('Directory')->save( $t );
226                 $c->stash->{'result'} = $stemweb_response;
227                 $c->forward('View::JSON');
228         } elsif( $resp->code == 500 && $resp->header('Client-Warning')
229                 && $resp->header('Client-Warning') eq 'Internal response' ) {
230                 # The server was unavailable.
231                 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
232         } else {
233                 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
234                         . $resp->content );
235         }
236 }
237
238 # Helper to check what permission, if any, the active user has for
239 # the given tradition
240 sub _check_permission {
241         my( $c, $tradition ) = @_;
242     my $user = $c->user_exists ? $c->user->get_object : undef;
243     if( $user ) {
244         return 'full' if ( $user->is_admin || 
245                 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
246     }
247         # Text doesn't belong to us, so maybe it's public?
248         return 'readonly' if $tradition->public;
249
250         # ...nope. Forbidden!
251         return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
252 }
253
254 # Helper to throw a JSON exception
255 sub _json_error {
256         my( $c, $code, $errmsg ) = @_;
257         $c->response->status( $code );
258         $c->stash->{'result'} = { 'error' => $errmsg };
259         $c->forward('View::JSON');
260         return 0;
261 }
262
263 sub _json_bool {
264         return $_[0] ? JSON::true : JSON::false;
265 }
266
267
268 1;