t/030_with_checksum.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   6 use Test::Deep;
   7
   8 use Test::Requires {
   9     'Digest' => 0.01, # skip all if not installed
  10     'Digest::SHA' => 0.00,
  11     'JSON::Any' => 0.01,
  12 };
  13
  14 BEGIN {
  15     plan tests => 26;
  16     use_ok('MooseX::Storage');
  17 }
  18
  19 {
  20     package Foo;
  21     use Moose;
  22     use MooseX::Storage;
  23
  24     with Storage(base => 'WithChecksum', format => "JSON");
  25
  26     has 'number' => ( is => 'ro', isa => 'Int' );
  27     has 'string' => ( is => 'ro', isa => 'Str' );
  28     has 'float'  => ( is => 'ro', isa => 'Num' );
  29     has 'array'  => ( is => 'ro', isa => 'ArrayRef' );
  30     has 'hash'   => ( is => 'ro', isa => 'HashRef' );
  31     has 'object' => ( is => 'ro', isa => 'Foo' );
  32 }
  33
  34 {
  35     my $foo = Foo->new(
  36         number => 10,
  37         string => 'foo',
  38         float  => 10.5,
  39         array  => [ 1 .. 10 ],
  40         hash   => { map { $_ => undef } ( 1 .. 10 ) },
  41         object => Foo->new( number => 2 ),
  42     );
  43     isa_ok( $foo, 'Foo' );
  44
  45     my $packed = $foo->pack;
  46
  47     cmp_deeply(
  48         $packed,
  49         {
  50             __CLASS__ => 'Foo',
  51             __DIGEST__  => re('[0-9a-f]+'),
  52             number    => 10,
  53             string    => 'foo',
  54             float     => 10.5,
  55             array     => [ 1 .. 10 ],
  56             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  57             object    => {
  58                             __CLASS__ => 'Foo',
  59                             __DIGEST__  => re('[0-9a-f]+'),
  60                             number    => 2
  61                          },
  62         },
  63         '... got the right frozen class'
  64     );
  65
  66     my $foo2;
  67     is( exception {
  68         $foo2 = Foo->unpack($packed);
  69     }, undef, '... unpacked okay');
  70     isa_ok($foo2, 'Foo');
  71
  72     cmp_deeply(
  73         $foo2->pack,
  74         {
  75             __CLASS__ => 'Foo',
  76             __DIGEST__  => re('[0-9a-f]+'),
  77             number    => 10,
  78             string    => 'foo',
  79             float     => 10.5,
  80             array     => [ 1 .. 10 ],
  81             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  82             object    => {
  83                             __CLASS__ => 'Foo',
  84                             __DIGEST__  => re('[0-9a-f]+'),
  85                             number    => 2
  86                          },
  87         },
  88         '... got the right frozen class'
  89     );
  90 }
  91
  92 {
  93     my $foo = Foo->new(
  94         number => 10,
  95         string => 'foo',
  96         float  => 10.5,
  97         array  => [ 1 .. 10 ],
  98         hash   => { map { $_ => undef } ( 1 .. 10 ) },
  99         object => Foo->new( number => 2 ),
 100     );
 101     isa_ok( $foo, 'Foo' );
 102
 103     my $frozen = $foo->freeze;
 104
 105     ok( length($frozen), "got frozen data" );
 106
 107     $frozen =~ s/foo/bar/;
 108
 109     my $foo2 = eval { Foo->thaw( $frozen ) };
 110     my $e = $@;
 111
 112     ok( !$foo2, "not thawed" );
 113     ok( $e, "has error" );
 114     like( $e, qr/bad checksum/i, "bad checksum error" );
 115 }
 116
 117 SKIP: {
 118     eval { require Digest::HMAC_SHA1 };
 119     if ($@)
 120     {
 121         my $message = join( " ", "no Digest::HMAC", ( $@ =~ /\@INC/ ? () : do { chomp(my $e = $@); "($e)" } ) );
 122         die $message if $ENV{AUTHOR_TESTING};
 123         skip $message, 15;
 124     }
 125
 126     local $::DEBUG = 1;
 127
 128     my $foo = Foo->new(
 129         number => 10,
 130         string => 'foo',
 131         float  => 10.5,
 132         array  => [ 1 .. 10 ],
 133         hash   => { map { $_ => undef } ( 1 .. 10 ) },
 134         object => Foo->new( number => 2 ),
 135     );
 136     isa_ok( $foo, 'Foo' );
 137
 138     my $frozen1 = $foo->freeze( digest => [ "HMAC_SHA1", "secret" ] );
 139     ok( length($frozen1), "got frozen data" );
 140
 141     $::DEBUG = 0;
 142
 143     my $d2 = Digest::HMAC_SHA1->new("s3cr3t");
 144
 145     my $frozen2 = $foo->freeze( digest => $d2 );
 146     ok( length($frozen2), "got frozen data" );
 147
 148     cmp_ok( $frozen1, "ne", $frozen2, "versions are different" );
 149
 150     is( $frozen1, $foo->freeze( digest => [ HMAC_SHA1 => "secret" ] ), "refreeze" );
 151
 152 $::DEBUG = 1;
 153
 154     my $foo1 = eval { Foo->thaw( $frozen1, digest => [ "HMAC_SHA1", "secret" ] ) };
 155     my $e = $@;
 156
 157     ok( $foo1, "thawed" );
 158     ok( !$e, "no error" ) || diag $e;
 159
 160     my $foo2 = eval { Foo->thaw( $frozen2, digest => $d2 ) };
 161     $e = $@;
 162
 163     ok( $foo2, "thawed" );
 164     ok( !$e, "no error" ) || diag $e;
 165
 166     $foo1 = eval { Foo->thaw( $frozen1, digest => $d2 ) };
 167     $e = $@;
 168
 169     ok( !$foo1, "not thawed" );
 170     ok( $e, "has error" );
 171     like( $e, qr/bad checksum/i, "bad checksum error" );
 172
 173     $frozen1 =~ s/foo/bar/;
 174
 175     $foo1 = eval { Foo->thaw( $frozen1, digest => [ "HMAC_SHA1", "secret" ] ) };
 176     $e = $@;
 177
 178     ok( !$foo1, "not thawed" );
 179     ok( $e, "has error" );
 180     like( $e, qr/bad checksum/i, "bad checksum error" );
 181 }