M3 demo

flake.nix

@@ -244,7 +244,7 @@
         docs = self.off-chain.project.${system}.launchSearchablePursDocs { };
         ctl-docs = cardano-transaction-lib.apps.${system}.docs;
         script-export = {
-          # nix run .#script-export -- off-chain/src
+          # nix run .#script-export
           type = "app";
           program = (on-chain.script-export system).outPath;
         };

milestone-2-demo.md

@@ -4,6 +4,8 @@ It is strongly recommended to use Nix to run this demo and following description
 
 Main entry point of the demo is [Seath.Test.Main module](./off-chain/test/Main.purs).
 
+🎦 Recording of the demo is available [here](https://drive.google.com/drive/folders/1uBvU1d5iAWRd7IvStLEiip83yS8kh5i5?usp=sharing).
+
 ## Running on local private network
 
 Local network capabilities are integrated into current setup. Local network provided by [Plutip](https://github.com/mlabs-haskell/plutip). Network is started from scratch on each run. Slot length is is to 1 second - see [config :: PlutipConfig](./off-chain/test/PlutipRunner.purs).

off-chain/spago.dhall

@@ -16,6 +16,7 @@ You can edit this file as you like.
   , "effect"
   , "either"
   , "exceptions"
+  , "integers"
   , "maybe"
   , "monad-logger"
   , "mote"
@@ -33,6 +34,7 @@ You can edit this file as you like.
   , "refs"
   , "spec"
   , "strings"
+  , "tailrec"
   , "transformers"
   , "tuples"
   , "typelevel-prelude"

off-chain/src/Core/ChainBuilder.purs

@@ -147,7 +147,7 @@ action2Transaction
       -- on next transaction in chain use outputs generated by previous transaction
       -- (I think it should be safe, as we want to build chain against only thouse outputs,
       --  that user decided to use as state for chain of transactions)
-      getUtxosInScript = findOwnOutputs config.stateVaildatorHash
+      getUtxosInScript = findOwnOutputs config.stateValidatorHash
         additionalUtxos
     (StateReturn handlerResult) <- config.actionHandler userAction userState
       getUtxosInScript
@@ -169,6 +169,7 @@ action2Transaction
               (unwrap userAction).userUTxOs
           )
         <> mustBeSignedBy (wrap (unwrap userAction).publicKey)
+        <> mustBeSignedBy (wrap config.leader)
     unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx
       (handlerResult.lookups <> unspentOutputs (unwrap userAction).userUTxOs)
       constraints

off-chain/src/Core/Types.purs

@@ -102,7 +102,7 @@ newtype CoreConfiguration
   (datumType :: Type)
   (redeemerType :: Type) = CoreConfiguration
   { leader :: PubKeyHash
-  , stateVaildatorHash :: ValidatorHash
+  , stateValidatorHash :: ValidatorHash
   , actionHandler ::
       DatumType validatorType datumType
       => RedeemerType validatorType redeemerType
@@ -117,7 +117,6 @@ newtype CoreConfiguration
                 (StateReturn validatorType datumType redeemerType userStateType)
          )
   , queryBlockchainState :: Contract (UtxoMap /\ userStateType)
-  , numberOfBuiltChains :: Int
   }
 
 newtype ChainBuilderState actionType userStateType = ChainBuilderState

off-chain/src/HTTP/SeathNode.purs

@@ -0,0 +1,57 @@
+module Seath.HTTP.SeathNode (SeathNode, start, stop) where
+
+import Contract.Prelude
+
+import Aeson (class DecodeAeson)
+import Effect.Aff (error, throwError)
+import Payload.Server as Payload
+import Seath.HTTP.Server (SeathServerConfig)
+import Seath.HTTP.Server as Server
+import Seath.Network.Leader (startLeaderNode, stopLeaderNode)
+import Seath.Network.Types
+  ( LeaderConfiguration
+  , LeaderNode
+  , UserConfiguration
+  , UserNode
+  )
+import Seath.Network.Users (startUserNode, stopUserNode)
+
+newtype SeathNode a = SeathNode
+  { leaderNode :: LeaderNode a
+  , userNode :: UserNode a
+  , server :: Payload.Server
+  }
+
+start
+  :: forall a
+   . Show a
+  => DecodeAeson a
+  => SeathServerConfig
+  -> LeaderConfiguration a
+  -> UserConfiguration a
+  -> Aff (SeathNode a)
+start serverConf leaderConf userConf = do
+  leaderNode <- startLeaderNode leaderConf
+  userNode <- startUserNode userConf
+  startServer <- Server.runServer serverConf leaderNode
+
+  case startServer of
+    Right server -> do
+      log "Seath node started"
+      pure $ SeathNode
+        { leaderNode
+        , userNode
+        , server
+        }
+    Left errMsg -> do
+      log "Failed to start Seath node sever - cleaning up fibers"
+      stopLeaderNode leaderNode
+      stopUserNode userNode
+      log "Cleaning up complete"
+      throwError (error $ "Failed to start Seath node: " <> errMsg)
+
+stop :: forall a. SeathNode a -> Aff Unit
+stop (SeathNode node) = do
+  Payload.close node.server
+  stopLeaderNode node.leaderNode
+  stopUserNode node.userNode

off-chain/src/HTTP/Server.purs

@@ -5,13 +5,13 @@ import Prelude
 import Aeson (class DecodeAeson)
 import Data.Either (Either)
 import Effect.Aff (Aff)
-import Payload.Server (Server)
+import Payload.Server (Server, defaultOpts)
 import Payload.Server as Payload
-import Seath.HTTP.Handlers as Handlers
+import Seath.HTTP.ServerHandlers as Handlers
 import Seath.HTTP.Spec as Spec
 import Seath.Network.Types (LeaderNode)
 
-type SeathServerConfig = {}
+type SeathServerConfig = { port :: Int }
 
 runServer
   :: forall a
@@ -20,6 +20,7 @@ runServer
   => SeathServerConfig
   -> LeaderNode a
   -> Aff (Either String Server)
-runServer _ leaderNode = Payload.start_
+runServer conf leaderNode = Payload.start
+  defaultOpts { port = conf.port }
   Spec.spec
   (Handlers.mkHandlers leaderNode)

off-chain/src/HTTP/Handlers.purs → off-chain/src/HTTP/ServerHandlers.purs

@@ -1,4 +1,4 @@
-module Seath.HTTP.Handlers where
+module Seath.HTTP.ServerHandlers where
 
 import Contract.Prelude
 

off-chain/src/HTTP/Types.purs

@@ -44,9 +44,6 @@ instance encIncludeReq ::
 instance includeContentType :: HasContentType (IncludeRequest a) where
   getContentType _ = json
 
-instance EncodeParam (IncludeRequest a) where
-  encodeParam = undefined
-
 -- Phantom types to make Spec and Handlers more readable
 -- Went with Record coz couldn't make `DecodeResponse` instance for custom `data` type
 type JSend :: forall err a. err -> a -> Type

off-chain/src/HTTP/UserHandlers.purs

@@ -0,0 +1,108 @@
+module Seath.HTTP.UserHandlers (mkHttpHandlers) where
+
+import Contract.Prelude
+
+import Aeson (class EncodeAeson, decodeJsonString)
+import Data.UUID (UUID, parseUUID)
+import Effect.Aff (Aff, error, throwError)
+import Payload.ResponseTypes (Response(Response))
+import Seath.Common.Types (UID(UID))
+import Seath.Core.Types (UserAction)
+import Seath.HTTP.Client (UserClient)
+import Seath.HTTP.Client as Client
+import Seath.HTTP.Types
+  ( IncludeRequest(IncludeRequest)
+  , SendSignedRequest(SendSignedRequest)
+  )
+import Seath.Network.Types
+  ( AcceptSignedTransactionError
+  , ActionStatus
+  , IncludeActionError
+  , NetworkHandlers
+  , SendSignedTransaction
+  )
+import Type.Proxy (Proxy(Proxy))
+
+mkHttpHandlers
+  :: forall a
+   . EncodeAeson a
+  => String
+  -> NetworkHandlers a
+mkHttpHandlers leaderUrl =
+  { submitToLeader: handleSendAction client
+  , sendSignedToLeader: handleSendSignedToLeader client
+  , refuseToSign: handleRefuseToSign client
+  , getActionStatus: handleGetStatus client
+  }
+  where
+  client :: UserClient a
+  client = Client.mkUserClient (Proxy :: Proxy a) leaderUrl
+
+handleSendAction
+  :: forall a
+   . EncodeAeson a
+  => UserClient a
+  -> UserAction a
+  -> Aff (Either IncludeActionError UUID)
+handleSendAction client action = do
+  res <- client.leader.includeAction
+    { body: IncludeRequest action }
+  case res of
+    Right resp -> do
+      convertResonse resp
+    Left r -> throwError
+      (error $ "Leader failed to respond to send action: " <> show r)
+  where
+  convertResonse (Response r) =
+    if (r.body.status == "success") then
+      maybe (throwError $ error "Can't parse request ID") (Right >>> pure)
+        (parseUUID r.body.data)
+    else either (show >>> error >>> throwError) (Left >>> pure)
+      (decodeJsonString r.body.data)
+
+handleSendSignedToLeader
+  :: forall a
+   . UserClient a
+  -> SendSignedTransaction
+  -> Aff (Either AcceptSignedTransactionError Unit)
+handleSendSignedToLeader client sendSig = do
+  res <- client.leader.acceptSignedTransaction
+    { body: SendSignedRequest sendSig }
+  case res of
+    -- FIXME: leader responds witn Unit always
+    -- but client expects AcceptSignedTransactionError as well
+    Right _resp -> pure $ Right unit
+    Left e -> throwError (error $ show e)
+
+handleRefuseToSign
+  :: forall a
+   . UserClient a
+  -> UUID
+  -> Aff Unit
+handleRefuseToSign client uuid = do
+  res <-
+    client.leader.refuseToSign
+      { params: { uid: UID uuid } }
+  case res of
+    Right _ -> pure unit
+    Left r -> throwError (error $ show r)
+
+handleGetStatus
+  :: forall a
+   . UserClient a
+  -> UUID
+  -> Aff ActionStatus
+handleGetStatus client uuid = do
+  res <-
+    client.leader.actionStatus
+      { params: { uid: UID uuid } }
+  case res of
+    Right resp -> convertResonse resp
+    Left r -> throwError (error $ "Leader failed to respond: " <> show r)
+  where
+  convertResonse (Response r) =
+    if (r.body.status == "success") then
+      either (show >>> error >>> throwError) pure
+        (decodeJsonString r.body.data)
+    else either (show >>> error >>> throwError) (error >>> throwError)
+      (decodeJsonString r.body.data)

off-chain/src/HTTP/Utils.purs

@@ -0,0 +1,69 @@
+module Seath.HTTP.Utils (mkLeaderConfig, mkUserConfig) where
+
+import Contract.Prelude
+
+import Aeson (class EncodeAeson)
+import Contract.PlutusData (class FromData, class ToData)
+import Contract.Scripts (class DatumType, class RedeemerType)
+import Contract.Transaction (Transaction)
+import Seath.Core.ChainBuilder as ChainBuilder
+import Seath.Core.Types (CoreConfiguration)
+import Seath.HTTP.UserHandlers as HttpUser
+import Seath.Network.Types
+  ( LeaderConfiguration(LeaderConfiguration)
+  , MilliSeconds
+  , RunContract(RunContract)
+  , UserConfiguration(UserConfiguration)
+  )
+
+mkLeaderConfig
+  :: forall (actionType :: Type) (userStateType :: Type) (validatorType :: Type)
+       (redeemerType :: Type)
+       (datumType :: Type)
+   . DatumType validatorType datumType
+  => RedeemerType validatorType redeemerType
+  => FromData datumType
+  => ToData datumType
+  => FromData redeemerType
+  => ToData redeemerType
+  => MilliSeconds
+  -> Int
+  -> MilliSeconds
+  -> CoreConfiguration actionType userStateType validatorType datumType
+       redeemerType
+  -> RunContract
+  -> LeaderConfiguration actionType
+mkLeaderConfig
+  maxWaitingTimeBeforeBuildChain
+  numberOfActionToTriggerChainBuilder
+  maxWaitingTimeForSignature
+  coreConfig
+  runContract =
+
+  let
+    (RunContract runC) = runContract
+    buildChain = \actions -> runC $ fst <$> ChainBuilder.buildChain coreConfig
+      actions
+      Nothing
+  in
+    LeaderConfiguration
+      { maxWaitingTimeForSignature
+      , numberOfActionToTriggerChainBuilder
+      , maxWaitingTimeBeforeBuildChain
+      , runContract
+      , buildChain
+      }
+
+mkUserConfig
+  :: forall a
+   . EncodeAeson a
+  => String
+  -> RunContract
+  -> (Transaction -> Aff (Either String Transaction))
+  -> UserConfiguration a
+mkUserConfig leaderUrl runContract checkChainedTx =
+  UserConfiguration
+    { networkHandlers: HttpUser.mkHttpHandlers leaderUrl
+    , runContract
+    , checkChainedTx
+    }

off-chain/src/HTTP/test.rest

@@ -1,7 +1,7 @@
 POST http://0.0.0.0:3000/leader/include-action HTTP/1.1
 content-type: application/json
 
-{"userUTxOs":[[{"transactionId":"dd010c7898521fe6c18c610a18ef101d123044478e665790d7424dc593563c8d","index":0},{"scriptRef":null,"output":{"referenceScript":null,"datum":{"tag":"NoOutputDatum","contents":{}},"amount":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},1000000000]]]]},"address":{"addressStakingCredential":null,"addressCredential":{"tag":"PubKeyCredential","contents":{"getPubKeyHash":"928ea41fdde65e1d0789c6baf6864728acd45f85da4f79b0763de25c"}}}}}]],"publicKey":{"getPubKeyHash":"928ea41fdde65e1d0789c6baf6864728acd45f85da4f79b0763de25c"},"changeAddress":"addr1vxfgafqlmhn9u8g838rt4a5xgu52e4zlshdy77dswc77yhql60q5v","action":100}
+{"userUTxOs":[[{"transactionId":"dd010c7898521fe6c18c610a18ef101d123044478e665790d7424dc593563c8d","index":0},{"scriptRef":null,"output":{"referenceScript":null,"datum":{"tag":"NoOutputDatum","contents":{}},"amount":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},1000000000]]]]},"address":{"addressStakingCredential":null,"addressCredential":{"tag":"PubKeyCredential","contents":{"getPubKeyHash":"928ea41fdde65e1d0789c6baf6864728acd45f85da4f79b0763de25c"}}}}}]],"publicKey":{"getPubKeyHash":"968ea41fdde65e1d0789c6baf6864728acd45f85da4f79b0763de25c"},"changeAddress":"addr1vxfgafqlmhn9u8g838rt4a5xgu52e4zlshdy77dswc77yhql60q5v","action":100}
 
 ###
 GET http://0.0.0.0:3000/leader/action-status/7b71822f-81ae-4cbd-831a-cf507007e861 HTTP/1.1