Commit | Line | Data |
532cc23b |
1 | package stemmaweb::Controller::Stemweb; |
2 | use Moose; |
3 | use namespace::autoclean; |
ed0ce314 |
4 | use Encode qw/ decode_utf8 /; |
3cb9d9c0 |
5 | use File::Which; |
c2b80bba |
6 | use JSON; |
3cb9d9c0 |
7 | use List::Util qw/ max /; |
70744367 |
8 | use LWP::UserAgent; |
532cc23b |
9 | use Safe::Isa; |
c55cf210 |
10 | use Scalar::Util qw/ looks_like_number /; |
3cb9d9c0 |
11 | use Text::Tradition::StemmaUtil qw/ character_input phylip_pars /; |
532cc23b |
12 | use TryCatch; |
70744367 |
13 | use URI; |
532cc23b |
14 | |
15 | BEGIN { extends 'Catalyst::Controller' } |
16 | |
d83d890b |
17 | has stemweb_url => ( |
18 | is => 'ro', |
19 | isa => 'Str', |
20 | default => 'http://slinkola.users.cs.helsinki.fi', |
21 | ); |
3cb9d9c0 |
22 | |
23 | has pars_path => ( |
24 | is => 'ro', |
25 | isa => 'Str', |
26 | ); |
27 | |
28 | has pars_pk => ( |
29 | is => 'rw', |
30 | isa => 'Int', |
31 | ); |
70744367 |
32 | |
532cc23b |
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): |
67b2a665 |
49 | { jobid: <ID number> |
532cc23b |
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. |
67b2a665 |
70 | $c->log->debug( "Request body is in a temp file" ); |
71 | open( POSTDATA, $c->request->body ) |
c0292f64 |
72 | or return _json_error( $c, 500, "Failed to open post data file" ); |
532cc23b |
73 | binmode( POSTDATA, ':utf8' ); |
74 | # JSON should be all one line |
75 | my $pdata = <POSTDATA>; |
76 | chomp $pdata; |
77 | close POSTDATA; |
c2b80bba |
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 | } |
532cc23b |
84 | } else { |
85 | $answer = from_json( $c->request->body ); |
86 | } |
67b2a665 |
87 | $c->log->debug( "Received push notification from Stemweb: " |
88 | . to_json( $answer ) ); |
c2b80bba |
89 | return _process_stemweb_result( $c, $answer ); |
90 | } else { |
91 | return _json_error( $c, 403, 'Please use POST!' ); |
92 | } |
93 | } |
94 | |
66458003 |
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(); |
d83d890b |
107 | my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' ); |
66458003 |
108 | if( $resp->is_success ) { |
3cb9d9c0 |
109 | my $parameters = decode_json( $resp->content ); |
110 | # Temporary hack: add Pars |
111 | if( $self->_has_pars ) { |
112 | # Use the highest passed primary key + 1 |
113 | my $parspk = max( map { $_->{pk} } |
114 | grep { $_->{model} eq 'algorithms.algorithm' } @$parameters ) + 1; |
115 | # Add Pars as an algorithm |
116 | $self->pars_pk( $parspk ); |
117 | push( @$parameters, { |
118 | pk => $parspk, |
119 | model => 'algorithms.algorithm', |
120 | fields => { |
121 | args => [], |
122 | name => 'Pars' |
123 | } |
124 | }); |
125 | } |
126 | $c->stash->{'result'} = $parameters; |
66458003 |
127 | } else { |
6aabefa3 |
128 | $c->stash->{'result'} = {}; |
66458003 |
129 | } |
130 | $c->forward('View::JSON'); |
131 | } |
132 | |
c2b80bba |
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(); |
d83d890b |
146 | my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" ); |
c2b80bba |
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 { |
532cc23b |
155 | return _json_error( $c, 500, |
c2b80bba |
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 ) = @_; |
c0292f64 |
173 | # Find the specified tradition and check its job ID. |
c2b80bba |
174 | my $m = $c->model('Directory'); |
c0292f64 |
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} ) { |
c2b80bba |
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 | } |
c0292f64 |
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 | } |
c0292f64 |
197 | if( @$stemmata ) { |
c2b80bba |
198 | # If we got here, success! |
c55cf210 |
199 | # TODO Use helper in Root.pm to do this |
c2b80bba |
200 | my @steminfo = map { { |
201 | name => $_->identifier, |
202 | directed => _json_bool( !$_->is_undirected ), |
203 | svg => $_->as_svg() } } |
2c514a6f |
204 | @$stemmata; |
c2b80bba |
205 | $c->stash->{'result'} = { |
206 | 'status' => 'success', |
207 | 'stemmata' => \@steminfo }; |
c2b80bba |
208 | } else { |
c0292f64 |
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' }; |
c2b80bba |
216 | } |
39283bfb |
217 | } elsif( $answer->{status} == -1 ) { |
c0292f64 |
218 | $c->stash->{'result'} = { 'status' => 'running' }; |
c2b80bba |
219 | } else { |
c0292f64 |
220 | return _json_error( $c, 500, |
221 | "Stemweb failure not handled: " . $answer->{result} ); |
532cc23b |
222 | } |
c2b80bba |
223 | $c->forward('View::JSON'); |
532cc23b |
224 | } |
225 | |
70744367 |
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 | |
70744367 |
250 | my $algorithm = delete $reqparams->{algorithm}; |
3cb9d9c0 |
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; |
70744367 |
257 | try { |
3cb9d9c0 |
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 ); |
70744367 |
262 | } |
3cb9d9c0 |
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 ); |
70744367 |
274 | } else { |
3cb9d9c0 |
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 | } |
70744367 |
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 | |
c55cf210 |
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 | |
532cc23b |
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; |
c55cf210 |
356 | } |
532cc23b |
357 | |
c2b80bba |
358 | sub _json_bool { |
359 | return $_[0] ? JSON::true : JSON::false; |
360 | } |
361 | |
3cb9d9c0 |
362 | sub _has_pars { |
363 | my $self = shift; |
364 | return $self->pars_path || which('pars'); |
365 | } |
366 | |
c2b80bba |
367 | |
ed0ce314 |
368 | 1; |