aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/repository/remote.lux
blob: 782b872f1f687b5ba8925eef0a48b950253099ed (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
(.using
 [library
  [lux "*"
   [abstract
    [monad {"+" do}]]
   [control
    ["[0]" io {"+" IO}]
    ["[0]" try {"+" Try}]
    ["[0]" exception {"+" exception:}]]
   [data
    ["[0]" product]
    [text
     ["%" format {"+" format}]]]
   ["[0]" meta "_"
    ["[1]/[0]" version]]
   [tool
    [compiler
     ["[0]" version]]]
   [world
    [net {"+" URL}
     [uri {"+" URI}]
     ["[0]" http "_"
      ["[1]" client]
      ["[1]/[0]" status]
      ["@[1]" /]]]]]]
 ["[0]" //
  ["[1][0]" identity {"+" Identity}]
  ["/[1]" // "_"
   ["[1][0]" artifact {"+" Version Artifact}
    [extension {"+" Extension}]]]])

(type: .public Address
  URL)

(template [<name>]
  [(exception: .public (<name> [url URL
                                status Nat])
     (exception.report
      "URL" (%.text url)
      "Status Code" (%.nat status)))]

  [download_failure]
  [upload_failure]
  )

(def: .public (uri version_template artifact extension)
  (-> Version Artifact Extension URI)
  (format (///artifact.uri version_template artifact) extension))

(def: .public user_agent
  (format "LuxAedifex/" (version.format meta/version.latest)))

(def: base_headers
  (List [Text Text])
  (list ["User-Agent" ..user_agent]))

(implementation: .public (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] (is (IO (Try (@http.Response IO)))
                            (http.get (format address uri)
                                      (http.headers ..base_headers)
                                      {.#None}
                                      http))]
      (case status
        (pattern (static http/status.ok))
        (# ! each product.right ((the @http.#body message) {.#None}))
        
        _
        (do !
          [_ ((the @http.#body message) {.#Some 0})]
          (# io.monad in (exception.except ..download_failure [(format address uri) status]))))))

  (def: (upload uri content)
    (do (try.with io.monad)
      [[status message] (is (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))
       _ ((the @http.#body message) {.#Some 0})]
      (case status
        (pattern (static http/status.created))
        (in [])
        
        _
        (# io.monad in (exception.except ..upload_failure [(format address uri) status])))))
  )