aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/aedifex.lux2
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux10
-rw-r--r--stdlib/source/test/aedifex/command/build.lux16
-rw-r--r--stdlib/source/test/aedifex/command/clean.lux8
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux6
-rw-r--r--stdlib/source/test/aedifex/command/deps.lux2
-rw-r--r--stdlib/source/test/aedifex/command/install.lux4
-rw-r--r--stdlib/source/test/aedifex/command/pom.lux8
-rw-r--r--stdlib/source/test/aedifex/command/test.lux22
-rw-r--r--stdlib/source/test/aedifex/command/version.lux14
-rw-r--r--stdlib/source/test/aedifex/dependency/deployment.lux203
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux120
-rw-r--r--stdlib/source/test/aedifex/input.lux6
-rw-r--r--stdlib/source/test/aedifex/package.lux47
-rw-r--r--stdlib/source/test/aedifex/repository.lux18
-rw-r--r--stdlib/source/test/aedifex/repository/remote.lux130
16 files changed, 475 insertions, 141 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index e3c2bd1eb..09ffcd3d8 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -9,6 +9,7 @@
["#." cli]
["#." command]
["#." dependency
+ ["#/." deployment]
["#/." resolution]
["#/." status]]
["#." hash]
@@ -27,6 +28,7 @@
Test
($_ _.and
/dependency.test
+ /dependency/deployment.test
/dependency/resolution.test
/dependency/status.test
))
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux
index 7ef74d2c0..0808c7d21 100644
--- a/stdlib/source/test/aedifex/command/auto.lux
+++ b/stdlib/source/test/aedifex/command/auto.lux
@@ -9,9 +9,7 @@
["." environment (#+ Environment)]]
[concurrency
["." atom (#+ Atom)]
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." text
["%" format (#+ format)]
@@ -62,7 +60,7 @@
(if (n.= expected_runs actual_runs)
(wrap (#try.Failure end_signal))
(do (try.with !)
- [_ (!.use (\ dummy_file over_write) (\ utf8.codec encode (%.nat actual_runs)))]
+ [_ (\ dummy_file over_write (\ utf8.codec encode (%.nat actual_runs)))]
(do !
[_ (promise.future (atom.write actual_runs @runs))]
(wrap (#try.Success [])))))))]))
@@ -99,8 +97,8 @@
($_ _.and
(wrap (do promise.monad
[verdict (do ///action.monad
- [_ (!.use (\ fs create_directory) [source])
- dummy_file (!.use (\ fs create_file) [dummy_path])
+ [_ (\ fs create_directory source)
+ dummy_file (\ fs create_file dummy_path)
#let [[@runs command] (..command expected_runs end_signal dummy_file)]
_ (\ watcher poll [])]
(do promise.monad
diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux
index 0e86ef946..9d37ceb00 100644
--- a/stdlib/source/test/aedifex/command/build.lux
+++ b/stdlib/source/test/aedifex/command/build.lux
@@ -10,9 +10,7 @@
[concurrency
["." promise (#+ Promise)]]
[parser
- ["." environment]]
- [security
- ["!" capability]]]
+ ["." environment]]]
[data
["." text ("#\." equivalence)]
[collection
@@ -42,7 +40,7 @@
(shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
- (: (shell.Simulation [])
+ (: (shell.Mock [])
(implementation
(def: (on_read state)
(exception.throw shell.no_more_output []))
@@ -60,7 +58,7 @@
(shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
- (: (shell.Simulation [])
+ (: (shell.Mock [])
(implementation
(def: (on_read state)
(exception.throw shell.no_more_output []))
@@ -142,8 +140,8 @@
(wrap (do promise.monad
[verdict (do ///action.monad
[_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs shell resolution profile)
- start (!.use (\ console read_line) [])
- end (!.use (\ console read_line) [])]
+ start (\ console read_line [])
+ end (\ console read_line [])]
(wrap (and (text\= /.start start)
(text\= /.success end))))]
(_.cover' [/.do!
@@ -156,8 +154,8 @@
(wrap (do promise.monad
[verdict (do ///action.monad
[_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution profile)
- start (!.use (\ console read_line) [])
- end (!.use (\ console read_line) [])]
+ start (\ console read_line [])
+ end (\ console read_line [])]
(wrap (and (text\= /.start start)
(text\= /.failure end))))]
(_.cover' [/.failure]
diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux
index 705cca7f2..18997e02e 100644
--- a/stdlib/source/test/aedifex/command/clean.lux
+++ b/stdlib/source/test/aedifex/command/clean.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
[binary (#+ Binary)]
["." product]
@@ -55,7 +53,7 @@
(do {! (try.with promise.monad)}
[file (: (Promise (Try (File Promise)))
(file.get_file promise.monad fs path))]
- (!.use (\ file over_write) content)))
+ (\ file over_write content)))
(def: (create_directory! fs path files)
(-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any)))
@@ -111,7 +109,7 @@
context_exists!/post (..directory_exists? fs context)
target_exists!/post (..assets_exist? fs target_path direct_files)
sub_exists!/post (..assets_exist? fs sub_path sub_files)
- logging (!.use (\ console read_line) [])]
+ logging (\ console read_line [])]
(wrap (and (and context_exists!/pre
context_exists!/post)
(and target_exists!/pre
diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux
index 7e1bf166e..fd4395935 100644
--- a/stdlib/source/test/aedifex/command/deploy.lux
+++ b/stdlib/source/test/aedifex/command/deploy.lux
@@ -8,8 +8,6 @@
["." exception]
[concurrency
["." promise (#+ Promise)]]
- [security
- ["!" capability]]
[parser
["." environment (#+ Environment)]]]
[data
@@ -80,7 +78,7 @@
[#let [console (@version.echo "")]
_ (..make_sources! fs (get@ #///.sources profile))
_ (/.do! console repository fs artifact profile)]
- (!.use (\ console read_line) [])))
+ (\ console read_line [])))
(def: #export test
Test
@@ -96,7 +94,7 @@
home (random.ascii/alpha 5)
working_directory (random.ascii/alpha 5)
- #let [repository (///repository.mock @repository.simulation
+ #let [repository (///repository.mock @repository.mock
@repository.empty)
fs (file.mock (\ file.default separator))
program (program.async (program.mock environment.empty home working_directory))]]
diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux
index 2b4898dd3..ecb34437a 100644
--- a/stdlib/source/test/aedifex/command/deps.lux
+++ b/stdlib/source/test/aedifex/command/deps.lux
@@ -8,8 +8,6 @@
["." try]
[concurrency
["." promise]]
- [security
- ["!" capability]]
[parser
["." environment]]]
[data
diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux
index 8096fc2b2..bb52b3cca 100644
--- a/stdlib/source/test/aedifex/command/install.lux
+++ b/stdlib/source/test/aedifex/command/install.lux
@@ -8,8 +8,6 @@
["." exception]
[concurrency
["." promise (#+ Promise)]]
- [security
- ["!" capability]]
[parser
["." environment (#+ Environment)]]]
[data
@@ -70,7 +68,7 @@
[#let [console (@version.echo "")]
_ (..make_sources! fs (get@ #///.sources sample))
_ (/.do! console fs (///repository/local.repository program fs) sample)]
- (!.use (\ console read_line) [])))
+ (\ console read_line [])))
(def: #export test
Test
diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux
index f7f182225..0338bf7c4 100644
--- a/stdlib/source/test/aedifex/command/pom.lux
+++ b/stdlib/source/test/aedifex/command/pom.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try) ("#\." functor)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." binary]
["." text ("#\." equivalence)
@@ -51,11 +49,11 @@
(\ ! wrap))
file (: (Promise (Try (File Promise)))
(file.get_file promise.monad fs path))
- actual (!.use (\ file content) [])
+ actual (\ file content [])
logging! (\ ///action.monad map
(text\= /.success)
- (!.use (\ console read_line) []))
+ (\ console read_line []))
#let [expected_path!
(text\= ///pom.file path)
diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux
index cad06aa69..47e2ed2b3 100644
--- a/stdlib/source/test/aedifex/command/test.lux
+++ b/stdlib/source/test/aedifex/command/test.lux
@@ -9,9 +9,7 @@
[concurrency
["." promise]]
[parser
- ["." environment]]
- [security
- ["!" capability]]]
+ ["." environment]]]
[data
["." text ("#\." equivalence)]
[collection
@@ -65,10 +63,10 @@
(wrap (do promise.monad
[verdict (do ///action.monad
[_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (@build.good_shell [])) resolution profile)
- build_start (!.use (\ console read_line) [])
- build_end (!.use (\ console read_line) [])
- test_start (!.use (\ console read_line) [])
- test_end (!.use (\ console read_line) [])]
+ build_start (\ console read_line [])
+ build_end (\ console read_line [])
+ test_start (\ console read_line [])
+ test_end (\ console read_line [])]
(wrap (and (and (text\= //build.start build_start)
(text\= //build.success build_end))
(and (text\= /.start test_start)
@@ -83,7 +81,7 @@
[#let [bad_shell (shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
- (: (shell.Simulation [])
+ (: (shell.Mock [])
(implementation
(def: (on_read state)
(exception.throw shell.no_more_output []))
@@ -99,10 +97,10 @@
shell.error)]))))))
[])]
_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async bad_shell) resolution profile)
- build_start (!.use (\ console read_line) [])
- build_end (!.use (\ console read_line) [])
- test_start (!.use (\ console read_line) [])
- test_end (!.use (\ console read_line) [])]
+ build_start (\ console read_line [])
+ build_end (\ console read_line [])
+ test_start (\ console read_line [])
+ test_end (\ console read_line [])]
(wrap (and (and (text\= //build.start build_start)
(text\= //build.success build_end))
(and (text\= /.start test_start)
diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux
index 079b0fde4..1bbb7f874 100644
--- a/stdlib/source/test/aedifex/command/version.lux
+++ b/stdlib/source/test/aedifex/command/version.lux
@@ -7,9 +7,7 @@
["." try]
["." exception (#+ exception:)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." maybe]
["." text ("#\." equivalence)
@@ -23,7 +21,7 @@
["#/." lux #_
["#" version]]]]]
[world
- ["." console (#+ Console Simulation)]]]
+ ["." console (#+ Console Mock)]]]
[///
["@." profile]]
{#program
@@ -31,8 +29,8 @@
(exception: #export console_is_closed!)
-(implementation: simulation
- (Simulation [Bit Text])
+(implementation: mock
+ (Mock [Bit Text])
(def: (on_read [open? state])
(if open?
@@ -61,7 +59,7 @@
(def: #export echo
(-> Text (Console Promise))
(|>> [true]
- (console.mock ..simulation)
+ (console.mock ..mock)
console.async))
(def: #export test
@@ -73,7 +71,7 @@
[#let [console (..echo "")]
verdict (do (try.with promise.monad)
[_ (/.do! console profile)
- logging (!.use (\ console read_line) [])]
+ logging (\ console read_line [])]
(wrap (text\= (version.format language/lux.version)
logging)))]
(_.cover' [/.do!]
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"))
diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux
index 86771cf1f..0241b27a9 100644
--- a/stdlib/source/test/aedifex/input.lux
+++ b/stdlib/source/test/aedifex/input.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." binary]
["." text
@@ -58,7 +56,7 @@
//format.profile
%.code
(\ utf8.codec encode)
- (!.use (\ file over_write)))
+ (\ file over_write))
actual (: (Promise (Try Profile))
(/.read promise.monad fs //.default))]
(wrap (\ //.equivalence =
diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux
index 132c51b38..56daf3cad 100644
--- a/stdlib/source/test/aedifex/package.lux
+++ b/stdlib/source/test/aedifex/package.lux
@@ -26,15 +26,16 @@
[world
["." file]]]
[//
- ["@." profile]
+ ["$." profile]
[//
[lux
[data
- ["_." binary]]]]]
+ ["$." binary]]]]]
{#program
["." /
["/#" // #_
["#" profile]
+ ["#." hash ("#\." equivalence)]
["#." pom]
[dependency
["#." status]]
@@ -45,13 +46,13 @@
(Random [//.Profile /.Package])
(do {! random.monad}
[content_size (\ ! map (n.% 100) random.nat)
- content (_binary.random content_size)
+ content ($binary.random content_size)
[profile pom] (random.one (function (_ profile)
(try.to_maybe
(do try.monad
[pom (//pom.write profile)]
(wrap [profile pom]))))
- @profile.random)]
+ $profile.random)]
(wrap [profile (/.local pom content)])))
(def: #export test
@@ -79,19 +80,31 @@
(and (case (get@ #/.origin local)
(#//origin.Local "") true
_ false)
- (and (is? expected_library actual_library)
- (case library_status
- #//status.Unverified true
- _ false))
- (and (is? expected_pom actual_pom)
- (|> (do try.monad
- [xml_pom (\ utf8.codec decode binary_pom)
- decoded_pom (\ xml.codec decode xml_pom)]
- (wrap (\ xml.equivalence = actual_pom decoded_pom)))
- (try.default false))
- (case pom_status
- #//status.Unverified true
- _ false)))))
+ (let [expected_sha1 (//hash.sha-1 expected_library)
+ expected_md5 (//hash.md5 expected_library)]
+ (and (is? expected_library actual_library)
+ (case library_status
+ (#//status.Verified actual_sha1 expected_md5)
+ (and (//hash\= expected_sha1 actual_sha1)
+ (//hash\= expected_md5 expected_md5))
+
+ _
+ false)))
+ (let [expected_sha1 (//hash.sha-1 binary_pom)
+ expected_md5 (//hash.md5 binary_pom)]
+ (and (is? expected_pom actual_pom)
+ (|> (do try.monad
+ [xml_pom (\ utf8.codec decode binary_pom)
+ decoded_pom (\ xml.codec decode xml_pom)]
+ (wrap (\ xml.equivalence = actual_pom decoded_pom)))
+ (try.default false))
+ (case pom_status
+ (#//status.Verified actual_sha1 expected_md5)
+ (and (//hash\= expected_sha1 actual_sha1)
+ (//hash\= expected_md5 expected_md5))
+
+ _
+ false))))))
(_.cover [/.dependencies]
(let [expected (get@ #//.dependencies profile)]
(case (/.dependencies package)
diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux
index ed32f0ac3..98d869b5b 100644
--- a/stdlib/source/test/aedifex/repository.lux
+++ b/stdlib/source/test/aedifex/repository.lux
@@ -24,13 +24,14 @@
["." / #_
["#." identity]
["#." origin]
+ ["#." remote]
[//
["@." artifact]]]
{#spec
["$." /]}
{#program
["." /
- ["#." remote]
+ ["." remote]
["/#" // #_
["#." artifact (#+ Version Artifact)
["#/." extension (#+ Extension)]]]]})
@@ -62,8 +63,8 @@
Version
"4.5.6-NO")
-(implementation: #export simulation
- (/.Simulation Store)
+(implementation: #export mock
+ (/.Mock Store)
(def: (on_download uri state)
(case (dictionary.get uri state)
@@ -83,18 +84,19 @@
Test
(<| (_.covering /._)
($_ _.and
- (_.for [/.mock /.Simulation]
+ (_.for [/.mock /.Mock]
(do random.monad
[_ (wrap [])]
($/.spec (..artifact ..valid_version)
(..artifact ..invalid_version)
- (/.mock ..simulation
+ (/.mock ..mock
(|> ..empty
- (dictionary.put (/remote.uri ..invalid_version
- (..artifact ..invalid_version)
- //artifact/extension.lux_library)
+ (dictionary.put (remote.uri ..invalid_version
+ (..artifact ..invalid_version)
+ //artifact/extension.lux_library)
(binary.create 0)))))))
/identity.test
/origin.test
+ /remote.test
)))
diff --git a/stdlib/source/test/aedifex/repository/remote.lux b/stdlib/source/test/aedifex/repository/remote.lux
new file mode 100644
index 000000000..f488391ce
--- /dev/null
+++ b/stdlib/source/test/aedifex/repository/remote.lux
@@ -0,0 +1,130 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try ("#\." monad)]
+ ["." exception]
+ ["." function]]
+ [data
+ ["." binary ("#\." equivalence)]
+ ["." maybe ("#\." functor)]
+ ["." text ("#\." equivalence)
+ ["%" format (#+ format)]
+ [encoding
+ ["." utf8]]]
+ [collection
+ ["." dictionary]]]
+ [math
+ ["." random (#+ Random)]]
+ [world
+ [net (#+ URL)
+ ["." http #_
+ ["#" client]
+ ["#/." status]
+ ["@#" /]]]]]
+ {#program
+ ["." /
+ ["/#" // #_
+ ["#." identity]]]})
+
+(def: (url_body url)
+ (-> URL (@http.Body IO))
+ (let [url (\ utf8.codec encode url)]
+ (function (_ _)
+ (io.io (#try.Success [(binary.size url) url])))))
+
+(def: (good_http user password)
+ (-> //identity.User //identity.Password (http.Client IO))
+ (implementation
+ (def: (request method url headers input)
+ (with_expansions [<failure> [http/status.bad_request
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body "")}]]
+ (<| io.io
+ #try.Success
+ (if (|> headers
+ (dictionary.get "User-Agent")
+ (maybe\map (is? /.user_agent))
+ (maybe.default false))
+ (case [method input]
+ [#@http.Get #.None]
+ [http/status.ok
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body url)}]
+
+ [#@http.Put (#.Some input)]
+ (if (|> headers
+ (dictionary.get "Authorization")
+ (maybe\map (text\= (//identity.basic_auth user password)))
+ (maybe.default false))
+ [http/status.created
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body url)}]
+ <failure>)
+
+ _
+ <failure>)
+ <failure>))))))
+
+(def: bad_http
+ (http.Client IO)
+ (implementation
+ (def: (request method url headers input)
+ (<| io.io
+ #try.Success
+ [http/status.bad_request
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body "")}]))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [address (random.ascii/upper 10)
+ uri (random.ascii/lower 10)
+
+ user (random.ascii/lower 10)
+ password (random.ascii/lower 10)
+
+ content (\ ! map (\ utf8.codec encode)
+ (random.ascii/lower 10))]
+ ($_ _.and
+ (_.cover [/.repository /.user_agent /.Address]
+ (let [repo (/.repository (..good_http user password)
+ (#.Some {#//identity.user user
+ #//identity.password password})
+ address)]
+ (and (|> (\ repo download uri)
+ io.run
+ (try\map (\ utf8.codec decode))
+ try\join
+ (try\map (text\= (format address uri)))
+ (try.default false))
+ (|> (\ repo upload uri content)
+ io.run
+ (try\map (function.constant true))
+ (try.default false)))))
+ (_.cover [/.upload_failure]
+ (let [repo (/.repository (..good_http user password)
+ #.None
+ address)]
+ (case (io.run (\ repo upload uri content))
+ (#try.Failure error)
+ (exception.match? /.upload_failure error)
+
+ (#try.Success _)
+ false)))
+ (_.cover [/.download_failure]
+ (let [repo (/.repository ..bad_http
+ #.None
+ address)]
+ (case (io.run (\ repo download uri))
+ (#try.Failure error)
+ (exception.match? /.download_failure error)
+
+ (#try.Success _)
+ false)))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 01:28:38 +0000