gnunet/gnu/gnunet/identity.scm

;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
;;;; 
;;;; Copyright © 2015 Rémi Delrue <asgeir@free.fr>
;;;; 
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;; 
;;;; 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.  See the
;;;; GNU General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu gnunet identity)
  #:use-module (srfi srfi-9)
  #:use-module (system foreign)
  #:use-module (rnrs bytevectors)
  #:use-module (gnu gnunet common)
  #:use-module (gnu gnunet binding-utils)
  #:use-module (gnu gnunet configuration)
  #:export (<ego>
	    ego?
	    wrap-ego
	    unwrap-ego
	    
	    ego-private-key
	    ego-public-key
	    open-identity-service
	    close-identity-service
	    get-default-ego
	    set-default-ego
	    cancel-operation!
	    start-ego-lookup
	    stop-ego-lookup!
            ecdsa-public-key->string))


(define-record-type <ego>
  (wrap-ego pointer)
  ego?
  (pointer unwrap-ego))


(define-gnunet-id %get-private-key
  "GNUNET_IDENTITY_ego_get_private_key" : '(*)   -> '*)
(define-gnunet-id %get-public-key
  "GNUNET_IDENTITY_ego_get_public_key"  : '(* *) -> void)

(define-gnunet-id %identity-connect
  "GNUNET_IDENTITY_connect"    : '(* * *) -> '*)
(define-gnunet-id %identity-disconnect
  "GNUNET_IDENTITY_disconnect" : '(*)     -> void)

(define-gnunet-id %identity-get
  "GNUNET_IDENTITY_get"      : '(* * * *)   -> '*)
(define-gnunet-id %identity-set!
  "GNUNET_IDENTITY_set"      : '(* * * * *) -> '*)

(define-gnunet-id %cancel! "GNUNET_IDENTITY_cancel" : '(*) -> void)

(define-gnunet-id %ego-lookup
  "GNUNET_IDENTITY_ego_lookup"        : '(* * * *) -> '*)
(define-gnunet-id %ego-lookup-cancel!
  "GNUNET_IDENTITY_ego_lookup_cancel" : '(*)       -> void)

(define-gnunet %ecdsa-public-key->string
  "GNUNET_CRYPTO_ecdsa_public_key_to_string" : '(*) -> '*)

(define (ego-private-key ego)
  (%get-private-key (unwrap-ego ego)))

(define (ego-public-key ego)
  (let ((key (bytevector->pointer
	      (make-bytevector (sizeof ecdsa-public-key)))))
    (%get-public-key (unwrap-ego ego) key)
    key))

(define (identity-callback->pointer thunk)
  (procedure->pointer void
		      (lambda (closure ego context name)
			(thunk (if (eq? %null-pointer ego) #f (wrap-ego ego))
			       (pointer->string* name)))
		      '(* * * *)))

(define (open-identity-service config identity-callback)
  "Connect to the identity service. IDENTITY-CALLBACK is called on each ego
known by the service, and once with arguments (#f #f) to mark the end of the
initial pass. Please note IDENTITY-CALLBACK can still be called after that: on
error (with arguments (#f #f)), and whenever an ego’s name changes or if it is
deleted.

IDENTITY-CALLBACK is a function of two arguments: an ego (or #f) and the name
assigned by the user for this ego (or #f if the user just deleted this ego).

Return a handle to the identity service that’s needed by every identity related
function."
  (or%
   (%identity-connect (unwrap-configuration config)
                      (identity-callback->pointer identity-callback)
                      %null-pointer)
   (throw 'invalid-result "open-identity-service" "%identity-connect"
          %null-pointer)))

(define (close-identity-service identity-handle)
  "Disconnect from the identity service."
  (%identity-disconnect identity-handle))

(define (get-default-ego identity-handle service identity-callback)
  "Obtain the ego that is currently prefered/default for SERVICE.

IDENTITY-CALLBACK is called once with arguments (#f #f) on error and with
non-null arguments on success, in which case OPEN-IDENTITY-SERVICE’s own
IDENTITY-CALLBACK will also be called.

Returns a handle to the “ego retrieving operation” that can be used to
cancel it (see CANCEL-OPERATION!)."
  (when (string-null? service)
    (throw 'invalid-arg "get-default-ego" service))
  (%identity-get identity-handle (string->pointer service)
		 (identity-callback->pointer identity-callback) %null-pointer))

(define (set-default-ego identity-handle service ego identity-callback)
  "Set the preferred/default ego for SERVICE.

IDENTITY-CALLBACK is called once with arguments (#f #f) on error and with
non-null arguments on success, in which case OPEN-IDENTITY-SERVICE’s own
IDENTITY-CALLBACK will also be called.

Returns a handle to the “ego setting operation” that can be used to cancel
it (see CANCEL-OPERATION!)."
  (when (string-null? service)
    (throw 'invalid-arg "set-current-ego" service))
  (when (eq? %null-pointer ego)
    (throw 'invalid-arg "set-current-ego" ego))
  (%identity-set! identity-handle (string->pointer service) (unwrap-ego ego)
		  (identity-callback->pointer identity-callback) %null-pointer))

(define (cancel-operation! op)
  "Cancel an identity operation.

Note that the operation may still be executed, notably if the request was
already transmitted to the service."
  (when (eq? %null-pointer op)
    (throw 'invalid-arg "cancel-operation!" op))
  (%cancel! op))

(define (ego-callback->pointer thunk)
  (procedure->pointer void
		      (lambda (closure ego)
			(thunk (if (eq? %null-pointer ego) #f (wrap-ego ego))))
		      '(* *)))

(define (start-ego-lookup config name ego-callback)
  "Lookup an ego by NAME.

Return a handle to the lookup that can be cancelled with CANCEL-EGO-LOOKUP!"
  (when (or (not (string? name))
            (string-null? name))
    (throw 'invalid-arg "lookup-ego" name))
  (%ego-lookup (unwrap-configuration config) (string->pointer name)
	       (ego-callback->pointer ego-callback) %null-pointer))

(define (stop-ego-lookup! lookup)
  "Abort an ego lookup attempt."
  (%ego-lookup-cancel! lookup))

(define (ecdsa-public-key->string key)
  (let* ((%s (%ecdsa-public-key->string key))
	 (res (pointer->string %s)))
    (%free %s)
    res))