Add clojure interface for spot instances

Add clojure template-builder keywords for spot instances introduced
for issue #308.  Add a builder for spot-options.
This commit is contained in:
Hugo Duncan 2011-03-12 16:29:31 -05:00
parent 9bdd97340b
commit d9cb934feb
5 changed files with 275 additions and 78 deletions

View File

@ -1,6 +1,6 @@
; ;
; ;
; Copyright (C) 2010 Cloud Conscious, LLC. <info@cloudconscious.com> ; Copyright (C) 2010, 2011 Cloud Conscious, LLC. <info@cloudconscious.com>
; ;
; ==================================================================== ; ====================================================================
; Licensed under the Apache License, Version 2.0 (the "License"); ; Licensed under the Apache License, Version 2.0 (the "License");
@ -23,8 +23,8 @@
Current supported providers are: Current supported providers are:
[aws-ec2, eucualyptus-partnercloud-ec2, elastichosts-lon-b, [aws-ec2, eucualyptus-partnercloud-ec2, elastichosts-lon-b,
cloudservers-uk, cloudservers-us, byon, cloudsigma-zrh, stub, cloudservers-uk, cloudservers-us, byon, cloudsigma-zrh, stub,
trmk-ecloud, trmk-vcloudexpress, vcloud, bluelock, eucalyptus, trmk-ecloud, trmk-vcloudexpress, vcloud, bluelock, eucalyptus,
slicehost, elastichosts-lon-p, elastichosts-sat-p, elastichosts, slicehost, elastichosts-lon-p, elastichosts-sat-p, elastichosts,
openhosting-east1, serverlove-z1-man, skalicloud-sdg-my] openhosting-east1, serverlove-z1-man, skalicloud-sdg-my]
Here's an example of getting some compute configuration from rackspace: Here's an example of getting some compute configuration from rackspace:
@ -372,50 +372,51 @@ See http://code.google.com/p/jclouds for details."
(define-accessors Hardware processors ram volumes) (define-accessors Hardware processors ram volumes)
(define-accessors NodeMetadata "node" credentials hardware state group) (define-accessors NodeMetadata "node" credentials hardware state group)
(defn builder-options [builder] (def
(or ^{:doc "TemplateBuilder functions" :private true}
(get-field template-map
org.jclouds.compute.domain.internal.TemplateBuilderImpl :options builder) (merge
(TemplateOptions.))) (make-option-map
kw-memfn-0arg [:smallest :fastest :biggest :any])
(make-option-map
kw-memfn-1arg
[:os-family :location-id :architecture :image-id :hardware-id
:os-name-matches :os-version-matches :os-description-matches
:os-64-bit :image-version-matches :image-name-matches
:image-description-matches :min-cores :min-ram])))
(defmacro option-option-fn-0arg [key] (def
`(fn [builder#] ^{:doc "TemplateOptions functions" :private true}
(let [options# (builder-options builder#)] options-map
(~(symbol (str "." (camelize-mixed (name key)))) options#) (merge
(.options builder# options#)))) (make-option-map
kw-memfn-0arg
[:destroy-on-error :enable-monitoring :no-placement-group :no-key-pair
:with-details])
(make-option-map
kw-memfn-1arg
[:run-script :install-private-key :authorize-public-key
;; aws ec2 options
:spot-price :spot-options :placement-group :subnet-id
:block-device-mappings :unmapDeviceNamed :security-groups
:key-pair :user-data])
(make-option-map kw-memfn-varargs [:inbound-ports])
(make-option-map
kw-memfn-2arg
[:block-on-port
;; aws ec2 options
:map-ephemeral-device-to-device-name])
{:map-ebs-snapshot-to-device-name
(kw-memfn-apply :map-ebs-snapshot-to-device-name
device-name snapshot-id size-in-gib delete-on-termination)
:map-new-volume-to-device-name
(kw-memfn-apply :map-new-volume-to-device-name
device-name size-in-gib delete-on-termination)}))
(defn- seq-to-array [args] (def
(if (or (seq? args) (vector? args)) ^{:doc "All receognised options"}
(int-array args) known-template-options
args)) (set (mapcat keys [options-map template-map])))
(defmacro option-option-fn-1arg [key]
`(fn [builder# value#]
(let [options# (builder-options builder#)]
(~(symbol (str "." (camelize-mixed (name key))))
options# (seq-to-array value#))
(.options builder# options#))))
(def option-1arg-map
(apply array-map
(concat
(make-option-map
option-fn-1arg
[:os-family :location-id :architecture :image-id :hardware-id
:os-name-matches :os-version-matches :os-description-matches
:os-64-bit :image-version-matches :image-name-matches
:image-description-matches :min-cores :min-ram])
(make-option-map
option-option-fn-1arg
[:run-script :install-private-key :authorize-public-key
:inbound-ports]))))
(def option-0arg-map
(apply hash-map
(concat
(make-option-map option-fn-0arg
[:smallest :fastest :biggest :any])
(make-option-map option-option-fn-0arg
[:destroy-on-error]))))
(defn os-families [] (defn os-families []
(. OsFamily values)) (. OsFamily values))
@ -426,14 +427,8 @@ See http://code.google.com/p/jclouds for details."
(or (-> (filter #(= (name value) (str %)) (kword enum-map)) first) (or (-> (filter #(= (name value) (str %)) (kword enum-map)) first)
value)) value))
(defn add-nullary-option [builder option value] (defn apply-option [builder option-map option value]
(if-let [f (option-0arg-map option)] (when-let [f (option-map option)]
(if value
(f builder)
builder)))
(defn add-value-option [builder option value]
(if-let [f (option-1arg-map option)]
(f builder (translate-enum-value option value)))) (f builder (translate-enum-value option value))))
;; TODO look at clojure-datalog ;; TODO look at clojure-datalog
@ -457,10 +452,31 @@ Options correspond to TemplateBuilder methods."
:as options}] :as options}]
(let [builder (.. compute (templateBuilder))] (let [builder (.. compute (templateBuilder))]
(doseq [[option value] options] (doseq [[option value] options]
(or (when-not (known-template-options option)
(add-value-option builder option value) (condition/raise
(add-nullary-option builder option value) :type :invalid-template-builder-option
(condition/raise :message (format "Invalid template builder option : %s" option)))
:type :invalid-template-builder-option ;; apply template builder options
:message (format "Invalid template builder option : %s" option)))) (try
(.build builder))) (apply-option builder template-map option value)
(catch Exception e
(condition/raise
:type :invalid-template-builder
:message (format
"Problem applying template builder %s with value %s: %s"
option (pr-str value) (.getMessage e))
:cause e))))
(let [template (.build builder)
template-options (.getOptions template)]
(doseq [[option value] options]
;; apply template option options
(try
(apply-option template-options options-map option value)
(catch Exception e
(condition/raise
:type :invalid-template-option
:message (format
"Problem applying template option %s with value %s: %s"
option (pr-str value) (.getMessage e))
:cause e))))
template)))

View File

@ -1,6 +1,6 @@
; ;
; ;
; Copyright (C) 2010 Cloud Conscious, LLC. <info@cloudconscious.com> ; Copyright (C) 2010, 2011 Cloud Conscious, LLC. <info@cloudconscious.com>
; ;
; ==================================================================== ; ====================================================================
; Licensed under the Apache License, Version 2.0 (the "License"); ; Licensed under the Apache License, Version 2.0 (the "License");
@ -65,32 +65,130 @@ Ensure the module is on the classpath. You are maybe missing a dependency on
:else %) :else %)
modules))))) modules)))))
;;; Functions and macros to map keywords to java member functions
(defn dashed [a] (defn dashed [a]
(apply str (interpose "-" (map string/lower-case (re-seq #"[A-Z][^A-Z]*" a))))) (apply
str (interpose "-" (map string/lower-case (re-seq #"[A-Z][^A-Z]*" a)))))
(defn camelize [a] (defn camelize
(string/map-str string/capitalize (.split a "-"))) "Takes a string, or anything named, and converts it to camel case
(capitalised initial component"
[a]
(string/map-str string/capitalize (.split (name a) "-")))
(defn camelize-mixed [a] (defn camelize-mixed
(let [c (.split a "-")] "Takes a string, or anything named, and converts it to mixed camel case
(lower case initial component)"
[a]
(let [c (.split (name a) "-")]
(apply str (string/lower-case (first c)) (map string/capitalize (rest c))))) (apply str (string/lower-case (first c)) (map string/capitalize (rest c)))))
(defmacro option-fn-0arg [key] (defn kw-fn-symbol
`(fn [builder#] "Converts a keyword into a camel cased symbol corresponding to a function
(~(symbol (str "." (camelize-mixed (name key)))) builder#))) name"
[kw]
(symbol (camelize-mixed kw)))
(defmacro option-fn-1arg [key] (defmacro kw-memfn
`(fn [builder# value#] "Expands into code that creates a function that expects to be passed an
(~(symbol (str "." (camelize-mixed (name key)))) builder# value#))) object and any args, and calls the instance method corresponding to
the camel cased version of the passed keyword, passing the arguments."
[kw & args]
`(memfn ~(kw-fn-symbol kw) ~@args))
(defmacro make-option-map [f keywords] (defmacro kw-memfn-apply
`[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)]) "Expands into code that creates a function that expects to be passed an object
and an arg vector containing the args, and calls the instance method
corresponding to the camel cased version of the passed keyword, passing the
arguments."
[kw & args]
`(fn [target# [~@args]]
((memfn ~(kw-fn-symbol kw) ~@args) target# ~@args)))
(defmacro kw-memfn-0arg
"Expands into code that creates a function that expects to be passed an
object, and calls the instance method corresponding to the camel cased
version of the passed keyword if the argument is non-nil."
[kw]
`(fn [target# arg#]
(if arg#
((kw-memfn ~kw) target#)
target#)))
(defmacro kw-memfn-1arg
"Expands into code that creates a function that expects to be passed an object
and an arg, and calls the instance method corresponding to the camel cased
version of the passed keyword, passing the argument."
[kw]
`(kw-memfn ~kw a#))
(defmacro kw-memfn-2arg
"Expands into code that creates a function that expects to be passed an object
and an arg vector containing 2 args, and calls the instance method
corresponding to the camel cased version of the passed keyword, passing the
arguments."
[kw]
`(kw-memfn-apply ~kw a# b#))
;; (defmacro memfn-overloads
;; "Construct a function that applies arguments to the given member function."
;; [name]
;; `(fn [target# args#]
;; (condp = (count args#)
;; 0 (. target# (~name))
;; 1 (. target# (~name (first args#)))
;; 2 (. target# (~name (first args#) (second args#)))
;; 3 (. target# (~name (first args#) (second args#) (nth args# 2)))
;; 4 (. target#
;; (~name (first args#) (second args#) (nth args# 2) (nth args# 3)))
;; 5 (. target#
;; (~name (first args#) (second args#) (nth args# 2) (nth args# 3)
;; (nth args# 4)))
;; (throw
;; (java.lang.IllegalArgumentException.
;; (str
;; "too many arguments passed. Limit 5, passed " (count args#)))))))
;; (defmacro kw-memfn-overloads
;; "Expands into code that creates a function that expects to be passed an
;; object and an arg vector, and calls the instance method corresponding to
;; the camel cased version of the passed keyword, passing the arguments.
;; The function accepts different arities at runtime."
;; [kw]
;; `(memfn-overloads ~(kw-fn-symbol kw)))
(defmacro memfn-varargs
"Construct a function that applies an argument sequence to the given member
function, which accepts varargs. array-fn should accept a sequence and
return a suitable array for passing as varargs."
[name array-fn]
`(fn [target# args#]
(. target#
(~name
(if (or (seq? args#) (vector? args#)) (~array-fn args#) args#)))))
(defmacro kw-memfn-varargs
"Expands into code that creates a function that expects to be passed an
object and an arg vector, and calls the instance method corresponding to
the camel cased version of the passed keyword, passing the arguments.
The function accepts different arities at runtime."
([kw] `(kw-memfn-varargs ~kw int-array))
([kw array-fn] `(memfn-varargs ~(kw-fn-symbol kw) ~array-fn)))
(defmacro make-option-map
"Builds a literal map from keyword, to a call on macro f with the keyword
as an argument."
[f keywords]
`(hash-map
~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)))
(defmacro define-accessor (defmacro define-accessor
[class property obj-name] [class property obj-name]
(list 'defn (symbol (str obj-name "-" (name property))) (list 'defn (symbol (str obj-name "-" (name property)))
(vector (with-meta (symbol obj-name) {:tag (.getName class)})) (vector (with-meta (symbol obj-name) {:tag (.getName class)}))
(list (symbol (str ".get" (camelize (name property)))) (symbol obj-name)))) (list
(symbol (str ".get" (camelize (name property))))
(symbol obj-name))))
(defmacro define-accessors (defmacro define-accessors
"Defines read accessors, modelled on class-name-property-name. If the second "Defines read accessors, modelled on class-name-property-name. If the second

View File

@ -1,6 +1,6 @@
; ;
; ;
; Copyright (C) 2010 Cloud Conscious, LLC. <info@cloudconscious.com> ; Copyright (C) 2010, 2011 Cloud Conscious, LLC. <info@cloudconscious.com>
; ;
; ==================================================================== ; ====================================================================
; Licensed under the Apache License, Version 2.0 (the "License"); ; Licensed under the Apache License, Version 2.0 (the "License");
@ -18,8 +18,9 @@
; ;
(ns org.jclouds.core-test (ns org.jclouds.core-test
(:use [org.jclouds.core] :reload-all) (:use
(:use clojure.test)) org.jclouds.core
clojure.test))
(defmacro with-private-vars [[ns fns] & tests] (defmacro with-private-vars [[ns fns] & tests]
"Refers private fns from ns and runs tests in context. From users mailing "Refers private fns from ns and runs tests in context. From users mailing
@ -50,3 +51,25 @@ list, Alan Dipert and MeikelBrandmeyer."
(assoc module-lookup (assoc module-lookup
:non-existing 'this.doesnt.Exist)] :non-existing 'this.doesnt.Exist)]
(is (.isEmpty (modules :non-existing))))) (is (.isEmpty (modules :non-existing)))))
(deftest kw-fn-symbol-test
(is (= 'aB (kw-fn-symbol :a-b))))
(deftest kw-memfn-test
(is (= "a" ((kw-memfn :to-lower-case) "A")))
(is (= "Ab" ((kw-memfn :concat s) "A" "b")))
(is (= "Ab" ((kw-memfn-apply :concat s) "A" ["b"])))
(is (= "Ac" ((kw-memfn-apply :replace a b) "Ab" ["b" "c"]))))
(deftest kw-memfn-0arg-test
(is (= "a" ((kw-memfn-0arg :to-lower-case) "A" true)))
(is (= "A" ((kw-memfn-0arg :to-lower-case) "A" nil))))
(deftest kw-memfn-1arg-test
(is (= "Ab" ((kw-memfn-1arg :concat) "A" "b"))))
(deftest kw-memfn-2arg-test
(is (= "Ac" ((kw-memfn-2arg :replace) "Ab" ["b" "c"]))))
(deftest kw-memfn-varargs-test
(is (fn? (kw-memfn-varargs :replace))))

View File

@ -0,0 +1,45 @@
(ns org.jclouds.aws.ec2
"AWS EC2 specific functionality"
(:require
[org.jclouds.core :as core])
(:import
org.jclouds.aws.ec2.domain.SpotInstanceRequest
org.jclouds.aws.ec2.options.RequestSpotInstancesOptions))
(def
^{:doc "TemplateBuilder functions" :private true}
spot-option-map
(core/make-option-map
core/kw-memfn-1arg
[:valid-from :valid-until :type :launch-group :availability-zone-group]))
(defn spot-types []
(. org.jclouds.aws.ec2.domain.SpotInstanceRequest$Type values))
(def enum-map {:type (spot-types)})
(defn translate-enum-value [kword value]
(or (-> (filter #(= (name value) (str %)) (kword enum-map)) first)
value))
(defn apply-option
[options [option value]]
(when-let [f (spot-option-map option)]
(f options (translate-enum-value option value)))
options)
(defn spot-options
"Build a spot request options object, for passing to the :spot-options
key of the template builder options.
Takes a hash-map of keys and values that correspond to the methods of
RequestSpotInstancesOptions.
Options are:
:valid-from :valid-until :type :launch-group :availability-zone-group
:type takes either :one-time or :persistent"
[request-map]
(reduce
apply-option
(RequestSpotInstancesOptions.) request-map))

View File

@ -0,0 +1,15 @@
(ns org.jclouds.aws.ec2-test
(:use
org.jclouds.aws.ec2
clojure.test))
(deftest translate-enum-value-test
(is (= org.jclouds.aws.ec2.domain.SpotInstanceRequest$Type/ONE_TIME
(org.jclouds.aws.ec2/translate-enum-value :type :one-time))))
(deftest spot-options-est
(is (spot-options {:type :one-time
:valid-from (java.util.Date.)
:valid-until (java.util.Date.)
:launch-group "lg"
:availability-zone-group "ag"})))