Refactored "export" common syntax.

7 files changed, 179 insertions, 130 deletions

diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux
index 50062c3f7..ce95f65b7 100644
--- a/stdlib/source/program/aedifex/cache.lux
+++ b/stdlib/source/program/aedifex/cache.lux
@@ -26,12 +26,14 @@
     ["." file (#+ Path File Directory)]]]
   ["." // #_
    ["#" local]
-   ["#." hash]
+   ["#." hash (#+ Hash SHA-1 MD5)]
    ["#." package (#+ Package)]
    ["#." artifact (#+ Artifact)
-    ["#/." extension]]
-   [dependency (#+ Dependency)
-    [resolution (#+ Resolution)]]])
+    ["#/." type]
+    ["#/." extension (#+ Extension)]]
+   ["#." dependency (#+ Dependency)
+    [resolution (#+ Resolution)]
+    ["#/." status (#+ Status)]]])
 
 (def: (write! system content file)
   (-> (file.System Promise) Binary Path (Promise (Try Any)))
@@ -40,6 +42,36 @@
              (file.get-file promise.monad system file))]
     (!.use (\ file over-write) [content])))
 
+(def: (write-hashed system directory [artifact type] [data status])
+  (-> (file.System Promise) Path Dependency [Binary Status] (Promise (Try Any)))
+  (let [prefix (format directory
+                       (\ system separator)
+                       (//artifact.identity artifact)
+                       (//artifact/extension.extension type))]
+    (do {! (try.with promise.monad)}
+      [_ (..write! system data prefix)
+       #let [write-hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any))))
+                           (function (_ codec extension hash)
+                             (..write! system
+                                       (|> hash (\ codec encode) (\ encoding.utf8 encode))
+                                       (format prefix extension))))]]
+      (case status
+        #//dependency/status.Unverified
+        (wrap [])
+        
+        (#//dependency/status.Partial partial)
+        (case partial
+          (#.Left sha-1)
+          (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1)
+          
+          (#.Right md5)
+          (write-hash //hash.md5-codec //artifact/extension.md5 md5))
+        
+        (#//dependency/status.Verified sha-1 md5)
+        (do !
+          [_ (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1)]
+          (write-hash //hash.md5-codec //artifact/extension.md5 md5))))))
+
 (def: #export (write-one program system [artifact type] package)
   (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact)))
   (do promise.monad
@@ -47,27 +79,12 @@
     (do (try.with promise.monad)
       [directory (: (Promise (Try Path))
                     (file.make-directories promise.monad system (//.path system home artifact)))
-       #let [prefix (format directory (\ system separator) (//artifact.identity artifact))]
-       directory (: (Promise (Try (Directory Promise)))
-                    (file.get-directory promise.monad system directory))
-       _ (..write! system
-                   (get@ #//package.library package)
-                   (format prefix (//artifact/extension.extension type)))
-       _ (..write! system
-                   (|> package
-                       (get@ #//package.sha-1)
-                       (\ //hash.sha-1-codec encode)
-                       (\ encoding.utf8 encode))
-                   (format prefix //artifact/extension.sha-1))
-       _ (..write! system
-                   (|> package
-                       (get@ #//package.md5)
-                       (\ //hash.md5-codec encode)
-                       (\ encoding.utf8 encode))
-                   (format prefix //artifact/extension.md5))
-       _ (..write! system
-                   (|> package (get@ #//package.pom) (\ xml.codec encode) (\ encoding.utf8 encode))
-                   (format prefix //artifact/extension.pom))]
+       _ (write-hashed system directory [artifact type] (get@ #//package.library package))
+       _ (let [[pom status] (get@ #//package.pom package)]
+           (write-hashed system directory
+                         [artifact //artifact/type.pom]
+                         [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+                          status]))]
       (wrap artifact))))
 
 (def: #export (write-all program system resolution)
@@ -104,19 +121,18 @@
                           (//artifact.identity artifact))]]
     (do (try.with promise.monad)
       [pom (..read! system (format prefix //artifact/extension.pom))
-       library (..read! system (format prefix (//artifact/extension.extension type)))
-       sha-1 (..read! system (format prefix //artifact/extension.sha-1))
-       md5 (..read! system (format prefix //artifact/extension.md5))]
+       #let [extension (//artifact/extension.extension type)]
+       library (..read! system (format prefix extension))
+       library-sha-1 (..read! system (format prefix extension //artifact/extension.sha-1))
+       library-md5 (..read! system (format prefix extension //artifact/extension.md5))]
       (\ promise.monad wrap
          (do try.monad
            [pom (..decode xml.codec pom)
-            sha-1 (..decode //hash.sha-1-codec sha-1)
-            md5 (..decode //hash.md5-codec md5)]
+            library-sha-1 (..decode //hash.sha-1-codec library-sha-1)
+            library-md5 (..decode //hash.md5-codec library-md5)]
            (wrap {#//package.origin #//package.Local
-                  #//package.library library
-                  #//package.pom pom
-                  #//package.sha-1 sha-1
-                  #//package.md5 md5}))))))
+                  #//package.library [library (#//dependency/status.Verified library-sha-1 library-md5)]
+                  #//package.pom [pom #//dependency/status.Unverified]}))))))
 
 (def: #export (read-all program system dependencies resolution)
   (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index c00f62852..4625136a3 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -10,7 +10,8 @@
     ["." product]
     ["." text]]]
   [//
-   [repository (#+ Identity)]
+   [repository
+    [identity (#+ Identity)]]
    ["/" profile (#+ Name)]])
 
 (type: #export Compilation
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index 4e33b145a..5763c1ff5 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -36,7 +36,8 @@
     ["#." action (#+ Action)]
     ["#." pom]
     ["#." hash]
-    ["#." repository (#+ Identity Repository)]
+    ["#." repository (#+ Repository)
+     [identity (#+ Identity)]]
     ["#." metadata
      ["#/." artifact]
      ["#/." snapshot]]
@@ -89,11 +90,11 @@
         (format ///artifact/type.lux-library ///artifact/extension.sha-1)
         (format ///artifact/type.lux-library ///artifact/extension.md5)))
 
-(def: #export (do! console repository fs identity artifact profile)
-  (-> (Console Promise) (Repository Promise) (file.System Promise) Identity Artifact (Command Any))
+(def: #export (do! console repository fs artifact profile)
+  (-> (Console Promise) (Repository Promise) (file.System Promise) Artifact (Command Any))
   (let [deploy! (: (-> Extension Binary (Action Any))
                    (|>> (///repository.uri artifact)
-                        (\ repository upload identity)))
+                        (\ repository upload)))
         fully-deploy! (: (-> Extension Binary (Action Any))
                          (function (_ extension payload)
                            (do ///action.monad
@@ -126,12 +127,12 @@
                ///metadata/snapshot.write
                (\ xml.codec encode)
                (\ encoding.utf8 encode)
-               (\ repository upload identity (///metadata.version artifact)))
+               (\ repository upload (///metadata.version artifact)))
          _ (|> project
                (set@ #///metadata/artifact.versions (list version))
                (set@ #///metadata/artifact.last-updated now)
                ///metadata/artifact.write
                (\ xml.codec encode)
                (\ encoding.utf8 encode)
-               (\ repository upload identity (///metadata.project artifact)))]
+               (\ repository upload (///metadata.project artifact)))]
         (console.write-line //clean.success console)))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 2131495b9..f49d1da56 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -31,65 +31,70 @@
     [net (#+ URL)
      ["." uri]]]]
   ["." // (#+ Dependency)
+   ["#." status (#+ Status)]
    ["/#" // #_
     ["/" profile]
     ["#." repository (#+ Address Repository)]
-    ["#." hash]
+    ["#." hash (#+ Hash SHA-1 MD5)]
     ["#." pom]
     ["#." package (#+ Package)]
     ["#." artifact (#+ Artifact)
      ["#/." extension (#+ Extension)]]]])
 
 (template [<name>]
-  [(exception: #export (<name> {dependency Dependency} {hash Text})
+  [(exception: #export (<name> {artifact Artifact} {extension Extension} {hash Text})
      (exception.report
-      ["Artifact" (///artifact.format (get@ #//.artifact dependency))]
-      ["Type" (%.text (get@ #//.type dependency))]
+      ["Artifact" (///artifact.format artifact)]
+      ["Extension" (%.text extension)]
       ["Hash" (%.text hash)]))]
 
   [sha-1-does-not-match]
   [md5-does-not-match]
   )
 
-(def: (verified-hash dependency library repository artifact extension hash codec exception)
+(def: (verified-hash library repository artifact extension hash codec exception)
   (All [h]
-    (-> Dependency Binary (Repository Promise) Artifact Extension
-        (-> Binary (///hash.Hash h)) (Codec Text (///hash.Hash h))
-        (Exception [Dependency Text])
-        (Promise (Try (///hash.Hash h)))))
+    (-> Binary (Repository Promise) Artifact Extension
+        (-> Binary (Hash h)) (Codec Text (Hash h))
+        (Exception [Artifact Extension Text])
+        (Promise (Try (Hash h)))))
   (do (try.with promise.monad)
     [actual (\ repository download (///repository.uri artifact extension))]
     (\ promise.monad wrap
        (do try.monad
          [output (\ encoding.utf8 decode actual)
           actual (\ codec decode output)
-          _ (exception.assert exception [dependency output]
+          _ (exception.assert exception [artifact extension output]
                               (\ ///hash.equivalence = (hash library) actual))]
          (wrap actual)))))
 
+(def: (hashed repository artifact extension)
+  (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status])))
+  (do (try.with promise.monad)
+    [data (\ repository download (///repository.uri artifact extension))
+     sha-1 (..verified-hash data
+                            repository artifact (format extension ///artifact/extension.sha-1)
+                            ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
+     md5 (..verified-hash data
+                          repository artifact (format extension ///artifact/extension.md5)
+                          ///hash.md5 ///hash.md5-codec ..md5-does-not-match)]
+    (wrap [data (#//status.Verified sha-1 md5)])))
+
 (def: #export (one repository dependency)
   (-> (Repository Promise) Dependency (Promise (Try Package)))
   (let [[artifact type] dependency
         extension (///artifact/extension.extension type)]
     (do (try.with promise.monad)
-      [library (\ repository download (///repository.uri artifact extension))
-       sha-1 (..verified-hash dependency library
-                              repository artifact ///artifact/extension.sha-1
-                              ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
-       md5 (..verified-hash dependency library
-                            repository artifact ///artifact/extension.md5
-                            ///hash.md5 ///hash.md5-codec ..md5-does-not-match)
-       pom (\ repository download (///repository.uri artifact ///artifact/extension.pom))]
+      [[pom pom-status] (..hashed repository artifact ///artifact/extension.pom)
+       library-&-status (..hashed repository artifact extension)]
       (\ promise.monad wrap
          (do try.monad
            [pom (\ encoding.utf8 decode pom)
             pom (\ xml.codec decode pom)
             profile (<xml>.run ///pom.parser pom)]
            (wrap {#///package.origin #///package.Remote
-                  #///package.library library
-                  #///package.pom pom
-                  #///package.sha-1 sha-1
-                  #///package.md5 md5}))))))
+                  #///package.library library-&-status
+                  #///package.pom [pom pom-status]}))))))
 
 (type: #export Resolution
   (Dictionary Dependency Package))
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
index de831555e..03f2c3994 100644
--- a/stdlib/source/program/aedifex/package.lux
+++ b/stdlib/source/program/aedifex/package.lux
@@ -15,7 +15,8 @@
     [collection
      [set (#+ Set)]]]]
   ["." // #_
-   [dependency (#+ Dependency)]
+   [dependency (#+ Dependency)
+    ["#." status (#+ Status)]]
    ["/" profile]
    ["#." hash (#+ Hash SHA-1 MD5)]
    ["#." pom]])
@@ -34,14 +35,13 @@
   (Equivalence Origin)
   ($_ sum.equivalence
       ..any-equivalence
-      ..any-equivalence))
+      ..any-equivalence
+      ))
 
 (type: #export Package
   {#origin Origin
-   #library Binary
-   #pom XML
-   #sha-1 (Hash SHA-1)
-   #md5 (Hash MD5)})
+   #library [Binary Status]
+   #pom [XML Status]})
 
 (template [<name> <tag>]
   [(def: #export <name>
@@ -55,14 +55,13 @@
 (def: #export (local pom library)
   (-> XML Binary Package)
   {#origin #Local
-   #library library
-   #pom pom
-   #sha-1 (//hash.sha-1 library)
-   #md5 (//hash.md5 library)})
+   #library [library #//status.Unverified]
+   #pom [pom #//status.Unverified]})
 
 (def: #export dependencies
   (-> Package (Try (Set Dependency)))
   (|>> (get@ #pom)
+       product.left
        (<xml>.run //pom.parser)
        (try\map (get@ #/.dependencies))))
 
@@ -70,8 +69,6 @@
   (Equivalence Package)
   ($_ product.equivalence
       ..origin-equivalence
-      binary.equivalence
-      xml.equivalence
-      //hash.equivalence
-      //hash.equivalence
+      (product.equivalence binary.equivalence //status.equivalence)
+      (product.equivalence xml.equivalence //status.equivalence)
       ))
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
index c351e9d0c..351d1c066 100644
--- a/stdlib/source/program/aedifex/repository.lux
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -13,8 +13,7 @@
    [data
     ["." binary (#+ Binary)]
     ["." text
-     ["%" format (#+ format)]
-     ["." encoding]]
+     ["%" format (#+ format)]]
     [number
      ["n" nat]]]
    [tool
@@ -26,27 +25,19 @@
    [world
     [net (#+ URL)
      ["." uri (#+ URI)]]]]
-  ["." // #_
-   ["#." artifact (#+ Artifact)
-    ["#/." extension (#+ Extension)]]])
+  ["." / #_
+   ["#." identity (#+ Identity)]
+   ["/#" // #_
+    ["#." artifact (#+ Artifact)
+     ["#/." extension (#+ Extension)]]]])
 
 (type: #export Address
   URL)
 
-(type: #export User
-  Text)
-
-(type: #export Password
-  Text)
-
-(type: #export Identity
-  {#user User
-   #password Password})
-
 (signature: #export (Repository !)
   (: (-> URI (! (Try Binary)))
      download)
-  (: (-> Identity URI Binary (! (Try Any)))
+  (: (-> URI Binary (! (Try Any)))
      upload))
 
 (def: #export (async repository)
@@ -55,14 +46,14 @@
    (def: (download uri)
      (promise.future (\ repository download uri)))
 
-   (def: (upload identity uri content)
-     (promise.future (\ repository upload identity uri content)))
+   (def: (upload uri content)
+     (promise.future (\ repository upload uri content)))
    ))
 
 (signature: #export (Simulation s)
   (: (-> URI s (Try [s Binary]))
      on-download)
-  (: (-> Identity URI Binary s (Try s))
+  (: (-> URI Binary s (Try s))
      on-upload))
 
 (def: #export (mock simulation init)
@@ -82,11 +73,11 @@
             (#try.Failure error)
             (wrap (#try.Failure error))))))
 
-     (def: (upload identity uri content)
+     (def: (upload uri content)
        (stm.commit
         (do {! stm.monad}
           [|state| (stm.read state)]
-          (case (\ simulation on-upload identity uri content |state|)
+          (case (\ simulation on-upload uri content |state|)
             (#try.Success |state|)
             (do !
               [_ (stm.write |state| state)]
@@ -126,28 +117,19 @@
    (new [java/lang/String])
    (openConnection [] #io #try java/net/URLConnection)])
 
-(import: java/util/Base64$Encoder
-  ["#::."
-   (encodeToString [[byte]] java/lang/String)])
-
-(import: java/util/Base64
-  ["#::."
-   (#static getEncoder [] java/util/Base64$Encoder)])
-
 (import: java/io/BufferedInputStream
   ["#::."
    (new [java/io/InputStream])
    (read [[byte] int int] #io #try int)])
 
+(exception: #export (no-credentials {address Address})
+  (exception.report
+   ["Address" (%.text address)]))
+
 (exception: #export (deployment-failure {code Int})
   (exception.report
    ["Code" (%.int code)]))
 
-(def: (basic-auth user password)
-  (-> User Password Text)
-  (format "Basic " (java/util/Base64$Encoder::encodeToString (\ encoding.utf8 encode (format user ":" password))
-                                                             (java/util/Base64::getEncoder))))
-
 (def: #export (uri artifact extension)
   (-> Artifact Extension URI)
   (format (//artifact.uri artifact) extension))
@@ -158,8 +140,8 @@
 (def: user-agent
   (format "LuxAedifex/" (version.format language/lux.version)))
 
-(structure: #export (remote address)
-  (All [s] (-> Address (Repository IO)))
+(structure: #export (remote identity address)
+  (All [s] (-> (Maybe Identity) Address (Repository IO)))
 
   (def: (download uri)
     (do {! (try.with io.monad)}
@@ -186,21 +168,26 @@
                   [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
                   (recur (\ binary.monoid compose output chunk)))))))))
 
-  (def: (upload [user password] uri content)
-    (do (try.with io.monad)
-      [connection (|> (format address uri)
-                      java/net/URL::new
-                      java/net/URL::openConnection)
-       #let [connection (:coerce java/net/HttpURLConnection connection)]
-       _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection)
-       _ (java/net/URLConnection::setDoOutput true connection)
-       _ (java/net/URLConnection::setRequestProperty "Authorization" (..basic-auth user password) connection)
-       stream (java/net/URLConnection::getOutputStream connection)
-       _ (java/io/OutputStream::write content stream)
-       _ (java/io/OutputStream::flush stream)
-       _ (java/lang/AutoCloseable::close stream)
-       code (java/net/HttpURLConnection::getResponseCode connection)]
-      (case code
-        +201 (wrap [])
-        _ (\ io.monad wrap (exception.throw ..deployment-failure [code])))))
+  (def: (upload uri content)
+    (case identity
+      #.None
+      (\ io.monad wrap (exception.throw ..no-credentials [address]))
+      
+      (#.Some [user password])
+      (do (try.with io.monad)
+        [connection (|> (format address uri)
+                        java/net/URL::new
+                        java/net/URL::openConnection)
+         #let [connection (:coerce java/net/HttpURLConnection connection)]
+         _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection)
+         _ (java/net/URLConnection::setDoOutput true connection)
+         _ (java/net/URLConnection::setRequestProperty "Authorization" (/identity.basic-auth user password) connection)
+         stream (java/net/URLConnection::getOutputStream connection)
+         _ (java/io/OutputStream::write content stream)
+         _ (java/io/OutputStream::flush stream)
+         _ (java/lang/AutoCloseable::close stream)
+         code (java/net/HttpURLConnection::getResponseCode connection)]
+        (case code
+          +201 (wrap [])
+          _ (\ io.monad wrap (exception.throw ..deployment-failure [code]))))))
   )
diff --git a/stdlib/source/program/aedifex/repository/identity.lux b/stdlib/source/program/aedifex/repository/identity.lux
new file mode 100644
index 000000000..fbc93f367
--- /dev/null
+++ b/stdlib/source/program/aedifex/repository/identity.lux
@@ -0,0 +1,42 @@
+(.module:
+  [lux #*
+   ["." host (#+ import:)]
+   [abstract
+    [equivalence (#+ Equivalence)]]
+   [data
+    ["." product]
+    ["." text
+     ["%" format (#+ format)]
+     ["." encoding]]]])
+
+(type: #export User
+  Text)
+
+(type: #export Password
+  Text)
+
+(type: #export Identity
+  {#user User
+   #password Password})
+
+(def: #export equivalence
+  (Equivalence Identity)
+  ($_ product.equivalence
+      text.equivalence
+      text.equivalence
+      ))
+
+(import: java/util/Base64$Encoder
+  ["#::."
+   (encodeToString [[byte]] java/lang/String)])
+
+(import: java/util/Base64
+  ["#::."
+   (#static getEncoder [] java/util/Base64$Encoder)])
+
+(def: #export (basic-auth user password)
+  (-> User Password Text)
+  (let [credentials (\ encoding.utf8 encode (format user ":" password))]
+    (|> (java/util/Base64::getEncoder)
+        (java/util/Base64$Encoder::encodeToString credentials)
+        (format "Basic "))))