No longer employing the capabilities model on the lux/world/* modules.

Capabilities should be opt-in, but using them in the standard library makes them mandatory.

2 files changed, 265 insertions, 58 deletions

diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux
new file mode 100644
index 000000000..b947e609e
--- /dev/null
+++ b/stdlib/source/test/aedifex/dependency/deployment.lux
@@ -0,0 +1,203 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    ["." hash (#+ Hash)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try ("#\." functor)]
+    [concurrency
+     ["." atom (#+ Atom)]
+     ["." promise]]]
+   [data
+    ["." product]
+    ["." maybe ("#\." functor)]
+    ["." binary (#+ Binary) ("#\." equivalence)]
+    ["." text
+     ["%" format (#+ format)]]
+    [collection
+     ["." dictionary (#+ Dictionary)]
+     ["." set]
+     ["." list ("#\." fold)]]]
+   [math
+    ["." random (#+ Random)]
+    [number
+     ["n" nat]]]
+   [world
+    [net (#+ URL)
+     ["." uri (#+ URI)]
+     ["." http #_
+      ["#" client]
+      ["#/." status]
+      ["@#" /]]]]]
+  ["$." //
+   ["#/" // #_
+    ["#." package]]]
+  {#program
+   ["." /
+    [// (#+ Dependency)
+     ["." resolution]
+     [//
+      ["." profile]
+      ["." metadata]
+      ["." package (#+ Package)]
+      ["." artifact (#+ Artifact) ("#\." equivalence)
+       ["#/." type]
+       ["#/." extension]]
+      ["." repository
+       ["." remote]]]]]})
+
+(def: good_upload
+  (@http.Response IO)
+  [http/status.created
+   {#@http.headers (http.headers (list))
+    #@http.body (function (_ _)
+                  (|> [0 (binary.create 0)]
+                      #try.Success
+                      io.io))}])
+
+(type: Cache
+  (Atom (Dictionary URL Binary)))
+
+(def: (http cache)
+  (-> Cache (http.Client IO))
+  (implementation
+   (def: (request method url headers input)
+     (do io.monad
+       [_ (: (IO Any)
+             (case [method input]
+               [#@http.Put (#.Some input)]
+               (atom.update (dictionary.put url input) cache)
+               
+               _
+               (wrap [])))]
+       (wrap (#try.Success ..good_upload))))))
+
+(def: (verify_one expected_deployments address package cache expected_artifact actual_artifact)
+  (-> Nat URL Package (Dictionary URL Binary) Artifact Artifact Bit)
+  (let [url (: (-> URI URL)
+               (|>> (format address)))
+        library_url (url (format (artifact.uri (get@ #artifact.version expected_artifact)
+                                               expected_artifact)
+                                 artifact/extension.lux_library))
+        pom_url (url (format (artifact.uri (get@ #artifact.version expected_artifact)
+                                           expected_artifact)
+                             artifact/extension.pom))
+        artifact_metadata_url (url (metadata.remote_artifact_uri expected_artifact))
+        project_metadata_url (url (metadata.remote_project_uri expected_artifact))
+
+        expected_library (|> package
+                             (get@ #package.library)
+                             product.left)
+        expected_pom (|> package
+                         (get@ #package.pom)
+                         product.right
+                         product.left)
+
+        correct_artifact!
+        (artifact\= expected_artifact actual_artifact)
+
+        expected_number_of_uploads!
+        (n.= (n.* expected_deployments 8)
+             (dictionary.size cache))
+
+        correct_library_upload!
+        (and (|> cache
+                 (dictionary.get library_url)
+                 (maybe\map (binary\= expected_library))
+                 (maybe.default false))
+             (dictionary.key? cache (format library_url artifact/extension.sha-1))
+             (dictionary.key? cache (format library_url artifact/extension.md5)))
+
+        correct_pom_upload!
+        (and (|> cache
+                 (dictionary.get pom_url)
+                 (maybe\map (binary\= expected_pom))
+                 (maybe.default false))
+             (dictionary.key? cache (format pom_url artifact/extension.sha-1))
+             (dictionary.key? cache (format pom_url artifact/extension.md5)))
+
+        artifact_metadata_upload!
+        (dictionary.key? cache artifact_metadata_url)
+
+        project_metadata_upload!
+        (dictionary.key? cache project_metadata_url)]
+    (and correct_artifact!
+         expected_number_of_uploads!
+         correct_library_upload!
+         correct_pom_upload!
+         artifact_metadata_upload!
+         project_metadata_upload!)))
+
+(def: bundle
+  (Random [Dependency Artifact Package])
+  (do random.monad
+    [[profile package] $///package.random
+     #let [artifact (|> profile
+                        (get@ #profile.identity)
+                        maybe.assume)
+           dependency (: Dependency
+                         [artifact
+                          artifact/type.lux_library])]]
+    (wrap [dependency artifact package])))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do {! random.monad}
+        [address (\ ! map (text.suffix uri.separator)
+                    (random.ascii/upper 10))]
+        ($_ _.and
+            (do {! random.monad}
+              [[dependency expected_artifact package] ..bundle
+               #let [cache (: Cache
+                              (atom.atom (dictionary.new text.hash)))
+                     http (..http cache)
+                     repository (repository.async (remote.repository http #.None address))]]
+              (wrap (do promise.monad
+                      [?outcome (/.one repository dependency package)
+                       cache (promise.future (atom.read cache))]
+                      (_.cover' [/.one]
+                                (|> ?outcome
+                                    (try\map (verify_one 1 address package cache expected_artifact))
+                                    (try.default false))))))
+            (do {! random.monad}
+              [#let [hash (: (Hash [Dependency Artifact Package])
+                             (\ hash.functor map (|>> product.right product.left product.left)
+                                text.hash))]
+               num_bundles (\ ! map (n.% 10) random.nat)
+               bundles (|> ..bundle
+                           (random.set hash num_bundles)
+                           (\ ! map set.to_list))
+               #let [resolution (list\fold (function (_ [dependency expected_artifact package] resolution)
+                                             (dictionary.put dependency package resolution))
+                                           resolution.empty
+                                           bundles)
+                     cache (: Cache
+                              (atom.atom (dictionary.new text.hash)))
+                     http (..http cache)
+                     repository (repository.async (remote.repository http #.None address))]]
+              (wrap (do promise.monad
+                      [?outcome (/.all repository resolution)
+                       cache (promise.future (atom.read cache))]
+                      (_.cover' [/.all]
+                                (|> ?outcome
+                                    (try\map (function (_ actual_artifacts)
+                                               (let [expected_deployments!
+                                                     (n.= num_bundles (set.size actual_artifacts))
+
+                                                     every_deployment_was_correct!
+                                                     (list.every? (function (_ [dependency expected_artifact package])
+                                                                    (let [deployed!
+                                                                          (set.member? actual_artifacts expected_artifact)
+
+                                                                          deployed_correctly!
+                                                                          (verify_one num_bundles address package cache expected_artifact expected_artifact)]
+                                                                      (and deployed!
+                                                                           deployed_correctly!)))
+                                                                  bundles)]
+                                                 (and expected_deployments!
+                                                      every_deployment_was_correct!))))
+                                    (try.default false))))))
+            ))))
diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux
index ebb32b790..7dcf46d3a 100644
--- a/stdlib/source/test/aedifex/dependency/resolution.lux
+++ b/stdlib/source/test/aedifex/dependency/resolution.lux
@@ -43,7 +43,7 @@
      ["#." artifact (#+ Artifact)
       ["#/." type]
       ["#/." extension]]
-     ["#." repository (#+ Simulation)
+     ["#." repository (#+ Mock)
       ["#/." origin]]]]})
 
 (def: random
@@ -56,43 +56,7 @@
                           package
                           /.empty))))
 
-(def: #export (single artifact package)
-  (-> Artifact Package (Simulation Any))
-  (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)]
-    (implementation
-     (def: (on_download uri state)
-       (if (text.contains? expected uri)
-         (cond (text.ends_with? ///artifact/extension.lux_library uri)
-               (#try.Success [state (|> package
-                                        (get@ #///package.library)
-                                        product.left)])
-               
-               (text.ends_with? ///artifact/extension.pom uri)
-               (#try.Success [state (|> package
-                                        (get@ #///package.pom)
-                                        product.left
-                                        (\ xml.codec encode)
-                                        (\ utf8.codec encode))])
-
-               ## (text.ends_with? ///artifact/extension.sha-1 uri)
-               ## (#try.Success [state (|> package
-               ##                          (get@ #///package.sha-1)
-               ##                          (\ ///hash.sha-1_codec encode)
-               ##                          (\ utf8.codec encode))])
-               
-               ## (text.ends_with? ///artifact/extension.md5 uri)
-               ## (#try.Success [state (|> package
-               ##                          (get@ #///package.md5)
-               ##                          (\ ///hash.md5_codec encode)
-               ##                          (\ utf8.codec encode))])
-
-               ## else
-               (#try.Failure "NOPE"))
-         (#try.Failure "NOPE")))
-     (def: (on_upload uri binary state)
-       (#try.Failure "NOPE")))))
-
-(def: lux_sha1
+(def: lux_sha-1
   Text
   (format ///artifact/extension.lux_library ///artifact/extension.sha-1))
 
@@ -100,7 +64,7 @@
   Text
   (format ///artifact/extension.lux_library ///artifact/extension.md5))
 
-(def: pom_sha1
+(def: pom_sha-1
   Text
   (format ///artifact/extension.pom ///artifact/extension.sha-1))
 
@@ -108,7 +72,7 @@
   Text
   (format ///artifact/extension.pom ///artifact/extension.md5))
 
-(def: sha1
+(def: sha-1
   (-> Binary Binary)
   (|>> ///hash.sha-1
        (\ ///hash.sha-1_codec encode)
@@ -120,8 +84,48 @@
        (\ ///hash.md5_codec encode)
        (\ utf8.codec encode)))
 
+(def: #export (single artifact package)
+  (-> Artifact Package (Mock Any))
+  (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)]
+    (implementation
+     (def: (on_download uri state)
+       (if (text.contains? expected uri)
+         (let [library (: Binary
+                          (|> package
+                              (get@ #///package.library)
+                              product.left))
+               pom (: Binary
+                      (|> package
+                          (get@ #///package.pom)
+                          product.left
+                          (\ xml.codec encode)
+                          (\ utf8.codec encode)))]
+           (cond (text.ends_with? ///artifact/extension.lux_library uri)
+                 (#try.Success [state library])
+
+                 (text.ends_with? ..lux_sha-1 uri)
+                 (#try.Success [state (..sha-1 library)])
+
+                 (text.ends_with? ..lux_md5 uri)
+                 (#try.Success [state (..md5 library)])
+                 
+                 (text.ends_with? ///artifact/extension.pom uri)
+                 (#try.Success [state pom])
+
+                 (text.ends_with? ..pom_sha-1 uri)
+                 (#try.Success [state (..sha-1 pom)])
+
+                 (text.ends_with? ..pom_md5 uri)
+                 (#try.Success [state (..md5 pom)])
+
+                 ## else
+                 (#try.Failure "NOPE")))
+         (#try.Failure "NOPE")))
+     (def: (on_upload uri binary state)
+       (#try.Failure "NOPE")))))
+
 (def: (bad_sha-1 expected_artifact expected_package dummy_package)
-  (-> Artifact Package Package (Simulation Any))
+  (-> Artifact Package Package (Mock Any))
   (implementation
    (def: (on_download uri state)
      (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
@@ -130,17 +134,17 @@
                                       (get@ #///package.library)
                                       product.left)])
 
-             (text.ends_with? lux_sha1 uri)
+             (text.ends_with? ..lux_sha-1 uri)
              (#try.Success [state (|> expected_package
                                       (get@ #///package.library)
                                       product.left
-                                      sha1)])
+                                      ..sha-1)])
 
-             (text.ends_with? lux_md5 uri)
+             (text.ends_with? ..lux_md5 uri)
              (#try.Success [state (|> expected_package
                                       (get@ #///package.library)
                                       product.left
-                                      md5)])
+                                      ..md5)])
              
              (text.ends_with? ///artifact/extension.pom uri)
              (#try.Success [state (|> expected_package
@@ -149,21 +153,21 @@
                                       (\ xml.codec encode)
                                       (\ utf8.codec encode))])
 
-             (text.ends_with? pom_sha1 uri)
+             (text.ends_with? ..pom_sha-1 uri)
              (#try.Success [state (|> dummy_package
                                       (get@ #///package.pom)
                                       product.left
                                       (\ xml.codec encode)
                                       (\ utf8.codec encode)
-                                      sha1)])
+                                      ..sha-1)])
 
-             (text.ends_with? pom_md5 uri)
+             (text.ends_with? ..pom_md5 uri)
              (#try.Success [state (|> expected_package
                                       (get@ #///package.pom)
                                       product.left
                                       (\ xml.codec encode)
                                       (\ utf8.codec encode)
-                                      md5)])
+                                      ..md5)])
 
              ## else
              (#try.Failure "NOPE"))
@@ -172,7 +176,7 @@
      (#try.Failure "NOPE"))))
 
 (def: (bad_md5 expected_artifact expected_package dummy_package)
-  (-> Artifact Package Package (Simulation Any))
+  (-> Artifact Package Package (Mock Any))
   (implementation
    (def: (on_download uri state)
      (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
@@ -181,17 +185,17 @@
                                       (get@ #///package.library)
                                       product.left)])
 
-             (text.ends_with? lux_sha1 uri)
+             (text.ends_with? ..lux_sha-1 uri)
              (#try.Success [state (|> expected_package
                                       (get@ #///package.library)
                                       product.left
-                                      sha1)])
+                                      ..sha-1)])
 
-             (text.ends_with? lux_md5 uri)
+             (text.ends_with? ..lux_md5 uri)
              (#try.Success [state (|> dummy_package
                                       (get@ #///package.library)
                                       product.left
-                                      md5)])
+                                      ..md5)])
              
              (text.ends_with? ///artifact/extension.pom uri)
              (#try.Success [state (|> expected_package
@@ -200,21 +204,21 @@
                                       (\ xml.codec encode)
                                       (\ utf8.codec encode))])
 
-             (text.ends_with? pom_sha1 uri)
+             (text.ends_with? ..pom_sha-1 uri)
              (#try.Success [state (|> expected_package
                                       (get@ #///package.pom)
                                       product.left
                                       (\ xml.codec encode)
                                       (\ utf8.codec encode)
-                                      sha1)])
+                                      ..sha-1)])
 
-             (text.ends_with? pom_md5 uri)
+             (text.ends_with? ..pom_md5 uri)
              (#try.Success [state (|> dummy_package
                                       (get@ #///package.pom)
                                       product.left
                                       (\ xml.codec encode)
                                       (\ utf8.codec encode)
-                                      md5)])
+                                      ..md5)])
 
              ## else
              (#try.Failure "NOPE"))