Merge pull request #7 from mlabs-haskell/dshuiski/v1

Hydra SDK V1

Author: errfrom

.gitignore

@@ -3,6 +3,7 @@
 /example/minimal/output/
 /example/minimal/.psa-stash
 /example/minimal/.spago/
+/example/minimal/.spago2nix/
 /generated-docs/
 /node_modules
 /output/

.prettierrc

@@ -0,0 +1,11 @@
+{
+  "arrowParens": "always",
+  "bracketSpacing": true,
+  "printWidth": 95,
+  "quoteProps": "as-needed",
+  "semi": true,
+  "singleQuote": false,
+  "tabWidth": 2,
+  "trailingComma": "none",
+  "useTabs": false
+}

.purs-repl

@@ -1,4 +1,6 @@
 import Prelude
+import Aeson as A
+import Data.Codec.Argonaut as CA
 import HydraSdk.Extra.AppManager
 import HydraSdk.Lib
 import HydraSdk.NodeApi

Makefile

@@ -1,6 +1,7 @@
-.PHONY: build, format, repl, docs, build-example, run-example, docker-cleanup, gen-keys
+.PHONY: build, test, format, repl, docs, build-example, run-example, docker-cleanup, gen-keys
 
 ps-sources := $(shell fd --no-ignore-parent -epurs)
+js-sources := $(shell fd --no-ignore-parent -ejs)
 nix-sources := $(shell fd --no-ignore-parent -enix --exclude='spago*')
 purs-args := "--stash --censor-lib --censor-codes=ImplicitImport,ImplicitQualifiedImport,ImplicitQualifiedImportReExport,UserDefinedWarning"
 example-docker := example/minimal/docker/cluster/docker-compose.yaml
@@ -15,9 +16,17 @@ requires-nix-shell:
 build: requires-nix-shell
 	spago build --purs-args ${purs-args}
 
+test: requires-nix-shell
+	spago run --main Test.Main
+
 format: requires-nix-shell
-	@purs-tidy format-in-place ${ps-sources}
-	@nixpkgs-fmt ${nix-sources}
+	@echo '1. Formatting PureScript sources:'
+	purs-tidy format-in-place ${ps-sources}
+	@echo -e '\n2. Formatting JavaScript sources:'
+	prettier -w ${js-sources}
+	@echo -e '\n3. Formatting Nix sources:'
+	nixpkgs-fmt ${nix-sources}
+	@echo -e '\n4. Generating table of contents for Markdown files:'
 	doctoc README.md --github --notitle
 
 repl: requires-nix-shell

example/minimal/app/Main.purs

@@ -4,32 +4,36 @@ module HydraSdk.Example.Minimal.Main
 
 import Prelude
 
-import Cardano.AsCbor (encodeCbor)
+import Aeson (stringifyAeson)
+import Cardano.AsCbor (decodeCbor, encodeCbor)
 import Cardano.Types (Language(PlutusV2), Transaction)
+import Cardano.Types.AuxiliaryData (hashAuxiliaryData)
+import Cardano.Types.Transaction (_body, _witnessSet)
+import Cardano.Types.TransactionBody (_auxiliaryDataHash)
+import Cardano.Types.TransactionWitnessSet (_vkeys)
 import Contract.CborBytes (cborBytesToHex)
 import Contract.Log (logError', logInfo', logTrace', logWarn')
 import Contract.Monad (Contract, ContractEnv, stopContractEnv)
 import Contract.ProtocolParameters (getProtocolParameters)
-import Contract.Transaction (submit)
+import Contract.Transaction (signTransaction, submit)
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Reader (ask)
 import Ctl.Internal.Transaction (setScriptDataHash)
-import Data.Argonaut (stringifyWithIndent)
 import Data.Array (length) as Array
 import Data.Codec.Argonaut (encode) as CA
 import Data.Either (Either(Left, Right))
+import Data.Lens ((.~))
 import Data.Log.Level (LogLevel(Info, Error))
 import Data.Map (empty, filterKeys, fromFoldable) as Map
-import Data.Maybe (Maybe(Just, Nothing))
+import Data.Maybe (Maybe(Just, Nothing), maybe)
 import Data.Newtype (unwrap)
 import Data.Posix.Signal (Signal(SIGINT, SIGTERM))
 import Data.Traversable (traverse_)
-import Data.UInt (fromInt) as UInt
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_, runAff_)
 import Effect.Aff.Class (liftAff)
 import Effect.Class (liftEffect)
-import Effect.Exception (error, message)
+import Effect.Exception (error, message, name, stack) as Error
 import Effect.Ref (Ref)
 import Effect.Ref (new, read, write) as Ref
 import HydraSdk.Example.Minimal.App
@@ -46,7 +50,7 @@ import HydraSdk.Example.Minimal.App
 import HydraSdk.Example.Minimal.App (setHeadStatus, setUtxoSnapshot) as App
 import HydraSdk.Example.Minimal.Config (configFromArgv)
 import HydraSdk.Example.Minimal.Contract.L2 (placeArbitraryDatumL2)
-import HydraSdk.Lib (log', reSignTransaction, setAuxDataHash)
+import HydraSdk.Lib (log')
 import HydraSdk.NodeApi
   ( HydraNodeApiWebSocket
   , HydraTxRetryStrategy(RetryTxWithParams, DontRetryTx)
@@ -55,14 +59,7 @@ import HydraSdk.NodeApi
   )
 import HydraSdk.Process (spawnHydraNode)
 import HydraSdk.Types
-  ( HydraHeadStatus
-      ( HeadStatus_Idle
-      , HeadStatus_Initializing
-      , HeadStatus_Open
-      , HeadStatus_Closed
-      , HeadStatus_FanoutPossible
-      , HeadStatus_Final
-      )
+  ( HydraHeadStatus(HeadStatus_Idle, HeadStatus_Closed)
   , HydraNodeApi_InMessage
       ( Greetings
       , HeadIsInitializing
@@ -76,14 +73,11 @@ import HydraSdk.Types
   , HydraSnapshot(HydraSnapshot)
   , hydraSnapshotCodec
   , mkSimpleCommitRequest
-  , printHeadStatus
-  , printHost
   , printHostPort
   , toUtxoMap
   )
 import Node.ChildProcess (ChildProcess, kill)
 import Node.Process (onSignal, onUncaughtException)
-import URI.Port (toInt) as Port
 
 type AppHandle =
   { cleanupHandler :: Effect Unit
@@ -99,7 +93,12 @@ main =
     appHandle <- startDelegateServer appState logger
     liftEffect do
       onUncaughtException \err -> do
-        runAppEff appState logger $ logError' $ "UNCAUGHT EXCEPTION: " <> message err
+        runAppEff appState logger $ logError' $
+          "UNCAUGHT "
+            <> Error.name err
+            <> ": "
+            <> Error.message err
+            <> maybe mempty (append ", STACK: ") (Error.stack err)
         appHandle.cleanupHandler
       onSignal SIGINT appHandle.cleanupHandler
       onSignal SIGTERM appHandle.cleanupHandler
@@ -119,6 +118,7 @@ startDelegateServer state logger = do
             , handlers:
                 { connectHandler: const (pure unit)
                 , messageHandler: \ws -> messageHandler ws
+                , headStatusHandler: Just App.setHeadStatus
                 , errorHandler: \_ws err ->
                     logError' $ "hydra-node API WebSocket error: " <> show err
                 }
@@ -160,34 +160,32 @@ messageHandler ws =
     Left _rawMessage -> pure unit
     Right message ->
       case message of
-        Greetings { headStatus } -> do
-          setHeadStatus headStatus
-          when (headStatus == HeadStatus_Idle) $ liftEffect ws.initHead
+        Greetings { headStatus } ->
+          when (headStatus == HeadStatus_Idle) $
+            liftEffect ws.initHead
         HeadIsInitializing _ -> do
-          setHeadStatus HeadStatus_Initializing
           { commitUtxo, config: { hydraNodeStartupParams: { hydraNodeApiAddress } } } <- ask
           let
             payload = mkSimpleCommitRequest $ Map.fromFoldable [ commitUtxo ]
-            serverConfig =
-              { port: UInt.fromInt $ Port.toInt hydraNodeApiAddress.port
-              , host: printHost hydraNodeApiAddress
-              , secure: false
-              , path: Nothing
-              }
-          liftAff (commitRequest serverConfig payload) >>= case _ of
+            hydraNodeHttpUrl = "http://" <> printHostPort hydraNodeApiAddress
+          liftAff (commitRequest hydraNodeHttpUrl payload) >>= case _ of
             Left httpErr ->
-              throwError $ error $ "Commit request failed with error: "
+              throwError $ Error.error $ "Commit request failed with error: "
                 <> show httpErr
-            Right { cborHex: commitTx } -> do
-              txHash <- runContractInApp $ submit =<< fixCommitTx commitTx
-              logInfo' $ "Submitted Commit transaction: " <> cborBytesToHex
-                (encodeCbor txHash)
+            Right { cborHex } -> do
+              case decodeCbor cborHex of
+                Just commitTx -> do
+                  txHash <- runContractInApp $ submit =<< fixCommitTx commitTx
+                  logInfo' $ "Submitted Commit transaction: " <> cborBytesToHex
+                    (encodeCbor txHash)
+                Nothing ->
+                  throwError $ Error.error "Could not decode CommitTx CBOR"
         HeadIsOpen { headId, utxo } -> do
-          setHeadStatus HeadStatus_Open
-          logInfo' $ "Head ID: " <> cborBytesToHex (encodeCbor headId)
+          logInfo' $ "Head ID: " <> headId
           setUtxoSnapshot $ HydraSnapshot
             { snapshotNumber: zero
             , utxo
+            , confirmedTransactions: mempty
             }
           tx <- runContractInApp $ placeArbitraryDatumL2 $ toUtxoMap utxo
           liftEffect $ ws.submitTxL2 tx
@@ -197,24 +195,31 @@ messageHandler ws =
           when ((unwrap snapshot).snapshotNumber > Array.length peers) do
             logInfo' "All Head participants must have advanced the L2 state. Closing Head..."
             liftEffect ws.closeHead
-        HeadIsClosed { snapshotNumber } -> do
-          -- TODO: set head status implicitly
-          setHeadStatus HeadStatus_Closed
+        HeadIsClosed { snapshotNumber } ->
           contestClosureIfNeeded ws snapshotNumber
         HeadIsContested { snapshotNumber } ->
           contestClosureIfNeeded ws snapshotNumber
-        ReadyToFanout _ -> do
-          setHeadStatus HeadStatus_FanoutPossible
+        ReadyToFanout _ ->
           liftEffect ws.fanout
-        HeadIsFinalized _ -> do
-          setHeadStatus HeadStatus_Final
+        HeadIsFinalized _ ->
           -- TODO: output fanout tx hash
-          throwError $ error "SUCCESS: Head finalized, Funds transfered to L1 - Exiting..."
+          throwError $ Error.error
+            "SUCCESS: Head finalized, Funds transfered to L1 - Exiting..."
         _ -> pure unit
 
 fixCommitTx :: Transaction -> Contract Transaction
 fixCommitTx = reSignTransaction <=< fixScriptIntegrityHash <<< setAuxDataHash
   where
+  -- | Computes and sets the transaction auxiliary data hash.
+  setAuxDataHash :: Transaction -> Transaction
+  setAuxDataHash tx =
+    tx # _body <<< _auxiliaryDataHash .~
+      (hashAuxiliaryData <$> (unwrap tx).auxiliaryData)
+
+  -- | Removes existing vkey witnesses and signs the transaction.
+  reSignTransaction :: Transaction -> Contract Transaction
+  reSignTransaction tx = signTransaction (tx # _witnessSet <<< _vkeys .~ mempty)
+
   fixScriptIntegrityHash :: Transaction -> Contract Transaction
   fixScriptIntegrityHash tx = do
     pparams <- unwrap <$> getProtocolParameters
@@ -235,15 +240,10 @@ contestClosureIfNeeded ws closeSnapshot = do
         <> ". Contesting Head closure..."
     liftEffect ws.challengeSnapshot
 
-setHeadStatus :: HydraHeadStatus -> AppM Unit
-setHeadStatus status = do
-  App.setHeadStatus status
-  logInfo' $ "New Head status: " <> printHeadStatus status
-
 setUtxoSnapshot :: HydraSnapshot -> AppM Unit
 setUtxoSnapshot snapshot = do
   App.setUtxoSnapshot snapshot
-  let snapshotFormatted = stringifyWithIndent 2 $ CA.encode hydraSnapshotCodec snapshot
+  let snapshotFormatted = stringifyAeson $ CA.encode hydraSnapshotCodec snapshot
   logInfo' $ "New confirmed snapshot: " <> snapshotFormatted
 
 cleanupHandler
@@ -264,7 +264,7 @@ cleanupHandler logger { hydraNodeProcess, hydraNodeApiWsRef, contractEnv } = do
     ( case _ of
         Left err ->
           logger Error $ "stopContractEnv failed with error: "
-            <> message err
+            <> Error.message err
         Right _ ->
           logger Info "Successfully completed all cleanup actions -> exiting."
     )

example/minimal/docker/cluster/config-a.json

@@ -7,7 +7,7 @@
     "hydraSigningKey": "keys/hydra-a.sk",
     "cardanoSigningKey": "keys/cardano-a.sk",
     "network": {
-      "tag": "testnet",
+      "tag": "Testnet",
       "magic": 1
     },
     "nodeSocket": "node-ipc/node.socket",

example/minimal/docker/cluster/config-b.json

@@ -7,7 +7,7 @@
     "hydraSigningKey": "keys/hydra-b.sk",
     "cardanoSigningKey": "keys/cardano-b.sk",
     "network": {
-      "tag": "testnet",
+      "tag": "Testnet",
       "magic": 1
     },
     "nodeSocket": "node-ipc/node.socket",
@@ -23,7 +23,7 @@
     ]
   },
   "blockfrostApiKey": null,
-  "logLevel": "info",
+  "logLevel": "trace",
   "ctlLogLevel": "warn",
   "commitOutRef": null
 }

example/minimal/docker/cluster/docker-compose.yaml

@@ -1,6 +1,6 @@
 services:
   cardano-node:
-    image: ghcr.io/intersectmbo/cardano-node:10.1.2
+    image: ghcr.io/intersectmbo/cardano-node:10.1.3
     environment:
       - NETWORK=preprod
     volumes: