1package Test::ACME2_Server;
2
3use Test::Crypt;
4
5use Net::ACME2::HTTP_Tiny;
6
7use constant _CONTENT_TYPE_JSON => ( 'content-type' => 'application/json' );
8
9use constant TOS_URL => 'http://the-terms-of-service/are/here';
10
11my $nonce_counter = 0;
12
13sub new {
14    my ($class, %opts) = @_;
15
16    my $self = bless \%opts, $class;
17
18    $self->{'ca_class'} or die "need “ca_class”!";
19
20    # For now, this is kept here. It’s feasible that future testing
21    # needs may prompt a desire to make it customizable.
22    $self->{'routing'} = {
23        ('GET:' . $self->{'ca_class'}->DIRECTORY_PATH()) => sub {
24            my $host = $self->{'ca_class'}->HOST();
25
26            return {
27                status => 'HTTP_OK',
28                headers => {
29                    _CONTENT_TYPE_JSON(),
30                },
31                content => {
32                    meta => {
33                        termsOfService => TOS_URL(),
34                    },
35
36                    newNonce => "https://$host/my-new-nonce",
37                    newAccount => "https://$host/my-new-account",
38                },
39            };
40        },
41
42        "HEAD:/my-new-nonce" => sub {
43            return {
44                status => 'HTTP_NO_CONTENT',
45                headers => {
46                    $self->_new_nonce_header(),
47                },
48            };
49        },
50
51        'POST:/my-new-account' => sub {
52            my $args_hr = shift;
53
54            my ($key_obj, $header, $payload) = Test::Crypt::decode_acme2_jwt_extract_key($args_hr->{'content'});
55
56            my $is_ecc = $key_obj->isa('Crypt::Perl::ECDSA::PublicKey');
57            my $pem_method = $is_ecc ? 'to_pem_with_curve_name' : 'to_pem';
58
59            my $key_pem = $key_obj->$pem_method();
60
61            my $status;
62            if ($self->{'_registered_keys'}{$key_pem}) {
63                $status = 'OK';
64            }
65            else {
66                $self->{'_registered_keys'}{$key_pem} = 1;
67                $status = 'CREATED';
68            }
69
70            my %response;
71
72            for my $name ( Net::ACME2::newAccount_booleans() ) {
73                next if !exists $payload->{$name};
74
75                if (ref($payload->{$name}) ne ref( JSON::true )) {
76                    die "$name should be boolean, not “$name”";
77                }
78
79                $response{$name} = $payload->{$name};
80            }
81
82            my $host = $self->{'ca_class'}->HOST();
83
84            return {
85                status => "HTTP_$status",
86                headers => {
87                    $self->_new_nonce_header(),
88                    _CONTENT_TYPE_JSON(),
89                    location => "https://$host/key/" . Digest::MD5::md5_hex($key_pem),
90                },
91                content => \%response,
92            };
93        },
94    };
95
96    $opts{'_base_request'} = \&Net::ACME2::HTTP_Tiny::_base_request;
97
98    {
99        no warnings 'redefine';
100        *Net::ACME2::HTTP_Tiny::_base_request = sub {
101            my ($http, $method, $url, $args_hr) = @_;
102
103            return $self->_handle_request($method, $url, $args_hr);
104        };
105    }
106
107    return $self;
108}
109
110sub DESTROY {
111    my ($self) = @_;
112
113    {
114        no warnings 'redefine';
115        *Net::ACME2::HTTP_Tiny::_base_request = $self->{'_base_request'};
116    }
117
118    return;
119}
120
121sub _verify_nonce {
122    my ($self, $args_hr) = @_;
123
124    my $content_hr = JSON::decode_json($args_hr->{'content'});
125    my $headers_hr = JSON::decode_json( MIME::Base64::decode_base64url( $content_hr->{'protected'} ) );
126
127    my $nonce = $headers_hr->{'nonce'};
128
129    if (!$nonce) {
130        die "No nonce given!";
131    }
132
133    delete $self->{'_nonces'}{$nonce} or do {
134        die "Unrecognized nonce! ($nonce)";
135    };
136
137    return;
138}
139
140sub _new_nonce_header {
141    my ($self) = @_;
142
143    my $new_nonce = "nonce-$nonce_counter";
144    $self->{'_nonces'}{$new_nonce} = 1;
145
146    $nonce_counter++;
147
148    return 'replay-nonce' => $new_nonce;
149}
150
151sub _verify_content_type {
152    my ($self, $args_hr) = @_;
153
154    my $ctype = $args_hr->{'headers'}{'content-type'};
155    if ($ctype ne 'application/jose+json') {
156        die "Wrong content-type ($ctype)";
157    }
158
159    return;
160}
161
162sub _handle_request {
163    my ($self, $method, $url, $args_hr) = @_;
164
165    if ($method eq 'POST') {
166        $self->_verify_content_type($args_hr);
167        $self->_verify_nonce($args_hr);
168    }
169
170    my $host = $self->{'ca_class'}->HOST();
171    my $dir_path = $self->{'ca_class'}->DIRECTORY_PATH();
172
173    my $uri = URI->new($url);
174    die "Must be https! ($url)" if $uri->scheme() ne 'https';
175    die "Wrong host! ($url)" if $uri->host() ne $host;
176
177    my $path = $uri->path();
178
179    my $dispatch_key = "$method:$path";
180
181    my $todo_cr = $self->{'routing'}{$dispatch_key} or do {
182        my @routes = keys %{ $opts{'routing'} };
183        die "No routing for “$dispatch_key”! (@routes)";
184    };
185
186    my $resp_hr = $todo_cr->($args_hr);
187
188    $resp_hr->{'status'} = HTTP::Status->can( $resp_hr->{'status'} )->();
189    $resp_hr->{'reason'} = HTTP::Status::status_message( $resp_hr->{'status'} );
190    $resp_hr->{'success'} = HTTP::Status::is_success($resp_hr->{'status'});
191    $resp_hr->{'uri'} = $url;
192
193    ref && ($_ = JSON::encode_json($_)) for $resp_hr->{'content'};
194
195    return $resp_hr;
196};
197
1981;
199