First working IBKR API implementation.HEADmain

* doc/ibkr.org: Docs for using the IBKR API.
* manifest.scm: Guix Manifest of all project dependencies.
* scripts/run-gateway.bash: A script for building and deploying the
IBKR Client Gateway.
* src/ibkr/api.scm: Support for specific endpoints, and generic tools
for using the IBKR API.
* src/ibkr/types.scm: Basic types for the IBKR endpoints. Orders,
positions, securities, etc.
* test/*.json: IBKR response and request examples for testing.
* test/api.scm: Response handling and endpoint construction.
* test/types.scm: Tests JSON parsing of IBKR requests and responses.

2 files changed, 385 insertions, 0 deletions

diff --git a/src/ibkr/api.scm b/src/ibkr/api.scm
new file mode 100644
index 0000000..cfea408
--- /dev/null
+++ b/src/ibkr/api.scm
@@ -0,0 +1,201 @@
+(define-module (ibkr api)
+  #:use-module (ibkr types)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-43)
+  #:use-module (web uri)
+  #:use-module (web request)
+  #:use-module (web client)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 match)
+  #:use-module (json))
+
+(define user-agent-headers '((user-agent . "ibkr-cli")))
+(define json-content-headers '((content-type . "application/json")))
+(define-record-type <ibkr-request>
+  (ibkr-request uri method headers body)
+  ibkr-request?
+  (uri ibkr-request-uri)
+  (method ibkr-request-method)
+  (headers ibkr-request-headers)
+  (body ibkr-request-body))
+(define-public (ibkr-get uri)
+  (ibkr-request uri 'GET user-agent-headers #f))
+(define-public (ibkr-post uri body)
+  (let ((headers (append user-agent-headers
+			 ; json-content-headers
+			 )))
+    (ibkr-request uri 'POST headers body)))
+(define-public (v1-api base rel) (string-append base "/v1/api" rel))
+
+(define-public (response-header pair) (car pair))
+(define-public (response-body pair) (cdr pair))
+(define-public (send-ibkr-request ibkr-request)
+  (define-values (response-header response-body-bytes)
+    (let ((endpoint (string->uri (ibkr-request-uri ibkr-request)))
+	  (headers (ibkr-request-headers ibkr-request))
+	  (method (ibkr-request-method ibkr-request))
+	  (body (ibkr-request-body ibkr-request)))
+      (match method
+	('GET
+	 (http-request endpoint
+		       #:method 'GET
+		       #:headers headers))
+	('POST
+	 (http-request endpoint
+		       #:method 'POST
+		       #:body body
+		       #:headers headers)))))
+  (cons response-header	(bytevector->string response-body-bytes "UTF-8")))
+(define (typed-response-body request responder json->type)
+  (json->type (response-body (responder request))))
+
+(define-public (auth-status-uri base) (v1-api base "/iserver/auth/status"))
+(define-public (auth-status base)
+  (typed-response-body (ibkr-get (auth-status-uri base))
+		       send-ibkr-request
+		       json->auth-status))
+
+(define-public (accounts-uri base) (v1-api base "/portfolio/accounts"))
+(define-public (response-body->accounts body)
+  (json->type-list scm->account body))
+(define-public (accounts base)
+  (typed-response-body (ibkr-get (accounts-uri base))
+		       send-ibkr-request
+		       response-body->accounts))
+
+(define-public (positions-uri base account-id)
+  (v1-api base (string-append "/portfolio2/" account-id "/positions")))
+(define-public (response-body->positions body)
+  (json->type-list scm->position body))
+(define-public (positions base account-id)
+  (typed-response-body (ibkr-get (positions-uri base account-id))
+		       send-ibkr-request
+		       response-body->positions))
+
+(define-public (ledger-uri base account-id)
+  (v1-api base (string-append "/portfolio/" account-id "/ledger")))
+(define-public (response-body->ledger body currency)
+  (let* ((alist (json-string->scm body))
+	 (obj (assoc-ref alist currency)))
+    (if obj (scm->ledger obj) #f)))
+(define-public (ledger base account-id currency)
+  (typed-response-body (ibkr-get (ledger-uri base account-id))
+		       send-ibkr-request
+		       (lambda (json)
+			 (response-body->ledger json currency))))
+
+(define-public (stocks-by-symbol-uri base symbol)
+  (v1-api base (string-append "/trsrv/stocks?symbols=" symbol)))
+(define-public (response-body->stocks-by-symbol body symbol)
+  (let* ((scm (json-string->scm body))
+	 (stock-vec (assoc-ref scm symbol)))
+    (map scm->stock (vector->list stock-vec))))
+(define-public (stocks-by-symbol base symbol)
+  (typed-response-body (ibkr-get (stocks-by-symbol-uri base symbol))
+		       send-ibkr-request
+		       (lambda (json)
+			 (response-body->stocks-by-symbol json symbol))))
+(define-public (first-contract-on-exchange stocks exch)
+  (let* ((get-contract-list (lambda (stock) (stock-contracts stock)))
+	 (all-contracts (concatenate (map get-contract-list stocks)))
+	 (pred (lambda (contract) (equal? (contract-exchange contract) exch)))
+	 (res (find pred all-contracts)))
+    res))
+(define-public (contract-for-stock-ticker base ticker exch)
+  (first-contract-on-exchange (stocks-by-symbol base ticker) exch))
+
+(define-public (contract-snapshot-uri base contract-id stat)
+  (v1-api base
+	  (string-append "/iserver/marketdata/snapshot"
+			 "?conids=" (number->string contract-id)
+			 "&fields=" (number->string (snapshot-field stat)))))
+(define-public (response-body->contract-snapshot body stat)
+  (let* ((scm (json-string->scm body))
+	 (snap (vector-ref scm 0))
+	 (key (number->string (snapshot-field stat))))
+    (string->number (assoc-ref snap key))))
+(define-public (contract-snapshot base contract-id stat)
+  (typed-response-body (ibkr-get (contract-snapshot-uri base contract-id stat))
+		       send-ibkr-request
+		       (lambda (json)
+			 (response-body->contract-snapshot json stat))))
+
+(define-public (order->request-body order)
+  (scm->json-string `(("orders" . #(,(order->scm order))))))
+
+(define-public (order-preview-uri base account-id)
+  (v1-api base
+	  (string-append "/iserver/account/" account-id "/orders/whatif")))
+(define-public (order-preview base account-id order)
+  (typed-response-body (ibkr-post (order-preview-uri base account-id)
+				  (order->request-body order))
+		       send-ibkr-request
+		       json->order-preview))
+
+(define-public (order-submit-uri base account-id)
+  (v1-api base (string-append "/iserver/account/" account-id "/orders")))
+(define-public (order-submit base account-id order)
+  (typed-response-body (ibkr-post (order-submit-uri base account-id)
+				  (order->request-body order))
+		       send-ibkr-request
+		       json-string->order-submit-response))
+
+(define-public (order-status-uri base order-id)
+  (v1-api base (string-append "/iserver/account/order/status/" order-id)))
+(define-public (order-status base order-id)
+  (typed-response-body (ibkr-get (order-status-uri base order-id))
+		       send-ibkr-request
+		       json->order-status))
+
+(define-public (suppress-uri base)
+  (v1-api base "/iserver/questions/suppress"))
+(define-public (suppress-messages base message-ids)
+  (typed-response-body
+   (ibkr-post
+    (suppress-uri base)
+    (scm->json-string `(("messageIds" . ,(list->vector message-ids)))))
+   send-ibkr-request
+   json-string->scm))
+
+(define-public (reset-suppress-uri base)
+  (v1-api base "/iserver/questions/suppress/reset"))
+(define-public (reset-suppress-messages base message-ids)
+  (typed-response-body
+   (ibkr-post (reset-suppress-uri base) "{}")
+   send-ibkr-request
+   json-string->scm))
+
+(define-public (reply-uri base reply-id)
+  (v1-api base (string-append "/iserver/reply/" reply-id)))
+(define-public (order-confirm base reply-id)
+  (typed-response-body (ibkr-post (reply-uri base reply-id)
+				  (scm->json-string '(("confirmed" . #t))))
+		       send-ibkr-request
+		       json-string->order-submit-response))
+
+(define-public (set-default-account-id-uri base)
+  (v1-api base "/iserver/account"))
+(define-public (set-default-account-id base account-id)
+  (typed-response-body
+   (ibkr-post (set-default-account-id-uri base)
+	      (scm->json-string `(("acctId" . ,account-id))))
+   send-ibkr-request
+   json-string->scm))
+
+(define-public (refresh-live-orders-uri base)
+  (v1-api base "/iserver/account/orders?force=true"))
+(define-public (refresh-live-orders base)
+  (typed-response-body
+   (ibkr-get (refresh-live-orders-uri base))
+   send-ibkr-request
+   json-string->scm))
+
+(define-public (list-live-orders-uri base)
+  (v1-api base "/iserver/account/orders"))
+(define-public (list-live-orders base)
+  (typed-response-body
+   (ibkr-get (list-live-orders-uri base))
+   send-ibkr-request
+   json-string->scm))
diff --git a/src/ibkr/types.scm b/src/ibkr/types.scm
new file mode 100644
index 0000000..8cc563d
--- /dev/null
+++ b/src/ibkr/types.scm
@@ -0,0 +1,184 @@
+(define-module (ibkr types)
+  #:use-module (json)         ; json records
+  #:use-module (srfi srfi-1)  ; lists
+  #:use-module (srfi srfi-43) ; vector map (vec in scm <-> array in json)
+  #:export (make-auth-status
+	    auth-status?
+	    auth-status->json
+	    json->auth-status
+	    scm->auth-status
+	    auth-status-connected
+
+	    make-account
+	    account?
+	    account->json
+	    json->account
+	    scm->account
+	    account-id
+	    account-type
+
+	    make-position
+	    position?
+	    position->json
+	    json->position
+	    scm->position
+	    position-contract-id
+	    position-quantity
+
+	    make-ledger
+	    ledger?
+	    ledger->json
+	    json->ledger
+	    scm->ledger
+	    ledger-cash-balance
+	    ledger-currency
+
+	    make-contract
+	    contract?
+	    contract->json
+	    json->contract
+	    scm->contract
+	    contract-exchange
+	    contract-exchange-in-usa
+	    contract-id
+
+	    make-stock
+	    stock?
+	    stock->json
+	    json->stock
+	    scm->stock
+	    stock-contracts
+	    stock-name
+
+	    make-order
+	    order?
+	    order->json
+	    order->scm
+	    json->order
+	    scm->order
+	    order-account-id
+	    order-contract-id
+	    order-quantity
+	    order-side
+	    order-time-in-force
+	    order-type
+
+	    make-order-reply
+	    order-reply?
+	    order-reply->json
+	    json->order-reply
+	    scm->order-reply
+	    order-reply-order-id
+	    order-reply-status
+	    order-reply-encrypted
+
+	    make-order-warning
+	    order-warning?
+	    order-warning->json
+	    json->order-warning
+	    scm->order-warning
+	    order-warning-id
+	    order-warning-message
+	    order-warning-is-suppressed
+	    order-warning-message-ids
+
+	    make-order-reject
+	    order-reject?
+	    order-reject->json
+	    json->order-reject
+	    scm->order-reject
+	    order-reject-error
+
+   	    make-order-confirmation
+	    order-confirmation?
+	    order-confirmation->json
+	    json->order-confirmation
+	    scm->order-confirmation
+	    order-confirmation-confirmed
+
+	    make-order-preview
+	    order-preview?
+	    order-preview->json
+	    json->order-preview
+	    scm->order-preview
+	    order-preview-amount
+	    order-preview-warning
+	    order-preview-error
+
+	    make-order-preview-amount
+	    order-preview-amount?
+	    order-preview-amount->json
+	    json->order-preview-amount
+	    scm->order-preview-amount
+	    order-preview-amount-commission
+	    order-preview-amount-total 	    
+
+	    make-order-status
+	    order-status?
+	    order-status->json
+	    json->order-status
+	    scm->order-status
+	    order-status-average-price
+	    order-status-contract-id
+	    order-status-currency
+	    order-status-order-id
+	    order-status-quantity
+	    order-status-side
+	    order-status-status
+	    order-status-type
+	    
+	    make-suppress-amount
+	    suppress-amount?
+	    suppress-amount->json
+	    json->suppress-amount
+	    scm->suppress-amount
+	    suppress-message-ids))
+
+(define-json-type <auth-status> (connected))
+(define-json-type <account> (id) (type))
+(define-json-type <position>
+  (contract-id "conid")
+  (market-price "marketPrice")
+  (market-value "marketValue"))
+(define-json-type <ledger> (cash-balance "cashbalance") (currency "currency"))
+(define-json-type <contract> (id "conid") (exchange) (exchange-in-usa "isUS"))
+(define-json-type <stock> (name) (contracts "contracts" #(<contract>)))
+
+(define-json-type <order>
+  (account-id "acctId") (contract-id "conid") (type "orderType")
+  (side) (time-in-force "tif") (quantity))
+(define-json-type <order-reply>
+  (order-id "order_id") (status "order_status")
+  (encrypted "encrypt_message"))
+(define-json-type <order-warning>
+  (id) (message) (is-suppressed "isSuppressed") (message-ids "messageIds"))
+(define-json-type <order-reject> (error))
+(define-json-type <order-confirmation> (confirmed))
+(define-json-type <order-preview>
+  (amount "amount" <order-preview-amount>) (warning "warn") (error))
+(define-json-type <order-preview-amount> (commission) (total))
+(define-json-type <order-status>
+  (order-id "order_id") (contract-id "conid") (currency) (side)
+  (quantity "total_size") (status "order_status")
+  (average-price "average_price"))
+
+(define-json-type <suppress> (message-ids "messageIds"))
+
+(define (position-quantity pos)
+  (/ (position-market-value pos) (position-market-price pos)))
+
+(define-public (json->type-list scm->type json-str)
+  (let ((vec (json-string->scm json-str))
+	(f (lambda (scm) (scm->type scm))))
+    (map f (vector->list vec))))
+
+(define-public (snapshot-field symbol) (assoc-ref '((last-trade . 31)) symbol))
+
+(define-public (json-string->order-submit-response txt)
+  (let ((obj (json-string->scm txt)))
+    (if (assoc-ref obj "error")
+	(scm->order-reject obj)
+	(let ((hd (vector-ref obj 0)))
+	  (if (assoc-ref hd "message")
+	      (scm->order-warning hd)
+	      (scm->order-reply hd))))))