serialize-aws-value: Add a docstring.
[software/guile-aws.git] / aws / serialize.scm
1 ;;; guile-aws --- Scheme DSL for the AWS APIs
2 ;;; Copyright © 2019, 2020, 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 (define-module (aws serialize)
19 #:use-module (aws base)
20 #:use-module (ice-9 match)
21 #:use-module (ice-9 format)
22 #:use-module (srfi srfi-1)
23 #:use-module (srfi srfi-26)
24 #:export (serialize-aws-value
25 aws-value->scm))
26
27 ;; See https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Query-Requests.html
28 (define* (serialize-aws-value thing)
29 "Return a list of strings that together should form the request
30 query string for THING, an AWS value."
31 ;; XXX: I don't know why this is necessary, but it seems to be
32 ;; required that the locationName begin with an uppercase letter.
33 ;; There is nothing in the specification that would hint at this,
34 ;; but testing against the AWS API have revealed this to be the
35 ;; case. This is at least true for "Value" and "Key" of a "Tag"
36 ;; value, and for "ResourceType" of a "TagSpecification".
37 (define (up string)
38 (let ((s (format #false "~a" string)))
39 (string-set! s 0 (char-upcase (string-ref s 0)))
40 s))
41 (define inner
42 (lambda (path thing)
43 (cond
44 ((aws-structure? thing)
45 ;; Operate on members
46 (let ((provided-members
47 (remove (lambda (member)
48 (eq? '__unspecified__ (aws-member-value member)))
49 (aws-structure-members thing))))
50 (map (lambda (member)
51 (inner (cons (or (aws-member-location-name member)
52 (aws-member-name member))
53 path)
54 (aws-member-value member)))
55 provided-members)))
56
57 ((aws-shape? thing)
58 (cond
59 ((aws-shape-primitive? thing)
60 (inner path (aws-shape-value thing)))
61 (else
62 (inner (cons (or (aws-shape-location-name thing)
63 (aws-shape-aws-name thing))
64 path)
65 (aws-shape-value thing)))))
66
67 ((boolean? thing)
68 (inner path (or (and thing "true") "false")))
69
70 ((list? thing)
71 (map (lambda (item n)
72 (inner (cons n path) item))
73 thing
74 (iota (length thing) 1)))
75
76 (else
77 (format #false "~{~a~^.~}=~a"
78 (map up (reverse (filter identity path)))
79 thing)))))
80 (define (flatten lst)
81 (match lst
82 (() '())
83 ((first . rest)
84 ((@ (guile) append)
85 (flatten first)
86 (flatten rest)))
87 (_ (list lst))))
88 (flatten (inner '() thing)))
89
90 (define* (aws-value->scm thing #:optional strip-name?)
91 "Transform the potentially nested AWS value THING into an alist,
92 which can easily be converted to JSON."
93 (cond
94 ((aws-structure? thing)
95 (let ((members
96 (filter-map (lambda (member)
97 (match (aws-member-value member)
98 ('__unspecified__ #false)
99 (value
100 `(,(format #false "~a"
101 (or (aws-member-location-name member)
102 (aws-member-name member)))
103 .
104 ,(aws-value->scm value)))))
105 (aws-structure-members thing))))
106 (if strip-name?
107 members
108 `((,(format #false "~a" (aws-structure-aws-name thing))
109 . ,members)))))
110 ((aws-shape? thing)
111 (match (aws-shape-value thing)
112 ((? list? l)
113 (list->vector (map aws-value->scm l)))
114 (x x)))
115 ;; TODO: what about the primitive "map" type? That would also
116 ;; appear as a pair, wouldn't it?
117 ((pair? thing)
118 (list->vector (map (cut aws-value->scm <> 'strip-name) thing)))
119 ;; Other primitive value, e.g. string or boolean
120 (else thing)))