(.require
 [library
  [lux (.except)
   [abstract
    [monad (.only do)]
    ["[0]" hash (.only Hash)]]
   [control
    ["[0]" io (.only IO)]
    ["[0]" maybe (.use "[1]#[0]" functor)]
    ["[0]" try (.use "[1]#[0]" functor)]
    [concurrency
     ["[0]" atom (.only Atom)]
     ["[0]" async]]]
   [data
    ["[0]" product]
    ["[0]" binary (.only Binary) (.use "[1]#[0]" equivalence)]
    ["[0]" text (.only)
     ["%" \\format (.only format)]]
    [collection
     ["[0]" dictionary (.only Dictionary)]
     ["[0]" set]
     ["[0]" list (.use "[1]#[0]" mix)]]]
   [math
    ["[0]" random (.only Random)]
    [number
     ["n" nat]]]
   [world
    [net (.only URL)
     ["[0]" uri (.only URI)]
     ["[0]" http
      ["[1]" client]
      ["[1]/[0]" status]
      ["@[1]" /]]]]
   [test
    ["[0]" unit]
    ["_" property (.only Test)]]]]
 ["$[0]" // (.only)
  ["[1]/" //
   ["[1][0]" package]]]
 [\\program
  ["[0]" / (.only)
   [// (.only Dependency)
    ["[0]" resolution]
    [//
     ["[0]" profile]
     ["[0]" metadata]
     ["[0]" package (.only Package)]
     ["[0]" artifact (.only Artifact) (.use "[1]#[0]" equivalence)
      ["[1]/[0]" type]
      ["[1]/[0]" extension]]
     ["[0]" repository (.only)
      ["[0]" remote]]]]]])

(def good_upload
  (@http.Response IO)
  [http/status.created
   [@http.#headers (http.headers (list))
    @http.#body (function (_ _)
                  (|> [0 (binary.empty 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
       [_ (is (IO Any)
              (case [method input]
                [{@http.#Put} {.#Some input}]
                (atom.update! (dictionary.has url input) cache)
                
                _
                (in [])))]
       (in {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 (is (-> URI URL)
                (|>> (format address)))
        library_url (url (format (artifact.uri (the artifact.#version expected_artifact)
                                               expected_artifact)
                                 artifact/extension.lux_library))
        pom_url (url (format (artifact.uri (the 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
                             (the package.#library)
                             product.left)
        expected_pom (|> package
                         (the 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.value library_url)
                 (maybe#each (binary#= expected_library))
                 (maybe.else 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.value pom_url)
                 (maybe#each (binary#= expected_pom))
                 (maybe.else 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
                        (the profile.#identity)
                        maybe.trusted)
           dependency (is Dependency
                          [artifact
                           artifact/type.lux_library])]]
    (in [dependency artifact package])))

(def .public test
  Test
  (<| (_.covering /._)
      (do [! random.monad]
        [address (at ! each (text.suffix uri.separator)
                     (random.upper_case 10))]
        (all _.and
             (do [! random.monad]
               [[dependency expected_artifact package] ..bundle
                .let [cache (is Cache
                                (atom.atom (dictionary.empty text.hash)))
                      http (..http cache)
                      repository (repository.async (remote.repository http {.#None} address))]]
               (in (do async.monad
                     [?outcome (/.one repository dependency package)
                      cache (async.future (atom.read! cache))]
                     (unit.coverage [/.one]
                       (|> ?outcome
                           (try#each (verify_one 1 address package cache expected_artifact))
                           (try.else false))))))
             (do [! random.monad]
               [.let [hash (is (Hash [Dependency Artifact Package])
                               (at hash.functor each (|>> product.right product.left product.left)
                                   text.hash))]
                num_bundles (at ! each (n.% 10) random.nat)
                bundles (|> ..bundle
                            (random.set hash num_bundles)
                            (at ! each set.list))
                .let [resolution (list#mix (function (_ [dependency expected_artifact package] resolution)
                                             (dictionary.has dependency package resolution))
                                           resolution.empty
                                           bundles)
                      cache (is Cache
                                (atom.atom (dictionary.empty text.hash)))
                      http (..http cache)
                      repository (repository.async (remote.repository http {.#None} address))]]
               (in (do async.monad
                     [?outcome (/.all repository resolution)
                      cache (async.future (atom.read! cache))]
                     (unit.coverage [/.all]
                       (|> ?outcome
                           (try#each (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.else false))))))
             ))))