implement publish logic associated to Builder.Http.upload #12

guida-lang · Oct 22, 2024 · 000263c · 000263c
1 parent dc4866c
commit 000263c
Show file tree

Hide file tree

Showing 9 changed files with 275 additions and 88 deletions.
diff --git a/bin/index.js b/bin/index.js
@@ -12,6 +12,7 @@ const AdmZip = require("adm-zip");
 const which = require("which");
 const tmp = require("tmp");
 const { Elm } = require("./guida.js");
+const FormData = require("form-data");
 
 const rl = readline.createInterface({
   input: process.stdin,
@@ -129,6 +130,24 @@ const io = {
       this.send({ index, value: null });
     });
   },
+  dirRemoveFile: function (index, path) {
+    fs.unlink(path, (err) => {
+      if (err) {
+        console.error(err);
+      } else {
+        this.send({ index, value: null });
+      }
+    });
+  },
+  dirRemoveDirectoryRecursive: function (index, path) {
+    fs.rm(path, { recursive: true, force: true }, (err) => {
+      if (err) {
+        console.error(err);
+      } else {
+        this.send({ index, value: null });
+      }
+    });
+  },
   writeIORef: function (index, id, value) {
     ioRefs[id].value = value;
 
@@ -182,6 +201,48 @@ const io = {
 
     req.end();
   },
+  httpUpload: function (index, urlStr, headers, parts) {
+    const url = new URL(urlStr);
+    const client = url.protocol == "https:" ? https : http;
+
+    const form = new FormData();
+
+    parts.forEach((part) => {
+      switch (part.type) {
+        case "FilePart":
+          form.append(part.name, fs.createReadStream(part.filePath));
+          break;
+
+        case "JsonPart":
+          form.append(part.name, JSON.stringify(part.value), {
+            contentType: "application/json",
+            filepath: part.filePath,
+          });
+          break;
+
+        case "StringPart":
+          form.append(part.name, part.string);
+          break;
+      }
+    });
+
+    const req = client.request(url, {
+      method: "POST",
+      headers: { ...headers, ...form.getHeaders() },
+    });
+
+    form.pipe(req);
+
+    req.on("response", (res) => {
+      res.on("end", () => {
+        this.send({ index, value: null });
+      });
+    });
+
+    req.on("error", (err) => {
+      console.error(err);
+    });
+  },
   write: function (index, path, value) {
     this.send({
       index,
@@ -227,6 +288,14 @@ const io = {
   dirCanonicalizePath: function (index, path) {
     this.send({ index, value: resolve(path) });
   },
+  dirWithCurrentDirectory: function (index, path) {
+    try {
+      process.chdir(path);
+      this.send({ index, value: null });
+    } catch (err) {
+      console.error(`chdir: ${err}`);
+    }
+  },
   getArchive: function (index, method, url) {
     download.apply(this, [index, method, url]);
   },

diff --git a/package-lock.json b/package-lock.json
diff --git a/package.json b/package.json
@@ -19,6 +19,7 @@
   },
   "dependencies": {
     "adm-zip": "^0.5.15",
+    "form-data": "^4.0.1",
     "tmp": "^0.2.3",
     "which": "^4.0.0"
   },

diff --git a/src/Builder/Http.elm b/src/Builder/Http.elm
@@ -109,31 +109,7 @@ type Method
 
 
 fetch : Method -> Manager -> String -> List Header -> (Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a)
-fetch methodVerb manager url headers onError onSuccess =
-    -- handle (handleSomeException url onError) <|
-    --     handle (handleHttpException url onError) <|
-    --         (parseUrlThrow url
-    --             |> IO.bind
-    --                 (\req0 ->
-    --                     let
-    --                         req1 =
-    --                             req0
-    --                                 { method = methodVerb
-    --                                 , requestHeaders = addDefaultHeaders headers
-    --                                 }
-    --                     in
-    --                     withResponse req1
-    --                         manager
-    --                         (\response ->
-    --                             brConsume (responseBody response)
-    --                                 |> IO.bind
-    --                                     (\chunks ->
-    --                                         onSuccess (BS.concat chunks)
-    --                                     )
-    --                         )
-    --                 )
-    --         )
-    -- IO.pure (Err (onError (BadHttp url (ConnectionFailure SomeException))))
+fetch methodVerb _ url headers _ onSuccess =
     IO.make Decode.string
         (IO.HttpFetch
             (case methodVerb of
@@ -231,52 +207,59 @@ getArchive manager url onError err onSuccess =
 
 
 type MultiPart
-    = MultiPart
+    = FilePart String String
+    | JsonPart String String Encode.Value
+    | StringPart String String
 
 
 upload : Manager -> String -> List MultiPart -> IO (Result Error ())
-upload manager url parts =
-    -- handle (handleSomeException url id) <|
-    --     handle (handleHttpException url id) <|
-    --         do req0
-    --             <- parseUrlThrow url
-    --                 req1
-    --             <- Multi.formDataBody parts
-    --         <|
-    --             req0
-    --                 { method = methodPost
-    --                 , requestHeaders = addDefaultHeaders []
-    --                 , responseTimeout = responseTimeoutNone
-    --                 }
-    --                 withResponse
-    --                 req1
-    --                 manager
-    --             <|
-    --                 \_ ->
-    --                     return (Right ())
-    todo "upload"
+upload _ url parts =
+    IO.make (Decode.succeed (Ok ()))
+        (IO.HttpUpload url
+            (addDefaultHeaders [])
+            (Encode.list
+                (\part ->
+                    case part of
+                        FilePart name filePath ->
+                            Encode.object
+                                [ ( "type", Encode.string "FilePart" )
+                                , ( "name", Encode.string name )
+                                , ( "filePath", Encode.string filePath )
+                                ]
+
+                        JsonPart name filePath value ->
+                            Encode.object
+                                [ ( "type", Encode.string "JsonPart" )
+                                , ( "name", Encode.string name )
+                                , ( "filePath", Encode.string filePath )
+                                , ( "value", value )
+                                ]
+
+                        StringPart name string ->
+                            Encode.object
+                                [ ( "type", Encode.string "StringPart" )
+                                , ( "name", Encode.string name )
+                                , ( "string", Encode.string string )
+                                ]
+                )
+                parts
+            )
+        )
 
 
 filePart : String -> String -> MultiPart
 filePart name filePath =
-    -- Multi.partFileSource (String.fromString name) filePath
-    todo "filePart"
+    FilePart name filePath
 
 
 jsonPart : String -> String -> Encode.Value -> MultiPart
 jsonPart name filePath value =
-    -- let
-    --     body =
-    --         Multi.RequestBodyLBS <| B.toLazyByteString <| Encode.encodeUgly value
-    -- in
-    -- Multi.partFileRequestBody (String.fromString name) filePath body
-    todo "jsonPart"
+    JsonPart name filePath value
 
 
 stringPart : String -> String -> MultiPart
 stringPart name string =
-    -- Multi.partBS (String.fromString name) (BS.pack string)
-    todo "stringPart"
+    StringPart name string
 
 
 

diff --git a/src/Compiler/Json/Encode.elm b/src/Compiler/Json/Encode.elm
@@ -108,7 +108,7 @@ oneOrMore encoder oneOrMore_ =
 type Value
     = Array (List Value)
     | Object (List ( String, Value ))
-    | String String
+    | StringVal String
     | Boolean Bool
     | Integer Int
     | Number Float
@@ -127,12 +127,12 @@ object =
 
 string : String -> Value
 string str =
-    String ("\"" ++ str ++ "\"")
+    StringVal str
 
 
 name : String -> Value
 name nm =
-    String ("\"" ++ nm ++ "\"")
+    StringVal nm
 
 
 bool : Bool -> Value
@@ -175,7 +175,7 @@ list encodeEntry entries =
 
 chars : String -> Value
 chars chrs =
-    String ("\"" ++ escape chrs ++ "\"")
+    StringVal (escape chrs)
 
 
 escape : String -> String
@@ -244,8 +244,8 @@ encodeUgly value =
         Object entries ->
             "{" ++ String.join "," (List.map encodeEntryUgly entries) ++ "}"
 
-        String builder ->
-            builder
+        StringVal builder ->
+            "\"" ++ builder ++ "\""
 
         Boolean boolean ->
             if boolean then
@@ -293,8 +293,8 @@ encodeHelp indent value =
         Object (first :: rest) ->
             encodeObject indent first rest
 
-        String builder ->
-            builder
+        StringVal builder ->
+            "\"" ++ builder ++ "\""
 
         Boolean boolean ->
             if boolean then
@@ -369,7 +369,7 @@ toJsonValue value =
         Object obj ->
             Encode.object (List.map (Tuple.mapSecond toJsonValue) obj)
 
-        String builder ->
+        StringVal builder ->
             Encode.string builder
 
         Boolean boolean ->