(require 'hash-table)

;;; Returns #t iff id is a valid YID in hex or base64 and we know the Yenta with it.
(define (identity:known-YID? id)
  (let ((bytes (ui:hex-or-base64->bytes id)))
    (and bytes
	 (identity:get-key bytes))))

;;; If the id is one we've heard of, this returns the handle associated with it,
;;; otherwise, returns #f
(define (identity:get-handle id) #f)

;;; If the id is one we've heard of, this returns the path associated with it,
;;; otherwise #f.
(define (identity:get-path id) #f)

;;; ditto, for public key.
(define (identity:get-key id) #f)

;;; Get the attestation for this particular message and id.
;;; (for signing, passing back signed attestations, etc.)
(define (identity:get-attestation id message) #f)

;;; The whole list, or #f if we don't know the person.
(define (identity:get-attestations id) #f)

;;; The list of people we want to ask id for attestations for.
;;; Currently it doesn't try for anything fancy, just one we're talking to.
;;; This is mostly a function so we can eventually make it more complex, if
;;; we end up with an idea of good people to contact for information about
;;; someone we can't find.
(define (identity:attestations-seek-list id) #f)

;;; Marks that we want a new set of attestations from the Yenta; does not make
;;; the network connection, however; use (iy:contact-yenta) for this.
;(define (identity:update-attestations id) #f)
; being phased out...

;;; Notes a message id (which is based on a yid) and the corresponding index in
;;; our message list. This may cause us to be curious about a new yid.
(define (identity:note-message-id mid index) #f)

;;; Returns the index of the message with the given mid.
(define (identity:index-of-message mid) #f)

(define (identity:add-attestation! id attestation) #f)
(define (identity:delete-attestation! id message) #f)

(define (identity:addr-hex->bytes hexaddr)
  (list (car hexaddr)
	(cadr hexaddr)
	(ui:hex->bytes (caddr hexaddr))
	(ui:hex->bytes (cadddr hexaddr))))

;;; If the id in the addr is one we know, put the correct handle, path, and
;;; public key in the addr. Return #t if we recognized it, #f otherwise.
(define (identity:fix-addr! addr) #f)

;;; Adds the identity in the addr to the database if the date is more recent,
;;; or the entry is entirely new. Date is a UNIX time. Signature should have
;;; been checked beforehand.
(define (identity:notice date addr signature) #f)

;;; Returns the indices of the most recent n messages from yid to come to us.
;;; Note, of course, that these may not be in composition order, if we called
;;; any of them out of someone's archives.
(define (identity:most-recent-from yid n) #f)

(define (identity:sign-addr)
  (let* ((signature-time (current-time))
	 (key (ssl:der-string->rsa-private-key *local-yenta-priv-key*))
	 (signed (format nil "~S ~A" signature-time *local-yenta-addr*)))
    (identity:notice signature-time *local-yenta-addr* 
		     (ssl:rsa-sign-sha1-hash signed key))
    (ssl:free-rsa! key)))

(define (identity:check-signature date addr signature)
  (let* ((key (ssl:der-string->rsa-public-key (list-ref addr 3)))
	 (okay (ssl:rsa-verify-sha1-hash
		(format nil "~S ~A" date addr) signature key)))
    (ssl:free-rsa! key)
    okay))

;;; %%% When we give users the ability to change their view of some other Yenta's handle,
;;; %%% this should be modified to use that view, and perhaps also somehow show the original view.
(define (identity:description id)
  (let* ((handle (identity:get-handle id))
	 (yids-for-handle (identity:reverse-lookup handle #t))) ; Case-insensitive 'cause otherwise users could easily be faked out.
    (cond ((equal? *local-yenta-id* id)
	   (format "~A [you]" handle))
	  (handle
	   (if (> (length yids-for-handle) 1) ; If there's more than one known Yenta with this handle, be specific by supplying the whole YID.
	       (format "~A [~A]" handle (binary-yid->user-rep id))
	       (format "~A" handle)))
	  (t
	   (format "Yenta ~A" (binary-yid->user-rep id))))))

;;; Adds MID to the queue of messages to send to YID.
(define (identity:add-message! yid mid) #f)

;;; Returns the list of messages that should be sent to this Yenta.
(define (identity:message-list yid) #f)

;;; Returns the list of referrals that should be sent to this Yenta.
(define (identity:referral-list yid) #f)

;;; Clears the list of referrals for this YID.
(define (identity:clear-referral-list! yid) #f)

;;; Adds a referal to send to this YID.
(define (identity:add-referral! yid iinfo) #f)

;;; Returns the list of messages that should be sent to this Yenta.
(define (identity:message-list yid) #f)

;;; Clears the message list for the given YID.  Use after the messages have all
;;; been acknowledged by the other end.
(define (identity:clear-message-list! yid) #f)

;;; Returns a :addr-is or :id-unknown message for the given id.
(define (identity:tell-info id) #f)

;;; Returns the id part of an address.
(define identity:addr->id caddr)

(define (identity:want id)
  (set! *identity:wanted* (cons id *identity:wanted*)))

(define (identity:wanted-list)
  *identity:wanted*)

(define (identity:last-seen id) #f)

(define (identity:seen-now id) #f)

(def-yenta-var *identity:wanted* '())

(def-yenta-var *identity:reverse* (make-hash-table 128))

;;; Returns a list of matching YID's.
(define (identity:reverse-lookup handle case-insensitive) #f)

;;; Returns all of the IP addresses where we've seen Yentas that we haven't
;;; later seen elsewhere.
(define (identity:all-ips) #f)

;;; Contacts all Yentas which we haven't contacted for at least duration
;;; seconds.
(define (identity:revisit-old duration) #f)

;;; How often to revisit old Yenta's, in seconds.  For the moment, this is an hour, but it should
;;; probably be upped to a day or so once debugging is done, and once we're sure that Y's talk to
;;; each other for their other needs when necessary.
(define *identity:revisit-old-timeout* 3600) ; %%% Maybe make this def-yenta-var instead?

(define *identity:revisit-old-taskname* "Revisit Yentas")

;;; Actually start revisiting old Yentas.  Don't call this until everything else is initialized.
(define (identity:revisit-old-periodically)
  (scheduler:add-periodic-task!		; This first runs -after- the timeout expires, which is correct.
    *identity:revisit-old-taskname* 1 *identity:revisit-old-timeout*
    (lambda ()
      (identity:revisit-old *identity:revisit-old-timeout*))))

(let ()
  ;; internally, the record is (YID path handle Ykey date signature 
  ;;			       messages-to-pass attestations message-indices
  ;;			       <unused> best-link last-seen
  ;;			       referrals-to-give)
  ;; get-item returns (path handle ...), however.
  ;; best-link is current just (), but will eventually be the Yentas we think
  ;; we ought to contact in case of failure in contacting YID-- this could be
  ;; somewhat random, if the other end is hiding, but at least tells us where
  ;; to begin. This will accumulate other yentas that have recently given us
  ;; good info on that guy.
  ;; The <unused> is always #f; it used to be used for something that we now
  ;; handle differently.

  (define (change-item key value)
    ((hash-associator equal?) *identity:handles* key value))

  (define (get-item id)
    ((hash-inquirer equal?) *identity:handles* id))

  (define (get-field-proc number)
    (lambda (id)
      (let ((item (get-item id)))
	(if item
	    (list-ref item number)
	    item))))

  (define (seen-now id)
    (let ((item (get-item id)))
      (cond (item
	     (list-set! item 10 (current-time))
	     #t)
	    (t
	     #f))))

  (define (start-of-list lst n)
    (if (and (not (null? lst))
	     (> n 0))
	(cons (car lst) (start-of-list (cdr lst) (- n 1)))
	'()))

  (define (most-recent-from yid n)
    (let ((item (get-item yid)))
      (if item
	  (start-of-list (list-ref item 7) n)
	  '())))

;  (define (update-attestations id)
;    (let ((item (get-item id)))
;      (cond (item 
;	     (list-set! item 8 #t)
;	     #t)
;	    (t
;	     #f))))
; being phased out...

  (define (note-message-id mid index)
    (let ((item (get-item (car mid))))
      (cond (item 
	     (cond ((not (assq (cadr mid) (list-ref item 7)))
		    (list-set! item 7 (cons (list (cadr mid) index)
					    (list-ref item 7)))
		    #t) ; new message
		   (t
		    #f))) ; old message
	    (t
	     (identity:want (car mid)) ; We should ask others about this Yenta,
	     ; who we have mail from, but have never met.
	     (change-item (car mid) ; YID
			  (list ; This is a Yenta we've never heard of.
			   #f ; path
			   #f ; handle
			   #f ; key
			   0  ; date
			   "" ; signature
			   '() ; to send
			   '() ; attestations
			   (list (list (cadr mid) index)) ; message-ids
			   #f ; want-attestations
			   '() ; best contacts
			   0 ; last seen
			   '() ; referrals
			   ))
	     #t))))

  (define (index-of-message mid)
    (let* ((item (get-item (car mid)))
	   (match (if item
		      (assq (cadr mid) (list-ref item 7))
		      #f)))
      (if match
	  (cadr match)
	  #f)))

  (define (get-attestation id message)
    (let ((lst (identity:get-attestations id)))
      (and lst (assoc message lst))))

  (define (attestations-seek-list id)
    (list id))

  (define (merge-signatures att sigs)
    (list (car att)
	  (append (map (lambda (sig)
			 (let ((match (assoc (car sig) sigs)))
			   (if (and match
				    (> (cadr match) (cadr sig)))
			       match
			       sig)))
		       (cadr att))
		  (filter (lambda (sig)
			    (not (assoc (car sig) (cadr att))))
			  sigs))))
		 
  (define (add-attestation! id attestation)
    (let ((item (get-item id)))
      (cond (item
	     (list-set! item 6
			(cons (let* ((old-att (assoc (car attestation)
						     (list-ref item 6)))
				     (extra-sigs (if old-att
						     (cadr old-att)
						     '())))
				(merge-signatures attestation extra-sigs))
			      (filter 
			       (lambda (att)
				 (not (equal? (car attestation) 
					      (car att))))
			       (list-ref item 6))))
	     #t)
	    (t
	     #f))))

  (define (add-message! yid mid)
    (if (not (equal? yid *local-yenta-id*))
	(let ((item (get-item yid)))
	  (cond (item
		 (set-car! (cddr (cdddr item))
			   (cons mid (remove mid (list-ref item 5))))
		 #t)
		(t
		 #f)))
	#f))				; Never mail to self this way.

  (define (clear-message-list! yid)
    (let ((item (get-item yid)))
      (cond (item
	     (set-car! (cddr (cdddr item))
		       '())
	     #t)
	    (t
	     #f))))

  (define (add-referral! yid iinfo)
    (if (not (equal? yid *local-yenta-id*))
	(let ((item (get-item yid)))
	  (cond (item
		 (set-car! (cdddr (cdddr (cdddr item)))
			   (cons iinfo (list-ref item 9)))
		 #t)
		(t
		 #f)))
	#f))				; Never mail to self this way.

  (define (clear-referral-list! yid)
    (let ((item (get-item yid)))
      (cond (item
	     (set-car! (cdddr (cdddr (cdddr item)))
		       '())
	     #t)
	    (t
	     #f))))

  (define (delete-attestation! id message)
    (let ((item (get-item id)))
      (cond ((and item (assoc message (list-ref item 6)))
	     (set-car! (cdddr (cdddr item)) (filter (lambda (att)
						      (not (equal? message 
								   (car att))))
						    (list-ref item 6)))
	     #t)
	    (t
	     #f))))

  (define (tell-info id)
    (let ((item (get-item id)))
      (if (and item (caddr item)) ; if we don't know the key, don't give info
	  (list ':addr-is (list (car (cdddr item)) ; date
				(car item) ; path
				(cadr item) ; handle
				(ui:bytes->hex id) ; YID
				(ui:bytes->hex (caddr item)) ; Ykey
				)
		(ui:bytes->hex (cadr (cdddr item))) ; signature
		)
	  (list ':id-unknown (ui:bytes->hex id)))))

  (define (fix-addr! addr)
    (let ((item (get-item (caddr addr))))
      (cond (item
	     (set-car! (cdr addr) (cadr item))
	     (set-car! (cdddr addr) (caddr item))
	     (set-car! addr (car item))
	     #t)
	    (t
	     #f))))

  (define (reverse-denote handle id)
    ((hash-associator equal?) *identity:reverse* (string-upcase handle)
			      (filter (lambda (elt)
					(not (equal? id (cadr elt))))
				      (reverse-lookup-int handle))))

  (define (reverse-note handle id)
    ((hash-associator equal?) *identity:reverse* (string-upcase handle)
			      (cons (list handle id)
				    (reverse-lookup-int handle))))
  
  (define (reverse-lookup handle case-insensitive)
    (map cadr
	 (filter (lambda (elt)
		   (or case-insensitive
		       (equal? handle (car elt))))
		 (reverse-lookup-int handle))))

  (define (reverse-lookup-int handle)
    (let ((item ((hash-inquirer equal?) *identity:reverse* 
					(string-upcase handle))))
      (if item item '())))
	  
  (define (notice date addr signature)
    (let ((item (get-item (caddr addr))))
      (cond ((not item)
	     (change-item (caddr addr) (list (car addr) ;; new record
					     (cadr addr)
					     (cadddr addr)
					     date
					     signature
					     '()
					     '()
					     '()
					     #f
					     '()
					     0
					     '()))
	     (reverse-note (cadr addr) (caddr addr))
	     #t)
	    ((> date (list-ref item 3))
	     (if (and (cadr addr)
		      (not (car item))) ;; address, and we don't have one...
		 (iy:contact-host (car item))) ; contact the newly found guy.
	     (reverse-denote (cadr item) (caddr addr))
	     (set-car! (cdddr item) date)
	     (set-car! (cddr (cddr item)) signature)
	     (set-car! (cdr item) (cadr addr))
	     (set-car! (cddr item) (cadddr addr))
	     (set-car! item (car addr))
	     (reverse-note (cadr addr) (caddr addr))
	     #t)
	    (else #f))))

  (define (all-ips)
    (map (lambda (name) (inet:address->string (inet:string->address name)))
	 (vector-reduce (lambda (sum bucket) 
			  (append sum (map (lambda (item) (list-ref item 1))
					   bucket)))
			'()
			*identity:handles*)))

  (define (revisit-old duration)
    (let ((now (current-time)))
      (vector-for-each 
       (lambda (bucket)
	 (for-each (lambda (rec)
		     (if (< (list-ref rec 11) (- now duration))
			 (iy:contact-host (list-ref rec 1))))
		   bucket))
       *identity:handles*)))

  (set! identity:revisit-old revisit-old)
  (set! identity:get-path (get-field-proc 0))
  (set! identity:get-handle (get-field-proc 1))
  (set! identity:get-key (get-field-proc 2))
  (set! identity:message-list (get-field-proc 5))
  (set! identity:referral-list (get-field-proc 9))
  (set! identity:clear-referral-list! clear-referral-list!)
  (set! identity:add-referral! add-referral!)
  (set! identity:get-attestations (get-field-proc 6))
  (set! identity:last-seen (get-field-proc 10))
  (set! identity:seen-now seen-now)
  (set! identity:most-recent-from most-recent-from)
  (set! identity:note-message-id note-message-id)
  (set! identity:index-of-message index-of-message)
  (set! identity:get-attestation get-attestation)
  (set! identity:attestations-seek-list attestations-seek-list)
  (set! identity:add-attestation! add-attestation!)
  (set! identity:add-message! add-message!)
  (set! identity:clear-message-list! clear-message-list!)
  (set! identity:delete-attestation! delete-attestation!)
  (set! identity:tell-info tell-info)
  (set! identity:fix-addr! fix-addr!)
  (set! identity:reverse-lookup reverse-lookup)
  (set! identity:notice notice)
  (set! identity:all-ips all-ips)
)
