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