aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/command/deploy.lux
blob: 617b3386adee5884700c55ebd00774c6cb2da278 (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
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    ["." monad (#+ do)]]
   [control
    ["." try (#+ Try) ("#\." functor)]
    ["." exception]
    [concurrency
     ["." promise (#+ Promise)]]
    [security
     ["!" capability]]
    [parser
     ["." environment (#+ Environment)]]]
   [data
    ["." maybe]
    ["." binary]
    ["." text ("#\." equivalence)
     ["%" format (#+ format)]
     ["." encoding]]
    ["." format #_
     ["#" binary]
     ["." tar]
     ["." xml]]
    [collection
     ["." set (#+ Set)]
     ["." dictionary (#+ Dictionary)]]]
   [math
    ["." random (#+ Random)]]
   [world
    ["." file (#+ Path File)]
    ["." program (#+ Program)]]]
  [program
   [compositor
    ["." export]]]
  [//
   ["@." version]
   [//
    ["@." profile]
    ["@." repository]]]
  {#program
   ["." /
    ["/#" // #_
     ["#." clean]
     ["/#" // #_
      ["#" profile]
      ["#." action]
      ["#." pom]
      ["#." local]
      ["#." hash]
      ["#." repository (#+ Repository)
       [identity (#+ Identity)]
       ["#/." remote]]
      ["#." artifact (#+ Artifact)
       ["#/." extension]]]]]})

(def: (make_sources! fs sources)
  (-> (file.System Promise) (Set Path) (Promise (Try Any)))
  (loop [sources (set.to_list sources)]
    (case sources
      #.Nil
      (|> []
          (\ try.monad wrap)
          (\ promise.monad wrap))
      
      (#.Cons head tail)
      (do (try.with promise.monad)
        [_ (: (Promise (Try Path))
              (file.make_directories promise.monad fs head))
         _ (: (Promise (Try (File Promise)))
              (file.get_file promise.monad fs (format head (\ fs separator) head ".lux")))]
        (recur tail)))))

(def: (execute! program repository fs artifact profile)
  (-> (Program Promise) (Repository Promise) (file.System Promise)
      Artifact ///.Profile
      (Promise (Try Text)))
  (do ///action.monad
    [#let [console (@version.echo "")]
     _ (..make_sources! fs (get@ #///.sources profile))
     _ (/.do! console repository fs artifact profile)]
    (!.use (\ console read_line) [])))

(def: #export test
  Test
  (<| (_.covering /._)
      (do {! random.monad}
        [[artifact expected_pom profile]
         (random.one (function (_ profile)
                       (do maybe.monad
                         [artifact (get@ #///.identity profile)
                          expected_pom (try.to_maybe (///pom.write profile))]
                         (wrap [artifact expected_pom profile])))
                     @profile.random)
         
         home (random.ascii/alpha 5)
         working_directory (random.ascii/alpha 5)
         #let [repository (///repository.mock @repository.simulation
                                              @repository.empty)
               fs (file.mock (\ file.default separator))
               program (program.async (program.mock environment.empty home working_directory))]]
        (wrap (do {! promise.monad}
                [verdict (do {! ///action.monad}
                           [logging (..execute! program repository fs artifact profile)
                            expected_library (|> profile
                                                 (get@ #///.sources)
                                                 set.to_list
                                                 (export.library fs)
                                                 (\ ! map (format.run tar.writer)))

                            actual_pom (\ repository download (///repository/remote.uri artifact ///artifact/extension.pom))
                            actual_library (\ repository download (///repository/remote.uri artifact ///artifact/extension.lux_library))
                            actual_sha-1 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1)))
                            actual_md5 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5)))

                            #let [deployed_library!
                                  (\ binary.equivalence =
                                     expected_library
                                     actual_library)

                                  deployed_pom!
                                  (\ binary.equivalence =
                                     (|> expected_pom (\ xml.codec encode) (\ encoding.utf8 encode))
                                     actual_pom)

                                  deployed_sha-1!
                                  (\ binary.equivalence =
                                     (///hash.data (///hash.sha-1 expected_library))
                                     actual_sha-1)

                                  deployed_md5!
                                  (\ binary.equivalence =
                                     (///hash.data (///hash.md5 expected_library))
                                     actual_md5)]]
                           (wrap (and (text\= //clean.success logging)
                                      deployed_library!
                                      deployed_pom!
                                      deployed_sha-1!
                                      deployed_md5!)))]
                (_.cover' [/.do!]
                          (try.default false verdict)))))))