File Coverage

blib/lib/Net/ACME2/JWTMaker.pm
Criterion Covered Total %
statement 43 48 89.5
branch 2 6 33.3
condition 3 6 50.0
subroutine 11 12 91.6
pod 0 3 0.0
total 59 75 78.6


line stmt bran cond sub pod time code
1             package Net::ACME2::JWTMaker;
2              
3             #----------------------------------------------------------------------
4             # This module exists because of a desire to do these computations
5             # in environments where a compiler may not be available.
6             # (Otherwise, CryptX would be ideal.)
7             #----------------------------------------------------------------------
8              
9 1     1   562 use strict;
  1         2  
  1         78  
10 1     1   8 use warnings;
  1         4  
  1         31  
11              
12 1     1   6 use JSON ();
  1         2  
  1         37  
13 1     1   9 use MIME::Base64 ();
  1         3  
  1         21  
14              
15 1     1   6 use Net::ACME2::X ();
  1         3  
  1         38  
16              
17             BEGIN {
18 1     1   668 *_encode_b64u = *MIME::Base64::encode_base64url;
19             }
20              
21             sub new {
22 6     6 0 22 my ($class, %opts) = @_;
23              
24 6 50       19 die Net::ACME2::X->create('Generic', 'need “key”') if !$opts{'key'};
25              
26 6         36 return bless \%opts, $class;
27             }
28              
29             sub create_full_jws {
30 12     12 0 50 my ($self, %args) = @_;
31              
32 12         91 local $args{'extra_headers'}{'jwk'} = $self->{'key'}->get_struct_for_public_jwk();
33              
34 12         137116 return $self->_create_jwt(%args);
35             }
36              
37             sub create_key_id_jws {
38 0     0 0 0 my ($self, %args) = @_;
39              
40 0         0 local $args{'extra_headers'}{'kid'} = $args{'key_id'};
41              
42 0         0 return $self->_create_jwt(%args);
43             }
44              
45             #----------------------------------------------------------------------
46              
47             #expects:
48             # payload - unblessed string, arrayref, or hashref
49             # extra_headers - hashref
50             sub _create_jwt {
51 12     12   61 my ( $self, %args ) = @_;
52              
53 12         63 my $alg = $self->_ALG();
54 12         103756 my $signer_cr = $self->_get_signer();
55              
56 12         37 my $key = $self->{'key'};
57              
58 12         30 my $payload = $args{payload};
59              
60 12         24 my $header = { %{$args{extra_headers}} };
  12         58  
61              
62             # serialize payload
63 12         54 $payload = $self->_payload_enc($payload);
64              
65             # encode payload
66 12         53 my $b64u_payload = _encode_b64u($payload);
67              
68             # prepare header
69 12         251 $header->{alg} = $alg;
70              
71             # encode header
72 12         31 my $json_header = $self->_encode_json($header);
73 12         29 my $b64u_header = _encode_b64u($json_header);
74              
75 12         162 my $b64u_signature = _encode_b64u( $signer_cr->("$b64u_header.$b64u_payload", $key) );
76              
77 12         84724178 return $self->_encode_json(
78             {
79             protected => $b64u_header,
80             payload => $b64u_payload,
81             signature => $b64u_signature,
82             }
83             );
84             }
85              
86             sub _encode_json {
87 36     36   188 my ($self, $payload) = @_;
88              
89             #Always do a canonical encode so that we can test more easily.
90             #Note that JWS itself does NOT require this.
91 36   66     231 $self->{'_json'} ||= JSON->new()->canonical(1);
92              
93 36         659 return $self->{'_json'}->encode($payload);
94             }
95              
96             #Derived from Crypt::JWT
97             sub _payload_enc {
98 12     12   31 my ($self, $payload) = @_;
99              
100 12 50 33     58 if (ref($payload) eq 'HASH' || ref($payload) eq 'ARRAY') {
101 12         44 $payload = $self->_encode_json($payload);
102             }
103             else {
104 0 0       0 utf8::downgrade($payload, 1) or do {
105 0         0 die Net::ACME2::X->create('Generic', "JWT: payload ($payload) cannot contain wide character");
106             };
107             }
108              
109 12         31 return $payload;
110             }
111              
112             1;