Merge pull request #3 from xvw/move-to-nightmare

Move to nightmare

.github/workflows/pfioooouuuu.yml

@@ -19,14 +19,19 @@ jobs:
       - name: YOCaml
         uses: ocaml/setup-ocaml@v2
         with:
-          ocaml-compiler: 5.0.0
+          ocaml-compiler: 5.1.0
           opam-depext-flags: --with-test
 
       - run: (cd hell; npm install; npm run build)
       - run: opam install . --deps-only --with-doc --with-test
+      - run: opam install js_of_ocaml-compiler js_of_ocaml-ppx js_of_ocaml-lwt
+      - run: opam install nightmare nightmare-dream nightmare-tyxml
+      - run: opam install nightmare_js nightmare_js-vdom
+      - run: opam install nightmare_js nightmare_js-vdom
+      - run: yourbones yourbones-ppx yourbones_js yourbones_js-beacon
       - run: opam install yocaml
       - run: opam install yocaml_unix yocaml_yaml yocaml_jingoo yocaml_syndication
-      - run: opam exec -- dune build
+      - run: opam exec -- dune build -- --profile=release
       - run: opam exec -- dune exec bin/capsule_cli/capsule.exe -- build
 
       - name: Deploy

Makefile

@@ -21,13 +21,15 @@ utop:
 hell:
 	(cd hell; npm install; npm run build)
 
-dev-deps:
-	opam install dune merlin ocamlformat ocp-indent utop -y
 
 local-deps:
-	opam install . --deps-only --with-doc --with-test -y
+	opam install . --deps-only --with-doc --with-test --with-dev-setup -y
 
 pinned-deps: local-deps
+	opam install js_of_ocaml-compiler js_of_ocaml-ppx js_of_ocaml-lwt
 	opam install yocaml yocaml_unix yocaml_yaml yocaml_jingoo yocaml_syndication  -y
+	opam install nightmare nightmare-dream nightmare-tyxml -y
+	opam install nightmare_js nightmare_js-vdom -y
+	opam install yourbones yourbones-ppx yourbones_js yourbones_js-beacon -y
 
-deps: pinned-deps dev-deps
+deps: pinned-deps

bin/capsule_client/capsule_client.ml

@@ -1,41 +1,12 @@
 open Js_of_ocaml
-module Lwt_js_events = Js_of_ocaml_lwt.Lwt_js_events
+open Nightmare_js
 
-let start f =
-  let open Lwt.Syntax in
-  let* _ = Lwt_js_events.onload () in
-  let+ () = f () in
-  ()
+let () = Suspension.allow ()
 
 let () =
-  let api =
-    object%js (self)
-      val internal =
-        object%js
-          val suspending = Js.array [| Hljs_js.mount |]
-        end
-
-      method suspend f =
-        let _ = self##.internal##.suspending##push f in
-        ()
-
-      val dapps =
-        object%js
-          val transfer = Dapp_transfer.entrypoint
-        end
-
-      method mount =
-        let suspension =
-          self##.internal##.suspending
-          |> Js.to_array
-          |> Array.fold_left
-               (fun continuation task () ->
-                 let open Lwt.Syntax in
-                 let+ () = continuation () in
-                 Js.Unsafe.fun_call task [||])
-               (fun () -> Lwt.return_unit)
-        in
-        start suspension
-    end
-  in
-  Js.export "capsule" api
+  Js.export "capsule_dapps"
+    (object%js
+       method mountTransfer container_id =
+         let id = Js.to_string container_id in
+         Dapp_transfer.mount id
+    end)

bin/capsule_client/dune

@@ -1,16 +1,12 @@
 (executable
  (name capsule_client)
- (js_of_ocaml
-  (flags :standard --opt 3))
  (modes js)
- (libraries
-  lwt
-  js_of_ocaml-lwt
-  vdom
-  preface
-  core_js
-  beacon_js
-  hljs_js
-  dapp_transfer)
  (preprocess
-  (pps js_of_ocaml-ppx)))
+  (pps js_of_ocaml-ppx))
+ (js_of_ocaml
+  (flags :standard))
+ (promote
+  (until-clean)
+  (into "../../hell/_build")
+  (only capsule_client.bc.js))
+ (libraries nightmare_js dapp_transfer))

bin/dapps/transfer/command.ml

@@ -0,0 +1,132 @@
+type 'msg Vdom.Cmd.t +=
+  | Synchronize_wallet of {
+        on_success :
+          account:Beacon.Account_info.t -> balance:Yourbones.Tez.t -> 'msg
+      ; on_failure : error:string -> 'msg
+    }
+  | Streaming_head of {
+        account : Beacon.Account_info.t
+      ; on_success :
+             new_balance:Yourbones.Tez.t
+          -> new_head:Yourbones.Block_header.t
+          -> 'msg
+    }
+  | Desynchronize_wallet of (unit -> 'msg)
+  | Perform_transfer of {
+        target : Yourbones.Address.t
+      ; amount : Yourbones.Tez.t
+      ; on_success :
+             target:Yourbones.Address.t
+          -> amount:Yourbones.Tez.t
+          -> ( Beacon.Transaction_hash_response_output.t
+             , [ `Request_operation_rejection of exn ] )
+             result
+          -> 'msg
+    }
+
+let get_balance address =
+  Yourbones_js.RPC.call ~node_address:Network.node_address
+    Yourbones.RPC.Directory.get_balance Yourbones.Chain_id.main
+    Yourbones.Block_id.head address
+
+let perform_wallet_synchronization dapp_client ctx on_success on_failure () =
+  let open Dapps.Lwt_util in
+  let* account = Beacon.Dapp_client.get_active_account dapp_client in
+  let+ account_with_balance =
+    let*? account =
+      match account with
+      | Some active_account -> Lwt.return_ok active_account
+      | None ->
+          let+? account =
+            Beacon.Dapp_client.request_permissions ~network:Network.network
+              dapp_client
+          in
+          account.account_info
+    in
+    let+? balance = get_balance account.address in
+    (account, balance)
+  in
+  let message =
+    match account_with_balance with
+    | Ok (account, balance) -> on_success ~account ~balance
+    | Error _ ->
+        let error = "Impossible de connecter le wallet" in
+        let () = Nightmare_js.Console.(string error) error in
+        on_failure ~error
+  in
+  Vdom_blit.Cmd.send_msg ctx message
+
+let perform_wallet_desynchronization dapp_client ctx on_success () =
+  let open Dapps.Lwt_util in
+  let+ () = Beacon.Dapp_client.clear_active_account dapp_client in
+  let message = on_success () in
+  Vdom_blit.Cmd.send_msg ctx message
+
+let perform_streaming_head ctx account on_success () =
+  let open Dapps.Lwt_util in
+  let* _ =
+    Yourbones_js.RPC.stream
+      ~on_chunk:(fun new_head ->
+        let () = Nightmare_js.Console.(string log) "New block" in
+        let+? new_balance = get_balance account.Beacon.Account_info.address in
+        let message = on_success ~new_balance ~new_head in
+        Vdom_blit.Cmd.send_msg ctx message)
+      ~node_address:Network.node_address Yourbones.RPC.Directory.monitor_heads
+      Yourbones.Chain_id.main
+  in
+  return ()
+
+let perform_performing_transfer dapp_client ctx target amount on_success () =
+  let open Dapps.Lwt_util in
+  let+ output =
+    Beacon.Dapp_client.request_simple_transaction ~destination:target
+      dapp_client amount
+  in
+  Vdom_blit.Cmd.send_msg ctx (on_success ~target ~amount output)
+
+let register dapp_client =
+  let open Vdom_blit in
+  let handler ctx = function
+    | Synchronize_wallet { on_success; on_failure } ->
+        let () =
+          Lwt.dont_wait
+            (perform_wallet_synchronization dapp_client ctx on_success
+               on_failure)
+            Nightmare_js.Console.error
+        in
+        true
+    | Desynchronize_wallet on_success ->
+        let () =
+          Lwt.dont_wait
+            (perform_wallet_desynchronization dapp_client ctx on_success)
+            Nightmare_js.Console.error
+        in
+        true
+    | Streaming_head { account; on_success } ->
+        let () =
+          Lwt.dont_wait
+            (perform_streaming_head ctx account on_success)
+            Nightmare_js.Console.error
+        in
+        true
+    | Perform_transfer { target; amount; on_success } ->
+        let () =
+          Lwt.dont_wait
+            (perform_performing_transfer dapp_client ctx target amount
+               on_success)
+            Nightmare_js.Console.error
+        in
+        true
+    | _ -> false
+  in
+
+  register @@ cmd Cmd.{ f = handler }
+
+let synchronize_wallet ~on_success ~on_failure =
+  Synchronize_wallet { on_success; on_failure }
+
+let desynchronize_wallet ~on_success = Desynchronize_wallet on_success
+let stream_head ~account ~on_success = Streaming_head { account; on_success }
+
+let perform_transfer ~target ~amount ~on_success =
+  Perform_transfer { target; amount; on_success }

bin/dapps/transfer/command.mli

@@ -0,0 +1,29 @@
+val register : Beacon.Dapp_client.t -> unit
+
+val synchronize_wallet :
+     on_success:
+       (account:Beacon.Account_info.t -> balance:Yourbones.Tez.t -> 'msg)
+  -> on_failure:(error:string -> 'msg)
+  -> 'msg Vdom.Cmd.t
+
+val desynchronize_wallet : on_success:(unit -> 'msg) -> 'msg Vdom.Cmd.t
+
+val stream_head :
+     account:Beacon.Account_info.t
+  -> on_success:
+       (   new_balance:Yourbones.Tez.t
+        -> new_head:Yourbones.Block_header.t
+        -> 'msg)
+  -> 'msg Vdom.Cmd.t
+
+val perform_transfer :
+     target:Yourbones.Address.t
+  -> amount:Yourbones.tez
+  -> on_success:
+       (   target:Yourbones.Address.t
+        -> amount:Yourbones.tez
+        -> ( Beacon.Transaction_hash_response_output.t
+           , [ `Request_operation_rejection of exn ] )
+           result
+        -> 'msg)
+  -> 'msg Vdom.Cmd.t