view release on metacpan or  search on metacpan

t/dispatch/interval_lock.t  view on Meta::CPAN

    $status = req( $test, 200, 'root', 'DELETE', "/interval/iid/$iid" );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
}

note( '- required property missing' );
req( $test, 400, 'root', 'POST', $base, <<"EOH" );
{ "intvl" : "[1957-01-02 08:00, 1957-01-02 08:00)", "whinger" : "me" }
EOH

note( '- nonsensical JSON' );
req( $test, 400, 'root', 'POST', $base, 0 );
req( $test, 400, 'root', 'POST', $base, '[ 1, 2, [1, 2], { "wombat":"five" } ]' );

note( 'DELETE' );
req( $test, 405, 'demo', 'DELETE', $base );
req( $test, 405, 'root', 'DELETE', $base );
req( $test, 405, 'WOMBAT5', 'DELETE', $base );


note( '=============================' );
note( '"lock/new" resource (see below for tests common to both "interval/new" and "lock/new" )' );
note( '=============================' );
$base = 'lock/new';
docu_check($test, $base);

note( 'GET, PUT -> 405' );
foreach my $method ( 'GET', 'PUT' ) {
    foreach my $user ( 'demo', 'active', 'root', 'WOMBAT5', 'WAMBLE owdkmdf 5**' ) {
        req( $test, 405, $user, $method, $base );
    }
}

note( 'POST' );
note ('instigate a "403 Forbidden"' );
foreach my $user ( qw( demo inactive ) ) {
    req( $test, 403, $user, 'POST', $base, <<"EOH" );
{ "intvl" : "[1957-01-02 00:00, 1957-01-03 24:00)" }
EOH
}

note( 'let active and root create themselves a lock' );
foreach my $user ( qw( active root ) ) {
    note( 'user == "active"' );
    $status = req( $test, 201, $user, 'POST', $base, <<"EOH" );
{ "intvl" : "[1957-01-02 00:00, 1957-01-03 24:00)" }
EOH
    if ( $status->not_ok ) {
        diag( "MARK foo5" );
        diag( Dumper $status );
        BAIL_OUT(0);
    }
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    ok( $status->{'payload'} );
    ok( $status->{'payload'}->{'lid'} );
    my $lid = $status->payload->{'lid'};
    note( "$user successfully created a lock" );

    note( "let $user try to add an intervals that overlap the locked period in various ways" );
    foreach my $intvl ( 
        '[1957-01-02 08:00, 1957-01-02 12:00)', # completely within the lock interval
        '[1957-01-03 23:00, 1957-01-04 01:00)', # extends past end of lock interval
        '[1957-01-02 08:00, today)',            # -- " -- but with 'today'
        '[1956-12-31 08:00, 1957-01-02 00:05)', # starts before beginning of lock interval
    ) {
        dbi_err( $test, 500, $user, 'POST', 'interval/new', 
            '{ "aid" : ' . $aid_of_work . ', "intvl" : "' . $intvl . '" }',
            qr/interval is locked/i 
        );
    }

    note( "'active' can't delete locks so we have to delete them as root" );
    $status = req( $test, 200, 'root', 'DELETE', "/lock/lid/$lid" );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
}

note( 'as long as all required properties are present, JSON with bogus properties' );
note( 'will be accepted for insert operation (bogus properties will be silently ignored)' );
foreach my $rb ( 
    "{ \"intvl\" : \"[1957-01-02 00:00, 1957-01-02 24:00)\", \"whinger\" : \"me\" }",
    "{ \"intvl\" : \"[1957-01-03 00:00, 1957-01-03 24:00)\", \"horse\" : \"E-Or\" }",
    "{ \"intvl\" : \"[1957-01-04 00:00, 1957-01-04 24:00)\", \"nine dogs\" : [ 1, 9 ] }"
) {
    $status = req( $test, 201, 'root', 'POST', $base, $rb );
    if ( $status->not_ok ) {
        diag( "MARK foo6" );
        diag( Dumper $status );
        BAIL_OUT(0);
    }
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    ok( $status->{'payload'} );
    ok( $status->{'payload'}->{'lid'} );
    my $lid = $status->payload->{'lid'};

    $status = req( $test, 200, 'root', 'DELETE', "/lock/lid/$lid" );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
}

note( 'required property missing' );
$status = req( $test, 400, 'root', 'POST', $base, <<"EOH" );
{ "whinger" : "me" }
EOH
is( $status->level, 'ERR' );
is( $status->code, 'DISPATCH_PROP_MISSING_IN_ENTITY' );

note( 'nonsensical JSON' );
$status = req( $test, 400, 'root', 'POST', $base, 0 );
$status = req( $test, 400, 'root', 'POST', $base, '[ 1, 2, [1, 2], { "wombat":"five" } ]' );

note( 'create an interval, lock it, and then try to update it and delete it' );

note( '- create interval' );
$status = req( $test, 201, 'root', 'POST', 'interval/new', <<"EOH" );
{ "aid" : $aid_of_work, "intvl" : "[1957-01-02 08:00, 1957-01-03 08:00)" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
my $ti = $status->payload->{'iid'};

note( '- lock it' );
$status = req( $test, 201, 'root', 'POST', 'lock/new', <<"EOH" );
{ "intvl" : "[1957-01-01 00:00, 1957-02-01 00:00)" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
my $tl = $status->payload->{'lid'};

note( '- try to update it' );
dbi_err( $test, 500, 'root', 'PUT', "interval/iid/$ti", 
    '{ "long_desc" : "I\'m changing this interval even though it\'s locked!" }',
    qr/interval is locked/ );

note( '- try to delete it' );
dbi_err( $test, 500, 'root', 'DELETE', "interval/iid/$ti", undef,
    qr/interval is locked/ );

note( '- remove the lock' );
$status = req( $test, 200, 'root', 'DELETE', "lock/lid/$tl" );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );

note( '- now we can delete it' );
$status = req( $test, 200, 'root', 'DELETE', "interval/iid/$ti" );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );

note( 'create a lock over the entire month of August 2014 and try to create' );
note( 'intervals that might be considered "edge cases"' );

$status = req( $test, 201, 'root', 'POST', 'lock/new', <<"EOH" );
{ "eid" : $eid_active, "intvl" : "[2014-08-01 00:00, 2014-09-01 00:00)" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
my $tlid = $status->payload->{'lid'};
$status = req( $test, 200, 'root', 'GET', "lock/lid/$tlid" );
ok( $status->ok );

note( '- this one will be OK' );
$status = req( $test, 201, 'active', 'POST', 'interval/new', <<"EOH" );
{ "aid" : $aid_of_work, "eid" : $eid_active, "intvl" : "[2014-07-31 20:00, 2014-08-01 00:00)" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
my $tiid = $status->payload->{'iid'};
$status = req( $test, 200, 'active', 'DELETE', "interval/iid/$tiid" );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
req( $test, 404, 'active', 'GET', "interval/iid/$tiid" );

note( '- illegal interval' );
dbi_err( $test, 500, 'active', 'POST', 'interval/new', 
    '{ "aid" : ' . $aid_of_work . ', "eid" : ' . $eid_active . 
        ', "intvl" : "[2014-07-31 20:00, 2014-08-01 00:00]" }', $illegal );

note( '- upper bound not evenly divisible by 5 minutes' );
dbi_err( $test, 500, 'active', 'POST', 'interval/new',
    '{ "aid" : '. $aid_of_work . ', "eid" : ' . $eid_active .
        ', "intvl" : "[2014-07-31 20:00, 2014-08-01 00:01)" }',
    qr/upper and lower bounds of interval must be evenly divisible by 5 minutes/ );

note( '- interval is locked' );
dbi_err( $test, 500, 'active', 'POST', 'interval/new',
    '{ "aid" : '. $aid_of_work . ', "eid" : ' . $eid_active .
        ', "intvl" : "[2014-07-31 20:00, 2014-08-01 00:05)" }',
    qr/interval is locked/ );

note( 'now let\'s try to attack upper bound of lock' );
note( '- this one looks like it might conflict with the lock\'s upper bound');
note( '  (2014-09-01), but since the upper bound is non-inclusive, the interval will');
note( '  be OK');

$status = req( $test, 201, 'active', 'POST', 'interval/new', <<"EOH" );
{ "aid" : $aid_of_work, "eid" : $eid_active, "intvl" : "[2014-09-01 00:00, 2014-09-01 04:00)" }
EOH
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
$tiid = $status->payload->{'iid'};
$status = req( $test, 200, 'active', 'DELETE', "interval/iid/$tiid" );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
req( $test, 404, 'active', 'GET', "interval/iid/$tiid" );

note( '- conclusion: I see no way to create an unexpected conflict (famous last words)' );

note( 'CLEANUP: delete the lock' );
$status = req( $test, 200, 'root', 'DELETE', "lock/lid/$tlid" );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
req( $test, 404, 'root', 'GET', "lock/lid/$tlid" );

note( "have an active user try to create a lock on someone else's attendance" );

req( $test, 403, 'active', 'POST', $base, <<"EOH" );
{ "eid" : $eid_inactive, "intvl" : "[1957-02-01 00:00, 1957-03-01 00:00)" }
EOH

note( 'DELETE -> 405' );
req( $test, 405, 'demo', 'DELETE', $base );
req( $test, 405, 'root', 'DELETE', $base );
req( $test, 405, 'WOMBAT5', 'DELETE', $base );


note( "========================" );
note( "'/interval/new' resource" );
note( "'/lock/new' resource" );
note( "tests of many pathological intervals" );
note( "========================" );

note( "tests common to both /interval/new and /lock/new" );

foreach my $il ( qw( interval lock ) ) {

    note( "looping: il == $il" );

    note( 'initialize insert tests' );
    my $insert_base = "$il/new";
    my $insert_part1 = ( $il eq 'interval' ) 
        ? "{ \"aid\" : $aid_of_work, \"intvl\" : "
        : "{ \"intvl\" : ";

    note( 'initialize update tests' );
    my $test_id = ( $il eq 'interval' ) ? $test_iid : $test_lid;
    my $update_base = "$il/$idmap{$il}/$test_id";
    my $update_part1 = "{ \"$idmap{$il}\" : $test_id, \"intvl\" : ";