path: root/stdlib/source/test/aedifex/dependency/resolution.lux

(.require
 [library
  [lux (.except all)
   [abstract
    [monad (.only do)]
    ["[0]" predicate]
    [\\specification
     ["$[0]" equivalence]]]
   [control
    ["[0]" try]
    ["[0]" exception]
    [concurrency
     ["[0]" async]]]
   [data
    [binary (.only Binary)]
    ["[0]" product]
    ["[0]" text (.only)
     ["%" \\format (.only format)]
     [encoding
      ["[0]" utf8]]]
    [format
     ["[0]" xml]]
    [collection
     ["[0]" dictionary]
     ["[0]" set]
     ["[0]" list]]]
   [math
    ["[0]" random (.only Random)]]
   [test
    ["[0]" unit]
    ["_" property (.only Test)]]]]
 ["$[0]" ///
  ["[1][0]" package]
  ["[1][0]" repository]
  ["[1][0]" artifact]
  [command
   ["[1][0]" version]]]
 [\\program
  ["[0]" / (.only)
   ["//[1]" ///
    ["[1]" profile]
    ["[1][0]" package (.only Package)]
    ["[1][0]" hash]
    ["[1][0]" dependency (.only Dependency) (.use "[1]#[0]" equivalence)
     ["[1]/[0]" status]]
    ["[1][0]" pom]
    ["[1][0]" artifact (.only Artifact)
     ["[1]/[0]" type]
     ["[1]/[0]" extension]]
    ["[1][0]" repository (.only Mock)
     ["[1]/[0]" origin]]]]])

(def random
  (Random /.Resolution)
  (do [! random.monad]
    [artifact $///artifact.random
     [_ package] $///package.random]
    (in (dictionary.has [///dependency.#artifact artifact
                         ///dependency.#type ///artifact/type.lux_library]
                        package
                        /.empty))))

(def lux_sha-1
  Text
  (format ///artifact/extension.lux_library ///artifact/extension.sha-1))

(def lux_md5
  Text
  (format ///artifact/extension.lux_library ///artifact/extension.md5))

(def pom_sha-1
  Text
  (format ///artifact/extension.pom ///artifact/extension.sha-1))

(def pom_md5
  Text
  (format ///artifact/extension.pom ///artifact/extension.md5))

(def sha-1
  (-> Binary Binary)
  (|>> ///hash.sha-1
       (at ///hash.sha-1_codec encoded)
       (at utf8.codec encoded)))

(def md5
  (-> Binary Binary)
  (|>> ///hash.md5
       (at ///hash.md5_codec encoded)
       (at utf8.codec encoded)))

(def .public nope
  (Mock Any)
  (implementation
   (def the_description
     "[0]")
   (def (on_download uri state)
     {try.#Failure "NOPE"})
   (def (on_upload uri binary state)
     {try.#Failure "NOPE"})))

(def .public (single artifact package)
  (-> Artifact Package (Mock Any))
  (let [expected (///artifact.uri (the ///artifact.#version artifact) artifact)]
    (implementation
     (def the_description
       "[1]")
     (def (on_download uri state)
       (if (text.contains? expected uri)
         (let [library (is Binary
                           (|> package
                               (the ///package.#library)
                               product.left))
               pom (is Binary
                       (|> package
                           (the ///package.#pom)
                           product.left
                           (at xml.codec encoded)
                           (at utf8.codec encoded)))]
           (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 (Mock Any))
  (implementation
   (def the_description
     "[~SHA-1]")
   (def (on_download uri state)
     (if (text.contains? (///artifact.uri (the ///artifact.#version expected_artifact) expected_artifact) uri)
       (cond (text.ends_with? ///artifact/extension.lux_library uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#library)
                                      product.left)]}

             (text.ends_with? ..lux_sha-1 uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#library)
                                      product.left
                                      ..sha-1)]}

             (text.ends_with? ..lux_md5 uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#library)
                                      product.left
                                      ..md5)]}
             
             (text.ends_with? ///artifact/extension.pom uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#pom)
                                      product.left
                                      (at xml.codec encoded)
                                      (at utf8.codec encoded))]}

             (text.ends_with? ..pom_sha-1 uri)
             {try.#Success [state (|> dummy_package
                                      (the ///package.#pom)
                                      product.left
                                      (at xml.codec encoded)
                                      (at utf8.codec encoded)
                                      ..sha-1)]}

             (text.ends_with? ..pom_md5 uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#pom)
                                      product.left
                                      (at xml.codec encoded)
                                      (at utf8.codec encoded)
                                      ..md5)]}

             ... else
             {try.#Failure "NOPE"})
       {try.#Failure "NOPE"}))
   (def (on_upload uri binary state)
     {try.#Failure "NOPE"})))

(def (bad_md5 expected_artifact expected_package dummy_package)
  (-> Artifact Package Package (Mock Any))
  (implementation
   (def the_description
     "[~MD5]")
   (def (on_download uri state)
     (if (text.contains? (///artifact.uri (the ///artifact.#version expected_artifact) expected_artifact) uri)
       (cond (text.ends_with? ///artifact/extension.lux_library uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#library)
                                      product.left)]}

             (text.ends_with? ..lux_sha-1 uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#library)
                                      product.left
                                      ..sha-1)]}

             (text.ends_with? ..lux_md5 uri)
             {try.#Success [state (|> dummy_package
                                      (the ///package.#library)
                                      product.left
                                      ..md5)]}
             
             (text.ends_with? ///artifact/extension.pom uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#pom)
                                      product.left
                                      (at xml.codec encoded)
                                      (at utf8.codec encoded))]}

             (text.ends_with? ..pom_sha-1 uri)
             {try.#Success [state (|> expected_package
                                      (the ///package.#pom)
                                      product.left
                                      (at xml.codec encoded)
                                      (at utf8.codec encoded)
                                      ..sha-1)]}

             (text.ends_with? ..pom_md5 uri)
             {try.#Success [state (|> dummy_package
                                      (the ///package.#pom)
                                      product.left
                                      (at xml.codec encoded)
                                      (at utf8.codec encoded)
                                      ..md5)]}

             ... else
             {try.#Failure "NOPE"})
       {try.#Failure "NOPE"}))
   (def (on_upload uri binary state)
     {try.#Failure "NOPE"})))

(def one
  Test
  (do [! random.monad]
    [expected_artifact $///artifact.random
     [_ expected_package] $///package.random
     [_ dummy_package] (random.only (|>> product.right
                                         (has ///package.#pom (the ///package.#pom expected_package))
                                         (at ///package.equivalence = expected_package)
                                         not)
                                    $///package.random)
     .let [good (..single expected_artifact expected_package)
           bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package)
           bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]]
    (`` (.all _.and
              (in (do async.monad
                    [actual_package (/.one (///repository.mock good [])
                                           [///dependency.#artifact expected_artifact
                                            ///dependency.#type ///artifact/type.lux_library])]
                    (unit.coverage [/.one]
                      (when actual_package
                        {try.#Success actual_package}
                        (at ///package.equivalence =
                            (has ///package.#origin {///repository/origin.#Remote ""} expected_package)
                            actual_package)
                        
                        {try.#Failure _}
                        false))))
              (,, (with_template [<exception> <bad>]
                    [(in (do async.monad
                           [actual_package (/.one (///repository.mock <bad> [])
                                                  [///dependency.#artifact expected_artifact
                                                   ///dependency.#type ///artifact/type.lux_library])]
                           (unit.coverage [<exception>]
                             (when actual_package
                               {try.#Failure error}
                               (exception.match? <exception> error)

                               {try.#Success _}
                               false))))]

                    [/.sha-1_does_not_match bad_sha-1]
                    [/.md5_does_not_match bad_md5]
                    ))
              ))))

(def any
  Test
  (do [! random.monad]
    [expected_artifact $///artifact.random
     [_ expected_package] $///package.random
     [_ dummy_package] (random.only (|>> product.right
                                         (has ///package.#pom (the ///package.#pom expected_package))
                                         (at ///package.equivalence = expected_package)
                                         not)
                                    $///package.random)
     .let [good (..single expected_artifact expected_package)
           bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package)
           bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]]
    (.all _.and
          (in (do async.monad
                [.let [console ($///version.echo "")]
                 actual_package (/.any console
                                       (list (///repository.mock bad_sha-1 [])
                                             (///repository.mock bad_md5 [])
                                             (///repository.mock good []))
                                       [///dependency.#artifact expected_artifact
                                        ///dependency.#type ///artifact/type.lux_library])]
                (unit.coverage [/.any]
                  (when actual_package
                    {try.#Success actual_package}
                    (at ///package.equivalence =
                        (has ///package.#origin {///repository/origin.#Remote ""} expected_package)
                        actual_package)
                    
                    {try.#Failure _}
                    false))))
          (in (do async.monad
                [.let [console ($///version.echo "")]
                 actual_package (/.any console
                                       (list (///repository.mock bad_sha-1 [])
                                             (///repository.mock bad_md5 []))
                                       [///dependency.#artifact expected_artifact
                                        ///dependency.#type ///artifact/type.lux_library])]
                (unit.coverage [/.cannot_resolve]
                  (when actual_package
                    {try.#Failure error}
                    (exception.match? /.cannot_resolve error)

                    {try.#Success _}
                    false))))
          )))

(def artifacts
  (Random [Artifact Artifact Artifact])
  (do random.monad
    [dependee_artifact $///artifact.random
     depender_artifact (random.only (predicate.complement
                                     (at ///artifact.equivalence = dependee_artifact))
                                    $///artifact.random)
     ignored_artifact (random.only (predicate.complement
                                    (predicate.and (at ///artifact.equivalence = dependee_artifact)
                                                   (at ///artifact.equivalence = depender_artifact)))
                                   $///artifact.random)]
    (in [dependee_artifact depender_artifact ignored_artifact])))

(def (packages [dependee_artifact depender_artifact ignored_artifact])
  (-> [Artifact Artifact Artifact]
      (Random [[Dependency Dependency Dependency]
               [Package Package Package]]))
  (do random.monad
    [[_ dependee_package] $///package.random
     [_ depender_package] $///package.random
     [_ ignored_package] $///package.random

     .let [dependee [///dependency.#artifact dependee_artifact
                     ///dependency.#type ///artifact/type.lux_library]
           depender [///dependency.#artifact depender_artifact
                     ///dependency.#type ///artifact/type.lux_library]
           ignored [///dependency.#artifact ignored_artifact
                    ///dependency.#type ///artifact/type.lux_library]

           dependee_pom (|> (at ///.monoid identity)
                            (has ///.#identity {.#Some dependee_artifact})
                            ///pom.write
                            try.trusted)
           depender_pom (|> (at ///.monoid identity)
                            (has ///.#identity {.#Some depender_artifact})
                            (has ///.#dependencies (set.of_list ///dependency.hash (list dependee)))
                            ///pom.write
                            try.trusted)
           ignored_pom (|> (at ///.monoid identity)
                           (has ///.#identity {.#Some ignored_artifact})
                           ///pom.write
                           try.trusted)

           dependee_package (has ///package.#pom
                                 [dependee_pom
                                  (|> dependee_pom (at xml.codec encoded) (at utf8.codec encoded))
                                  {///dependency/status.#Unverified}]
                                 dependee_package)
           depender_package (has ///package.#pom
                                 [depender_pom
                                  (|> depender_pom (at xml.codec encoded) (at utf8.codec encoded))
                                  {///dependency/status.#Unverified}]
                                 depender_package)
           ignored_package (has ///package.#pom
                                [ignored_pom
                                 (|> ignored_pom (at xml.codec encoded) (at utf8.codec encoded))
                                 {///dependency/status.#Unverified}]
                                ignored_package)]]
    (in [[dependee depender ignored]
         [dependee_package depender_package ignored_package]])))

(def all
  Test
  (do [! random.monad]
    [[dependee_artifact depender_artifact ignored_artifact] ..artifacts

     [[dependee depender ignored]
      [dependee_package depender_package ignored_package]]
     (..packages [dependee_artifact depender_artifact ignored_artifact])]
    (.all _.and
          (in (do async.monad
                [.let [console ($///version.echo "")]
                 [successes failures resolution] (/.all console
                                                        (list (///repository.mock (..single dependee_artifact dependee_package) [])
                                                              (///repository.mock (..single depender_artifact depender_package) [])
                                                              (///repository.mock (..single ignored_artifact ignored_package) []))
                                                        (function (_ url)
                                                          (///repository.mock ..nope []))
                                                        (list depender)
                                                        /.empty)]
                (unit.coverage [/.all]
                  (and (dictionary.key? resolution depender)
                       (list.any? (///dependency#= depender) successes)
                       
                       (dictionary.key? resolution dependee)
                       (list.any? (///dependency#= dependee) successes)

                       (list.empty? failures)
                       (not (dictionary.key? resolution ignored))))))
          )))

(def .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Resolution])
      (.all _.and
            (_.for [/.equivalence]
                   ($equivalence.spec /.equivalence ..random))

            (_.coverage [/.empty]
              (dictionary.empty? /.empty))

            ..one
            ..any
            ..all
            )))