aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/repository/remote.lux
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])))))
  )