### ----------------------------------------------------
### -- HTTP::UserAgent
### -- Licenses: MIT
### -- Authors: Filip Sergot
### -- File: t/230-binary-request.rakutest
### ----------------------------------------------------
use HTTP::UserAgent;
use HTTP::Request::Common;
use Test::Util::ServerPort; 
         
use Test;

plan 6;

use lib $*PROGRAM.sibling('lib').Str;
use TestServer;

%*ENV<NO_PROXY> = 'localhost';

my sub get-rand-buff() {
    Buf.new((0 .. 0xFF).pick((10 .. 75).pick));
}

my $port = get-unused-port(); 

my $p = Promise.new;
my $s  = test-server($p, port => $port);

my $uri = "http://localhost:$port";

subtest {
    my $ua = HTTP::UserAgent.new;
    my $buf = get-rand-buff();
    my $req;
    lives-ok { $req = POST($uri, content => $buf);  }, "create POST with Buf";
    ok $req.content ~~ Blob, "content is a blob";
    is $req.content.elems, $buf.elems, "content is right length";
    is ~$req.header.field('Content-Length'), $buf.elems, "right 'Content-Length'";
    is ~$req.header.field('Content-Type'), 'application/octet-stream', "right (default) Content-Type";
    ok $req.binary, "and binary is good";
    my $res;
    lives-ok { $res = $ua.request($req) }, "make request";
    is $res.content-type, 'application/octet-stream', "got the right ct back";
    ok $res.is-binary, "got binary response";
    is $res.content.elems, $buf.elems, "and we got back what we sent";
    ok $res.content eqv $buf, "and buffer looks the same";

}, "POST (with defaults)";
subtest {
    my $ua = HTTP::UserAgent.new;
    my $buf = get-rand-buff();
    my $req;
    lives-ok { $req = POST($uri, content => $buf, Content-Type => 'image/x-something', Content-Length => 158); }, "create POST with Buf (supplying Content-Type and Content-Length";
    ok $req.content ~~ Blob, "content is a blob";
    is $req.content.elems, $buf.elems, "content is right length";
    is ~$req.header.field('Content-Length'), $buf.elems, "right 'Content-Length'";
    is ~$req.header.field('Content-Type'), 'image/x-something', "right explicit Content-Type";
    ok $req.binary, "and binary is good";
    my $res;
    lives-ok { $res = $ua.request($req) }, "make request";
    is $res.content-type, 'image/x-something', "got the right ct back";
    ok $res.is-binary, "got binary response";
    is $res.content.elems, $buf.elems, "and we got back what we sent";
    ok $res.content eqv $buf, "and buffer looks the same";

}, "POST (with explicit Content-Type)";

subtest {
    my $ua = HTTP::UserAgent.new;
    # need the "\n" because our server is so crap
    my $buf = "Hello, World!\r\n".encode;
    my $req;
    lives-ok { $req = POST($uri, content => $buf, Content-Type => 'text/plain', Content-Length => 158); }, "create POST with Buf (supplying Content-Type and Content-Length";
    ok $req.content ~~ Blob, "content is a blob";
    is $req.content.elems, $buf.elems, "content is right length";
    is ~$req.header.field('Content-Length'), $buf.elems, "right 'Content-Length'";
    is ~$req.header.field('Content-Type'), 'text/plain', "right explicit Content-Type";
    ok $req.binary, "and binary is good";
    my $res;
    lives-ok { $res = $ua.request($req) }, "make request";
    is $res.content-type, 'text/plain', "got the right ct back";
    nok $res.is-binary, "inferred text response";
    ok  $res.is-text, "and it's text";
    is $res.content.encode.elems, $buf.elems, "and we got back what we sent";
    is $res.content , "Hello, World!\r\n", "and content looks the same";

}, "POST (with something that will be text coming back)";

subtest {
    my $ua = HTTP::UserAgent.new;
    my $buf = get-rand-buff();
    my $req;
    lives-ok { $req = PUT($uri, content => $buf); }, "create PUT with Buf";
    ok $req.content ~~ Blob, "content is a blob";
    is $req.content.elems, $buf.elems, "content is right length";
    is ~$req.header.field('Content-Length'), $buf.elems, "right 'Content-Length'";
    is ~$req.header.field('Content-Type'), 'application/octet-stream', "right (default) Content-Type";
    ok $req.binary, "and binary is good";
    my $res;
    lives-ok { $res = $ua.request($req) }, "make request";
    is $res.content-type, 'application/octet-stream', "got the right ct back";
    ok $res.is-binary, "got binary response";
    is $res.content.elems, $buf.elems, "and we got back what we sent";
    ok $res.content eqv $buf, "and buffer looks the same";

}, "PUT (with defaults)";
subtest {
    my $ua = HTTP::UserAgent.new;
    my $buf = get-rand-buff();
    my $req;
    lives-ok { $req = PUT($uri, content => $buf, Content-Type => 'image/x-something', Content-Length => 158); }, "create PUT with Buf (supplying Content-Type and Content-Length";
    ok $req.content ~~ Blob, "content is a blob";
    is $req.content.elems, $buf.elems, "content is right length";
    is ~$req.header.field('Content-Length'), $buf.elems, "right 'Content-Length'";
    is ~$req.header.field('Content-Type'), 'image/x-something', "right explicit Content-Type";
    ok $req.binary, "and binary is good";
    my $res;
    lives-ok { $res = $ua.request($req) }, "make request";
    is $res.content-type, 'image/x-something', "got the right ct back";
    ok $res.is-binary, "got binary response";
    is $res.content.elems, $buf.elems, "and we got back what we sent";
    ok $res.content eqv $buf, "and buffer looks the same";

}, "PUT (with explicit Content-Type)";
subtest {
    my $ua = HTTP::UserAgent.new;
    # need the "\n" because our server is so crap
    my $buf = "Hello, World!\n".encode;
    my $req;
    lives-ok { $req = PUT($uri, content => $buf, Content-Type => 'text/plain', Content-Length => 158); }, "create PUT with Buf (supplying Content-Type and Content-Length";
    ok $req.content ~~ Blob, "content is a blob";
    is $req.content.elems, $buf.elems, "content is right length";
    is ~$req.header.field('Content-Length'), $buf.elems, "right 'Content-Length'";
    is ~$req.header.field('Content-Type'), 'text/plain', "right explicit Content-Type";
    ok $req.binary, "and binary is good";
    my $res;
    lives-ok { $res = $ua.request($req) }, "make request";
    is $res.content-type, 'text/plain', "got the right ct back";
    nok $res.is-binary, "inferred text response";
    ok  $res.is-text, "and it's text";
    is $res.content.encode.elems, $buf.elems, "and we got back what we sent";
    is $res.content , "Hello, World!\n", "and content looks the same";

}, "PUT (with something that will be text coming back)";

$p.keep("shutdown");
#try await $s;

# vim: expandtab shiftwidth=4


