Demonstrate that simple resources can be modified

doc/introduction.texinfo

@@ -38,9 +38,12 @@ resource Y?)
 [FUTURE] Use infrastructure as code description to understand
 authorization boundaries in your infrastructure.
 @item
-[FUTURE] Use infrastructurew as code description and automatic
+[FUTURE] Use infrastructure as code description and automatic
 security vulnerability analysis to understand threats on your
 infrastructure.
+@item
+[FUTURE] Use infrastructure as code description to forecast
+operational costs.
 @end itemize
 
 @subsection Escape the hold of the Monolithic Continuous Integration and Delivery Server

src/package.lisp

@@ -81,8 +81,8 @@
    #:list-resource-identifiers
    #:resource-prerequisites
    #:sort-resources
-   ;; Infrastructure Stacks
-   #:stack-name
+   #:prepare-modification-instructions
+   #:apply-modification-instructions
    ;; Simulators and Simulations
    #:simulator
    #:make-simulator

src/poc.lisp

@@ -44,6 +44,7 @@
    #:configure-laboratory
    #:cloud-vendor
    #:make-cloud-vendor
+   #:*cloud-vendor*
    #:private-network
    #:make-private-network
    #:container-image
@@ -59,8 +60,6 @@
    #:make-public-load-balancer
    #:infrastructure-stack
    #:make-infrastructure-stack
-   #:write-infrastructure-stack
-   #:read-infrastructure-stack
    #:make-delivery-stack))
 
 (in-package #:org.melusina.cid/poc)

src/resource.lisp

@@ -623,11 +623,49 @@ The possible INSTRUCTIONS and their semantics are described below:
 (defun prepare-modification-instructions (resource blueprint)
   "Prepare INSTRUCTIONS to modify RESOURCE to resemble the BLUEPRINT.
 When applied the instruction must update the RESOURCE instance so that its slots take the
-values of the slots of BLUEPRINT.  Some slots are excluded from the process, such as the
-STATE and the IDENTIFIER."
-  (list
-   (list :delete resource)
-   (list :update-instance resource blueprint)
-   (list :create resource)))
+values of the slots of BLUEPRINT.  Some slots are handled specially by
+the process, such as the STATE and the IDENTIFIER. The STATE and IDENTIFIER
+slots from the BLUEPRINT are ignored."
+  (labels ((blueprint-slots (blueprint)
+	     (flet ((ignored-slot-p (slot-name)
+		      (member slot-name '(:state :identifier)))
+		    (getf-slot-name (spec)
+		      (getf spec :slot-name)))
+	       (remove-if #'ignored-slot-p 
+			  (persistent-slots blueprint)
+			  :key #'getf-slot-name)))
+	   (slot-value-changed-p (slot-value1 slot-value2)
+	     (not (equal slot-value1 slot-value2)))
+	   (update-slot-specs (resource blueprint)
+	     (loop :for spec :in (blueprint-slots blueprint)
+		   :for slot-name = (getf spec :slot-name)
+		   :for slot-value-resource = (slot-value resource slot-name)
+		   :for slot-value-blueprint = (slot-value blueprint slot-name)
+		   :when (slot-value-changed-p slot-value-resource slot-value-blueprint)
+		   :collect spec))
+	   (resource-recreate-p (update-slot-specs)
+	     (flet ((getf-immutable (spec)
+		      (getf spec :immutable)))
+	       (member t update-slot-specs :key #'getf-immutable)))
+	   (prepare-update-instructions (update-slot-specs)
+	     (list*
+	      :update-instance
+	      resource
+	      (loop :for spec :in update-slot-specs
+		    :for slot-name = (getf spec :slot-name)
+		    :collect slot-name
+		    :collect (slot-value blueprint slot-name)))))
+    (let ((update-slot-specs
+	    (update-slot-specs resource blueprint)))
+      (unless update-slot-specs
+	(return-from prepare-modification-instructions nil))
+      (if (resource-recreate-p update-slot-specs)
+	  (list
+	   (list :delete resource)
+	   (prepare-update-instructions update-slot-specs)
+	   (list :create resource))
+	  (list
+	   (prepare-update-instructions update-slot-specs)
+	   (list :update-resource resource))))))
 
 ;;;; End of file `resource.lisp'

src/utilities.lisp

@@ -128,7 +128,16 @@ The following members are optional:
 
   :PRESENTATION
     When provided, a function used to transform the slot value in a value
-    which can be persisted."))
+    which can be persisted.
+
+  :EXTERNAL
+    This flag indicates a slot-value which is determined by external factors.
+    It is forbidden for the user to modify this value.
+
+  :IMMUTABLE
+    This flag indicates a slot-value which cannot be modified by the Steward
+    of a resource.  It means that modifying that slot of the resource is only
+    possible by deleting and recreating the resource."))
 
 (defun write-persistent-object (object stream)
   "Readably write persistent OBJECT on STREAM."

testsuite/poc.lisp

@@ -30,7 +30,7 @@ This is the smallest possible testcase for an infrastructure stack."
 		   :do (assert-nil (cid:resource-exists-p resource))))
 	   (stack-resources (stack)
 	     (loop :for resource :in (slot-value stack 'poc::resources)
-		   :append (cid:resource-prerequisites resource))))		      
+		   :append (cid:resource-prerequisites resource))))
       (let* ((delivery-stack
 	       (poc:make-delivery-stack
 		:cloud-vendor (poc:make-cloud-vendor
@@ -100,6 +100,76 @@ resources is usually longer than those of Common Lisp sessions."
 	   (cid:save-persistent-object delivery-stack *testsuite-id*)
 	   (cid:load-persistent-object delivery-stack *testsuite-id*)))))))
 
+(define-testcase demonstrate-that-single-resources-can-be-modified ()
+  "Demonstrate that a single resource can be modified.
+This testcase handles several case: the regular case, the case where
+the attribute to modify is immutable, the case where the attribute to
+modify has a value of type resource."
+  (with-test-environment
+    (flet ((regular-case ()
+	     (let* ((cloud-vendor
+		      (poc:make-cloud-vendor
+		       :credential "ThisIsNotARealCredential"))
+		    (resource
+		      (poc:make-private-network
+		       :cloud-vendor cloud-vendor
+		       :name "vpc"
+		       :displayname "Unique VPC"))
+		    (blueprint
+		      (poc:make-private-network
+		       :cloud-vendor cloud-vendor
+		       :name "vpc-1"
+		       :displayname "First VPC")))
+	       (flet ((validate-update-instance (instructions)
+			(let ((instruction
+				(first instructions)))
+			  (assert-eq
+			   :update-instance
+			   (first instruction))
+			  (assert-eq
+			   resource
+			   (getf instruction :update-instance))
+			  (assert-string=
+			   "vpc-1"
+			   (getf instruction 'cid:name))
+			  (assert-string=
+			   "First VPC"
+			   (getf instruction 'cid:displayname))
+			  (assert-nil
+			   (member 'cid::state instruction))
+			  (assert-nil
+			   (member 'cid::identifier instruction))))
+		      (validate-update-resource (instructions)
+			(let ((instruction
+				(second instructions)))
+			  (assert-eq
+			   :update-resource
+			   (first instruction))
+			  (assert-eq
+			   resource
+			   (getf instruction :update-resource))
+			  (assert-eq
+			   2
+			   (length instruction)))))
+		 (cid:create-resource resource)
+		 (let ((instructions
+			 (cid:prepare-modification-instructions resource blueprint)))
+		   (assert-eq 2 (length instructions))
+		   (validate-update-instance instructions)
+		   (validate-update-resource instructions)
+		   (cid:apply-modification-instructions instructions)
+		   (assert-string=
+		    (cid:name blueprint)
+		    (cid:name resource))
+		   (assert-string=
+		    (cid:displayname blueprint)
+		    (cid:displayname resource))
+		   (assert-t
+		    (cid:resource-ready-p resource))
+		   (assert-t
+		    (cid:resource-exists-p resource)))))))
+      (regular-case))))
+
 (define-testcase demonstrate-that-infrastructure-stack-can-be-modified ()
   "Demonstrate that an infrastructure stack can be modified.
 This testcase prepares an infrastructure stack value, then creates