Add IPFS machine backend

* Add a `MachineBackend` implementation based on IPFS
* Extend `test/machine-backends.rad` to test IPFS backend against real
  IPFS daemon
* Add commands `rad-ipfs`, `rad-ipfs-daemon`, and
`rad-ipfs-machine-create`

Follow-up

* Replace `Wreq` with `servant-client` and `ipfs-api` from
  https://github.com/oscoin/ipfs/tree/master/ipfs-api

bin/rad-ipfs

@@ -0,0 +1,6 @@
+#!/usr/bin/env bash
+#
+# Wrapper for the 'ipfs' command that talks to the IPFS daemon instance
+# for the Radicle network.
+
+IPFS_PATH=${IPFS_PATH:-"$HOME/.local/share/radicle/ipfs"} ipfs --api "/ip4/127.0.0.1/tcp/9301" "$@"

bin/rad-ipfs-daemon

@@ -0,0 +1,27 @@
+#!/usr/bin/env  bash
+#
+# Run the IPFS daemon with configuration for the Radicle network.
+
+set -euo pipefail
+
+export IPFS_PATH=${IPFS_PATH:-"$HOME/.local/share/radicle/ipfs"}
+if [[ ! -d "$IPFS_PATH" ]]; then
+  mkdir -p "$IPFS_PATH"
+  ipfs init
+  cat >"$IPFS_PATH/swarm.key" <<DOC
+/key/swarm/psk/1.0.0/
+/base16/
+420076a5ac043665bf6b78ebff1bbf17b3d5b29919e38792ff3e430cf889cef8
+DOC
+  ipfs bootstrap rm all
+  ipfs bootstrap add \
+      "/ip4/35.187.83.104/tcp/4000/ipfs/QmQqaBdD5g9o4L6KEtjL1RJbTSbb9gxUWgSF7FBxBqwvjr" \
+      "/ip4/35.187.83.104/tcp/4001/ipfs/QmVdMvYQL6WuC4uaKV39SpQfNMmEZptzf6hoXenkcHKozU"
+  echo '{"radicle": true}' | ipfs dag put --pin
+fi
+
+ipfs config Addresses.API "/ip4/127.0.0.1/tcp/9301"
+ipfs config Addresses.Gateway "/ip4/127.0.0.1/tcp/9302"
+ipfs config --json Addresses.Swarm '["/ip4/0.0.0.0/tcp/9303", "/ip6/::/tcp/9303"]'
+
+ipfs daemon "$@"

bin/rad-ipfs-machine-create

@@ -0,0 +1,17 @@
+#!/usr/bin/env bash
+#
+# rad-ipfs-machine-create [local-name]
+#
+# Creates a new Radicle State Machine on IPFS and prints the machine
+# ID.
+#
+# If `local-name` is provided it uses this value to name the machines
+# IPNS key on the local IPFS daemon. By default a UUID is used.
+
+set -euo pipefail
+
+ipns_name=${1:-$(uuidgen)}
+empty_machine="zdpuAyyGtvC37aeZid2zh7LAGKCbFTn9MzdqoPpbNQm3BCwWT"
+ipns_id=$(bin/rad-ipfs key gen "$ipns_name" --type ed25519)
+bin/rad-ipfs name publish --key "$ipns_id" "$empty_machine" >/dev/null
+echo "$ipns_id"

cloudbuild.yaml

@@ -121,23 +121,33 @@ steps:
         docker push "$image_name:$tag"
       fi
 
-  - id: "Start and expose radicle-server"
+  - id: "Start radicle-server and IPFS daemon"
     name: 'docker/compose:1.23.2'
     waitFor:
     - "Build radicle-server image"
     entrypoint: sh
     args:
     - "-c"
     - |
+      set -euxo pipefail
       cd images/radicle-server
       docker-compose up -d postgres
       sleep 5 # Wait for the DB to be ready
       docker-compose up -d
+      docker run \
+        --name ipfs-test-network \
+        --detach \
+        --publish 9301:5001 \
+        --network cloudbuild \
+        eu.gcr.io/opensourcecoin/ipfs-test-network
       docker network connect cloudbuild radicle-server_radicle-server_1 --alias radicle-server
+      sleep 3 # Wait for service to be booted
+      # Add the empty entry to the IPFS test network. Radicle requires it
+      echo '{"radicle": true}' | docker exec -i ipfs-test-network ipfs dag put --pin
 
-  - id: "radicle-server integration test"
+  - id: "Integration tests"
     waitFor:
-    - "Start and expose radicle-server"
+    - "Start radicle-server and IPFS daemon"
     name: 'haskell:8.6.3'
     env: ['STACK_ROOT=/workspace/.stack']
     entrypoint: 'bash'
@@ -146,7 +156,7 @@ steps:
     - |
       set -euxo pipefail
       stack exec -- radicle - <<<'(load! "rad/examples/counter.rad") (counter/run-test)'
-      stack exec -- radicle test/server.rad radicle-server
+      IPFS_API_URL=http://ipfs-test-network:5001 stack exec -- radicle test/machine-backends.rad radicle-server
 
   - id: "Save cache"
     waitFor:

exe/RadicleExe.hs

@@ -10,6 +10,7 @@ import           System.Directory (doesFileExist)
 import           Radicle
 import           Radicle.Internal.Effects (exitCode)
 import           Radicle.Internal.MachineBackend.EvalServer
+import           Radicle.Internal.MachineBackend.Ipfs (ipfsPrimFns)
 import           Radicle.Internal.Pretty (putPrettyAnsi)
 
 main :: IO ()
@@ -88,5 +89,5 @@ opts = Opts
 
 createBindings :: (MonadIO m, ReplM m) => [Text] -> IO (Bindings (PrimFns m))
 createBindings scriptArgs' = do
-    machineBackendPrimFns <- createEvalServerBackendPrimFns
-    pure $ addPrimFns (replPrimFns scriptArgs' <> machineBackendPrimFns) pureEnv
+    evalServerPackendPrimFns <- createEvalServerBackendPrimFns
+    pure $ addPrimFns (replPrimFns scriptArgs' <> evalServerPackendPrimFns <> ipfsPrimFns) pureEnv

package.yaml

@@ -30,21 +30,25 @@ library:
   - generics-eot
   - haskeline
   - http-client
+  - ipld-cid
   - megaparsec
+  - microlens
   - mtl
   - pointed
   - prettyprinter
   - prettyprinter-ansi-terminal
   - process
-  - servant
-  - servant-client
+  - safe-exceptions
   - scientific
   - serialise
+  - servant
+  - servant-client
   - template-haskell
   - text
   - time
   - unordered-containers
   - uuid
+  - wreq
 
 tests:
   spec:

rad/prelude/chain.rad

@@ -10,29 +10,43 @@
 (import prelude/basic :unqualified)
 (import prelude/io :unqualified)
 (import prelude/patterns :unqualified)
+(import prelude/strings :unqualified)
+(import prelude/seq :unqualified)
+
+(def base-send!
+  "See documentation of `send!`"
+  (fn [id inputs]
+    (match id
+      (/prefix "ipfs://" 'rest) (machine/ipfs/update! rest inputs)
+      (/prefix "http://" _) (machine/eval-server/update! id inputs)
+      _ (throw 'unknown-machine-type (string-append "Cannot handle machine ID " id)))
+  ))
 
-;; Chains: Functions for dealing with chains.
-
-;; A chain is conceptually:
-;;   - A known starting state (i.e. environment, and the assumption that `eval
-;;     == base-eval')
-;;   - A sequence of inputs.
-
+(def primitive-stub-ref/send! (ref base-send!))
 (def send!
   "Update a machine with the vector of `inputs` to evaluate. Returns an
   index that identifies that last input. This index can be passed to
   `receive!`"
-  (fn [machine-id inputs]
-    (machine/eval-server/update! machine-id inputs)))
+  (fn [machine-id inputs] ((read-ref primitive-stub-ref/send!) machine-id inputs)))
+
+(def base-receive!
+  "See documentation of `receive!`"
+  (fn [id index]
+    (match id
+      (/prefix "ipfs://" 'rest) (machine/ipfs/get-log! rest index)
+      (/prefix "http://" _) (machine/eval-server/get-log! id index)
+      _ (throw 'unknown-machine-type (string-append "Cannot handle machine ID " id)))
+  ))
 
+(def primitive-stub-ref/receive! (ref base-receive!))
 (def receive!
   "Get inputs from a machine. Returns a `[index inputs]` pair where
   `inputs` is a vector of expressions and `index` is the index of the
   last input in `inputs`. The `index` argument is either `:nothing` in
   which case all inputs are fetched or `[:just i]` in which case all
   inputs following after the index `i` are fetched."
-  (fn [machine-id index]
-    (machine/eval-server/get-log! machine-id index)))
+  (fn [machine-id index] ((read-ref primitive-stub-ref/receive!) machine-id index)))
+
 
 (def env-var
   "A lens for variables in envs."

rad/prelude/test.rad

@@ -126,7 +126,7 @@
             #t
             )
           [:error 'msg] (do
-            (put-str! (string-append "not ok " (show index) " - " name))
+            (put-str! (string-append "not ok " (show index) " - " name "\n" (show msg)))
             #f
             )
           )))))

rad/tests/stub-primitives.rad

@@ -9,17 +9,6 @@
 ;;
 ;; See `prelude/chain/install-remote-chain-fake` for how to use primitve stubs.
 
-;; send!
-(def primitive-stub-ref/send! (ref machine/eval-server/update!))
-(def machine/eval-server/update!
-  (fn [a b] ((read-ref primitive-stub-ref/send!) a b)))
-
-;; receive!
-(def primitive-stub-ref/receive! (ref machine/eval-server/get-log!))
-(def machine/eval-server/get-log!
-  (fn [a b] ((read-ref primitive-stub-ref/receive!) a b)))
-
-
 ;; now!
 (def primitive-stub-ref/now! (ref now!))
 (def now!

snapshot.yaml

@@ -9,6 +9,19 @@ name: radicle-deps-13.2
 resolver: lts-13.2
 
 packages:
+- base58-bytestring-0.1.0@sha256:a1da72ee89d5450bac1c792d9fcbe95ed7154ab7246f2172b57bd4fd9b5eab79
 - cborg-0.2.1.0
-- serialise-0.2.1.0
 - github-0.20
+- sandi-0.4.3@sha256:2ada9c759424f243095ab28b55687cdec4e9d16bac3589f9d200280207c50216
+- serialise-0.2.1.0
+- git: https://github.com/oscoin/ipfs.git
+  commit: 19b25fa4d0003b5c2027c8cc1b8a3c36ac2f9f60
+  subdirs:
+  - ipld-cid
+  - binary-varint
+  - multibase
+  - multihash-cryptonite
+
+flags:
+  sandi:
+    with-conduit: false