mirror of https://github.com/apache/jclouds.git
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:
parent
9bdd97340b
commit
d9cb934feb
|
@ -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");
|
||||||
|
@ -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)))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -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))
|
|
@ -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"})))
|
Loading…
Reference in New Issue