migrate to cloudflare workers

Author: y2k

.dev.vars

@@ -0,0 +1,2 @@
+S_TOKEN = "2DE97130-0F07-4BB8-9A55-B45C75A98EC1"
+TG_TOKEN = "300777612:AAGeXAgHXehSNPj9G9GD8FjzOnOX5zuc4qM"

.gitignore

@@ -1,12 +1,7 @@
-/target
-/classes
-/checkouts
-profiles.clj
-pom.xml
-pom.xml.asc
-*.jar
-*.class
-/.lein-*
-/.nrepl-port
-.hgignore
-.hg/
+*.js
+*.out
+*.cmi
+*.cmo
+_build/
+.DS_Store
+

.ocamlformat

@@ -0,0 +1 @@
+profile = ocamlformat

.travis.yml

@@ -0,0 +1,6 @@
+(executable
+ (name main)
+ (libraries core js_of_ocaml yojson)
+ (modes js)
+ (preprocess
+  (pps js_of_ocaml-ppx)))

Dockerfile

@@ -0,0 +1,51 @@
+open Js_of_ocaml
+
+module Utils = struct
+  module U = Js_of_ocaml.Js.Unsafe
+  module StringMap = Map.Make (String)
+
+  let entries_to_string_map entries =
+    U.global ##. Array##from entries
+    |> Js.to_array
+    |> Array.fold_left
+         (fun a e ->
+           let k = e##at 0 in
+           let v = e##at 1 in
+           if Js.typeof k = Js.string "string" then
+             StringMap.add (Js.to_string k) (Js.to_string v) a
+           else a )
+         StringMap.empty
+
+  let make_response (body : string) =
+    U.new_obj U.global ##. Response [|U.inject body|]
+
+  let post (url : string) (body : string) =
+    U.global##fetch (U.inject url)
+      (U.obj
+         [| ("method", U.inject "post")
+          ; ("body", U.inject body)
+          ; ("headers", U.obj [|("content-type", U.inject "application/json")|])
+         |] )
+
+  let get_entries obj = U.global ##. Object##entries obj
+
+  let log_error e = U.global##.console##error e
+end
+
+(* application/json *)
+let fetch req env =
+  req##text##then_ (fun body ->
+      match
+        Core.handle
+          { env= Utils.entries_to_string_map (Utils.get_entries env)
+          ; headers= Utils.entries_to_string_map req##.headers
+          ; body= Js.to_string body }
+      with
+      | Some cmd ->
+          let promise = Utils.post cmd.url cmd.body in
+          (promise##catch (fun e -> Utils.log_error e))##then_ (fun _ ->
+              Utils.make_response "" )
+      | None ->
+          Utils.make_response "" )
+
+let () = Js.export "fetch" fetch

app/dune

@@ -0,0 +1 @@
+(lang dune 3.2)

app/main.ml

@@ -0,0 +1,53 @@
+module J = Yojson.Safe
+module U = Yojson.Safe.Util
+
+module StringMap = struct
+  include Map.Make (String)
+
+  let pp _ ppf m =
+    Format.fprintf ppf "{" ;
+    iter (fun k v -> Format.fprintf ppf "\"%s\": \"%s\"; " k v) m ;
+    Format.fprintf ppf "}"
+end
+
+type http_msg_props =
+  {env: string StringMap.t; headers: string StringMap.t; body: string}
+[@@deriving show]
+
+type http_cmd_props = {url: string; body: string} [@@deriving show]
+
+let handle' ({body; env; _} : http_msg_props) =
+  match J.from_string body |> U.member "message" with
+  | `Null ->
+      None
+  | message ->
+      if U.keys message |> List.mem "new_chat_member" then
+        let url =
+          Printf.sprintf "https://api.telegram.org/bot%s/deleteMessage"
+            (StringMap.find "TG_TOKEN" env)
+        in
+        Some
+          { url
+          ; body=
+              `Assoc
+                [ ("chat_id", message |> U.member "chat" |> U.member "id")
+                ; ("message_id", message |> U.member "message_id") ]
+              |> Yojson.Safe.to_string }
+      else None
+
+let handle'' ({env; headers; _} as msg) =
+  let hst = StringMap.find_opt "x-telegram-bot-api-secret-token" headers in
+  let st = StringMap.find_opt "S_TOKEN" env in
+  match (st, hst) with
+  | Some st, Some hst when st = hst ->
+      handle' msg
+  | _ ->
+      None
+
+let handle (msg : http_msg_props) : http_cmd_props option =
+  print_endline @@ "LOG:MSG: " ^ show_http_msg_props msg ^ "\n" ;
+  let result = handle'' msg in
+  Option.iter
+    (fun x -> print_endline @@ "LOG:CMD: " ^ show_http_cmd_props x ^ "\n")
+    result ;
+  result

dune-project

@@ -0,0 +1,5 @@
+(library
+ (name core)
+ (libraries js_of_ocaml yojson)
+ (preprocess
+  (pps ppx_deriving.show js_of_ocaml-ppx)))

project.clj

@@ -0,0 +1,5 @@
+(tests
+ (names test)
+ (libraries core alcotest js_of_ocaml yojson)
+ (preprocess
+  (pps js_of_ocaml-ppx)))

src/core.ml

@@ -0,0 +1,65 @@
+open Alcotest
+open Core
+module M = Core.StringMap
+
+let make_tests ?headers rules =
+  let make_msg body =
+    let open Core in
+    { env=
+        StringMap.singleton "S_TOKEN" "token" |> StringMap.add "TG_TOKEN" "123"
+    ; headers=
+        Option.value headers
+          ~default:
+            (StringMap.singleton "x-telegram-bot-api-secret-token" "token")
+    ; body }
+  in
+  List.map
+    (fun (expected, input) ->
+      let expected =
+        expected
+        |> Option.map (fun x ->
+               {url= "https://api.telegram.org/bot123/deleteMessage"; body= x} )
+      in
+      test_case "test" `Quick (fun _ ->
+          let cmd_fmt =
+            Fmt.record
+              [ Fmt.field "url" (fun x -> x.url) Fmt.string
+              ; Fmt.field "body" (fun x -> x.body) Fmt.string ]
+          in
+          check
+            (option (of_pp cmd_fmt))
+            "" expected
+            (Core.handle (make_msg input)) ) )
+    rules
+
+let samples =
+  [ (None, {|{}|})
+  ; ( None
+    , {|{"update_id":569999999,"message":{"message_id":4699,"from":{"id":249999999,"is_bot":false,"first_name":"JohnDoe","username":"johndoe","language_code":"en"},"chat":{"id":249999999,"first_name":"JohnDoe","username":"johndoe","type":"private"},"date":1699999999,"text":"hello"}}|}
+    )
+  ; ( Some {|{"chat_id":-1001000000000,"message_id":12000}|}
+    , {|{"update_id":560000000,"message":{"message_id":12000,"from":{"id":240000000,"is_bot":false,"first_name":"Alex","username":"alex000","language_code":"en"},"chat":{"id":-1001000000000,"title":"GroupName","type":"supergroup"},"date":1600000000,"new_chat_participant":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_member":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_members":[{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"}]}}|}
+    ) ]
+  |> make_tests
+
+let auth_base =
+  [ (None, {|{}|})
+  ; ( None
+    , {|{"update_id":569999999,"message":{"message_id":4699,"from":{"id":249999999,"is_bot":false,"first_name":"JohnDoe","username":"johndoe","language_code":"en"},"chat":{"id":249999999,"first_name":"JohnDoe","username":"johndoe","type":"private"},"date":1699999999,"text":"hello"}}|}
+    )
+  ; ( None
+    , {|{"update_id":560000000,"message":{"message_id":12000,"from":{"id":240000000,"is_bot":false,"first_name":"Alex","username":"alex000","language_code":"en"},"chat":{"id":-1001000000000,"title":"GroupName","type":"supergroup"},"date":1600000000,"new_chat_participant":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_member":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_members":[{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"}]}}|}
+    )
+  ; ( None
+    , {|{"update_id":560000000,"message":{"message_id":12000,"from":{"id":240000000,"is_bot":false,"first_name":"Alex","username":"alex000","language_code":"en"},"chat":{"id":-1001000000000,"title":"GroupName","type":"supergroup"},"date":1600000000,"new_chat_participant":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_member":{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"},"new_chat_members":[{"id":1300000000,"is_bot":true,"first_name":"Docker","username":"docker_bot"}]}}|}
+    ) ]
+
+let auth = auth_base |> make_tests ~headers:M.empty
+
+let auth2 =
+  auth_base
+  |> make_tests
+       ~headers:(M.singleton "x-telegram-bot-api-secret-token" "token2")
+
+let () =
+  run "tests" [("message parse", samples); ("auth", auth); ("auth2", auth2)]

src/delete_message_bot/core.clj

@@ -0,0 +1,17 @@
+name = "delete-messages-bot"
+type = "javascript"
+route = ''
+zone_id = ''
+usage_model = 'bundled'
+compatibility_flags = []
+workers_dev = true
+compatibility_date = "2022-12-27"
+node_compat = true
+
+[build]
+watch_dir = "app"
+command = "dune build --profile=release"
+upload.dir = "_build/default/app"
+upload.main = "main.bc.js"
+upload.format = "modules"
+upload.rules = [{ type = "ESModule", globs = ["**/*.js"] }]