Basic session implementation

chicken-on-a-raft.impl.scm

@@ -3,38 +3,66 @@
 (import (r7rs))
 (import (scheme base))
 (import (srfi 180))
-(import (srfi 99))
-(import coops)
-(import (chicken process))
+(import coops coops-extras coops-primitive-objects coops-utils)
+(import (chicken process)
+        (chicken gc)
+        (chicken condition))
+(import uri-common)
 (import intarweb)
 (import http-client)
 
 (define-class <Browser> ()
-  (url stdout stdin stderr pid))
-
-(define-method (terminate (browser <Browser>))
-  (process-signal (slot-value browser 'pid)))
+  ((base-url accessor: base-url)
+   (stdout accessor: stdout)
+   (stdin accessor: stdin)
+   (stderr accessor: stderr)
+   (pid accessor: pid)
+   (session accessor: session)))
 
 (define-method (initialize-instance (browser <Browser>))
-  (call-next-method)
-  (set-finalizer! browser (lambda (obj) (terminate browser))))
+  (set-finalizer! browser (lambda (obj) (terminate browser)))
+  (call-next-method))
 
-(define-method (send (browser <Browser>) struct #!key to path using method)
-  (with-input-from-request
-   (make-request method: method
-                 uri: (uri-reference (string-append (slot-value browser 'url) path))
-                 headers: (headers `((content-type application/json))))
-   (lambda () (json-write struct))
-   json-read))
+(define-method (send (browser <Browser>) struct path method)
+  (let ((uri (string-append (base-url browser) path)))
+    (with-input-from-request
+     (make-request method: method
+                   uri: (uri-reference uri)
+                   headers: (headers `((content-type application/json))))
+     (lambda () (json-write struct))
+     json-read)))
+
+(define-method (initialize-session (browser <Browser>))
+  (set! (session browser) (alist-ref 'sessionId (send browser '() "session" 'POST))))
+
+(define-method (terminate-session (browser <Browser>))
+  (send browser '() (string-append "session/" (session browser)) 'DELETE))
+
+;; TODO: Apparently session has to be closed first
+(define-method (terminate (browser <Browser>))
+  (call/cc
+   (lambda (c)
+     (with-exception-handler
+         (lambda (x) (c #t))
+       (lambda ()
+         (terminate-session browser)
+         (process-signal (pid browser))
+         (close-input-port (stdout browser))
+         (close-input-port (stderr browser))
+         (close-output-port (stdin browser)))))))
 
 (define-class <Firefox> (<Browser>))
 
 (define (firefox #!key ip ip port port)
   (let-values (((stdout stdin pid stderr) (process* "geckodriver")))
-    (make <Browser>
-      url: (string-append "http://" (or ip "127.0.0.1")
-                          ":" (or port "4444") "/")
-      stdout: stdout
-      stdin: stdin
-      stderr: stderr
-      pid: pid)))
+    (make <Firefox>
+      'base-url (string-append "http://" (or ip "127.0.0.1")
+                               ":" (or port "4444") "/")
+      'stdout stdout
+      'stdin stdin
+      'stderr stderr
+      'pid pid)))
+
+(define-method (send (browser <Firefox>) struct path method)
+  (let ((result (call-next-method)))
+    (alist-ref 'value result)))