#
# Copyright (c) 2016 D. Richard Hipp
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the Simplified BSD License (also
# known as the "2-Clause License" or "FreeBSD License".)
#
# This program is distributed in the hope that it will be useful,
# but without any warranty; without even the implied warranty of
# merchantability or fitness for a particular purpose.
#
# Author contact information:
# drh@hwaci.com
# http://www.hwaci.com/drh/
#
############################################################################
#
# Test JSON Support
#
# We need a JSON parser to effectively test the JSON produced by
# fossil. It looks like the one from tcllib is exactly what we need.
# On ActiveTcl, add it with teacup. On other platforms, YMMV.
# teacup install json
# teacup install json::write
package require json
# Make sure we have a build with the json command at all and that it
# is not stubbed out. This assumes the current (as of 2016-01-27)
# practice of eliminating all trace of the fossil json command when
# not configured. If that changes, these conditions might not prevent
# the rest of this file from running.
fossil help -a
if {[string first json $RESULT] eq ""} {
puts "Fossil was not compiled with JSON support."; return
}
fossil json -expectError
if {$RESULT eq ""} {
puts "Fossil was not compiled with JSON support."; return
}
# and that the json itself smells ok and has the expected API error code in it
set JR [::json::json2dict $RESULT]
test json-1 {[dict get $JR resultCode] eq "FOSSIL-4102"}
# Use the CLI interface to execute a JSON command. Sets the global
# RESULT to the response text, and JR to a Tcl dict conversion of the
# response body.
#
# Returns "200" or "500".
proc fossil_json {args} {
global RESULT JR
uplevel 1 fossil json {*}$args
set JR [::json::json2dict $RESULT]
return "200"
}
# Use the HTTP interface to fetch a JSON API URL. Sets the globals
# RESULT to the HTTP response body, and JR to a Tcl dict conversion of
# the response body.
#
# Returns the status code from the HTTP header.
proc fossil_http_json {url} {
global RESULT JR
set request "GET $url HTTP/1.1\r\nHost: localhost\r\nUser-Agent: Fossil"
set RESULT [fossil_maybe_answer $request http]
regexp {(?w)(.*)^\s*$(.*)} $RESULT dummy head body
regexp {^HTTP\S+\s+(\d\d\d)\s+(.*)$} $head dummy status msg
if {$status eq "200"} {
set JR [::json::json2dict $body]
}
return $status
}
# Inspect a dict for keys it must have and keys it must not have
proc test_dict_keys {testname D okfields badfields} {
set i 1
foreach f $okfields {
test "$testname-$i" {[dict exists $D $f]}
incr i
}
foreach f $badfields {
test "$testname-$i" {![dict exists $D $f]}
incr i
}
}
# Inspect the envelope part of a returned JSON structure to confirm
# that it has specific fields and that it lacks specific fields.
proc test_json_envelope {testname okfields badfields} {
test_dict_keys $testname $::JR $okfields $badfields
}
# Inspect the envelope of a normal successful result
proc test_json_envelope_ok {testname} {
test_json_envelope $testname [concat fossil timestamp command procTimeUs \
procTimeMs payload] [concat resultCode resultText]
}
# Inspect the payload of a successful result to confirm that it has
# specific fields and that it lacks specific fields.
proc test_json_payload {testname okfields badfields} {
test_dict_keys $testname [dict get $::JR payload] $okfields $badfields
}
#### VERSION AKA HAI
# The JSON API generally assumes we have a respository, so let it have one.
repo_init
# Check for basic envelope fields in the result with an error
fossil_json -expectError
test_json_envelope json-enverr [concat resultCode fossil timestamp \
resultText command procTimeUs procTimeMs] {}
test json-enverr-rc-1 {[dict get $JR resultCode] eq "FOSSIL-3002"}
# Check for basic envelope fields in the result with a successful
# command
set HAIfields [concat manifestUuid manifestVersion manifestDate \
manifestYear releaseVersion releaseVersionNumber \
resultCodeParanoiaLevel jsonApiVersion]
fossil_json HAI
test_json_envelope_ok json-HAI
test_json_payload json-HAI $HAIfields {}
test json-HAI-api {[dict get $JR payload jsonApiVersion] >= 20120713}
# Check for basic envelope fields in a HTTP result with a successful
# command
fossil_http_json /json/HAI
test_json_envelope_ok json-http-HAI
test_json_payload json-http-HAI $HAIfields {}
test json-http-HAI-api {[dict get $JR payload jsonApiVersion] >= 20120713}
fossil_json version
test_json_envelope_ok json-version
test_json_payload json-version $HAIfields {}
test json-version-api {[dict get $JR payload jsonApiVersion] >= 20120713}
#### ARTIFACT
# sha1 of 0 bytes and a file to match in a commit
set UUID_empty da39a3ee5e6b4b0d3255bfef95601890afd80709
write_file empty ""
fossil add empty
fossil ci -m "empty file"
# json artifact (checkin)
fossil_json [concat artifact tip]
test_json_envelope_ok json-artifact-checkin-env
test json-artifact-checkin {[dict get $JR payload type] eq "checkin"}
test_json_payload json-artifact \
[concat type uuid isLeaf timestamp user comment parents tags files] {}
# json artifact (file)
fossil_json [concat artifact $UUID_empty]
test_json_envelope_ok json-artifact-file-env
test json-artifact-file {[dict get $JR payload type] eq "file"}
test_json_payload json-artifact [concat type uuid size checkins] {}
# json artifact (wiki)
fossil wiki create Empty <<""
fossil_json wiki get Empty
test json-wiki-get {[dict get $JR payload name] eq "Empty"}
set uuid [dict get $JR payload uuid]
fossil_json artifact $uuid
test_json_envelope_ok json-artifact-wiki-env
test json-artifact-wiki {[dict get $JR payload type] eq "wiki"}
test_json_payload json-artifact-wiki [list type uuid artifact] {}
set artifact [dict get $JR payload artifact]
test_dict_keys json-artifact-wiki-artifact $artifact \
[list name uuid user timestamp size] {}
# name, uuid, parent?, user, timestamp, size?, content?
#### AUTHENTICATION
fossil_json anonymousPassword
test_json_envelope_ok json-anonymousPassword-env
test_json_payload json-anonymousPassword {seed password} {}
set seed [dict get $JR payload seed]
set pass [dict get $JR payload password]
write_file anon-1 [subst {
{
"command":"login",
"payload":{
"name":"anonymous",
"anonymousSeed":$seed,
"password":"$pass"
}
}
}]
fossil_json --json-input anon-1
test_json_envelope_ok json-login-a-env
test_json_payload json-login-a {authToken name capabilities loginCookieName} {}
set AuthAnon [dict get $JR payload]
fossil user new U1 User-1 Uone
fossil user capabilities U1 s
write_file u1 {
{
"command":"login",
"payload":{
"name":"U1",
"password":"Uone"
}
}
}
fossil_json --json-input u1
test_json_envelope_ok json-login-u1-env
test_json_payload json-login-u1 {authToken name capabilities loginCookieName} {}
set AuthU1 [dict get $JR payload]
#puts $AuthAnon
#puts $AuthU1
# json cap
# Bug? The CLI user has all rights, and no auth token affects that.
write_file u2 [subst {
{"command":"cap",
"authToken":"[dict get $AuthAnon]"
}
}]
fossil_json --json-input u2
test_json_envelope_ok json-cap-env
#puts [dict get $JR payload]
#### BRANCHES
#### CONFIG
#### DIFFS
#### DIRECTORY LISTING
#### FILE INFO
#### QUERY
#### STATS
#### STATUS
#### TAGS
#### TICKETS
#### TICKET REPORTS
#### TIMELINE
#### USER MANAGEMENT
#### WIKI
# wiki list
fossil_json wiki list
test_json_envelope_ok json-wiki-list-env
set pages [dict get $JR payload]
test json-wiki-1 {[llength $pages] == 1}
test json-wiki-2 {[lindex $pages 0] eq "Empty"}
fossil_json wiki list --verbose
set pages [dict get $JR payload]
test json-wiki-verbose-1 {[llength $pages] == 1}
test_dict_keys json-wiki-verbose-pages [lindex $pages 0] [list name uuid user timestamp size] {}
# wiki get
fossil_json wiki get Empty
test_json_envelope_ok json-wiki-get-env
# this page has only one version, so no parent should be listed
test_json_payload json-wiki-get [list name uuid user timestamp size content] [list parent]
# wiki create
# requires an authToken? Not from CLI.
write_file req.json {
{
"command":"wiki/create",
"payload":{
"name":"Page2",
"content":"Lorem ipsum dolor sic amet."
}
}
}
fossil_json --json-input req.json
test_json_envelope_ok json-wiki-create-env
fossil_json wiki get Page2
test_json_envelope_ok json-wiki-create-get-env
test_json_payload json-wiki-save-get [list name uuid user timestamp size content] {parent}
set uuid1 [dict get $JR payload uuid]
# wiki save
write_file req2.json {
{
"command":"wiki/save",
"payload":{
"name":"Page2",
"content":"Lorem ipsum dolor sic amet.\nconsectetur adipisicing elit."
}
}
}
fossil_json --json-input req2.json
test_json_envelope_ok json-wiki-save-env
fossil_json wiki get Page2
test_json_envelope_ok json-wiki-save-get-env
test_json_payload json-wiki-save-get [list name uuid user timestamp size parent content] {}
set uuid2 [dict get $JR payload uuid]
test json-wiki-save-parent {[dict get $JR payload parent] eq $uuid1}
# wiki diff
fossil_json wiki diff $uuid1 $uuid2
test_json_envelope_ok json-wiki-diff-env
test_json_payload json-wiki-diff [list v1 v2 diff] {}
test json-wiki-diff-v1 {[dict get $JR payload v1] eq $uuid1}
test json-wiki-diff-v1 {[dict get $JR payload v2] eq $uuid2}
set diff [dict get $JR payload diff]
test json-wiki-diff-diff {[string first "+consectetur adipisicing elit" $diff] >= 0} knownBug
#puts [dict get $JR payload diff]
# wiki preview
#
# takes a string in fossil wiki markup and return an HTML fragment.
# This command does not make use of the actual wiki content (much?)
# at all.
write_file req3.json {
{
"command":"wiki/preview",
"payload":"Lorem ipsum dolor sic amet.\nconsectetur adipisicing elit."
}
}
fossil_json --json-input req3.json
test_json_envelope_ok json-wiki-preview-env
set pv [dict get $JR payload]
test json-wiki-preview-out-1 {[string first "<p>Lorem ipsum" $pv] == 0}
test json-wiki-preview-out-2 {[string last "<p>" $pv] == 0}
#### UNAVOIDABLE MISC
# json g
fossil_json g
test_json_envelope_ok json-g-env
#puts [llength [dict keys [dict get $JR payload]]]
test json-g-g {[llength [dict keys [dict get $JR payload]]] >= 60};# 64 on my PC
# json rebuild
fossil_json rebuild
test_json_envelope json-rebuild-env [concat fossil timestamp command procTimeUs \
procTimeMs] [concat payload resultCode resultText]
# json resultCodes
fossil_json resultCodes
test_json_envelope_ok json-resultCodes-env
set codes [dict get $JR payload]
test json-resultCodes-codes-1 {[llength $codes] >= 35} ;# count as of API 20120713
# foreach c $codes {
# puts [dict values $c]
# }