File Coverage

blib/lib/Protocol/Matrix.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	12	20	60.0
condition			n/a
subroutine	12	12	100.0
pod	4	4	100.0
total	72	80	90.0

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2015 -- [e-mail]

package Protocol::Matrix;

use strict;
use warnings;
use 5.014; # s///r

our $VERSION = '0.01';

use Carp;

use Crypt::NaCl::Sodium;
use JSON;
use MIME::Base64 qw( encode_base64 decode_base64 );

use Exporter 'import';
our @EXPORT_OK = qw(
   encode_json_for_signing
   encode_base64_unpadded

   sign_json
   verify_json_signature
);

my $sign = Crypt::NaCl::Sodium->sign;

my $json_canon = JSON->new
                     ->convert_blessed
                     ->canonical
                     ->utf8;

=head1 NAME

C - Helper functions for the Matrix protocol

=head1 DESCRIPTION

This module provides some helper functions for implementing a F client
or server. Currently it only contains a few base-level functions to assist
with signing and verifying signatures on federation-level events.

=cut

=head1 FUNCTIONS

=cut

=head2 encode_json_for_signing

   $json = encode_json_for_signing( $data )

Encodes a given HASH reference as Canonical JSON, having removed the
C and C keys if present. This is the first step
towards signing it or verifying an embedded signature in it. The hash
referred to by C<$data> remains unmodified by this function.

=cut

sub encode_json_for_signing
{
   my ( $d ) = @_;

   # Remove keys that don't get signed
   my %to_sign = %$d;
   delete $to_sign{signatures};
   delete $to_sign{unsigned};

   return $json_canon->encode( \%to_sign );
}

=head2 encode_base64_unpadded

   $base64 = encode_base64( $bytes )

Returns a character string containing the Base-64 encoding of the given bytes,
with no internal linebreaks and no trailing padding.

=cut

sub encode_base64_unpadded
{
   return encode_base64( $_[0], "" ) =~ s/=+$//r;
}

=head2 sign_json

   sign_json( $data, secret_key => $key, origin => $name, key_id => $id )

Modifies the given HASH reference in-place to add a signature. This signature
is created from the given key, and annotated as being from the given origin
name and key ID. Existing signatures already in the hash are not disturbed.

The C<$key> should be a plain byte string or L object obtained
from L's C method.

=cut

sub sign_json
{
   my ( $data, %args ) = @_;

   my $key = $args{secret_key} or croak "Require a 'secret_key'";

   my $origin = $args{origin} or croak "Require an 'origin'";
   my $key_id = $args{key_id} or croak "Require a 'key_id'";

   my $signature = $sign->mac( encode_json_for_signing( $data ), $key );

   $data->{signatures}{$origin}{$key_id} = encode_base64_unpadded( $signature );
}

=head2 verify_json_signature

   verify_json_signature( $data, public_key => $key, origin => $name, key_id => $id )

Inspects the given HASH reference to check that it contains a signature from
the named origin, with the given key ID, and that it is actually valid.

This function does not return an interesting value; all failures are indicated
by thrown exceptions. If no exception is thrown, it can be presumed valid.

=cut

sub verify_json_signature
{
   my ( $data, %args ) = @_;

   my $key = $args{public_key} or croak "Require a 'public_key'";

   my $origin = $args{origin} or croak "Require an 'origin'";
   my $key_id = $args{key_id} or croak "Require a 'key_id'";

   $data->{signatures} or
      croak "No 'signatures'";
   $data->{signatures}{$origin} or
      croak "No signatures from '$origin'";

   my $signature = $data->{signatures}{$origin}{$key_id} or
      croak "No signature from '$origin' using key '$key_id'";

   $sign->verify( decode_base64( $signature ), encode_json_for_signing( $data ), $key ) or
      croak "Signature verification failed";
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;