userdb test

package require sqlite3
package require anticrisis_http
namespace import anticrisis::*

namespace eval ::userdb {}

proc userdb::open {filename} {
    sqlite3 ::db $filename
}

proc userdb::close {} {
    # optional: recommended analysis settings
    db eval {pragma analysis_limit=100}
    db eval {pragma optimize}
    db close
}

proc userdb::ensure {filename} {
    if {[info commands db] eq ""} {::userdb::open $filename}
}

proc userdb::create {filename} {
    ensure $filename

    # optional: recommended security settings
    db config trusted_schema off
    db config enable_view off
    db config enable_trigger off
    db config defensive 1
    db config dqs_dml 0
    db config dqs_ddl 0

    # recommended: enable write-ahead log for performance
    db eval {pragma journal_mode=WAL}

    db eval {drop table if exists users}
    db eval {create table users(username text primary key not null,
                                plainpass text not null)}
}

proc userdb::now {}  {db eval {select datetime('now')}}
proc userdb::uuid {} {db eval {select lower(hex(randomblob(15)))}}

proc userdb::create_user {username plainpass} {
    db eval {insert into users values(:username, :plainpass)}
}

proc userdb::valid_plainpass {username checkpass} {
    set res [db eval {select plainpass from users where username=:username}]
    return [expr {$res eq $checkpass}]
}

# ---------------------------------------------------------------------------

set dbfile "test-userdb.sqlite"

userdb::create $dbfile

namespace eval web {
    variable target
}

proc web::create_user {} {
    set random_name [userdb::uuid]
    set random_pass [userdb::uuid]
    userdb::create_user $random_name $random_pass
    list 200 "Created user $random_name with pass $random_pass" "text/plain"
}

proc web::check_password {} {
    set random_name [userdb::uuid]
    set random_pass [userdb::uuid]
    set result [userdb::valid_plainpass $random_name $random_pass]
    list 200 "Checked user $random_name pass $random_pass: $result" "text/plain"
}

proc web::default {} {
    list 200 "Try paths /create or /check" "text/plain"
}

proc web::handle_get {} {
    variable target
    switch $target {
        /create {create_user}
        /check  {check_password}
        default {default}
    }
}

http configure -get web::handle_get -reqtargetvar web::target {*}$argv

puts "Listening on http://[http configure -host]:[http configure -port]"
http run