view release on metacpan or  search on metacpan

bin/mock_onfido.pl  view on Meta::CPAN

            if (exists $applicants{$id}) {
                $deleted_applicants{$id} = delete $applicants{$id};
                $deleted_applicants{$id}->{delete_at} =
                    Date::Utility->new()->datetime_iso8601;
            }

            # no content
            return HTTP::Response->new(204);
        }
    }};

# here lies the http server

my $httpserver = Net::Async::HTTP::Server->new(
    on_request => sub {
        my $self = shift;
        my ($req) = @_;

        my $controller = $router->{lc $req->method}->{$req->path};

        # parametric route pairing
        # if some route is parametric (e.g: /:document_id)
        # we will split that path and compare coincidences against the router
        # a full coincidence would resolve to that controller
        unless ($controller) {
            for my $route (keys $router->{lc $req->method}->%*) {
                my @path_chunks  = split /\//, $req->path;
                my @route_chunks = split /\//, $route;

                next unless scalar @route_chunks == scalar @path_chunks;

                my @matching_chunks = grep {
                    my $path_chunk = shift @path_chunks;

# a parametric path can be considered a coincidence regardless of the actual path value
# at that position
                    $_ =~ /^:.*/ ? 1 : $_ eq $path_chunk;
                } @route_chunks;

                $controller = $router->{lc $req->method}->{$route}
                    if scalar @matching_chunks == scalar @route_chunks;

                last if $controller;
            }
        }

        $controller
            ? $req->respond($controller->($req))
            : $req->respond(HTTP::Response->new(404));
    },
);

# Run the HTTP server

my $loop = IO::Async::Loop->new();
$loop->add($httpserver);

$httpserver->listen(
    addr => {
        family   => "inet6",
        socktype => "stream",
        port     => 3000
    },
)->get;

$loop->run;

sub END {
    for my $f (values %files) {
        print "removing $f\n";
        $f->remove;
    }

    $loop->stop;
}

# HTTP SERVER UTILITIES

# sends a json response

sub json_response {
    my ($req, $payload) = @_;

    my $response = HTTP::Response->new(200);
    my $json     = encode_json_utf8($payload);

    $response->add_content($json);
    $response->content_type('application/json');
    $response->content_length(length $response->content);

    return $response;
}
# dumps a generated on the fly really tiny pdf file

sub pdf_response {
    my ($req, $id) = @_;

    my $response = HTTP::Response->new(200);
    my $file     = decode_base64(DAMN_SMALL_PDF);

    $response->add_content($file);
    $response->content_type('application/pdf');
    $response->content_length(length $file);
    $response->header('content-disposition' => 'attachment; filename="' . $id . '.pdf"');

    return $response;
}

# dumps a file

sub file_response {
    my ($req, $id) = @_;

    my $response = HTTP::Response->new(200);
    $response->add_content($files{$id}->slurp_raw);

    my $data = $documents{$id} // $photos{$id};

    $response->content_type($data->{file_type});
    $response->content_length($data->{file_size});