base: aws-operation: Pass request arguments to request constructor.
[software/guile-aws.git] / aws / base.scm
1 ;;; guile-aws --- Scheme DSL for the AWS APIs
2 ;;; Copyright © 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
3 ;;;
4 ;;; Guile-AWS is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published
6 ;;; by the Free Software Foundation, either version 3 of the License,
7 ;;; or (at your option) any later version.
8 ;;;
9 ;;; Guile-AWS is distributed in the hope that it will be useful, but
10 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
17
18 ;;; Commentary:
19 ;;;
20 ;;; This module defines the basic record types, their constructors and
21 ;;; accessors, as well as the type checker procedure generator.
22 ;;;
23 ;;; There are three records: 1) <aws-shape> for types that are little
24 ;;; more than type-checked wrappers around primitive types (e.g. a
25 ;;; ranged integer, a typed list, or a string with an enumeration of
26 ;;; possible values; 2) <aws-structure> for composite types, which can
27 ;;; have an arbitrary number of members of different types; and 3)
28 ;;; <aws-operation>, which is how either of the previous types can be
29 ;;; turned into API requests.
30 ;;;
31 ;;; Code:
32
33 (define-module (aws base)
34 #:use-module (ice-9 match)
35 #:use-module (srfi srfi-1)
36 #:use-module (srfi srfi-9)
37 #:use-module (srfi srfi-9 gnu)
38 #:use-module ((srfi srfi-19) #:select (date?))
39 #:use-module (srfi srfi-26)
40 #:use-module ((rnrs bytevectors) #:select (bytevector?))
41 #:export (aws-shape
42 aws-shape?
43 aws-shape-aws-name
44 aws-shape-value
45 aws-shape-location-name
46 aws-shape-primitive?
47
48 aws-structure
49 aws-structure-aws-name
50 aws-structure-members
51 aws-structure?
52
53 aws-member
54 aws-member-name
55 aws-member-value
56 aws-member-documentation
57 aws-member-location
58 aws-member-location-name
59
60 aws-name
61 ensure
62
63 aws-operation))
64
65 \f
66 ;;; Simple shapes
67
68 (define-record-type <aws-shape>
69 (make-aws-shape aws-name primitive? type-checker location location-name value)
70 aws-shape?
71 (aws-name aws-shape-aws-name)
72 (primitive? aws-shape-primitive?)
73 (type-checker aws-shape-type-checker)
74 (location aws-shape-location)
75 (location-name aws-shape-location-name)
76 (value aws-shape-value))
77
78 (define* (aws-shape #:key aws-name primitive? type-checker location location-name documentation)
79 (let ((proc (lambda (value)
80 (if (type-checker value)
81 (make-aws-shape aws-name primitive? type-checker location location-name value)
82 (error (format #f "~a: invalid value: ~a~%"
83 aws-name value))))))
84 (set-procedure-property! proc 'name aws-name)
85 (set-procedure-property! proc 'documentation documentation)
86 proc))
87
88 (set-record-type-printer! <aws-shape>
89 (lambda (obj port)
90 (format port "#<aws:~a ~a>"
91 (aws-shape-aws-name obj)
92 (aws-shape-value obj))))
93
94 \f
95 ;;; Structures
96 (define-record-type <aws-structure>
97 (aws-structure aws-name members)
98 aws-structure?
99 (aws-name aws-structure-aws-name)
100 (members aws-structure-members))
101
102 (set-record-type-printer! <aws-structure>
103 (lambda (obj port)
104 (format port "#<aws-structure:~a>"
105 (aws-structure-aws-name obj))))
106
107 (define-record-type <aws-member>
108 (make-aws-member name value shape documentation location location-name)
109 aws-member?
110 (name aws-member-name)
111 (value aws-member-value)
112 (shape aws-member-shape)
113 (documentation aws-member-documentation)
114 (location aws-member-location)
115 (location-name aws-member-location-name))
116
117 (define* (aws-member #:key name value shape documentation location location-name)
118 (make-aws-member name value shape documentation location location-name))
119
120 (set-record-type-printer! <aws-structure>
121 (lambda (obj port)
122 (format port "#<aws-structure:~a>"
123 (aws-structure-aws-name obj))))
124
125 \f
126 (define (aws-name thing)
127 (cond
128 ((aws-structure? thing)
129 (aws-structure-aws-name thing))
130 ((aws-shape? thing)
131 (aws-shape-aws-name thing))
132 (else #f)))
133
134 (define (ensure value type)
135 (unless (and=> (aws-name value) (cut eq? <> type))
136 (error (format #f "wrong type: ~a, expected ~a~%."
137 value type))))
138
139 \f
140 (define* (aws-operation requester
141 #:key
142 name
143 input-constructor
144 input-type
145 output-type
146 http documentation)
147 (let ((proc
148 (lambda args
149 (let ((input*
150 (match args
151 ;; Accept a keyword list and pass it to the
152 ;; appropriate constructor.
153 (((? keyword?) . rest)
154 (apply input-constructor args))
155 ;; Otherwise type check the input
156 ((input)
157 (unless (eq? (aws-name input) input-type)
158 (error (format #f "~a: input must be of type ~a: ~a~%"
159 name input-type input)))
160 input)
161 (() #false))))
162 ;; TODO: do something with the response!
163 (requester #:http http #:operation-name name #:input input*)))))
164 (set-procedure-property! proc 'documentation documentation)
165 (set-procedure-property! proc 'name name)
166 proc))