Unified repository abstraction for Aedifex.

3 files changed, 167 insertions, 17 deletions

diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux
new file mode 100644
index 000000000..1f3e776a9
--- /dev/null
+++ b/stdlib/source/program/aedifex/dependency/deployment.lux
@@ -0,0 +1,128 @@
+(.module:
+  [lux #*
+   [abstract
+    [codec (#+ Codec)]
+    ["." monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise)]]
+    [security
+     ["!" capability]]]
+   [data
+    [binary (#+ Binary)]
+    ["." product]
+    [text
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [collection
+     ["." dictionary]
+     ["." set (#+ Set)]
+     ["." list ("#\." monoid)]]
+    [format
+     ["." xml]]]
+   [time
+    ["." instant]]
+   [world
+    [program (#+ Program)]
+    ["." file (#+ Path File Directory)]]]
+  ["." /// #_
+   ["#" local]
+   ["#." hash (#+ Hash SHA-1 MD5)]
+   ["#." package (#+ Package)]
+   ["#." artifact (#+ Artifact)
+    ["#/." type]
+    ["#/." extension (#+ Extension)]]
+   ["#." metadata
+    ["#/." artifact]
+    ["#/." snapshot]]
+   ["#." dependency (#+ Dependency)
+    [resolution (#+ Resolution)]
+    ["#/." status (#+ Status)]]
+   ["#." repository (#+ Repository)
+    ["#/." origin]]])
+
+(def: (with_status repository [artifact type] [data status])
+  (-> (Repository Promise) Dependency [Binary Status] (Promise (Try Any)))
+  (let [artifact (format (///artifact.uri artifact)
+                         (///artifact/extension.extension type))
+        deploy_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any))))
+                       (function (_ codec extension hash)
+                         (|> hash
+                             (\ codec encode)
+                             (\ encoding.utf8 encode)
+                             (\ repository upload (format artifact extension)))))]
+    (do {! (try.with promise.monad)}
+      [_ (\ repository upload artifact data)]
+      (case status
+        #///dependency/status.Unverified
+        (wrap [])
+        
+        (#///dependency/status.Partial partial)
+        (case partial
+          (#.Left sha-1)
+          (deploy_hash ///hash.sha-1_codec ///artifact/extension.sha-1 sha-1)
+          
+          (#.Right md5)
+          (deploy_hash ///hash.md5_codec ///artifact/extension.md5 md5))
+        
+        (#///dependency/status.Verified sha-1 md5)
+        (do !
+          [_ (deploy_hash ///hash.sha-1_codec ///artifact/extension.sha-1 sha-1)]
+          (deploy_hash ///hash.md5_codec ///artifact/extension.md5 md5))))))
+
+(def: (artifacts type status)
+  (-> ///artifact/type.Type Status (List ///artifact/type.Type))
+  (with_expansions [<sha-1> (format type ///artifact/extension.sha-1)
+                    <md5> (format type ///artifact/extension.md5)]
+    (list& type
+           (case status
+             #///dependency/status.Unverified
+             (list)
+             
+             (#///dependency/status.Partial partial)
+             (list (case partial
+                     (#.Left _) <sha-1>
+                     (#.Right _) <md5>))
+             
+             (#///dependency/status.Verified _)
+             (list <sha-1> <md5>)))))
+
+(def: #export (one repository [artifact type] package)
+  (-> (Repository Promise) Dependency Package (Promise (Try Artifact)))
+  (do {! promise.monad}
+    [now (promise.future instant.now)]
+    (do (try.with !)
+      [_ (with_status repository [artifact type] (get@ #///package.library package))
+
+       _ (let [[pom status] (get@ #///package.pom package)]
+           (with_status repository
+             [artifact ///artifact/type.pom]
+             [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+              status]))
+
+       snapshot (///metadata/snapshot.read repository artifact)
+       _ (|> snapshot
+             (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.time_stamp] now)
+             (update@ [#///metadata/snapshot.versioning #///metadata/snapshot.build] inc)
+             (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.snapshot]
+                   (list\compose (..artifacts type (product.right (get@ #///package.library package)))
+                                 (..artifacts ///artifact/type.pom (product.right (get@ #///package.pom package)))))
+             (///metadata/snapshot.write repository artifact))
+
+       project (///metadata/artifact.read repository artifact)
+       #let [version (get@ #///artifact.version artifact)]
+       _ (|> project
+             (set@ #///metadata/artifact.versions (list version))
+             (set@ #///metadata/artifact.last_updated now)
+             (///metadata/artifact.write repository artifact))]
+      (wrap artifact))))
+
+(def: #export (all repository resolution)
+  (-> (Repository Promise) Resolution (Promise (Try (Set Artifact))))
+  (do {! (try.with promise.monad)}
+    []
+    (|> (dictionary.entries resolution)
+        (monad.map ! (function (_ [dependency package])
+                       (..one repository dependency package)))
+        (\ ! map (set.from_list ///artifact.hash)))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 1b40a3004..e6b24b152 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -60,28 +60,43 @@
     (-> Binary (Repository Promise) Artifact Extension
         (-> Binary (Hash h)) (Codec Text (Hash h))
         (Exception [Artifact Extension Text])
-        (Promise (Try (Hash h)))))
-  (do (try.with promise.monad)
-    [actual (\ repository download (///repository/remote.uri artifact extension))]
-    (\ promise.monad wrap
-       (do try.monad
-         [output (\ encoding.utf8 decode actual)
-          actual (\ codec decode output)
-          _ (exception.assert exception [artifact extension output]
-                              (\ ///hash.equivalence = (hash library) actual))]
-         (wrap actual)))))
+        (Promise (Try (Maybe (Hash h))))))
+  (do promise.monad
+    [?actual (\ repository download (///repository/remote.uri artifact extension))]
+    (case ?actual
+      (#try.Success actual)
+      (wrap (do try.monad
+              [output (\ encoding.utf8 decode actual)
+               actual (\ codec decode output)
+               _ (exception.assert exception [artifact extension output]
+                                   (\ ///hash.equivalence = (hash library) actual))]
+              (wrap (#.Some actual))))
+      
+      (#try.Failure error)
+      (wrap (#try.Success #.None)))))
 
 (def: (hashed repository artifact extension)
   (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status])))
   (do (try.with promise.monad)
     [data (\ repository download (///repository/remote.uri artifact extension))
-     sha-1 (..verified_hash data
-                            repository artifact (format extension ///artifact/extension.sha-1)
-                            ///hash.sha-1 ///hash.sha-1_codec ..sha-1_does_not_match)
-     md5 (..verified_hash data
-                          repository artifact (format extension ///artifact/extension.md5)
-                          ///hash.md5 ///hash.md5_codec ..md5_does_not_match)]
-    (wrap [data (#//status.Verified sha-1 md5)])))
+     ?sha-1 (..verified_hash data
+                             repository artifact (format extension ///artifact/extension.sha-1)
+                             ///hash.sha-1 ///hash.sha-1_codec ..sha-1_does_not_match)
+     ?md5 (..verified_hash data
+                           repository artifact (format extension ///artifact/extension.md5)
+                           ///hash.md5 ///hash.md5_codec ..md5_does_not_match)]
+    (wrap [data (case [?sha-1 ?md5]
+                  [(#.Some sha-1) (#.Some md5)]
+                  (#//status.Verified sha-1 md5)
+
+                  [(#.Some sha-1) _]
+                  (#//status.Partial (#.Left sha-1))
+
+                  [_ (#.Some md5)]
+                  (#//status.Partial (#.Right md5))
+
+                  [#.None #.None]
+                  #//status.Unverified)])))
 
 (def: #export (one repository dependency)
   (-> (Repository Promise) Dependency (Promise (Try Package)))
diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux
index bedaffdb8..82d99e9aa 100644
--- a/stdlib/source/program/aedifex/dependency/status.lux
+++ b/stdlib/source/program/aedifex/dependency/status.lux
@@ -3,6 +3,7 @@
    [abstract
     [equivalence (#+ Equivalence)]]
    [data
+    [binary (#+ Binary)]
     ["." sum]
     ["." product]]]
   ["." /// #_
@@ -33,3 +34,9 @@
           ///hash.equivalence
           )
       ))
+
+(def: #export (verified payload)
+  (-> Binary Status)
+  (#Verified
+   (///hash.sha-1 payload)
+   (///hash.md5 payload)))