Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

More JSON code

  • Loading branch information...
commit a6d41e985118f18a258c0b16a2f05e617f2dbfdb 1 parent 0fe0fd1
@billstclair authored
View
69 src/client-json.lisp
@@ -4,7 +4,7 @@
;;;
;;; The Truledger JSON webapp server
;;;
-;;; See www/docs/json.txt (http://truledger.com/doc/json.txt) for spec.
+;;; See www/doc/json.txt (http://truledger.com/doc/json.txt) for spec.
;;;
(in-package :truledger-json)
@@ -37,12 +37,12 @@
"login"
"logout"
"current-user"
- "user-pubkey"
+ "getpubkey"
"getserver"
"getservers"
"addserver"
"setserver"
- "currentserver"
+ "current-server"
"privkey-cached?"
"cache-privkey"
"getcontact"
@@ -64,11 +64,11 @@
"getstoragefees"
"spend"
"spendreject"
- "ishistoryenabled?"
- "sethistoryenabled"
- "gethistorytimes"
- "gethistoryitems"
- "removehistoryitems"
+ "is-history-enabled?"
+ "set-history-enabled"
+ "get-history-times"
+ "get-history-items"
+ "remove-history-items"
"getinbox"
"processinbox"
"storagefees"
@@ -76,7 +76,7 @@
"redeem"
"getversion"
"getpermissions"
- "getgrantedpermissions"
+ "get-granted-permissions"
"grant"
"deny"
"audit"))
@@ -107,7 +107,7 @@
(when (null x) (return t))
(unless (listp x) (return nil))
(let ((elt (pop x)))
- (unless (and (listp elt) (atom (car elt)) (atom (cdr elt)))
+ (unless (and (listp elt) (atom (car elt)))
(return nil)))))
(defun json-server-internal (client)
@@ -253,7 +253,8 @@
(defun %login-json (client args)
(with-json-args (session) args
(login-with-sessionid client session)
- (%setserver-json client)))
+ (%setserver-json client)
+ (initialize-client-history client)))
(defun json-logout (client args)
(%login-json client args)
@@ -263,7 +264,7 @@
(%login-json client args)
(id client))
-(defun json-user-pubkey (client args)
+(defun json-getpubkey (client args)
(%login-json client args)
(pubkey client))
@@ -306,7 +307,7 @@
(with-json-args (serverid) args
(setserver client serverid)))
-(defun json-currentserver (client args)
+(defun json-current-server (client args)
(%login-json client args)
(serverid client))
@@ -483,6 +484,48 @@
(loop for fee in (getstoragefee client)
collect (%json-storagefee-alist fee)))
+(defun json-spend (client args)
+ (%login-json client args)
+ (with-json-args (toid assetid formatted-amount acct note) args
+ (let* ((plist (spend client toid assetid formatted-amount acct note)))
+ `(("@type" . "spendresult")
+ ,@(%json-optional "transaction-fee" (getf plist :transaction-fee))
+ ,@(%json-optional "storage-fee" (getf plist :storage-fee))
+ ,@(%json-optional "coupon" (getcoupon client))))))
+
+(defun json-spend-reject (client args)
+ (%login-json client args)
+ (with-json-args (time note) args
+ (spendreject client time note)
+ nil))
+
+(defun json-is-history-enabled? (client args)
+ (%login-json client args)
+ (keep-history-p client))
+
+(defun json-set-history-enabled (client args)
+ (%login-json client args)
+ (with-json-args (enabled?) args
+ (setf (keep-history-p client) enabled?)))
+
+(defun json-get-history-times (client args)
+ (%login-json client args)
+ (gethistorytimes client))
+
+(defun json-get-history-items (client args)
+ (%login-json client args)
+ (with-json-args (time) args
+ (let ((items (gethistoryitems client time)))
+ ;; *** This needs processing ***
+ (loop for hash in items
+ collect
+ (let ((res nil))
+ (maphash (lambda (key value)
+ (when (stringp key)
+ (push `(,key . ,value) res)))
+ hash)
+ res)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Copyright 2012 Bill St. Clair
View
11 src/client-web.lisp
@@ -1283,11 +1283,6 @@
(setf (cw-error cw) (stringify c))))
(draw-balance cw)))
-(defun initialize-client-history (client)
- (let* ((keephistory (or (user-preference client "keephistory")
- "keep")))
- (setf (keep-history-p client) (equal keephistory "keep"))))
-
(defun do-balancemisc (cw)
(with-parms (togglehistory resync toggledebug toggleinstructions)
(cond (togglehistory (do-togglehistory cw))
@@ -1297,11 +1292,9 @@
(defun do-togglehistory (cw)
(let* ((client (cw-client cw))
- (keephistory-p (initialize-client-history client)))
- (setf (user-preference client "keephistory")
- (if keephistory-p "forget" "keep"))
+ (keephistory-p (toggle-client-history client)))
(setf (cw-error cw)
- (if keephistory-p "History disabled" "History enabled"))
+ (if keephistory-p "History enabled" "History disabled"))
(draw-balance cw)))
(defun hideinstructions(cw)
View
23 src/client.lisp
@@ -493,6 +493,18 @@ Error if it does not. If it does, return two values:
(unless (current-server client)
(error (or msg "Server not set"))))
+(defun initialize-client-history (client)
+ (let* ((keephistory (or (user-preference client "keephistory")
+ "keep")))
+ (setf (keep-history-p client) (equal keephistory "keep"))))
+
+(defun toggle-client-history (client)
+ (setf (keep-history-p client) (not (keep-history-p client))))
+
+(defmethod (setf keep-history-p) :after (value (client client))
+ (setf (user-preference client "keep-history")
+ (if value "keep" "forget")))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; All the API methods below require the user to be logged and the server to be set.
@@ -1496,7 +1508,7 @@ Error if it does not. If it does, return two values:
oldamount
oldtime
time
- (storagefee 0)
+ storagefee
(digits 0)
percent
fraction
@@ -1951,7 +1963,12 @@ Error if it does not. If it does, return two values:
Clear the coupon store, so you can only get the coupon once."
(let ((coupon (coupon client)))
(setf (coupon client) nil)
- (and coupon (privkey-decrypt coupon (privkey client)))))
+ (when coupon
+ (setf coupon (privkey-decrypt coupon (privkey client)))
+ (let* ((args (unpack-servermsg client coupon $COUPON))
+ (url (getarg $SERVERURL args))
+ (coupon-number (getarg $COUPON args)))
+ (format nil "[~a,~a]" url coupon-number)))))
(defstruct inbox
request
@@ -2604,7 +2621,7 @@ Error if it does not. If it does, return two values:
(args (unpack-servermsg client coupon $COUPON))
(url (getarg $SERVERURL args))
(coupon-number (getarg $COUPON args)))
- (push (format nil "[~a, ~a]" url coupon-number)
+ (push (format nil "[~a,~a]" url coupon-number)
coupons)))
(t (error "Bad request in outbox: ~s" request)))))
(unless item
View
2  src/package.lisp
@@ -517,6 +517,8 @@
#:addserver
#:setserver
#:current-server
+ #:initialize-client-history
+ #:toggle-client-history
#:register
#:privkey-cached-p
#:need-privkey-cache-p
View
21 www/doc/json.txt
@@ -55,7 +55,7 @@ Error results are always returned as {"@type":"error","message":<string>}
["current-user",{"session":<session-string>}] => <user-id>
Return the user id string of the currently logged in user.
-["user-pubkey",{client:<session-string>,id:<user-id>}] => <string>
+["getpubkey",{client:<session-string>,id:<user-id>}] => <string>
Return the public key for "id", which defaults to the
currently logged-in user.
@@ -83,7 +83,7 @@ Error results are always returned as {"@type":"error","message":<string>}
["setserver",{"session":<session-string>,"serverid":<string>}] => null
Set the current server to "serverid".
-["currentserver",{"session":<session-string>}] => <serverid>
+["current-server",{"session":<session-string>}] => <serverid>
Returns the ID of the current server, or null if there isn't one.
["privkey-cached?",{"session":<session-string>,"serverid":<string>}] => <boolean>
@@ -200,22 +200,23 @@ Error results are always returned as {"@type":"error","message":<string>}
You lose your transaction fee when you reject a spend.
This discourages making it a habit.
-["ishistoryenabled?",{"client:<session-string>"}] => <boolean>
+["is-history-enabled?",{"client:<session-string>"}] => <boolean>
Return true if keeping history is enabled.
-["sethistoryenabled",{"client:<session-string>","enabled?":<boolean>}] => null
+["set-history-enabled",{"client:<session-string>","enabled?":<boolean>}] => enabled?
Enable history if "enabled?" is true. Disable otherwise.
-["gethistorytimes",{"session":<session-string>}] => [<string>,...]
+["get-history-times",{"session":<session-string>}] => [<string>,...]
Get the times for which there are history items.
-["gethistoryitems",{"session":<session-string>,"time":<string>}]
- => [{"@type":"history","time":<string>,"request":<string>,"from":<string>
- "to":<string>,"formatted-amount":<string>,"assetid":<string>,
+["get-history-items",{"session":<session-string>,"time":<string>}]
+ => [{"@type":"history","time":<string>,"request":<string>,
+ "fromid":<string>,"from":<string>,"toid":<string>,"to":<string>,
+ "amount":<string>,"formatted-amount":<string>,"assetid":<string>,
"assetname":<string>,"note":<string>,"response":<string>},...]
Returns all the history items for "time".
-["removehistoryitems",{"session":<session-string>,"time":<string>}] => null
+["remove-history-items",{"session":<session-string>,"time":<string>}] => null
Remove all the history items for "time".
["getinbox",{"session":<session-string>}]
@@ -285,7 +286,7 @@ Error results are always returned as {"@type":"error","message":<string>}
The currently supported "permission"s are "mint-tokens", "mint-coupons",
and "add-asset".
-["getgrantedpermissions",{"session":<session-string>}]
+["get-granted-permissions",{"session":<session-string>}]
=> [{"@type:"permission",...},...]
Return the permissions you've directly granted.
Please sign in to comment.
Something went wrong with that request. Please try again.