blob: dbc458897142195a75e2f89b235f17dc2279aa70 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
(.require
[library
[lux (.except)
[abstract
[monad (.only do)]
["[0]" hash (.only Hash)]]
[control
["[0]" io (.only IO)]
["[0]" maybe (.use "[1]#[0]" functor)]
["[0]" try (.use "[1]#[0]" functor)]
[concurrency
["[0]" atom (.only Atom)]
["[0]" async]]]
[data
["[0]" product]
["[0]" binary (.only Binary) (.use "[1]#[0]" equivalence)]
["[0]" text (.only)
["%" \\format (.only format)]]
[collection
["[0]" dictionary (.only Dictionary)]
["[0]" set]
["[0]" list (.use "[1]#[0]" mix)]]]
[math
["[0]" random (.only Random)]
[number
["n" nat]]]
[world
[net (.only URL)
["[0]" uri (.only URI)]
["[0]" http
["[1]" client]
["[1]/[0]" status]
["@[1]" /]]]]
[test
["[0]" unit]
["_" property (.only Test)]]]]
["$[0]" // (.only)
["[1]/" //
["[1][0]" package]]]
[\\program
["[0]" / (.only)
[// (.only Dependency)
["[0]" resolution]
[//
["[0]" profile]
["[0]" metadata]
["[0]" package (.only Package)]
["[0]" artifact (.only Artifact) (.use "[1]#[0]" equivalence)
["[1]/[0]" type]
["[1]/[0]" extension]]
["[0]" repository (.only)
["[0]" remote]]]]]])
(def good_upload
(@http.Response IO)
[http/status.created
[@http.#headers (http.headers (list))
@http.#body (function (_ _)
(|> [0 (binary.empty 0)]
{try.#Success}
io.io))]])
(type Cache
(Atom (Dictionary URL Binary)))
(def (http cache)
(-> Cache (http.Client IO))
(implementation
(def (request method url headers input)
(do io.monad
[_ (is (IO Any)
(case [method input]
[{@http.#Put} {.#Some input}]
(atom.update! (dictionary.has url input) cache)
_
(in [])))]
(in {try.#Success ..good_upload})))))
(def (verify_one expected_deployments address package cache expected_artifact actual_artifact)
(-> Nat URL Package (Dictionary URL Binary) Artifact Artifact Bit)
(let [url (is (-> URI URL)
(|>> (format address)))
library_url (url (format (artifact.uri (the artifact.#version expected_artifact)
expected_artifact)
artifact/extension.lux_library))
pom_url (url (format (artifact.uri (the artifact.#version expected_artifact)
expected_artifact)
artifact/extension.pom))
artifact_metadata_url (url (metadata.remote_artifact_uri expected_artifact))
project_metadata_url (url (metadata.remote_project_uri expected_artifact))
expected_library (|> package
(the package.#library)
product.left)
expected_pom (|> package
(the package.#pom)
product.right
product.left)
correct_artifact!
(artifact#= expected_artifact actual_artifact)
expected_number_of_uploads!
(n.= (n.* expected_deployments 8)
(dictionary.size cache))
correct_library_upload!
(and (|> cache
(dictionary.value library_url)
(maybe#each (binary#= expected_library))
(maybe.else false))
(dictionary.key? cache (format library_url artifact/extension.sha-1))
(dictionary.key? cache (format library_url artifact/extension.md5)))
correct_pom_upload!
(and (|> cache
(dictionary.value pom_url)
(maybe#each (binary#= expected_pom))
(maybe.else false))
(dictionary.key? cache (format pom_url artifact/extension.sha-1))
(dictionary.key? cache (format pom_url artifact/extension.md5)))
artifact_metadata_upload!
(dictionary.key? cache artifact_metadata_url)
project_metadata_upload!
(dictionary.key? cache project_metadata_url)]
(and correct_artifact!
expected_number_of_uploads!
correct_library_upload!
correct_pom_upload!
artifact_metadata_upload!
project_metadata_upload!)))
(def bundle
(Random [Dependency Artifact Package])
(do random.monad
[[profile package] $///package.random
.let [artifact (|> profile
(the profile.#identity)
maybe.trusted)
dependency (is Dependency
[artifact
artifact/type.lux_library])]]
(in [dependency artifact package])))
(def .public test
Test
(<| (_.covering /._)
(do [! random.monad]
[address (at ! each (text.suffix uri.separator)
(random.upper_case 10))]
(all _.and
(do [! random.monad]
[[dependency expected_artifact package] ..bundle
.let [cache (is Cache
(atom.atom (dictionary.empty text.hash)))
http (..http cache)
repository (repository.async (remote.repository http {.#None} address))]]
(in (do async.monad
[?outcome (/.one repository dependency package)
cache (async.future (atom.read! cache))]
(unit.coverage [/.one]
(|> ?outcome
(try#each (verify_one 1 address package cache expected_artifact))
(try.else false))))))
(do [! random.monad]
[.let [hash (is (Hash [Dependency Artifact Package])
(at hash.functor each (|>> product.right product.left product.left)
text.hash))]
num_bundles (at ! each (n.% 10) random.nat)
bundles (|> ..bundle
(random.set hash num_bundles)
(at ! each set.list))
.let [resolution (list#mix (function (_ [dependency expected_artifact package] resolution)
(dictionary.has dependency package resolution))
resolution.empty
bundles)
cache (is Cache
(atom.atom (dictionary.empty text.hash)))
http (..http cache)
repository (repository.async (remote.repository http {.#None} address))]]
(in (do async.monad
[?outcome (/.all repository resolution)
cache (async.future (atom.read! cache))]
(unit.coverage [/.all]
(|> ?outcome
(try#each (function (_ actual_artifacts)
(let [expected_deployments!
(n.= num_bundles (set.size actual_artifacts))
every_deployment_was_correct!
(list.every? (function (_ [dependency expected_artifact package])
(let [deployed!
(set.member? actual_artifacts expected_artifact)
deployed_correctly!
(verify_one num_bundles address package cache expected_artifact expected_artifact)]
(and deployed!
deployed_correctly!)))
bundles)]
(and expected_deployments!
every_deployment_was_correct!))))
(try.else false))))))
))))
|
