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 2     2   1030 use strict;
  2         49  
  2         59  
10 2     2   10 use warnings;
  2         5  
  2         82  
11              
12 2     2   44 use JSON ();
  2         6  
  2         43  
13 2     2   11 use MIME::Base64 ();
  2         3  
  2         39  
14              
15 2     2   10 use Net::ACME2::X ();
  2         3  
  2         65  
16              
17             BEGIN {
18 2     2   1055 *_encode_b64u = *MIME::Base64::encode_base64url;
19             }
20              
21             sub new {
22 12     12 0 41 my ($class, %opts) = @_;
23              
24 12 50       68 die Net::ACME2::X->create('Generic', 'need “key”') if !$opts{'key'};
25              
26 12         69 return bless \%opts, $class;
27             }
28              
29             sub create_full_jws {
30 24     24 0 104 my ($self, %args) = @_;
31              
32 24         107 local $args{'extra_headers'}{'jwk'} = $self->{'key'}->get_struct_for_public_jwk();
33              
34 24         305360 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 24     24   102 my ( $self, %args ) = @_;
52              
53 24         108 my $alg = $self->_ALG();
54 24         238983 my $signer_cr = $self->_get_signer();
55              
56 24         71 my $key = $self->{'key'};
57              
58 24         60 my $payload = $args{payload};
59              
60 24         40 my $header = { %{$args{extra_headers}} };
  24         123  
61              
62             # serialize payload
63 24         118 $payload = $self->_payload_enc($payload);
64              
65             # encode payload
66 24         80 my $b64u_payload = _encode_b64u($payload);
67              
68             # prepare header
69 24         365 $header->{alg} = $alg;
70              
71             # encode header
72 24         51 my $json_header = $self->_encode_json($header);
73 24         67 my $b64u_header = _encode_b64u($json_header);
74              
75 24         343 my $b64u_signature = _encode_b64u( $signer_cr->("$b64u_header.$b64u_payload") );
76              
77 24         188369096 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 72     72   180 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 72   66     373 $self->{'_json'} ||= JSON->new()->canonical(1);
92              
93 72         1331 return $self->{'_json'}->encode($payload);
94             }
95              
96             #Derived from Crypt::JWT
97             sub _payload_enc {
98 24     24   67 my ($self, $payload) = @_;
99              
100 24 50 33     114 if (ref($payload) eq 'HASH' || ref($payload) eq 'ARRAY') {
101 24         79 $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 24         69 return $payload;
110             }
111              
112             1;