@@ -8,3 +8,4 @@ daydreamer

 daydreamer--all-systems.a

 daydreamer-runtime

 remember--versions_half_up_to_pi

+*.sw?

@@ -1,32 +1,43 @@

 (defpackage :daydreamer.aws-result

-  (:use :cl :fw.lu :alexandria :st)

-  (:export

-   #:stack

-   #:outputs

-   #:reader

-   #:creation-time

-   #:notification-arns

-   #:stack-id

-   #:stack-name

-   #:description

-   #:stack-status

-   #:disable-rollback

-   #:tags

-   #:deletion-time

-   #:rollback-configuration

-   #:drift-information

-   #:enable-termination-protection

-   #:parameters

-   #:start-date-time

-   #:end-date-time

-   #:creation-date-time

-   #:extract-timeline

-   #:extract-list

-   #:extract-stack

-   #:timeline

-   #:tagged-kv-formatter))

+  (:use :cl :fw.lu :alexandria)

+  (:export #:stack

+           #:outputs

+           #:reader

+           #:creation-time

+           #:notification-arns

+           #:stack-id

+           #:stack-name

+           #:description

+           #:stack-status

+           #:disable-rollback

+           #:tags

+           #:deletion-time

+           #:rollback-configuration

+           #:drift-information

+           #:enable-termination-protection

+           #:parameters

+           #:start-date-time

+           #:end-date-time

+           #:creation-date-time

+           #:extract-timeline

+           #:extract-list

+           #:extract-stack

+           #:timeline

+           #:tagged-kv-formatter

+           #:extract-stack-resource

+           #:stack-resource

+           #:physical-resource-id

+           #:resource-status

+           #:logical-resource-id

+           #:timestamp

+           #:resource-type

+           #:resource-status-reason))

 (in-package :daydreamer.aws-result)

+(defgeneric stack-name (stack)

+  (:method ((stack string))

+    stack))

+

 (defun find-all-indices (pred str &optional accum (start (or (car accum) 0)))

   (check-type pred function)

   (check-type str string)

@@ -158,16 +169,18 @@

 (defparameter *stack-statuses*

   '("CREATE_COMPLETE" "CREATE_IN_PROGRESS" "CREATE_FAILED"

     "DELETE_COMPLETE" "DELETE_FAILED" "DELETE_IN_PROGRESS"

-    "REVIEW_IN_PROGRESS"

-    "ROLLBACK_COMPLETE" "ROLLBACK_FAILED" "ROLLBACK_IN_PROGRESS"

-    "UPDATE_COMPLETE" "UPDATE_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_IN_PROGRESS"

-    "UPDATE_ROLLBACK_COMPLETE" "UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_ROLLBACK_FAILED" "UPDATE_ROLLBACK_IN_PROGRESS"))

+    "REVIEW_IN_PROGRESS" "ROLLBACK_COMPLETE" "ROLLBACK_FAILED"

+    "ROLLBACK_IN_PROGRESS" "UPDATE_COMPLETE"

+    "UPDATE_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_IN_PROGRESS"

+    "UPDATE_ROLLBACK_COMPLETE"

+    "UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS"

+    "UPDATE_ROLLBACK_FAILED" "UPDATE_ROLLBACK_IN_PROGRESS"))

 #+nil

-(aws-sdk/services/cloudformation:list-stacks 

+(aws-sdk/services/cloudformation:list-stacks

  :stack-status-filter '("UPDATE_COMPLETE" "UPDATE_IN_PROGRESS"

                         "UPDATE_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_ROLLBACK_COMPLETE"

-                        "UPDATE_ROLLBACK_IN_PROGRESS" "UPDATE_ROLLBACK_FAILED" 

+                        "UPDATE_ROLLBACK_IN_PROGRESS" "UPDATE_ROLLBACK_FAILED"

                         "UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS" "CREATE_FAILED"

                         "CREATE_COMPLETE" "CREATE_IN_PROGRESS"))

@@ -183,11 +196,47 @@

           s-edt (initialize-date s-edt)

           s-cdt (initialize-date s-cdt))))

-

+(defclass stack-resource ()

+  ((%physical-resource-id :initarg :physical-resource-id :reader physical-resource-id)

+   (%resource-status :initarg :resource-status :reader resource-status)

+   (%resource-status-reason :initarg :resource-status-reason :reader resource-status-reason :initform nil)

+   (%stack-id :initarg :stack-id :reader stack-id)

+   (%stack-name :initarg :stack-name :reader stack-name)

+   (%drift-information :initarg :drift-information :reader drift-information)

+   (%logical-resource-id :initarg :logical-resource-id :reader logical-resource-id)

+   (%timestamp :initarg :timestamp :reader timestamp)

+   (%resource-type :initarg :resource-type :reader resource-type)))

+

+(defmethod print-object ((o stack-resource) s)

+  (print-unreadable-object (o s :type t :identity t)

+    (format s "~a (~a): ~a"

+            (logical-resource-id o)

+            (resource-type o)

+            (resource-status o))))

+

+(defun extract-stack-resource (it)

+  (apply 'make-instance 'daydreamer.aws-result::stack-resource

+         (daydreamer.aws-result::alist-to-initargs

+          it (fw.lu:alist-string-hash-table

+              `((:physical-resource-id . car)

+                (:resource-status . car)

+                (:resource-status-reason . car)

+                (:stack-id . car)

+                (:stack-name . car)

+                (:drift-information . car)

+                (:logical-resource-id . car)

+                (:timestamp . car)

+                (:resource-type . car))))))

+

+(defclass stack-template ()

+  ((template-body :initarg :template-body :reader template-body)

+   (stages-available :initarg :stages-available :reader stages-available)))

+

+

+#+(or)

 (deftest decamelize ()

   (should be equal "a" (decamelize "A"))

   (should be equal "a" (decamelize "a"))

   (should be equal "outputs" (decamelize "Outputs"))

   (should be equal "outputs-outputs" (decamelize "OutputsOutputs"))

   (should be equal "a-b-c" (decamelize "ABC")))

-

@@ -21,23 +21,25 @@

 ;;     nil)

 (stepwise

-  ((defun load-compile (pn)

-     (load (compile-file pn))))

-

-  ((ql:quickload :cffi-grovel))

-  ((princ

-    (mapcar 'load-compile

-            (remove #\.

-                    (directory (merge-pathnames "*.asd"

-                                                *load-pathname*)) 

-                    :key 'pathname-name 

-                    :test 'alexandria:starts-with)))

-   (terpri))

-

-  ((ql:quickload :daydreamer))

-

-  ((asdf:operate :static-program-op :daydreamer))

-  #+nil

-  ((asdf/driver:symbol-call :daydreamer.cli :dump))

-  

-  ((sb-ext:quit)))

+ ((defun load-compile (pn)

+    (load (compile-file pn))))

+

+ ((ql:quickload :cffi-grovel))

+ ((princ

+   (mapcar 'load-compile

+           (remove #\.

+                   (directory (merge-pathnames "*.asd"

+                                               *load-pathname*))

+                   :key 'pathname-name

+                   :test 'alexandria:starts-with)))

+  (terpri))

+

+ ((ql:quickload :daydreamer))

+

+ #+linux

+ ((asdf:operate :static-program-op :daydreamer))

+

+ #-linux

+ ((uiop:symbol-call :daydreamer.cli :dump))

+

+ ((sb-ext:quit)))

@@ -13,30 +13,45 @@

 (in-package :daydreamer.cli)

-

 (defparameter *daydreamer-synopsis*

   (defsynopsis (:postfix "ARGS...")

     (group (:header "actions")

-           (flag :short-name "s" :long-name "stacks" :description "show stack information")

-           (flag :short-name "p" :long-name "parameters" :description "show stack parameters")

-           (flag :short-name "o" :long-name "outputs" :description "show stack outputs")

-           (flag :short-name "w" :long-name "watch" :description "watch a cloudformation stack until it's done processing")

-           (flag :short-name "i" :long-name "info" :description "get parameters, status and output of a stack")

-           #+null

-           (flag :short-name "s" :long-name "start")

-           (stropt :long-name "aws-region" :default-value "us-west-2")

-           (flag :short-name "u" :long-name "update"))

+      (flag :short-name "s" :long-name "stacks" :description "show stack information")

+      (flag :short-name "p" :long-name "parameters" :description "show stack parameters")

+      (flag :short-name "o" :long-name "outputs" :description "show stack outputs")

+      (flag :short-name "r" :long-name "resources" :description "show stack resources")

+      (flag :short-name "w" :long-name "watch" :description "watch a cloudformation stack until it's done processing")

+      (flag :short-name "i" :long-name "info" :description "get parameters, status and output of a stack")

+      #+null

+      (flag :short-name "s" :long-name "start")

+      (stropt :long-name "aws-region"

+              :description "explicitly pick AWS Region"

+              :env-var "AWS_DEFAULT_REGION")

+      (stropt :long-name "aws-profile"

+              :description "aws profile to use for authentication"

+              :env-var "AWS_PROFILE")

+      (stropt :long-name "aws-access-key-id"

+              :description "aws access-key-id to use for authentication"

+              :env-var "AWS_ACCESS_KEY_ID")

+      (stropt :long-name "aws-secret-access-key"

+              :description "aws secret-access-key to use for authentication"

+              :env-var "AWS_SECRET_ACCESS_KEY")

+      (stropt :long-name "aws-session-token"

+              :description "aws session-token to use for authentication"

+              :env-var "AWS_SESSION_TOKEN")

+      #+null

+      (flag :short-name "u" :long-name "update"))

     (group (:header "misc")

-           (flag :long-name "rebuild")

-           (flag :long-name "self-test")

-           (flag :long-name "help"))))

+      (flag :long-name "rebuild")

+      (flag :long-name "self-test")

+      (flag :long-name "help"))))

 (defun stacks-main ()

   (mapcar (lambda (s)

             (format t "~3&STACK ~a ~a~2%"

                     (daydreamer.aws-result:stack-name s)

                     (daydreamer.aws-result:stack-status s))

-            (stack-info s))

+            (stack-info s t t t))

           (mapcar 'daydreamer.aws-result:extract-stack

                   (daydreamer.aws-result:extract-list

                    (cdar

@@ -48,8 +63,8 @@

 (defun stack-outputs-main (name)

   (stack-outputs (stack-for-name name)))

-(defun stack-info-main (name)

-  (stack-info (stack-for-name name)))

+(defun stack-info-main (name status parameters outputs resources)

+  (stack-info (stack-for-name name) status parameters outputs resources))

 (defun run-tests ()

   (st:test :package (find-package :daydreamer.aws-result))

@@ -74,20 +89,58 @@

   (let* ((context (net.didierverna.clon:make-context :synopsis *daydreamer-synopsis*))

          (files (clon:remainder :context context))

          (region (clon:getopt :long-name "aws-region"))

-         (aws-sdk:*session* (aws-sdk:make-session :credentials (aws-sdk:default-aws-credentials)

-                                                  :region region)))

+         (profile (clon:getopt :long-name "aws-profile"))

+         (access-key-id (clon:getopt :long-name "aws-access-key-id"))

+         (secret-access-key (clon:getopt :long-name "aws-secret-access-key"))

+         (session-token (clon:getopt :long-name "aws-session-token")))

+

+    (cond (access-key-id

+           (setf aws:*session*

+                 (aws:make-session

+                  :credentials (if session-token

+                                   (aws:make-credentials

+                                    :access-key-id access-key-id

+                                    :secret-access-key secret-access-key

+                                    :session-token session-token

+                                    )

+                                   (aws:make-credentials

+                                    :access-key-id access-key-id

+                                    :secret-access-key secret-access-key

+                                    :session-token nil

+                                    ))

+                  :region region)))

+          ((and region profile)

+           (aws:init-session

+            :region region

+            :profile profile))

+          (region

+           (aws:init-session

+            :region region))

+          (profile

+           (aws:init-session

+            :profile profile))

+          (t

+           (aws:init-session)))

-    (format *error-output* "~&IN REGION: ~a~%" region)

+    (format *error-output* "~&IN REGION: ~a~%WITH PROFILE: ~a~%"

+            (aws:session-region aws:*session*)

+            profile)

     (cond ((clon:getopt :long-name "help") (clon:help))

-          ((clon:getopt :long-name "info") (stack-info-main (car files)))

           ((clon:getopt :long-name "watch") (daydreamer.main:watch-stack (car files)))

           ((clon:getopt :long-name "stacks") (stacks-main))

-          ((clon:getopt :long-name "outputs") (stack-outputs-main (car files)))

-          ((clon:getopt :long-name "parameters") (stack-parameters-main (car files)))

           ((clon:getopt :long-name "self-test") (run-tests))

           ((clon:getopt :long-name "rebuild")

            (load (compile-file (load-time-value

                                 (asdf:system-relative-pathname :daydreamer "cli.lisp"))))

-           (dump)))))

-

+           (dump))

+          (t

+           (let ((info (clon:getopt :long-name "info"))

+                 (parameters (clon:getopt :long-name "parameters"))

+                 (outputs (clon:getopt :long-name "outputs"))

+                 (resources (clon:getopt :long-name "resources")))

+             (stack-info-main (car files)

+                              info

+                              (or info parameters)

+                              (or info outputs)

+                              resources))))))

@@ -1,12 +1,20 @@

 #!/usr/bin/env bash

-cd $HOME

+

+set -eu -o pipefail

+

+cd "$HOME" 

 pwd

-git clone --depth=1 https://gitlab.com/fiddlerwoaroof/osicat.git ~/quicklisp/local-projects/osicat

-git clone --depth=1 https://gitlab.com/fiddlerwoaroof/cffi.git ~/quicklisp/local-projects/cffi

-git clone --depth=1 https://github.com/fiddlerwoaroof/fwoar.lisputils.git ~/quicklisp/local-projects/fwoar.lisputils/

-git clone --depth=1 https://github.com/fiddlerwoaroof/data-lens.git ~/quicklisp/local-projects/data-lens/

-git clone --depth=1 https://github.com/pokepay/aws-sdk-lisp.git ~/quicklisp/local-projects/aws-sdk-lisp && pushd ~/quicklisp/local-projects/aws-sdk-lisp && git checkout 6d1f66e && popd

+git clone --depth=1 https://gitlab.com/fiddlerwoaroof/osicat.git "$HOME"/quicklisp/local-projects/osicat

+git clone --depth=1 https://gitlab.com/fiddlerwoaroof/cffi.git "$HOME"/quicklisp/local-projects/cffi

+

+git clone --depth=1 https://github.com/fiddlerwoaroof/fwoar.lisputils.git "$HOME"/quicklisp/local-projects/fwoar.lisputils/

+git clone --depth=1 https://github.com/fiddlerwoaroof/data-lens.git "$HOME"/quicklisp/local-projects/data-lens/

+git clone --depth=1 https://github.com/fiddlerwoaroof/aws-sdk-lisp.git "$HOME"/quicklisp/local-projects/aws-sdk-lisp

+

+pushd "$HOME"/quicklisp/local-projects/aws-sdk-lisp

+git checkout my-patches

+popd

-ln -s /root/project/ ~/quicklisp/local-projects/daydreamer

+ln -s /root/project/ "$HOME"/quicklisp/local-projects/daydreamer

@@ -5,42 +5,42 @@

 (sb-posix:setenv "CC" "clang" 1)

 (defsystem :daydreamer

-    :description ""

-    :author "Ed L <gh@elangley.org>"

-    :license "MIT"

-    :defsystem-depends-on (#:cffi-grovel)

-    :depends-on (#:alexandria

-                 #:uiop

-                 #:serapeum

-                 #:fwoar-lisputils

-                 (:feature (:not :lispworks)

-                           #:net.didierverna.clon)

-                 #:cl-base64

-                 #:local-time

-                 #:osicat

-                 #:local-time-duration

-                 #:closer-mop

-                 #:aws-sdk                 

-                 #:aws-sdk/services/cloudformation

-                 #:aws-sdk/services/monitoring

-                 #:aws-sdk/services/elasticmapreduce

-                 #:should-test

-                 #:yason

-                 #:hunchentoot

-                 #:data-lens

-                 #:cffi)

-    :serial t

-    :components ((:file "aws-result")

-                 (:file "main")

-                 (:file "cli" :if-feature (:not :lispworks)))

+  :description ""

+  :author "Ed L <gh@elangley.org>"

+  :license "MIT"

+  :defsystem-depends-on (#:cffi-grovel)

+  :depends-on (#:alexandria

+               #:uiop

+               #:serapeum

+               #:fwoar-lisputils

+               #:cl-base64

+               #:local-time

+               #:local-time-duration

+               #:closer-mop

+               #:aws-sdk                 

+               #:aws-sdk/services/cloudformation

+               #:aws-sdk/services/monitoring

+               #:aws-sdk/services/elasticmapreduce

+               #:yason

+               #:hunchentoot

+               #:data-lens

+               #:cffi

+               (:feature (:not :lispworks)

+                         #:net.didierverna.clon)

+               (:feature (:not :lispworks)

+                         #:should-test))

+  :serial t

+  :components ((:file "aws-result")

+               (:file "main")

+               (:file "cli" :if-feature (:not :lispworks)))

-    :entry-point "daydreamer.cli::main"

-    #-lispworks 

-    :output-files

-    #-lispworks

-    (cffi-toolchain:static-program-op (o c)

-                                      (format t "~&*dpd* ~s~%%" (merge-pathnames "daydreamer"

-                                                                                 *default-pathname-defaults*))

-                                      (list

-                                       (merge-pathnames "daydreamer"

-                                                        *default-pathname-defaults*))))

+  :entry-point "daydreamer.cli::main"

+  #-lispworks 

+  :output-files

+  #-lispworks

+  (cffi-toolchain:static-program-op (o c)

+                                    (format t "~&*dpd* ~s~%%" (merge-pathnames "daydreamer"

+                                                                               *default-pathname-defaults*))

+                                    (list

+                                     (merge-pathnames "daydreamer"

+                                                      *default-pathname-defaults*))))

@@ -1,7 +1,7 @@

 ;; MIT license Edward Langley (c) 2018

 (defpackage :daydreamer.main

-  (:use :cl :fw.lu :alexandria :st :daydreamer.aws-result)

+  (:use :cl :fw.lu :alexandria :daydreamer.aws-result)

   (:export main dump

            #:stack-parameters

            #:stack-outputs

@@ -35,7 +35,7 @@

 (defun stack-parameters (the-stack)

   (print-kvs "Parameter"

-             (tagged-kv-formatter "PARAMETERS") t

+             (tagged-kv-formatter "PARAMETER") t

              (parameters the-stack)))

 (defun lt-format (a b &key &allow-other-keys)

@@ -48,10 +48,11 @@

 (defun every-five-seconds (cb args &optional (delay-function #'sleep))

   (loop

-     for (continue? . next-args) = (multiple-value-list (apply cb args)) then (multiple-value-list (apply cb next-args))

-     while continue?

-     do (funcall delay-function 5)))

+    for (continue? . next-args) = (multiple-value-list (apply cb args)) then (multiple-value-list (apply cb next-args))

+    while continue?

+    do (funcall delay-function 5)))

+#+(or)

 (deftest every-five-seconds ()

   (let ((counter 0)

         delay)

@@ -85,6 +86,23 @@

               counters)

       (should be = 5 delay))))

+(defun resource-block (the-stack)

+  (format t "~& RESOURCES ~%============~%")

+  (let ((resources (daydreamer.aws-result:extract-list

+                    (serapeum:assocdr "StackResources"

+                                      (aws/cloudformation:describe-stack-resources

+                                       :stack-name (stack-name the-stack))

+                                      :test 'equal)

+                    'daydreamer.aws-result:extract-stack-resource)))

+    (loop for resource in resources

+          do (format t "RESOURCE ~a (~a) ~a ~a~:[~;~%~:*~4t~a~]~%"

+                     (logical-resource-id resource)

+                     (resource-type resource)

+                     (resource-status resource)

+                     (physical-resource-id resource)

+                     (resource-status-reason resource))))

+  (format t "~&============~2%"))

+

 (defun parameter-block (the-stack)

   (format t "~& PARAMETERS ~%============~%")

   (stack-parameters the-stack)

@@ -100,6 +118,10 @@

   ((%stack :initarg :stack :accessor stack)

    (%old-status :initarg :old-status :accessor old-status :initform nil)))

+(defmethod stack-name ((stack-formatter stack-formatter))

+  (when (slot-boundp stack-formatter '%stack)

+    (stack-status (stack stack-formatter))))

+

 (defmethod stack-status ((stack-formatter stack-formatter))

   (when (slot-boundp stack-formatter '%stack)

     (stack-status (stack stack-formatter))))

@@ -117,7 +139,7 @@

 (defgeneric refresh (stack-formatter)

   (:method ((stack daydreamer.aws-result:stack))

-    (stack-for-name (stack-name stack))) 

+    (stack-for-name (stack-name stack)))

   (:method ((stack-formatter string))

     (make-instance 'stack-formatter :stack (stack-for-name stack-formatter)))

   (:method ((stack-formatter stack-formatter))

@@ -127,28 +149,34 @@

 (defmethod old-status ((stack daydreamer.aws-result:stack))

   nil)

-(defun stack-info (the-stack)

+(defun stack-info (the-stack status parameters outputs &optional (resources nil))

   (with-accessors ((old-status old-status)) the-stack

     (let* ((current-status (stack-status the-stack)))

       (unless old-status

-        (parameter-block the-stack))

+        (when parameters

+          (parameter-block the-stack)))

       (unless (equal old-status current-status)

-        (format t "~&STATUS ~a~%" current-status))

+        (when status

+          (format t "~&STATUS ~a~%" current-status)))

+

+      (when resources

+        (terpri)

+        (resource-block the-stack))

       (if (ends-with-subseq "COMPLETE" (symbol-name current-status))

-          (output-block the-stack)

+          (when outputs

+            (output-block the-stack))

           t))))

-(defmacro refreshing (cb)

+(defmacro refreshing (cb &rest args)

   `(lambda (thing)

      (let ((refreshed-thing (refresh thing)))

-       (values (,cb refreshed-thing)

+       (values (,cb refreshed-thing ,@args)

                refreshed-thing))))

 (defun watch-stack (name)

   (format t "~&Watching ~s~2%" name)

-  (every-five-seconds (refreshing stack-info)

+  (every-five-seconds (refreshing stack-info t t t)

                       (list name))

   (fresh-line))

-

@@ -3,6 +3,6 @@ export ASDF_OUTPUT_TRANSLATIONS="/:" CC="clang"

 env

-sbcl --no-userinit --disable-debugger --load /root/quicklisp/setup.lisp --load build.lisp

+sbcl --no-userinit --disable-debugger --load "$HOME"/quicklisp/setup.lisp --load build.lisp

 ./daydreamer --self-test