aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/command/deploy.lux
blob: 7e1bf166e5af90647064b98f7164602f6a564d63 (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
(.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
      ["." utf8]]]
    ["." 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 (get@ #///artifact.version artifact) artifact ///artifact/extension.pom))
                            actual_library (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.lux_library))
                            actual_sha-1 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1)))
                            actual_sha-1 (\ promise.monad wrap
                                            (do try.monad
                                              [actual_sha-1 (\ utf8.codec decode actual_sha-1)]
                                              (\ ///hash.sha-1_codec decode actual_sha-1)))
                            actual_md5 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5)))
                            actual_md5 (\ promise.monad wrap
                                          (do try.monad
                                            [actual_md5 (\ utf8.codec decode actual_md5)]
                                            (\ ///hash.md5_codec decode actual_md5)))

                            #let [succeeded!
                                  (text\= /.success logging)

                                  deployed_library!
                                  (\ binary.equivalence =
                                     expected_library
                                     actual_library)

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

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

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