From 5cf4efa861075f8276f43a2516f5beacaf610b44 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 2 Jul 2021 03:11:36 -0400 Subject: 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.--- stdlib/source/test/aedifex/command/auto.lux | 10 +- stdlib/source/test/aedifex/command/build.lux | 16 +- stdlib/source/test/aedifex/command/clean.lux | 8 +- stdlib/source/test/aedifex/command/deploy.lux | 6 +- stdlib/source/test/aedifex/command/deps.lux | 2 - stdlib/source/test/aedifex/command/install.lux | 4 +- stdlib/source/test/aedifex/command/pom.lux | 8 +- stdlib/source/test/aedifex/command/test.lux | 22 +-- stdlib/source/test/aedifex/command/version.lux | 14 +- .../source/test/aedifex/dependency/deployment.lux | 203 +++++++++++++++++++++ .../source/test/aedifex/dependency/resolution.lux | 120 ++++++------ stdlib/source/test/aedifex/input.lux | 6 +- stdlib/source/test/aedifex/package.lux | 47 +++-- stdlib/source/test/aedifex/repository.lux | 18 +- stdlib/source/test/aedifex/repository/remote.lux | 130 +++++++++++++ 15 files changed, 473 insertions(+), 141 deletions(-) create mode 100644 stdlib/source/test/aedifex/dependency/deployment.lux create mode 100644 stdlib/source/test/aedifex/repository/remote.lux (limited to 'stdlib/source/test/aedifex') 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 [ [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)}] + ) + + _ + ) + )))))) + +(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))) + )))) -- cgit v1.2.3