### ----------------------------------------------------
### -- Cro::HTTP
### -- Licenses: Artistic-2.0
### -- Authors: Jonathan Worthington <jnthn@jnthn.net>
### -- File: t/http-request-parser.rakutest
### ----------------------------------------------------
### -- Chunk 2 of 2
2,49,49,52,56,48,49,53,56,54,50,53,57,50,56,51,53,48,55,54,54,48,
        50,51,49,13,10,67,111,110,116,101,110,116,45,68,105,115,112,111,115,105,116,105,
        111,110,58,32,102,111,114,109,45,100,97,116,97,59,32,110,97,109,101,61,34,112,104,
        111,116,111,34,59,32,102,105,108,101,110,97,109,101,61,34,84,114,97,110,115,112,
        97,114,101,110,116,46,103,105,102,34,13,10,67,111,110,116,101,110,116,45,84,121,
        112,101,58,32,105,109,97,103,101,47,103,105,102,13,10,13,10,71,73,70,56,57,97,1,0,
        1,0,128,0,0,0,0,0,255,255,255,33,249,4,1,0,0,0,0,44,0,0,0,0,1,0,1,0,0,2,1,68,0,59,
        13,10,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,
        45,45,45,45,50,48,53,52,52,49,49,52,56,48,49,53,56,54,50,53,57,50,56,51,53,48,55,
        54,54,48,50,51,49,45,45,13,10),
    tests => {
        my $body = .body.result;
        my @parts = $body.parts;
        is @parts.elems, 2, 'Have 2 parts';

        is @parts[0].headers.elems, 1, 'First part has 1 header';
        is @parts[0].headers[0].name, 'Content-Disposition', 'First part header name correct';
        is @parts[0].headers[0].value, 'form-data; name="title"', 'First part header value correct';
        ok @parts[0].content-type ~~ Cro::MediaType,
            'First part has a content-type that is a Cro::MediaType';
        is @parts[0].content-type.type, 'text', 'First part has default text type';
        is @parts[0].content-type.subtype, 'plain', 'First part has default plain subtype';
        is @parts[0].name, 'title', 'First part has correct field name';
        ok !defined(@parts[0].filename), 'First part has no filename';
        is @parts[0].body-text, 'I can see right through this', 'First part has correct body text';
        is-deeply @parts[0].body, 'I can see right through this', 'First part has correct body';

        is @parts[1].headers.elems, 2, 'Second part has 2 headers';
        is @parts[1].headers[0].name, 'Content-Disposition',
            'First header name correct';
        is @parts[1].headers[0].value, 'form-data; name="photo"; filename="Transparent.gif"',
            'First header value correct';
        is @parts[1].headers[1].name, 'Content-Type',
            'Second header name correct';
        is @parts[1].headers[1].value, 'image/gif',
            'Second header value correct';
        ok @parts[1].content-type ~~ Cro::MediaType,
            'Second part has a content-type that is a Cro::MediaType';
        is @parts[1].content-type.type, 'image', 'Second part has image media type';
        is @parts[1].content-type.subtype, 'gif', 'Second part has gif media subtype';
        is @parts[1].name, 'photo', 'Second part has correct field name';
        is @parts[1].filename, 'Transparent.gif', 'Second part has correct filename';
        is-deeply @parts[1].body-blob,
            Blob[uint8].new(71,73,70,56,57,97,1,0,1,0,128,0,0,0,0,0,255,255,255,33,249,4,1,
                0,0,0,0,44,0,0,0,0,1,0,1,0,0,2,1,68,0,59),
            'Second part has correct body blob';
        is-deeply @parts[1].body,
            Blob[uint8].new(71,73,70,56,57,97,1,0,1,0,128,0,0,0,0,0,255,255,255,33,249,4,1,
                0,0,0,0,44,0,0,0,0,1,0,1,0,0,2,1,68,0,59),
            'Second part has correct body';
    };

parses 'An application/json request decodes JSON body',
    q:to/REQUEST/,
    POST /bar HTTP/1.1
    Content-type: application/json
    Content-Length: 25

    { "foo": [ "bar", 42 ] }
    REQUEST
    tests => {
        my $body = .body.result;
        ok $body ~~ Hash, '.body of application/json with object gives Hash';
        is-deeply $body, ${ foo => [ "bar", 42 ] }, 'JSON was correctly decoded';
    };

parses 'An media type with the +json suffix decodes JSON body',
    q:to/REQUEST/,
    POST /bar HTTP/1.1
    Content-type: application/vnd.my-org+json
    Content-Length: 25

    { "foo": [ "baz", 46 ] }
    REQUEST
    tests => {
        my $body = .body.result;
        ok $body ~~ Hash, '.body of application/vnd.my-org+json with object gives Hash';
        is-deeply $body, ${ foo => [ "baz", 46 ] }, 'JSON was correctly decoded';
    };

# XXX Test these security checks (allow configuration of them):
#
# HTTP does not place a predefined limit on the length of a
# request-line, as described in Section 2.5.  A server that receives a
# method longer than any that it implements SHOULD respond with a 501
# (Not Implemented) status code.  A server that receives a
# request-target longer than any URI it wishes to parse MUST respond
# with a 414 (URI Too Long) status code (see Section 6.5.12 of
# [RFC7231]).
#
# Various ad hoc limitations on request-line length are found in
# practice.  It is RECOMMENDED that all HTTP senders and recipients
# support, at a minimum, request-line lengths of 8000 octets.

sub messages($desc, $mess1, $mess2, @checks1, @checks2) {
    my $parser = Cro::HTTP::RequestParser.new;
    my $fake-in = Supplier.new;
    my Int $counter = 0;
    my $test-completed = Promise.new;
    $parser.transformer($fake-in.Supply).tap: -> $request {
        my $body = $request.body-text.result;
        if $counter == 0 {
            for @checks1.kv -> $i, $check {
                ok $check($body), "check first {$i + 1}";
            }

        } else {
            for @checks2.kv -> $i, $check {
                ok $check($body), "check second {$i + 1}";
            }
        }
        $counter++;
        $test-completed.keep(True) if $counter == 2;
    };

    start {
        my $req-blob1 = test-request-to-tcp-message($mess1);
        my $req-blob2 = test-request-to-tcp-message($mess2) if $mess2;
        $fake-in.emit($req-blob1);
        $fake-in.emit($req-blob2) if $mess2;
        $fake-in.done();
    }

    await Promise.anyof($test-completed, Promise.in(10));
    if $test-completed {
        pass $desc;
    } else {
        flunk $desc;
    }
}

messages 'Two separate packages are parsed', q:to/REQUEST/,
    POST /bar HTTP/1.1
    Content-Type: text/plain
    Content-Length: 22

    Fields, Flowers, Rails
    POST /bar HTTP/1.1
    Content-Type: text/plain
    Content-Length: 19

    Gear Of Despondency
    REQUEST
    q:to/REQUEST/,
    REQUEST
    ([* eq 'Fields, Flowers, Rails']),
    ([* eq 'Gear Of Despondency']);

messages 'Two separate packages are parsed, RequestLine in the first', q:to/REQUEST/,
    POST /bar HTTP/1.1
    Content-Type: text/plain
    Content-Length: 22

    Fields, Flowers, Rails
    POST /bar HTTP/1.1
    REQUEST
    q:to/REQUEST/,
    Content-Type: text/plain
    Content-Length: 19

    Gear Of Despondency
    REQUEST
    ([* eq 'Fields, Flowers, Rails']),
    ([* eq 'Gear Of Despondency']);

messages 'Two separate packages are parsed, RequestLine and part of header in the first', q:to/REQUEST/,
    POST /bar HTTP/1.1
    Content-Type: text/plain
    Content-Length: 22

    Fields, Flowers, Rails
    POST /bar HTTP/1.1
    Content-Type: text/plain
    REQUEST
    q:to/REQUEST/,
    Content-Length: 19

    Gear Of Despondency
    REQUEST
    ([* eq 'Fields, Flowers, Rails']),
    ([* eq 'Gear Of Despondency']);

done-testing;


