The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;

use lib 't/lib';
use MongooseT;

{
	package Request;
	use Moose;
	use Moose::Util::TypeConstraints;
	with 'Mongoose::Document';

	use HTTP::Headers  ();
	use Params::Coerce ();
	use URI            ();

	subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');

	coerce 'My::Types::HTTP::Headers'
	=> from 'ArrayRef'
	=> via { HTTP::Headers->new( @{$_} ) }
	=> from 'HashRef'
	=> via { HTTP::Headers->new( %{$_} ) };

	subtype 'My::Types::URI' => as class_type('URI');

	coerce 'My::Types::URI'
	=> from 'Object'
	=> via { $_->isa('URI')
		? $_
			: Params::Coerce::coerce( 'URI', $_ ); }
			=> from 'Str'
			=> via { URI->new( $_, 'http' ) };

	subtype 'Protocol'
	=> as 'Str'
	=> where { /^HTTP\/[0-9]\.[0-9]$/ };

	has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
	has 'uri'  => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
	has 'method'   => ( is => 'rw', isa => 'Str' );
	has 'protocol' => ( is => 'rw', isa => 'Protocol' );
	has 'headers'  => (
			is      => 'rw',
			isa     => 'My::Types::HTTP::Headers',
			coerce  => 1,
			default => sub { HTTP::Headers->new }
			);
}

package main;
{
	my $r = new Request( base=>'http://example.com', headers=>{ "user-agent"=> 'mozilla' });
	my $id = $r->save;
	is( ref($id), 'MongoDB::OID', 'id ok' );
}
{
	my $r = Request->find->next;
	is( ref($r->_id), 'MongoDB::OID', 'id ok again' );
	ok( $r->base->isa('URI::http'), 'isa uri' );
	ok( $r->headers->isa('HTTP::Headers'), 'isa uri' );
	$r->delete;
	is( Request->find->count, 0, 'nobody left');
}

done_testing;