fix: fix RPC behavior when exception is thrown accross boundary

lib/Myriad/Exception/Base.pm

@@ -46,6 +46,28 @@ Returns the exception message as a string.
 
 sub as_string { shift->message }
 
+=head2 does
+
+Check the role ownership of the objects, added here to maintain compatibility with Object::Pad exports.
+This is needed as some part of Myriad code assume that the objects created by Myriad exceptions do exports does,
+which in turn to be absent.
+
+=cut
+
+sub does {
+    use Object::Pad::MOP::Class qw(:experimental);
+    my ($self, $role) = @_;
+
+    return 0 unless $role and ref $self;
+
+    my $klass = ref $self;
+    my $klass_ptr = Object::Pad::MOP::Class->try_for_class($klass);
+    return 0 unless defined $klass_ptr;
+
+    my %roles = map {($_->name) => 1} $klass_ptr->all_roles;
+    return $roles{$role} // 0;
+}
+
 1;
 
 =head1 AUTHOR

lib/Myriad/RPC.pm

@@ -81,6 +81,16 @@ declare_exception UnknownTransport => (
     message => 'Unknown transport'
 );
 
+=head2 RemoteException
+
+An exception has been thrown from remote service
+
+=cut
+
+declare_exception RemoteException => (
+    message => 'The RPC method failed at server side'
+);
+
 =head1 METHODS
 
 =cut

lib/Myriad/RPC/Client/Implementation/Memory.pm

@@ -88,14 +88,21 @@ async method call_rpc ($service, $method, %args) {
             $self->loop->timeout_future(at => $deadline),
             $pending
         );
+
+        unless (exists $message->response->{message}) {
+            my $reason = $message->response->{error}{message} // "Unknown";
+            Myriad::Exception::RPC::RemoteException->throw(reason => "Remote exception is thrown: $reason")
+                unless exists $message->response->{response};
+        }
+
         return $message->response->{response};
     } catch ($e) {
         if ($e =~ /Timeout/) {
             $e  = Myriad::Exception::RPC::Timeout->new(reason => 'deadline is due');
         } else {
             $e = Myriad::Exception::InternalError->new(reason => $e) unless blessed $e && $e->does('Myriad::Exception');
         }
-        $pending->fail($e);
+        $pending->fail($e) unless $pending->is_ready;
         delete $pending_requests->{$message_id};
         $e->throw();
     }

lib/Myriad/RPC/Client/Implementation/Redis.pm

@@ -95,14 +95,20 @@ async method call_rpc($service, $method, %args) {
         # The subscription loop will parse the message for us
         my $message = await Future->wait_any($self->loop->timeout_future(after => $timeout), $pending);
 
+        unless (exists $message->response->{message}) {
+            my $reason = $message->response->{error}{message} // "Unknown";
+            Myriad::Exception::RPC::RemoteException->throw(reason => "Remote exception is thrown: $reason")
+                unless exists $message->response->{response};
+        }
+
         return $message->response->{response};
     } catch ($e) {
         if ($e =~ /Timeout/) {
             $e  = Myriad::Exception::RPC::Timeout->new(reason => 'deadline is due');
         } else {
             $e = Myriad::Exception::InternalError->new(reason => $e) unless blessed $e && $e->does('Myriad::Exception');
         }
-        $pending->fail($e);
+        $pending->fail($e) unless $pending->is_ready;
         delete $pending_requests->{$message_id};
         $e->throw();
     }

lib/Myriad/Service/Implementation.pm

@@ -317,7 +317,16 @@ async method load () {
                     });
                     await $self->rpc->reply_success($service_name, $message, $response);
                 } catch ($e) {
-                    $e = Myriad::Exception::InternalError->new(reason => $e) unless (blessed $e and $e->does('Myriad::Exception'));
+                    # Pass through the myriad exception, use indirect exports from Myriad::Exception::Base
+                    # for simplicity
+                    unless (blessed $e and Myriad::Exception::Base::does($e, 'Myriad::Exception')) {
+                        # Ensure that we are passing the exception reason only by means of scalar
+                        # or it would cause issue with strongly typed clients.
+                        # Moreover, attempt to use blessed object would crash the listener
+                        $e = "$e" if ref $e;
+                        $e =~ s/(\s+)$//; # Drop the trailling spaces
+                        $e = Myriad::Exception::InternalError->new(reason => $e);
+                    }
                     await $self->rpc->reply_error($service_name, $message, $e);
                 }
             }))->resolve->completed;

t/RPC/exceptions.t

@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Test::Fatal;
+use Test::Myriad;
+
+use Future;
+use Future::AsyncAwait;
+use Object::Pad qw(:experimental);
+use Myriad::Exception::InternalError;
+
+my ($broken_services);
+
+# Example of some broken behavior that implementations can have
+package Test::BrokenServices {
+    use Myriad::Service;
+    async method normal : RPC (%args) {
+        return {pong => 1};
+    }
+    async method normal_dead : RPC (%args) {
+        die "I am died";
+    }
+    async method hash_dead : RPC (%args) {
+        die {reason => "I am died"};
+    }
+    async method blessed_dead : RPC (%args) {
+        die bless {reason => "I am died"}, "Test::Exceptions";
+    }
+    async method bubbled_dead : RPC (%args) {
+        # Fake it as something is wrong with Myriad itself
+        Myriad::Exception::InternalError->throw();
+    }
+}
+
+BEGIN {
+    $broken_services = Test::Myriad->add_service(service => 'Test::BrokenServices');
+}
+
+
+await Test::Myriad->ready();
+
+subtest 'Normal RPC calls must succeeded as usual' => sub {
+    my $resposne = $broken_services->call_rpc('normal')->get;
+    cmp_deeply($resposne, {pong => 1});
+};
+
+subtest 'Dead RPC calls must have its exceptions bubbled up to caller' => sub {
+    my $failure = exception {
+        $broken_services->call_rpc('normal_dead')->get;
+    };
+    is(ref $failure, "Myriad::Exception::RPC::RemoteException", "Correct error received by caller");
+    like($failure->reason, qr/reason=I am died/, "Correct error message");
+};
+
+subtest 'HASHREFs must not cross RPC boundary!' => sub {
+    my $failure = exception {
+        $broken_services->call_rpc('hash_dead')->get;
+    };
+    is(ref $failure, "Myriad::Exception::RPC::RemoteException", "Correct error received by caller");
+    like($failure->reason, qr/reason=HASH\(0x[a-zA-Z0-9]+\)/, "Correct error message");
+};
+
+subtest 'blessed HASHREFs must not cross RPC boundary!' => sub {
+    my $failure = exception {
+        $broken_services->call_rpc('blessed_dead')->get;
+    };
+    is(ref $failure, "Myriad::Exception::RPC::RemoteException", "Correct error received by caller");
+    like($failure->reason, qr/reason=Test::Exceptions=HASH\(0x[a-zA-Z0-9]+\)/, "Correct error message");
+};
+
+subtest 'Internal Myriad errors on remote must not appear as local Myriad error!' => sub {
+    my $failure = exception {
+        $broken_services->call_rpc('bubbled_dead')->get;
+    };
+    is(ref $failure, "Myriad::Exception::RPC::RemoteException", "Correct error received by caller");
+    is($failure->reason, 'Remote exception is thrown: Internal error (category=internal)', "Correct error message");
+};
+
+done_testing();
+

t/exception.t

@@ -18,6 +18,9 @@ subtest 'can declare exceptions' => sub {
     is($ex->message, 'this is a message (category=some_category)', 'message is correct');
     is($ex->category, 'some_category', 'category is correct');
     is("$ex", 'this is a message (category=some_category)', 'stringifies too');
+    # Some of the Myriad RPC code expect the does method is present but it doesn't in old version
+    # This would enforce it
+    ok($ex->does('Myriad::Exception'), 'It inherits from Myriad::Exception role');
 };
 
 done_testing;