Merge pull request #351 from Troglodyne-Internet-Widgets/use-cpan-trog-sqlite

Use Trog::SQLite from CPAN, and keep the failures that callers answer

Makefile.PL

@@ -21,6 +21,7 @@ WriteMakefile(
     },
     PREREQ_PM => {
         'Trog::TOTP'                          => '1.007',
+        'Trog::SQLite'                        => '0.001',
         'CGI::Cookie'                         => '0',
         'Capture::Tiny'                       => '0',
         'Carp'                                => '0',

Readme.md

@@ -139,8 +139,10 @@ site, a search goes from about 2.5 seconds to about 3 milliseconds.  Search is a
 FTS5 index built with the trigram tokenizer, so it keeps the case insensitive
 substring matching the search box always had.
 
-Adding a queryable field is one ALTER TABLE and one CREATE INDEX in
-schema/sqlite.schema.  No migration, because the data itself never moves:
+Adding a queryable field is one ALTER TABLE and one CREATE INDEX in the next
+update file beside the schema, such as schema/sqlite.schema.v1.update.sql.
+Trog::SQLite runs each update file once per database, in order.  No migration of
+the data, because the data itself never moves:
 
     ALTER TABLE posts ADD COLUMN subhead TEXT
         GENERATED ALWAYS AS (json_extract(post_data, '$.subhead')) VIRTUAL;

lib/Trog/Auth.pm

@@ -219,7 +219,10 @@ sub totp ( $user, $domain ) {
         # returns 0 for a file that was never there, it does not warn or die.
         unlink "totp/$qr";
 
-        $dbh->do( "UPDATE user SET totp_secret=? WHERE name=?", undef, $secret, $user ) or return ( undef, undef, 1, "Failed to store TOTP secret." );
+        eval { $dbh->do( "UPDATE user SET totp_secret=? WHERE name=?", undef, $secret, $user ); 1 } or do {
+            WARN("Could not store the TOTP secret of $user: $@");
+            return ( undef, undef, 1, "Failed to store TOTP secret." );
+        };
     }
 
     # This is subsequently served via authenticated _serve() in TCMS.pm.
@@ -334,8 +337,10 @@ sub spend_totp ( $user, $code ) {
         return ( 0, 'that code has already been used; wait for the next one' );
     }
 
-    $dbh->do( "INSERT OR REPLACE INTO totp_spent (username, step) VALUES (?,?)", undef, $user, $matched )
-      or return ( 0, 'could not record the code as used, so it is refused' );
+    eval { $dbh->do( "INSERT OR REPLACE INTO totp_spent (username, step) VALUES (?,?)", undef, $user, $matched ); 1 } or do {
+        WARN("Could not record the TOTP step of $user as spent: $@");
+        return ( 0, 'could not record the code as used, so it is refused' );
+    };
 
     return ( 1, '' );
 }
@@ -409,7 +414,8 @@ sub _hash_password ($pass) {
 sub _store_password ( $user, $pass ) {
     my ( $hash, $salt ) = _hash_password($pass);
     my $dbh = _dbh();
-    return $dbh->do( "UPDATE user SET hash=?, salt=? WHERE name=?", undef, $hash, $salt, $user ) ? 1 : 0;
+    $dbh->do( "UPDATE user SET hash=?, salt=? WHERE name=?", undef, $hash, $salt, $user );
+    return 1;
 }
 
 =head2 mksession(user, pass, token) = STRING
@@ -447,7 +453,7 @@ sub mksession ( $user, $pass, $token, $ip_addr = '' ) {
 
     # Issue cookie
     my $uuid = Trog::Utils::uuid();
-    $dbh->do( "INSERT OR REPLACE INTO session (id,username) VALUES (?,?)", undef, $uuid, $uid ) or return '';
+    $dbh->do( "INSERT OR REPLACE INTO session (id,username) VALUES (?,?)", undef, $uuid, $uid );
     log_event( 'login_success', $user, $ip_addr, $uuid );
     return $uuid;
 }
@@ -470,7 +476,8 @@ sub killsession ( $user, $ip_addr = '' ) {
 Adds a user identified by the provided password into the auth DB.
 Also used to alter users.
 
-Returns True or False (likely false when user already exists).
+Returns true.  Dies if the user cannot be stored, as the rest of this module
+does when the auth database fails.
 
 =cut
 
@@ -490,20 +497,19 @@ sub useradd ( $user, $displayname, $pass, $acls, $contactemail ) {
 
     my $dbh = _dbh();
     ( $hash, $salt ) = _hash_password($pass) if $pass;
-    my $res = $dbh->do( "INSERT OR REPLACE INTO user (name, display_name, salt, hash, contact_email, totp_secret) VALUES (?,?,?,?,?,?)", undef, $user, $displayname, $salt, $hash, $contactemail, $t_secret );
-    return unless $res && ref $acls eq 'ARRAY';
+    $dbh->do( "INSERT OR REPLACE INTO user (name, display_name, salt, hash, contact_email, totp_secret) VALUES (?,?,?,?,?,?)", undef, $user, $displayname, $salt, $hash, $contactemail, $t_secret );
 
     #XXX this is clearly not normalized with an ACL mapping table, will be an issue with large number of users
     foreach my $acl (@$acls) {
-        return unless $dbh->do( "INSERT OR REPLACE INTO user_acl (username,acl) VALUES (?,?)", undef, $user, $acl );
+        $dbh->do( "INSERT OR REPLACE INTO user_acl (username,acl) VALUES (?,?)", undef, $user, $acl );
     }
     return 1;
 }
 
 sub add_change_request (%args) {
     my $dbh = _dbh();
-    my $res = $dbh->do( "INSERT INTO change_request (username,token,type,secret) VALUES (?,?,?,?)", undef, $args{user}, $args{token}, $args{type}, $args{secret} );
-    return !!$res;
+    $dbh->do( "INSERT INTO change_request (username,token,type,secret) VALUES (?,?,?,?)", undef, $args{user}, $args{token}, $args{type}, $args{secret} );
+    return 1;
 }
 
 sub process_change_request ($token) {
@@ -524,16 +530,14 @@ sub process_change_request ($token) {
             #XXX The fact that this is an INSERT OR REPLACE means all the entries in change_request for this user will get cascade wiped.  Which is good, as the secrets aren't salted.
             # This is also why we have to snag the user's ACLs or they will be wiped.
             my @acls = acls4user($user);
-            useradd( $user, $display, $pass, \@acls, $contactemail ) or do {
-                return '';
-            };
+            useradd( $user, $display, $pass, \@acls, $contactemail );
             killsession($user);
             return "Password set to $pass for $user";
         },
     );
     my $res = $dispatch{$type}->( $user, $secret );
-    $dbh->do( "UPDATE change_request SET processed=1 WHERE token=?", undef, $token ) or do {
-        FATAL("Could not set job with token $token to completed!");
+    eval { $dbh->do( "UPDATE change_request SET processed=1 WHERE token=?", undef, $token ); 1 } or do {
+        FATAL("Could not set job with token $token to completed: $@");
     };
     return $res;
 }

lib/Trog/Data/SQLite.pm

@@ -36,8 +36,12 @@ What that buys is get(): the filtering Trog::DataModule::filter() does in Perl
 over every post on disk happens here in one indexed query.  See _where() for
 the mapping, which is filter() clause for clause.
 
-Adding a queryable field is one ALTER TABLE and one CREATE INDEX in
-schema/sqlite.schema, with no migration, because the data itself never moves.
+Adding a queryable field is one ALTER TABLE and one CREATE INDEX, with no
+migration of the data, because the data itself never moves.  They go in the
+next update file beside the schema, such as
+schema/sqlite.schema.v1.update.sql, and not in schema/sqlite.schema itself.
+Trog::SQLite applies the schema on every new handle, and an ALTER TABLE fails
+the second time.  It runs each update file once per database, in order.
 
 =head1 Termination Conditions
 
@@ -348,12 +352,11 @@ sub _insert ( $dbh, $data ) {
         delete @stored{qw{version_max modified display_name user_class post_id}};
         $stored{version} //= 0;
 
-        # Checked rather than fired and forgotten: DBI is not in RaiseError mode
-        # here, so a rejected write -- the unique index catching two workers on
-        # the same version, most of all -- would otherwise be a warning on
-        # stderr and a save the user was told had succeeded.
-        $insert->execute( $parser->encode( \%stored ) )
-          or confess "Could not write post '$post->{id}' version $stored{version}: " . $dbh->errstr;
+        # Caught to name the post: a rejected write -- the unique index catching
+        # two workers on the same version, most of all -- otherwise dies with
+        # the message of DBI alone, which does not say which post it was.
+        eval { $insert->execute( $parser->encode( \%stored ) ); 1 }
+          or confess "Could not write post '$post->{id}' version $stored{version}: $@";
     }
 
     return 1;
@@ -466,13 +469,13 @@ sub index_fields ( $self, @fields ) {
     foreach my $field ( sort keys %want ) {
         if ( !$have{$field} ) {
             ## no critic(ValuesAndExpressions::PreventSQLInjection) -- $field is the anchored capture above
-            $dbh->do("ALTER TABLE posts ADD COLUMN $field TEXT GENERATED ALWAYS AS (json_extract(post_data, '\$.$field')) VIRTUAL")
-              or confess "Could not add a column for '$field': " . $dbh->errstr;
+            eval { $dbh->do("ALTER TABLE posts ADD COLUMN $field TEXT GENERATED ALWAYS AS (json_extract(post_data, '\$.$field')) VIRTUAL"); 1 }
+              or confess "Could not add a column for '$field': $@";
         }
 
         ## no critic(ValuesAndExpressions::PreventSQLInjection) -- as above
-        $dbh->do("CREATE INDEX IF NOT EXISTS $index_prefix$field ON posts($field)")
-          or confess "Could not index '$field': " . $dbh->errstr;
+        eval { $dbh->do("CREATE INDEX IF NOT EXISTS $index_prefix$field ON posts($field)"); 1 }
+          or confess "Could not index '$field': $@";
         $built++;
     }
 
@@ -489,7 +492,7 @@ sub index_fields ( $self, @fields ) {
         next if $want{$field};
 
         ## no critic(ValuesAndExpressions::PreventSQLInjection) -- $index came out of sqlite_master
-        $dbh->do("DROP INDEX IF EXISTS $index") or confess "Could not drop the index on '$field': " . $dbh->errstr;
+        eval { $dbh->do("DROP INDEX IF EXISTS $index"); 1 } or confess "Could not drop the index on '$field': $@";
         $dropped++;
     }
 

lib/Trog/Log/DBI.pm

@@ -71,7 +71,8 @@ my %buffer;
 Record one log line.
 
 Returns the request insert's result for a request line, 1 for a message that
-got buffered, and undef for a line we couldn't make sense of.
+got buffered, and undef for a line we couldn't make sense of or could not write.
+A write that fails is a warning on stderr, and never dies.
 
 =cut
 
@@ -113,22 +114,29 @@ sub log_message {
     $ua      //= 'none';
     $urchin  //= {};
 
-    # TODO track bytes in the DB
-    my $res = $self->{sth}->execute( $uuid, $epoch, $ip, $user, $method, $route, $referer, $ua, $code );
-
-    # Dump in the accumulated messages
-    if ( is_arrayref( $buffer{$uuid} ) && @{ $buffer{$uuid} } ) {
-        $self->{sth2}->bind_param_array( 1, $uuid );
-        $self->{sth2}->bind_param_array( 2, $buffer{$uuid} );
-        $self->{sth2}->execute_array( {} );
-        delete $buffer{$uuid};
-
-    }
+    # The handle raises, and this runs inside every log call, so a failed write warns rather than dies.
+    my $messages = delete $buffer{$uuid};
+    my $res;
+    eval {
+        # TODO track bytes in the DB
+        $res = $self->{sth}->execute( $uuid, $epoch, $ip, $user, $method, $route, $referer, $ua, $code );
+
+        # Dump in the accumulated messages
+        if ( is_arrayref($messages) && @$messages ) {
+            $self->{sth2}->bind_param_array( 1, $uuid );
+            $self->{sth2}->bind_param_array( 2, $messages );
+            $self->{sth2}->execute_array( {} );
+        }
 
-    # Record urchin data if there is any.
-    if ( %$urchin && $urchin->{utm_source} ) {
-        $self->{sth3}->execute( $uuid, $urchin->{utm_source}, $urchin->{utm_medium}, $urchin->{utm_campaign}, $urchin->{utm_term}, $urchin->{utm_content} );
-    }
+        # Record urchin data if there is any.
+        if ( %$urchin && $urchin->{utm_source} ) {
+            $self->{sth3}->execute( $uuid, $urchin->{utm_source}, $urchin->{utm_medium}, $urchin->{utm_campaign}, $urchin->{utm_term}, $urchin->{utm_content} );
+        }
+        1;
+    } or do {
+        warn "Could not record request $uuid in the metrics database: $@";
+        return;
+    };
 
     return $res;
 }

lib/Trog/SQLite.pm

@@ -1,128 +0,0 @@
-package Trog::SQLite;
-
-use v5.36;
-use re '/aa';
-
-use POSIX qw{floor};
-
-use DBI;
-use DBD::SQLite;
-use File::Slurper();
-use List::Util qw{any};
-
-=head1 Name
-
-Trog::SQLite - Abstracts the boilerpain away!
-
-=head1 SYNOPSIS
-
-    my $dbh = Trog::SQLite::dbh("my_schema.sql", "my_sqlite3.db");
-    ...
-
-=head1 FUNCTIONS
-
-Everything in this module throws when something goes wrong.
-
-=head2 dbh
-
-Get you a database handle with fkeys turned on, and schema consistency enforced.
-Caches the handle past the first call.
-
-Be careful when first calling, the standard fork-safety concerns with sqlite apply
-
-=cut
-
-# We need to make sure this is different across forks, AND consistent within them.
-my $dbh = {};
-
-# Ensure the db schema is OK, and give us a handle
-# WARNING: do not ever call during BEGIN or outside a sub.
-# Otherwise, we can't preload_app.
-sub dbh {
-    my ( $schema, $dbname ) = @_;
-    $dbh //= {};
-    return $dbh->{$dbname} if $dbh->{$dbname};
-
-    # No touch first: DBI:SQLite creates the file on connect.  It also cannot
-    # simply be made unconditional, as that would bump mtime on a live database.
-    my $db = DBI->connect( "dbi:SQLite:dbname=$dbname", "", "" );
-
-    if ($schema) {
-
-        # No pre-flight test: read_text dies with "Cannot open <path>: <errno>",
-        # which says more than the guard did and covers unreadable as well as absent.
-        my $qq = File::Slurper::read_text($schema);
-        $db->{sqlite_allow_multiple_statements} = 1;
-        $db->do($qq) or die "Could not ensure database consistency: " . $db->errstr;
-        $db->{sqlite_allow_multiple_statements} = 0;
-    }
-
-    $dbh->{$dbname} = $db;
-
-    # Turn on fkeys
-    $db->do("PRAGMA foreign_keys = ON") or die "Could not enable foreign keys";
-
-    # Turn on WALmode
-    $db->do("PRAGMA journal_mode = WAL") or die "Could not enable WAL mode";
-
-    # Turn on normal sync mode
-    $db->do("PRAGMA synchronous = NORMAL") or die "Could not enable sync mode normal";
-
-    # 5s busy timeout
-    $db->do("PRAGMA busy_timeout = 5000") or die "Could not set busy_timeout";
-
-    return $db;
-}
-
-=head2 bulk_insert(DBI $dbh, STRING $table, ARRAYREF $keys, STRING $action='IGNORE', MIXED @values)
-
-Insert the values into specified table corresponding to the provided keys.
-Values must be repeating tuples corresponding to the values. Example:
-
-    my $keys   = [qw{A B C}];
-    my @values = qw{1 2 3 4 5 6 7 8 9};
-
-Essentially works around the 999 named param limit and executes by re-using prepared statements.
-This results in a quick insert/update of lots of data, such as when building an index or importing data.
-
-For the vast majority of in-practice usage, this will be swatting flies with an elephant gun.
-That said, it should always do the job correctly and quickly, even for trivial datasets.
-
-If you don't put fkeys in place (or simply turn them off),
-you can use REPLACE as your action to do upserts without causing destructive consequences.
-It's less code than writing an ON CONFLICT UPDATE clause, and faster.
-
-Batch your values to whatever is appropriate given your available heap.
-
-=cut
-
-sub bulk_insert ( $dbh, $table, $keys, $ACTION = 'IGNORE', @values ) {
-    die "unsupported insert action $ACTION" unless any { $ACTION eq $_ } qw{ROLLBACK ABORT FAIL IGNORE REPLACE};
-
-    die "keys must be nonempty ARRAYREF" unless ref $keys eq 'ARRAY' && @$keys;
-    die "#Values must be a multiple of #keys" if @values % @$keys;
-
-    my ( $smt, $query ) = ( '', '' );
-    while (@values) {
-
-        #Must have even multiple of #keys, so floor divide and chop remainder
-        my $nkeys = scalar(@$keys);
-        my $limit = floor( 999 / $nkeys );
-        $limit = $limit - ( $limit % $nkeys );
-        $smt   = '' if scalar(@values) < $limit;
-        my @params = splice( @values, 0, $limit );
-        if ( !$smt ) {
-            my @value_tuples;
-            my @huh = map { '?' } @params;
-            while (@huh) {
-                push( @value_tuples, "(" . join( ',', ( splice( @huh, 0, $nkeys ) ) ) . ")" );
-            }
-            ## no critic(ValuesAndExpressions::PreventSQLInjection)
-            $query = "INSERT OR $ACTION INTO $table (" . join( ',', @$keys ) . ") VALUES " . join( ',', @value_tuples );
-            $smt   = $dbh->prepare($query);
-        }
-        $smt->execute(@params);
-    }
-}
-
-1;

lib/Trog/Vault.pm

@@ -214,10 +214,16 @@ sub set ( $user, $name, $secret ) {
     my $tag        = $gcm->encrypt_done();
 
     my $dbh = _dbh();
-    $dbh->do(
-        "INSERT OR REPLACE INTO user_secret (username, name, key_id, salt, ciphertext, tag, created) VALUES (?,?,?,?,?,?,?)",
-        undef, $user, $name, key_id(), $salt, $ciphertext, $tag, time()
-    ) or return ( 0, 'could not store it' );
+    eval {
+        $dbh->do(
+            "INSERT OR REPLACE INTO user_secret (username, name, key_id, salt, ciphertext, tag, created) VALUES (?,?,?,?,?,?,?)",
+            undef, $user, $name, key_id(), $salt, $ciphertext, $tag, time()
+        );
+        1;
+    } or do {
+        WARN("Could not store the secret '$name' of $user: $@");
+        return ( 0, 'could not store it' );
+    };
 
     Trog::Auth::log_event( 'secret_write', $user );
     return ( 1, "'$name' stored" );

schema/sqlite.schema

@@ -5,7 +5,9 @@
 /* Every column but the blob is GENERATED ALWAYS ... VIRTUAL, so it costs no   */
 /* storage, cannot drift from the post it was drawn from, and can be indexed.  */
 /* Adding a queryable field later is one ALTER TABLE plus one CREATE INDEX --  */
-/* no migration of the data itself, because the data never moves.              */
+/* no migration of the data itself, because the data never moves.  They go in  */
+/* the next update file, sqlite.schema.vN.update.sql, and not in this file:    */
+/* Trog::SQLite runs this file on every new handle, and each update only once. */
 
 CREATE TABLE IF NOT EXISTS posts (
     id        INTEGER PRIMARY KEY AUTOINCREMENT,

t/Trog-Log-DBI.t

@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal   qw{exception};
+use Capture::Tiny qw{capture_stderr};
+use File::Temp    qw{tempdir};
+use FindBin;
+
+use lib "$FindBin::Bin/../lib";
+
+use Trog::SQLite;
+
+require_ok('Trog::Log::DBI') or BAIL_OUT("Can't find SUT");
+
+# The metrics database the way Trog::Log opens it, in a directory of its own.
+my $dir    = tempdir( CLEANUP => 1 );
+my $dbh    = Trog::SQLite::dbh( "$FindBin::Bin/../schema/log.schema", "$dir/log.db" );
+my $output = Trog::Log::DBI->new( name => 'dbi', min_level => 'info', dbh => $dbh );
+
+my $line = "2026-09-29T12:00:00Z [INFO]: RequestId r-1 From 192.0.2.1 |nobody| GET 200 512 /posts\n";
+
+subtest 'a request line is a row' => sub {
+    ok( $output->log_message( message => $line ), 'the write reports success' );
+    my ($count) = $dbh->selectrow_array("SELECT count(*) FROM all_requests WHERE uuid='r-1'");
+    is( $count, 1, 'and the request is in all_requests' );
+};
+
+# The handle raises on every error, and log_message runs inside every log
+# call, so a refused write must not take the caller down with it.
+subtest 'a write the database refuses is a warning, not a die' => sub {
+    $dbh->do("CREATE TEMP TRIGGER refuse_request BEFORE INSERT ON requests BEGIN SELECT RAISE(ABORT, 'refused for the test'); END");
+
+    my ( $res, $died );
+    my $stderr = capture_stderr {
+        $died = exception { $res = $output->log_message( message => $line =~ s/r-1/r-2/r ) };
+    };
+    $dbh->do("DROP TRIGGER temp.refuse_request");
+
+    is( $died, undef, 'the caller of the log does not die' );
+    is( $res,  undef, 'the write reports that it failed' );
+    like( $stderr, qr/Could not record request r-2 in the metrics database: .*refused for the test/, 'and says why on stderr' );
+};
+
+done_testing();

t/Trog-SQLite.t

@@ -1,56 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::MockModule qw{strict};
-use Test::Deep;
-use Test::Fatal qw{exception};
-use FindBin;
-
-use lib "$FindBin::Bin/../lib";
-
-require_ok('Trog::SQLite') or BAIL_OUT("Can't find SUT");
-
-subtest 'dbh' => sub {
-    my $readmock = Test::MockModule->new('File::Slurper');
-    $readmock->redefine( 'read_text', sub { "SELECT me FROM candidates" } );
-    my $dbimock = Test::MockModule->new("DBI");
-    $dbimock->redefine( 'connect', sub { bless( {}, 'TrogDBD' ) } );
-
-    my $works = 0;
-    no warnings qw{redefine once};
-    local *TrogDBD::do     = sub { $works };
-    local *TrogDBD::errstr = sub { 'bogus' };
-
-    like( exception { Trog::SQLite::dbh( 'bogus', 'bogus' ) }, qr/ensure/i, "Failure to enforce schema throws" );
-    $works = 1;
-
-    # Otherwise it works
-    isa_ok( Trog::SQLite::dbh( 'bogus', 'bogus' ), 'TrogDBD' );
-    unlink 'bogus';
-};
-
-subtest bulk_insert => sub {
-    like( exception { Trog::SQLite::bulk_insert( {}, 'bogus', [qw{a b c}], 'PROCASTINATE' ) },      qr/unsupported/i, "insert OR keyword consistency enforced" );
-    like( exception { Trog::SQLite::bulk_insert( {}, 'bogus', [] ) },                               qr/nonempty/,     "keys must be provided" );
-    like( exception { Trog::SQLite::bulk_insert( {}, 'bogus', [qw{a b c}], 'IGNORE', qw{jello} ) }, qr/multiple of/i, "sufficient values must be provided" );
-
-    my $smt;
-    my $dbh = bless( {}, 'TrogDBH' );
-    no warnings qw{redefine once};
-    local *TrogDBH::prepare = sub { $smt .= $_[1]; return bless( {}, 'TrogSMT' ) };
-    local *TrogSMT::execute = sub { };
-
-    is( exception { Trog::SQLite::bulk_insert( $dbh, 'bogus', [qw{moo cows}], 'IGNORE', qw{a b c d} ) }, undef,                                                       "can do bulk insert" );
-    is( $smt,                                                                                            "INSERT OR IGNORE INTO bogus (moo,cows) VALUES (?,?),(?,?)", "Expected query prepared" );
-
-    # Million insert
-    $smt = '';
-    my $keys   = [ ("a") x 10 ];
-    my @values = ("b") x ( 10**6 );
-    Trog::SQLite::bulk_insert( $dbh, 'bogus', $keys, 'IGNORE', @values );
-    my $expected = "INSERT OR IGNORE INTO bogus (a,a,a,a,a,a,a,a,a,a) VALUES (?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?)INSERT OR IGNORE INTO bogus (a,a,a,a,a,a,a,a,a,a) VALUES (?,?,?,?,?,?,?,?,?,?)";
-    is( $smt, $expected, "As expected, only two statements are necessary to be prepared, no matter how many rows to insert." );
-};
-
-done_testing;

t/Trog-Vault.t

@@ -406,4 +406,23 @@ subtest 'the page a user manages them from' => sub {
     is( Trog::Vault::get( 'bob', 'keepass' ), 'correct horse battery staple', "bob's is untouched by eve asking to forget it" );
 };
 
+# The handle raises on every error, so these two are the writes whose failure
+# must still come back as an answer rather than as a die.
+subtest 'a write the database refuses is an answer, not a crash' => sub {
+    my ( $ok, $why ) = Trog::Vault::set( 'nobody', 'thing', 'a secret for a user who does not exist' );
+    is( $ok,  0,                    'a secret for a user the foreign key does not know is refused' );
+    is( $why, 'could not store it', 'with the message the page shows' );
+
+    my $dbh = Trog::SQLite::dbh( 'schema/auth.schema', 'config/auth.db' );
+    $dbh->do("DELETE FROM totp_spent WHERE username='bob'");
+    $dbh->do("CREATE TEMP TRIGGER refuse_spend BEFORE INSERT ON totp_spent BEGIN SELECT RAISE(ABORT, 'refused for the test'); END");
+
+    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'bob', 'vault.example.com' );
+    ( $ok, $why ) = Trog::Auth::spend_totp( 'bob', $totp->expected_totp_code( time() ) );
+    $dbh->do("DROP TRIGGER temp.refuse_spend");
+
+    is( $ok, 0, 'a right code that cannot be recorded as spent is refused' );
+    like( $why, qr/could not record the code/, 'saying why' );
+};
+
 done_testing();