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:
Hugo Duncan
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");
|
||||
|
|
@ -372,50 +372,51 @@ See http://code.google.com/p/jclouds for details."
|
|||
(define-accessors Hardware processors ram volumes)
|
||||
(define-accessors NodeMetadata "node" credentials hardware state group)
|
||||
|
||||
(defn builder-options [builder]
|
||||
(or
|
||||
(get-field
|
||||
org.jclouds.compute.domain.internal.TemplateBuilderImpl :options builder)
|
||||
(TemplateOptions.)))
|
||||
|
||||
(defmacro option-option-fn-0arg [key]
|
||||
`(fn [builder#]
|
||||
(let [options# (builder-options builder#)]
|
||||
(~(symbol (str "." (camelize-mixed (name key)))) options#)
|
||||
(.options builder# options#))))
|
||||
|
||||
(defn- seq-to-array [args]
|
||||
(if (or (seq? args) (vector? args))
|
||||
(int-array args)
|
||||
args))
|
||||
|
||||
(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
|
||||
(def
|
||||
^{:doc "TemplateBuilder functions" :private true}
|
||||
template-map
|
||||
(merge
|
||||
(make-option-map
|
||||
option-fn-1arg
|
||||
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])
|
||||
:image-description-matches :min-cores :min-ram])))
|
||||
|
||||
(def
|
||||
^{:doc "TemplateOptions functions" :private true}
|
||||
options-map
|
||||
(merge
|
||||
(make-option-map
|
||||
option-option-fn-1arg
|
||||
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
|
||||
: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]))))
|
||||
;; 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)}))
|
||||
|
||||
(def
|
||||
^{:doc "All receognised options"}
|
||||
known-template-options
|
||||
(set (mapcat keys [options-map template-map])))
|
||||
|
||||
(defn os-families []
|
||||
(. OsFamily values))
|
||||
|
|
@ -426,14 +427,8 @@ See http://code.google.com/p/jclouds for details."
|
|||
(or (-> (filter #(= (name value) (str %)) (kword enum-map)) first)
|
||||
value))
|
||||
|
||||
(defn add-nullary-option [builder option value]
|
||||
(if-let [f (option-0arg-map option)]
|
||||
(if value
|
||||
(f builder)
|
||||
builder)))
|
||||
|
||||
(defn add-value-option [builder option value]
|
||||
(if-let [f (option-1arg-map option)]
|
||||
(defn apply-option [builder option-map option value]
|
||||
(when-let [f (option-map option)]
|
||||
(f builder (translate-enum-value option value))))
|
||||
|
||||
;; TODO look at clojure-datalog
|
||||
|
|
@ -457,10 +452,31 @@ Options correspond to TemplateBuilder methods."
|
|||
:as options}]
|
||||
(let [builder (.. compute (templateBuilder))]
|
||||
(doseq [[option value] options]
|
||||
(or
|
||||
(add-value-option builder option value)
|
||||
(add-nullary-option builder option value)
|
||||
(when-not (known-template-options option)
|
||||
(condition/raise
|
||||
:type :invalid-template-builder-option
|
||||
:message (format "Invalid template builder option : %s" option))))
|
||||
(.build builder)))
|
||||
:message (format "Invalid template builder option : %s" option)))
|
||||
;; apply template builder options
|
||||
(try
|
||||
(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");
|
||||
|
|
@ -65,32 +65,130 @@ Ensure the module is on the classpath. You are maybe missing a dependency on
|
|||
:else %)
|
||||
modules)))))
|
||||
|
||||
;;; Functions and macros to map keywords to java member functions
|
||||
(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]
|
||||
(string/map-str string/capitalize (.split a "-")))
|
||||
(defn camelize
|
||||
"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]
|
||||
(let [c (.split a "-")]
|
||||
(defn camelize-mixed
|
||||
"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)))))
|
||||
|
||||
(defmacro option-fn-0arg [key]
|
||||
`(fn [builder#]
|
||||
(~(symbol (str "." (camelize-mixed (name key)))) builder#)))
|
||||
(defn kw-fn-symbol
|
||||
"Converts a keyword into a camel cased symbol corresponding to a function
|
||||
name"
|
||||
[kw]
|
||||
(symbol (camelize-mixed kw)))
|
||||
|
||||
(defmacro option-fn-1arg [key]
|
||||
`(fn [builder# value#]
|
||||
(~(symbol (str "." (camelize-mixed (name key)))) builder# value#)))
|
||||
(defmacro kw-memfn
|
||||
"Expands into code that creates a function that expects to be passed an
|
||||
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]
|
||||
`[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)])
|
||||
(defmacro kw-memfn-apply
|
||||
"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
|
||||
[class property obj-name]
|
||||
(list 'defn (symbol (str obj-name "-" (name property)))
|
||||
(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
|
||||
"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");
|
||||
|
|
@ -18,8 +18,9 @@
|
|||
;
|
||||
|
||||
(ns org.jclouds.core-test
|
||||
(:use [org.jclouds.core] :reload-all)
|
||||
(:use clojure.test))
|
||||
(:use
|
||||
org.jclouds.core
|
||||
clojure.test))
|
||||
|
||||
(defmacro with-private-vars [[ns fns] & tests]
|
||||
"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
|
||||
:non-existing 'this.doesnt.Exist)]
|
||||
(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