@reventlessdev/reventless-core 3.0.0-alpha.134

package/src/util/EffectLogger.res

@@ -0,0 +1,178 @@
+// Compact Effect logger — delegates to Logger.emit for format.
+//
+// Two responsibilities:
+//   1. install() — replaces Effect's default logger (timestamp=/level=/fiber=)
+//      with Logger.emit so all Effect.runPromise/runSync calls use the unified format.
+//   2. logInfo/logWarn/logError/logDebug — structured helpers with ~comp and ~detail
+//      that return Effect.t<unit> for use in Effect pipelines.
+//
+// ~comp / ~detail and any ambient annotations (e.g. correlationId, requestId set
+// via Effect.annotateLogs at the request boundary) travel as Effect log
+// annotations — NOT baked into the message string. install() reads them off
+// `loggerOptions.annotations` and forwards them to Logger.emit, which promotes
+// them to top-level JSON fields. The message stays clean human text.
+//
+// Usage: import at platform startup (module init calls install()).
+//   EffectLogger.logInfo(~comp=`Aggregate(${Spec.name})`, ~detail=eventJson, "replay done")
+
+type loggerOptions
+type logLevel
+type annotationsMap
+
+@get external _message: loggerOptions => JSON.t = "message"
+@get external _logLevel: loggerOptions => logLevel = "logLevel"
+@get external _ordinal: logLevel => int = "ordinal"
+@get external _annotations: loggerOptions => annotationsMap = "annotations"
+
+// Effect stores log annotations as a HashMap<string, unknown>; toEntries gives a
+// plain [key, value] array. Values arrive as raw JS — string annotations decode
+// directly via JSON.Decode.string.
+@module("effect/HashMap")
+external _annotationEntries: annotationsMap => array<(string, JSON.t)> = "toEntries"
+
+let _messageToString = (msg: JSON.t): string =>
+  switch msg {
+  | Array(arr) =>
+    arr
+    ->Array.map(j =>
+      switch j {
+      | String(s) => s
+      | _ => j->JSON.stringifyAny->Option.getOr("")
+      }
+    )
+    ->Array.join(" ")
+  | String(s) => s
+  | _ => msg->JSON.stringifyAny->Option.getOr("")
+  }
+
+type effectLogger = {mutable log: loggerOptions => unit}
+
+@module("effect/Logger")
+external _defaultLogger: effectLogger = "defaultLogger"
+
+// Effect's runtime gates log effects by a minimum LogLevel BEFORE they reach the
+// installed logger above — so `Effect.logDebug` is dropped unless the threshold is
+// lowered. We set that threshold per log effect from a configurable minimum.
+type effectLogLevel
+@module("effect/LogLevel") external _llDebug: effectLogLevel = "Debug"
+@module("effect/LogLevel") external _llInfo: effectLogLevel = "Info"
+@module("effect/LogLevel") external _llWarning: effectLogLevel = "Warning"
+@module("effect/LogLevel") external _llError: effectLogLevel = "Error"
+@module("effect/LogLevel") external _llNone: effectLogLevel = "None"
+
+@module("effect/Logger")
+external _withMinimumLogLevel: (Effect.t<'a, 'e, 'r>, effectLogLevel) => Effect.t<'a, 'e, 'r> =
+  "withMinimumLogLevel"
+
+@val external _envLogLevel: option<string> = "process.env.LOG_LEVEL"
+
+// Minimum level used when LOG_LEVEL is unset. Framework default is Info; a platform
+// may lower it (e.g. the in-memory dev platform sets Debug) via setDefaultMinLevel.
+let _defaultMin = ref(Logger.Info)
+let setDefaultMinLevel = (l: Logger.level) => _defaultMin := l
+
+// Resolve the active minimum: explicit LOG_LEVEL wins, else the platform default.
+let _effectMin = (): effectLogLevel =>
+  switch _envLogLevel {
+  | Some("silent") => _llNone
+  | Some("debug") => _llDebug
+  | Some("info") => _llInfo
+  | Some("warn") => _llWarning
+  | Some("error") => _llError
+  | _ =>
+    switch _defaultMin.contents {
+    | Logger.Debug => _llDebug
+    | Logger.Info => _llInfo
+    | Logger.Warn => _llWarning
+    | Logger.Error => _llError
+    }
+  }
+
+let ordinalToLevel = ordinal =>
+  if ordinal >= 40000 {
+    Logger.Error
+  } else if ordinal >= 30000 {
+    Logger.Warn
+  } else if ordinal >= 20000 {
+    Logger.Info
+  } else {
+    Logger.Debug
+  }
+
+let install = () =>
+  _defaultLogger.log = opts => {
+    let msg = opts->_message->_messageToString
+    let level = opts->_logLevel->_ordinal->ordinalToLevel
+    // Decode log annotations: `comp`, `plugin`, and `detail` get dedicated
+    // Logger.emit handling (prefix/plugin resolution, expandable payload);
+    // everything else (correlationId, requestId, …) flows through as
+    // top-level string fields.
+    let comp = ref(None)
+    let plugin = ref(None)
+    let detail = ref(None)
+    let extra = Dict.make()
+    opts
+    ->_annotations
+    ->_annotationEntries
+    ->Array.forEach(((k, v)) =>
+      switch k {
+      | "comp" => comp := v->JSON.Decode.string
+      | "plugin" => plugin := v->JSON.Decode.string
+      | "detail" =>
+        detail :=
+          switch v->JSON.Decode.string {
+          | Some(s) =>
+            try Some(s->JSON.parseOrThrow) catch {
+            | _ => Some(JSON.Encode.string(s))
+            }
+          | None => Some(v)
+          }
+      | _ =>
+        switch v->JSON.Decode.string {
+        | Some(s) => extra->Dict.set(k, s)
+        | None => extra->Dict.set(k, v->JSON.stringify)
+        }
+      }
+    )
+    let annotations = extra->Dict.toArray->Array.length == 0 ? None : Some(extra)
+    Logger.emit(
+      ~level,
+      ~comp=?comp.contents,
+      ~plugin=?plugin.contents,
+      ~detail=?detail.contents,
+      ~annotations?,
+      msg,
+    )
+  }
+
+// Self-installing: runs at module initialization time.
+install()
+
+// ─── Structured log helpers ──────────────────────────────────────────────────
+// Returns Effect.t<unit> — usable in Effect pipelines or with ->Effect.runSync.
+//
+// ~comp / ~detail attach as Effect log annotations; install() reads them back.
+//   ~detail: structured JSON shown only in a JSON sink (expandable on click);
+//   the in-memory terminal output shows only the message line.
+
+// Attach comp/detail as annotations on the log effect. detail is stringified so
+// it rides through Effect's string-keyed annotation map; install() re-parses it.
+let _annotate = (eff, ~comp=?, ~detail=?) => {
+  let eff = switch comp {
+  | Some(c) => eff->Effect.annotateLogs("comp", c)
+  | None => eff
+  }
+  switch detail {
+  | Some(d) => eff->Effect.annotateLogs("detail", d->JSON.stringify)
+  | None => eff
+  }
+}
+
+let logInfo = (~comp=?, ~detail=?, msg) =>
+  Effect.logInfo(msg)->_annotate(~comp?, ~detail?)->_withMinimumLogLevel(_effectMin())
+let logWarn = (~comp=?, ~detail=?, msg) =>
+  Effect.logWarning(msg)->_annotate(~comp?, ~detail?)->_withMinimumLogLevel(_effectMin())
+let logError = (~comp=?, ~detail=?, msg) =>
+  Effect.logError(msg)->_annotate(~comp?, ~detail?)->_withMinimumLogLevel(_effectMin())
+let logDebug = (~comp=?, ~detail=?, msg) =>
+  Effect.logDebug(msg)->_annotate(~comp?, ~detail?)->_withMinimumLogLevel(_effectMin())

package/src/util/EffectLogger.res.mjs

@@ -0,0 +1,171 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Stdlib_JSON from "@rescript/runtime/lib/es6/Stdlib_JSON.js";
+import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
+import * as Effect from "effect/Effect";
+import * as Logger from "effect/Logger";
+import * as HashMap from "effect/HashMap";
+import * as LogLevel from "effect/LogLevel";
+import * as Logger$ReventlessCore from "./Logger.res.mjs";
+
+function _messageToString(msg) {
+  if (Array.isArray(msg)) {
+    return msg.map(j => {
+      if (typeof j === "string") {
+        return j;
+      } else {
+        return Stdlib_Option.getOr(JSON.stringify(j), "");
+      }
+    }).join(" ");
+  }
+  switch (typeof msg) {
+    case "string" :
+      return msg;
+    default:
+      return Stdlib_Option.getOr(JSON.stringify(msg), "");
+  }
+}
+
+let _defaultMin = {
+  contents: "Info"
+};
+
+function setDefaultMinLevel(l) {
+  _defaultMin.contents = l;
+}
+
+function _effectMin() {
+  let match = process.env.LOG_LEVEL;
+  if (match !== undefined) {
+    switch (match) {
+      case "debug" :
+        return LogLevel.Debug;
+      case "error" :
+        return LogLevel.Error;
+      case "info" :
+        return LogLevel.Info;
+      case "silent" :
+        return LogLevel.None;
+      case "warn" :
+        return LogLevel.Warning;
+    }
+  }
+  let match$1 = _defaultMin.contents;
+  switch (match$1) {
+    case "Debug" :
+      return LogLevel.Debug;
+    case "Info" :
+      return LogLevel.Info;
+    case "Warn" :
+      return LogLevel.Warning;
+    case "Error" :
+      return LogLevel.Error;
+  }
+}
+
+function ordinalToLevel(ordinal) {
+  if (ordinal >= 40000) {
+    return "Error";
+  } else if (ordinal >= 30000) {
+    return "Warn";
+  } else if (ordinal >= 20000) {
+    return "Info";
+  } else {
+    return "Debug";
+  }
+}
+
+function install() {
+  Logger.defaultLogger.log = opts => {
+    let msg = _messageToString(opts.message);
+    let level = ordinalToLevel(opts.logLevel.ordinal);
+    let comp = {
+      contents: undefined
+    };
+    let plugin = {
+      contents: undefined
+    };
+    let detail = {
+      contents: undefined
+    };
+    let extra = {};
+    HashMap.toEntries(opts.annotations).forEach(param => {
+      let v = param[1];
+      let k = param[0];
+      switch (k) {
+        case "comp" :
+          comp.contents = Stdlib_JSON.Decode.string(v);
+          return;
+        case "detail" :
+          let s = Stdlib_JSON.Decode.string(v);
+          let tmp;
+          if (s !== undefined) {
+            try {
+              tmp = JSON.parse(s);
+            } catch (exn) {
+              tmp = s;
+            }
+          } else {
+            tmp = v;
+          }
+          detail.contents = tmp;
+          return;
+        case "plugin" :
+          plugin.contents = Stdlib_JSON.Decode.string(v);
+          return;
+        default:
+          let s$1 = Stdlib_JSON.Decode.string(v);
+          if (s$1 !== undefined) {
+            extra[k] = s$1;
+          } else {
+            extra[k] = JSON.stringify(v);
+          }
+          return;
+      }
+    });
+    let annotations = Object.entries(extra).length === 0 ? undefined : extra;
+    Logger$ReventlessCore.emit(level, comp.contents, plugin.contents, detail.contents, annotations, msg);
+  };
+}
+
+install();
+
+function _annotate(eff, comp, detail) {
+  let eff$1 = comp !== undefined ? Effect.annotateLogs(eff, "comp", comp) : eff;
+  if (detail !== undefined) {
+    return Effect.annotateLogs(eff$1, "detail", JSON.stringify(detail));
+  } else {
+    return eff$1;
+  }
+}
+
+function logInfo(comp, detail, msg) {
+  return Logger.withMinimumLogLevel(_annotate(Effect.logInfo(msg), comp, detail), _effectMin());
+}
+
+function logWarn(comp, detail, msg) {
+  return Logger.withMinimumLogLevel(_annotate(Effect.logWarning(msg), comp, detail), _effectMin());
+}
+
+function logError(comp, detail, msg) {
+  return Logger.withMinimumLogLevel(_annotate(Effect.logError(msg), comp, detail), _effectMin());
+}
+
+function logDebug(comp, detail, msg) {
+  return Logger.withMinimumLogLevel(_annotate(Effect.logDebug(msg), comp, detail), _effectMin());
+}
+
+export {
+  _messageToString,
+  _defaultMin,
+  setDefaultMinLevel,
+  _effectMin,
+  ordinalToLevel,
+  install,
+  _annotate,
+  logInfo,
+  logWarn,
+  logError,
+  logDebug,
+}
+/*  Not a pure module */

package/src/util/FTP.res

@@ -0,0 +1,69 @@
+/** SSH2 (FTPS) bindings with added helper function to parseUrl */
+include SSH2
+
+/** parses the given url into a tuple of two strings: (host, port, path)
+  (ftp://[user[:password]@])
+  actually respects: host[:port]/url-path
+ */
+let parseUrl: string => (
+  /* host */ string,
+  /* port */ option<int>,
+  /* url-path */ string,
+) = url => {
+  let colonI = url->String.indexOf(":")
+  let slashI = url->String.indexOf("/")
+  switch (colonI > -1, slashI > -1) {
+  | (true, true) =>
+    let fst = colonI < slashI ? colonI : slashI
+    let port =
+      colonI < slashI
+        ? url->String.slice(~start=colonI + 1, ~end=slashI)
+        : url->String.slice(~start=colonI + 1)
+    let path =
+      colonI < slashI
+        ? url->String.slice(~start=slashI + 1)
+        : url->String.slice(~start=slashI + 1, ~end=colonI)
+    (url->String.slice(~start=0, ~end=fst), port->Int.fromString, path)
+  | (false, true) => (
+      url->String.slice(~start=0, ~end=slashI),
+      None,
+      url->String.slice(~start=slashI + 1),
+    )
+  | (true, false) => (
+      url->String.slice(~start=0, ~end=colonI),
+      url->String.slice(~start=colonI + 1)->Int.fromString,
+      "",
+    )
+  | (false, false) => (url, None, "")
+  }
+}
+
+exception CouldNotEstablishSftpConnection(error)
+
+let make: Client.t => promise<t> = client => {
+  let (promise, resolve, reject) = Util.Promise.make()
+  client
+  ->make((readdirError, entities) =>
+    switch readdirError {
+    | None => resolve(entities)
+    | Some(err) => reject(CouldNotEstablishSftpConnection(err->toSftpError))
+    }
+  )
+  ->ignore // ignore bool return value, which states to listen for continue event before sending more data
+  promise
+}
+
+exception CouldNotReadDirectory(string, error)
+
+let readdir: (t, string) => promise<array<entity>> = (client, dirName) => {
+  let (promise, resolve, reject) = Util.Promise.make()
+  client
+  ->readdir(~dirName, (readdirError, entities) =>
+    switch readdirError {
+    | None => resolve(entities)
+    | Some(err) => reject(CouldNotReadDirectory(dirName, err))
+    }
+  )
+  ->ignore // ignore bool return value, which states to listen for continue event before sending more data
+  promise
+}

package/src/util/FTP.res.mjs

@@ -0,0 +1,101 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as SSH2 from "@reventlessdev/rescript-ssh2/src/SSH2.res.mjs";
+import * as Stdlib_Int from "@rescript/runtime/lib/es6/Stdlib_Int.js";
+import * as Primitive_option from "@rescript/runtime/lib/es6/Primitive_option.js";
+import * as Primitive_exceptions from "@rescript/runtime/lib/es6/Primitive_exceptions.js";
+import * as Util_Promise$ReventlessCore from "./Util_Promise.res.mjs";
+
+function parseUrl(url) {
+  let colonI = url.indexOf(":");
+  let slashI = url.indexOf("/");
+  let match = colonI > -1;
+  let match$1 = slashI > -1;
+  if (!match) {
+    if (match$1) {
+      return [
+        url.slice(0, slashI),
+        undefined,
+        url.slice(slashI + 1 | 0)
+      ];
+    } else {
+      return [
+        url,
+        undefined,
+        ""
+      ];
+    }
+  }
+  if (!match$1) {
+    return [
+      url.slice(0, colonI),
+      Stdlib_Int.fromString(url.slice(colonI + 1 | 0), undefined),
+      ""
+    ];
+  }
+  let fst = colonI < slashI ? colonI : slashI;
+  let port = colonI < slashI ? url.slice(colonI + 1 | 0, slashI) : url.slice(colonI + 1 | 0);
+  let path = colonI < slashI ? url.slice(slashI + 1 | 0) : url.slice(slashI + 1 | 0, colonI);
+  return [
+    url.slice(0, fst),
+    Stdlib_Int.fromString(port, undefined),
+    path
+  ];
+}
+
+let CouldNotEstablishSftpConnection = /* @__PURE__ */Primitive_exceptions.create("FTP-ReventlessCore.CouldNotEstablishSftpConnection");
+
+function make(client) {
+  let match = Util_Promise$ReventlessCore.make();
+  let reject = match[2];
+  let resolve = match[1];
+  client.sftp((readdirError, entities) => {
+    if (readdirError !== undefined) {
+      return reject({
+        RE_EXN_ID: CouldNotEstablishSftpConnection,
+        _1: Primitive_option.valFromOption(readdirError)
+      });
+    } else {
+      return resolve(entities);
+    }
+  });
+  return match[0];
+}
+
+let CouldNotReadDirectory = /* @__PURE__ */Primitive_exceptions.create("FTP-ReventlessCore.CouldNotReadDirectory");
+
+function readdir(client, dirName) {
+  let match = Util_Promise$ReventlessCore.make();
+  let reject = match[2];
+  let resolve = match[1];
+  client.readdir(dirName, (readdirError, entities) => {
+    if (readdirError !== undefined) {
+      return reject({
+        RE_EXN_ID: CouldNotReadDirectory,
+        _1: dirName,
+        _2: Primitive_option.valFromOption(readdirError)
+      });
+    } else {
+      return resolve(entities);
+    }
+  });
+  return match[0];
+}
+
+let Client = SSH2.Client;
+
+let ReadStreamOptions = SSH2.ReadStreamOptions;
+
+let extendedError = SSH2.extendedError;
+
+export {
+  Client,
+  ReadStreamOptions,
+  extendedError,
+  parseUrl,
+  CouldNotEstablishSftpConnection,
+  make,
+  CouldNotReadDirectory,
+  readdir,
+}
+/* Util_Promise-ReventlessCore Not a pure module */

package/src/util/FTPHandler.res

@@ -0,0 +1,142 @@
+// open FTP
+type password = string
+type privateKey = string
+type passphrase = option<string>
+
+type secret = Password(password) | Key(privateKey, passphrase)
+
+type connectionParams = {
+  host: string,
+  port: option<int>,
+  path: string,
+  userName: string,
+  secret: secret,
+  readyTimeout: option<int>,
+  retryCount: int,
+  retryInterval: int,
+}
+type getFile = (
+  ~remotePath: string,
+  ~localPath: string,
+  ~options: SSH2.fastOptions=?,
+  ~callback: JsExn.t => unit,
+) => promise<unit>
+type failFn = JsExn.t => unit
+type endFtpFn = unit => unit
+
+type downloadAction = (
+  ~connectionParams: connectionParams,
+  ~entities: array<FTP.entity>,
+  ~sftp: FTP.t,
+  ~fail: failFn,
+  ~endFtp: endFtpFn,
+) => promise<bool>
+
+type ftpAction =
+  | Download(downloadAction)
+  | Upload(NodeStreams.Readable.t, /* filename on ftp */ string)
+
+let ftp = (~connectionParams: connectionParams, ~ftpAction: ftpAction) => {
+  let {host, port, userName, secret, path, readyTimeout} = connectionParams
+  let (promise, resolve, _reject) = Util.Promise.make()
+  let result: ref<result<bool, string>> = ref(Error("Stream ended before action handling!"))
+  let client = FTP.Client.make()
+
+  client
+  ->FTP.Client.onEnd(() => {
+    EffectLogger.logInfo(~comp=__MODULE__, "Client.onEnd")->Effect.runSync
+    resolve(result.contents)
+  })
+  ->FTP.Client.onError(err => {
+    resolve(Error(err->JsExn.message->Option.getOr("Error contains no message.")))
+    // client->FTP.Client.end_
+  })
+  ->FTP.Client.onTimeout(() =>
+    client
+    ->FTP.Client.error(
+      FTP.makeError("SSH-Client Error: Connection timed out")->Message.log("Client.onTimeout"),
+    )
+    ->ignore
+  )
+  ->FTP.Client.onReady(client => {
+    let _ = Util.Promise.onEndHandler(
+      async () =>
+        switch await client->FTP.make {
+        | sftp =>
+          let fail: failFn = err => sftp->FTP.error(err->FTP.toSftpError)->ignore
+          let endFtp: endFtpFn = () => client->FTP.Client.end_
+
+          sftp
+          ->FTP.onEnd(() => {
+            EffectLogger.logInfo(~comp=__MODULE__, "end sftp stream")->Effect.runSync
+            // client->FTP.Client.end_
+          })
+          ->FTP.onError(err => {
+            EffectLogger.logError(
+              ~comp=__MODULE__,
+              `Error: ${err->JSON.stringifyAny->Option.getOr("unknown")}`,
+            )->Effect.runSync
+            client->FTP.Client.error(err->FTP.toJsError)->ignore
+            endFtp()
+          })
+          ->ignore
+
+          switch ftpAction {
+          | Download(downloadAction) =>
+            switch await sftp->FTP.readdir(path) {
+            | entities =>
+              result :=
+                (await downloadAction(~connectionParams, ~entities, ~sftp, ~fail, ~endFtp))->Ok
+            | exception JsExn(e) => result := e->Util.Error.message->Error
+            }
+          | Upload(readableStream, filename) =>
+            let ws =
+              (path ++ ("/" ++ filename))
+              ->Message.log("FTPHandler: path for write stream")
+              ->FTP.createWriteStream(sftp, ~path=_)
+              ->NodeStreams.Writable.onFinish(() => {
+                result := Ok(true)
+                EffectLogger.logInfo(~comp=__MODULE__, "writable ended")->Effect.runSync
+              })
+              ->NodeStreams.Writable.onClose(() => {
+                result := Ok(true) // Workaround: since Node 18 there is no call to onFinish() anymore
+                EffectLogger.logInfo(~comp=__MODULE__, "writable closed")->Effect.runSync
+                endFtp()
+              })
+              ->NodeStreams.Writable.onError(err => {
+                EffectLogger.logError(
+                  ~comp=__MODULE__,
+                  `Error in Write Stream: ${err
+                    ->JsExn.message
+                    ->Option.getOr("unknown")}`,
+                )->Effect.runSync
+                FTP.makeError("FTPHandler: Error in Write Stream")->fail
+              })
+            await readableStream->NodeStreams.pipeline0(ws)
+          }
+        | exception FTP.CouldNotEstablishSftpConnection(err) =>
+          client
+          ->FTP.Client.error(
+            err->Message.log("Couldn't establish SFTP connection:")->SSH2.toJsError,
+          )
+          ->ignore
+        },
+      _ => (),
+    )
+  })
+  ->FTP.Client.connect(
+    switch secret {
+    | Password(password) => {SSH2.Client.host, ?port, username: userName, password, ?readyTimeout}
+    | Key(privateKey, passphrase) => {
+        host,
+        ?port,
+        username: userName,
+        privateKey,
+        ?passphrase,
+        ?readyTimeout,
+      }
+    },
+  )
+
+  promise
+}