blob: 7feaa97104bdbd2b580ca71a22d43cf56ca5e110 (
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
|
(.module:
[lux #*
[abstract
[monad (#+ do)]]
[control
["." io (#+ IO)]
["." try (#+ Try)]
["." exception (#+ exception:)]]
[data
["." product]
[text
["%" format (#+ format)]]]
[tool
[compiler
["." version]
["." language #_
["#/." lux #_
["#" version]]]]]
[world
[net (#+ URL)
[uri (#+ URI)]
["." http #_
["#" client]
["#/." status]
["@#" /]]]]]
["." //
["#." identity (#+ Identity)]
["/#" // #_
["#." artifact (#+ Version Artifact)
[extension (#+ Extension)]]]])
(type: #export Address
URL)
(template [<name>]
[(exception: #export (<name> {url URL} {status Nat})
(exception.report
["URL" (%.text url)]
["Status Code" (%.nat status)]))]
[download_failure]
[upload_failure]
)
(def: #export (uri version_template artifact extension)
(-> Version Artifact Extension URI)
(format (///artifact.uri version_template artifact) extension))
(def: #export user_agent
(format "LuxAedifex/" (version.format language/lux.version)))
(def: base_headers
(List [Text Text])
(list ["User-Agent" ..user_agent]))
(implementation: #export (repository http identity address)
(All [s] (-> (http.Client IO) (Maybe Identity) Address (//.Repository IO)))
(def: description
address)
(def: (download uri)
(do {! (try.with io.monad)}
[[status message] (: (IO (Try (@http.Response IO)))
(http.get (format address uri)
(http.headers ..base_headers)
#.None
http))]
(case status
(^ (static http/status.ok))
(\ ! map product.right ((get@ #@http.body message) #.None))
_
(do !
[_ ((get@ #@http.body message) (#.Some 0))]
(\ io.monad wrap (exception.throw ..download_failure [(format address uri) status]))))))
(def: (upload uri content)
(do (try.with io.monad)
[[status message] (: (IO (Try (@http.Response IO)))
(http.put (format address uri)
(http.headers (case identity
#.None
..base_headers
(#.Some [user password])
(list& ["Authorization" (//identity.basic_auth user password)]
..base_headers)))
(#.Some content)
http))
_ ((get@ #@http.body message) (#.Some 0))]
(case status
(^ (static http/status.created))
(wrap [])
_
(\ io.monad wrap (exception.throw ..upload_failure [(format address uri) status])))))
)
|
