Added deployment code to Aedifex.

7 files changed, 200 insertions, 8 deletions

diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 874e32ceb..bfa2377f4 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -38,7 +38,8 @@
    [command
     ["#." build]
     ["#." test]
-    ["#." auto]]])
+    ["#." auto]
+    ["#." deploy]]])
 
 (def: (read-file! path)
   (-> Path (IO (Try Binary)))
@@ -133,12 +134,16 @@
           #/cli.POM
           (..write-pom! project)
           
+          #/cli.Dependencies
+          (exec (..fetch-dependencies! project)
+            (wrap []))
+
           #/cli.Install
           (exec (..install! project)
             (wrap []))
 
-          #/cli.Dependencies
-          (exec (..fetch-dependencies! project)
+          (#/cli.Deploy repository user password)
+          (exec (/deploy.do! repository user password project)
             (wrap []))
 
           (#/cli.Compilation compilation)
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index 3cbb2aae8..b0d210c17 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -2,7 +2,9 @@
   [lux #*
    [control
     ["<>" parser
-     ["." cli (#+ Parser)]]]])
+     ["." cli (#+ Parser)]]]]
+  [//
+   [upload (#+ User Password)]])
 
 (type: #export Compilation
   #Build
@@ -15,8 +17,9 @@
 
 (type: #export Command
   #POM
-  #Install
   #Dependencies
+  #Install
+  (#Deploy Text User Password)
   (#Compilation Compilation)
   (#Auto Compilation))
 
@@ -24,8 +27,13 @@
   (Parser Command)
   ($_ <>.or
       (cli.this "pom")
-      (cli.this "install")
       (cli.this "deps")
+      (cli.this "install")
+      (<>.after (cli.this "deploy")
+                ($_ <>.and
+                    cli.any
+                    cli.any
+                    cli.any))
       ..compilation
       (<>.after (cli.this "auto")
                 ..compilation)
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
new file mode 100644
index 000000000..ed6667264
--- /dev/null
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -0,0 +1,67 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." exception (#+ exception:)]
+    [concurrency
+     ["." promise ("#@." monad)]]]
+   [data
+    [binary (#+ Binary)]
+    [text
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [collection
+     ["." dictionary (#+ Dictionary)]]
+    [format
+     ["." binary]
+     ["." tar]
+     ["." xml]]]
+   [world
+    ["." file]]]
+  [program
+   [compositor
+    ["." export]]]
+  ["." /// #_
+   ["/" project (#+ Project)]
+   ["//" upload (#+ User Password)]
+   ["#." action (#+ Action)]
+   ["#." command (#+ Command)]
+   ["#." dependency]
+   ["#." pom]
+   ["#." hash]])
+
+(exception: #export (cannot-find-repository {repository Text}
+                                            {options (Dictionary Text ///dependency.Repository)})
+  (exception.report
+   ["Repository" (%.text repository)]
+   ["Options" (exception.enumerate (function (_ [name repo])
+                                     (format (%.text name) " := " (%.text repo)))
+                                   (dictionary.entries options))]))
+
+(def: #export (do! repository user password project)
+  (-> Text User Password (Command Any))
+  (case (dictionary.get repository (get@ #/.deploy-repositories project))
+    (#.Some repository)
+    (let [artifact (get@ #/.identity project)
+          deploy! (: (-> ///dependency.Type Binary (Action Any))
+                     (function (_ type content)
+                       (promise.future
+                        (//.upload repository
+                                   user
+                                   password
+                                   {#///dependency.artifact artifact
+                                    #///dependency.type type}
+                                   content))))]
+      (do {@ ///action.monad}
+        [library (:: @ map (binary.run tar.writer)
+                     (export.library (file.async file.system)
+                                     (get@ #/.sources project)))
+         _ (deploy! ///dependency.pom (|> project ///pom.project (:: xml.codec encode) encoding.to-utf8))
+         _ (deploy! ///dependency.lux-library library)
+         _ (deploy! "sha1" (///hash.sha1 library))
+         _ (deploy! "md5" (///hash.md5 library))]
+        (wrap [])))
+    
+    #.None
+    (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories project)]))))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 7c40bf2ae..92ac3e8ac 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -57,6 +57,7 @@
 
   ["tar" lux-library]
   ["jar" jvm-library]
+  ["pom" pom]
   )
 
 (import: #long java/lang/String)
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index bbcbabb95..17191d5cb 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -166,6 +166,11 @@
   (Parser Module)
   <c>.text)
 
+(def: deploy-repository
+  (Parser [Text //dependency.Repository])
+  (<c>.tuple (<>.and <c>.text
+                     ..repository)))
+
 (def: #export project
   (Parser /.Project)
   (do {@ <>.monad}
@@ -187,4 +192,7 @@
                     (..singular input "target" <c>.text))
         (<>.maybe (..singular input "program" ..module))
         (<>.maybe (..singular input "test" ..module))
+        (<| (:: @ map (dictionary.from-list text.hash))
+            (<>.default (list))
+            (..plural input "deploy-repositories" ..deploy-repository))
         )))
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index ebd689760..20bbda840 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,7 +1,9 @@
 (.module:
   [lux (#- Info Source Module)
    [data
-    ["." text]]
+    ["." text]
+    [collection
+     ["." dictionary (#+ Dictionary)]]]
    [world
     [net (#+ URL)]
     [file (#+ Path)]]
@@ -64,4 +66,5 @@
    #sources (List Source)
    #target Path
    #program (Maybe Module)
-   #test (Maybe Module)})
+   #test (Maybe Module)
+   #deploy-repositories (Dictionary Text dependency.Repository)})
diff --git a/stdlib/source/program/aedifex/upload.lux b/stdlib/source/program/aedifex/upload.lux
new file mode 100644
index 000000000..8b849ed10
--- /dev/null
+++ b/stdlib/source/program/aedifex/upload.lux
@@ -0,0 +1,100 @@
+(.module:
+  [lux #*
+   ["." host (#+ import:)]
+   [abstract
+    [monad (#+ Monad do)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]]
+   [data
+    ["." binary (#+ Binary)]
+    ["." text
+     ["%" format (#+ format)]
+     ["." encoding]]]
+   [time
+    ["." instant]]
+   [world
+    [net (#+ URL)
+     ["." uri]]]]
+  ["." // #_
+   ["#." dependency (#+ Repository Dependency)]
+   ["#." artifact]])
+
+(type: #export (Action a)
+  (IO (Try a)))
+
+(def: #export monad
+  (:coerce (Monad Action)
+           (try.with io.monad)))
+
+(type: #export User
+  Text)
+
+(type: #export Password
+  Text)
+
+(def: (url repository dependency)
+  (-> Repository Dependency URL)
+  (format repository
+          uri.separator
+          (//artifact.path (get@ #//dependency.artifact dependency))
+          "."
+          (get@ #//dependency.type dependency)))
+
+(import: #long java/lang/AutoCloseable
+  (close [] #io #try void))
+
+(import: #long java/io/OutputStream
+  (flush [] #io #try void)
+  (write [[byte]] #io #try void))
+
+(import: #long java/lang/String)
+
+(import: #long java/net/URLConnection
+  (setDoOutput [boolean] #io #try void)
+  (setRequestProperty [java/lang/String java/lang/String] #io #try void)
+  (getOutputStream [] #io #try java/io/OutputStream))
+
+(import: #long java/net/HttpURLConnection
+  (setRequestMethod [java/lang/String] #io #try void)
+  (getResponseCode [] #io #try int))
+
+(import: #long java/net/URL
+  (new [java/lang/String])
+  (openConnection [] #io #try java/net/URLConnection))
+
+(import: #long java/util/Base64$Encoder
+  (encodeToString [[byte]] java/lang/String))
+
+(import: #long java/util/Base64
+  (#static getEncoder [] java/util/Base64$Encoder))
+
+(exception: #export (failure {code Int})
+  (exception.report
+   ["Code" (%.int code)]))
+
+(def: (basic-auth user password)
+  (-> User Password Text)
+  (format "Basic " (java/util/Base64$Encoder::encodeToString (encoding.to-utf8 (format user ":" password))
+                                                             (java/util/Base64::getEncoder))))
+
+(def: #export (upload repository user password dependency content)
+  (-> Repository User Password Dependency Binary
+      (Action Any))
+  (do {@ ..monad}
+    [connection (|> (..url repository dependency)
+                    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
+      +200 (wrap [])
+      _ (:: io.monad wrap (exception.throw ..failure [code])))))