From 6ab023dbd11ca0a761a5a7f348e6fb66c2014294 Mon Sep 17 00:00:00 2001
From: Russell Sim <russell.sim@gmail.com>
Date: Sun, 13 Oct 2013 18:25:59 +1100
Subject: [PATCH] Added token validity predicate

CONNECTION-TOKEN-VALID-P will return T if the token expires in the
future.

Change-Id: I27d1aa0fa8dfee736a5c0ebd4fca2bd22c62ba9b
---
 cl-openstack-client-test.asd |  3 +-
 cl-openstack-client.asd      |  2 +-
 keystone.lisp                | 28 ++++++++++++++++--
 tests/keystone.lisp          | 56 ++++++++++++++++++++++++++++++++++++
 4 files changed, 84 insertions(+), 5 deletions(-)

diff --git a/cl-openstack-client-test.asd b/cl-openstack-client-test.asd
index 36b4782..73143dd 100644
--- a/cl-openstack-client-test.asd
+++ b/cl-openstack-client-test.asd
@@ -6,7 +6,8 @@
                #:chunga
                #:drakma
                #:trivial-gray-streams
-               #:flexi-streams)
+               #:flexi-streams
+               #:local-time)
   :description "OpenStack client libraries tests"
   :components
   ((:file "keystone"
diff --git a/cl-openstack-client.asd b/cl-openstack-client.asd
index 8f0ecfd..0b0238c 100644
--- a/cl-openstack-client.asd
+++ b/cl-openstack-client.asd
@@ -1,6 +1,6 @@
 (defsystem cl-openstack-client
   :author "Julien Danjou <julien@danjou.info>"
-  :depends-on (#:drakma #:cl-json)
+  :depends-on (#:drakma #:cl-json #:local-time)
   :description "OpenStack client libraries"
   :components
   ((:file "keystone")))
diff --git a/keystone.lisp b/keystone.lisp
index 61fba75..e927d75 100644
--- a/keystone.lisp
+++ b/keystone.lisp
@@ -1,5 +1,9 @@
 (defpackage cl-keystone-client
   (:use cl cl-json drakma)
+  (:import-from :local-time
+                :parse-timestring
+                :timestamp>
+                :now)
   (:export connection-v2
            authenticate
            keystone-error
@@ -11,7 +15,9 @@
            connection-password
            connection-url
            connection-token-id
-           connection-token-expires))
+           connection-token-expires
+           connection-token-issued-at
+           connection-token-valid-p))
 
 (in-package :cl-keystone-client)
 
@@ -121,9 +127,25 @@ to STREAM (or to *JSON-OUTPUT*)."
 (defmethod connection-token-id ((connection connection-v2))
   (cdr (assoc :id (slot-value connection 'token))))
 
+(defgeneric connection-token-issued-at (connection)
+  (:documentation "Return the time the CONNECTION's token was issued
+at."))
+
+(defmethod connection-token-issued-at ((connection connection-v2))
+  (parse-timestring (cdr (assoc :issued--at (slot-value connection 'token)))))
 
 (defgeneric connection-token-expires (connection)
-  (:documentation "Retrieve token expiration for CONNECTION."))
+  (:documentation "Return the time when the CONNECTION's token will
+expire."))
 
 (defmethod connection-token-expires ((connection connection-v2))
-  (cdr (assoc :expires (slot-value connection 'token))))
+  (parse-timestring (cdr (assoc :expires (slot-value connection 'token)))))
+
+(defgeneric connection-token-valid-p (connection)
+  (:documentation "Return T if the CONNECTION's token is still
+valid."))
+
+(defmethod connection-token-valid-p ((connection connection-v2))
+  (timestamp>
+   (connection-token-expires connection)
+   (now)))
diff --git a/tests/keystone.lisp b/tests/keystone.lisp
index 326f7ce..1b7d920 100644
--- a/tests/keystone.lisp
+++ b/tests/keystone.lisp
@@ -4,6 +4,14 @@
         trivial-gray-streams
         cl-openstack-client-test
         cl-keystone-client)
+  (:import-from :local-time
+                :encode-timestamp
+                :timestamp-to-unix
+                :timestamp=
+                :timestamp+
+                :format-timestring
+                :now
+                :+utc-zone+)
   (:import-from :cl-ppcre
                 :regex-replace-all)
   (:import-from :flexi-streams
@@ -21,6 +29,20 @@
 
 (in-suite keystone)
 
+(defparameter +keystone-format+
+  ;; same as +ISO-8601-FORMAT+ except with non nano seconds.
+  '((:year 4) #\- (:month 2) #\- (:day 2) #\T
+    (:hour 2) #\: (:min 2) #\: (:sec 2)
+    :gmt-offset-or-z))
+
+(defun connection-fixture (&key
+                             (url "http://localhost:5000")
+                             (username "demo")
+                             (password "demo"))
+  (make-instance 'connection-v2 :url url
+                                :password password
+                                :username username))
+
 (defclass mock-http-stream (fundamental-binary-input-stream
                             fundamental-binary-output-stream
                             fundamental-character-input-stream
@@ -73,6 +95,40 @@
                    :username "test"
                    :password "test")))
 
+(test token-expiry-conversion
+  "Test that the token expiry is correctly converted to a local-time
+object."
+  (let ((connection (connection-fixture)))
+    (setf (slot-value connection 'cl-keystone-client::token)
+          '((:issued--at . "2013-10-13T06:01:36.315343")
+            (:expires . "2013-10-14T06:01:36Z")))
+    (is (timestamp=
+         (connection-token-expires connection)
+         (encode-timestamp 0 36 1 6 14 10 2013
+                           :timezone +utc-zone+)))
+    (is (timestamp=
+         (connection-token-issued-at connection)
+         (encode-timestamp 315343000 36 1 6 13 10 2013
+                           :timezone +utc-zone+)))))
+
+(test token-expired
+  "Test that the token expiry is detected correctly."
+  (let ((connection (connection-fixture)))
+    (setf (slot-value connection 'cl-keystone-client::token)
+          '((:expires . "2013-10-12T06:01:36Z")))
+    (is-false (connection-token-valid-p connection))))
+
+(test token-valid
+  "Test the validity of a token is detected correctly."
+  (let ((connection (connection-fixture)))
+    (setf (slot-value connection 'cl-keystone-client::token)
+          `((:expires . ,(format-timestring
+                          nil
+                          (timestamp+ (now) 1 :minute)
+                          :format +keystone-format+
+                          :timezone +utc-zone+))))
+    (is-true (connection-token-valid-p connection))))
+
 (test authentication-error-404
   "Test that the correct condition is signalled when a 404 is returned
 from the keystone server."