Support multiple auctions

.gitignore

@@ -16,3 +16,4 @@
 /keys/*.vk
 /keys/*.addr
 /hydra-persist/
+/result

Makefile

@@ -1,8 +1,12 @@
 .PHONY: requires-nix-shell build bundle bundle-docker serve repl \
-			  format check plutip-test plutip-env delegate-server-help \
-        delegate-cluster delegate-cluster-cleanup
+			  format check-format localnet-env delegate-server-help \
+        delegate-cluster delegate-cluster-cleanup test test-nix \
+				build-delegate-server-nix
 
-purs-args := "--stash --censor-lib --censor-codes=ImplicitImport,ImplicitQualifiedImport,UserDefinedWarning"
+ps-sources := $(shell fd --no-ignore-parent -epurs)
+nix-sources := $(shell fd --no-ignore-parent -enix --exclude='spago*')
+js-sources := $(shell fd --no-ignore-parent -ejs)
+purs-args := "--stash --censor-lib --censor-codes=ImplicitImport,ImplicitQualifiedImport,ImplicitQualifiedImportReExport,UserDefinedWarning"
 ha-frontend-api := ha-frontend-api
 delegate-cluster-docker-compose := docker/delegate-cluster/docker-compose.yaml
 
@@ -12,15 +16,23 @@ requires-nix-shell:
 				&& false \
 		)
 
-format:
-	@nix run .#pursFormat && nix run .#jsFormat && nix run .#nixFormat
-
-check:
-	@nix build .#checks.x86_64-linux.all
-
 build: requires-nix-shell
 	spago build --purs-args ${purs-args}
 
+test: requires-nix-shell
+	CARDANO_NETWORK=mainnet spago run --main Test.Main
+
+test-nix:
+	nix run .#checks.x86_64-linux.hydra-auction-offchain-tests
+
+format: requires-nix-shell
+	@purs-tidy format-in-place ${ps-sources}
+	@nixpkgs-fmt ${nix-sources}
+	@prettier -w ${js-sources}
+
+check-format:
+	nix run .#checks.x86_64-linux.formatting-check
+
 bundle: build requires-nix-shell
 	node bundle.js && tsc --emitDeclarationOnly
 
@@ -37,17 +49,20 @@ serve:
 repl: requires-nix-shell
 	spago repl
 
-plutip-test: requires-nix-shell
-	CARDANO_NETWORK=mainnet spago run --main Test.Plutip
-
-plutip-env: requires-nix-shell
+localnet-env: requires-nix-shell
 	spago run --main PlutipEnv.Main --exec-args "--payment-skey-file plutip-env/payment.skey" 
 
+build-delegate-server-nix:
+	nix build .#packages.x86_64-linux.delegate-server
+
 delegate-server-help: requires-nix-shell
 	spago run --main DelegateServer.Main --exec-args '--help'
 
 delegate-cluster:
-	docker compose -f ${delegate-cluster-docker-compose} up --build
+	docker compose -f ${delegate-cluster-docker-compose} up --build --no-attach cardano-node
 
 delegate-cluster-cleanup:
 	docker compose -f ${delegate-cluster-docker-compose} rm --force --stop --volumes
+
+ctl-runtime:
+	nix run .#ctl-runtime

api/api.ts

@@ -183,6 +183,55 @@ export const announceDelegateGroup = async (
   delegates: Array<PubKeyHash>
 ): Promise<ContractOutput<TxCbor>> => unimplemented();
 
+/*
+// Delegate groups ---------------------------------------------------
+
+export type Url = string;
+export type RawBytes = string;
+
+export type DelegateGroupMetadata = {
+  url: Url;
+  dataHash: RawBytes;
+};
+
+export type DelegateGroupInfo = {
+  groupId: CurrencySymbol;
+  groupMetadata: DelegateGroupMetadata;
+  delegates: Array<PubKeyHash>;
+  httpServers: Array<string>;
+  wsServers: Array<string>;
+};
+
+export type DelegateGroupSlot = string; // stringified int
+
+export type HostAuctionInfo = {
+  delegateGroup: DelegateGroupInfo;
+  slot: DelegateGroupSlot;
+  auctionMetadataOref: TransactionInput;
+};
+
+export const queryDelegateGroups = async (
+  config: ContractConfig
+): Promise<Array<DelegateGroupInfo>> => unimplemented();
+
+// Attempt to book a delegate group slot for an upcoming auction.
+//
+// This query will perform the following steps under the hood:
+// 1. Query a list of available auction slots from each delegate.
+// 2. Identify the common slots by finding their intersection.
+// 3. Randomly select one slot from the common available slots.
+// 4. Attempt to book the selected slot by sending booking requests to each delegate.
+export const bookSlotForAuction = async (
+  groupInfo: DelegateGroupInfo
+): Promise<DelegateGroupSlot | null> => unimplemented();
+
+// Attempt to host announced auction at a specific delegate group slot.
+export const hostAuction = async (
+  hostInfo: HostAuctionInfo
+): Promise<ContractOutput<any>> => unimplemented();
+
+*/
+
 // Helpers -----------------------------------------------------------
 
 export const getWalletVk = async (

app/delegate-server/App.purs

@@ -9,7 +9,6 @@ module DelegateServer.App
   , runApp
   , runAppEff
   , runContract
-  , runContractExitOnErr
   , runContractLift
   , runContractNullCosts
   ) where
@@ -18,7 +17,6 @@ import Prelude
 
 import Contract.Config
   ( ContractParams
-  , NetworkId(TestnetId, MainnetId)
   , PrivatePaymentKeySource(PrivatePaymentKeyFile)
   , WalletSpec(UseKeys)
   , defaultTimeParams
@@ -32,13 +30,14 @@ import Control.Monad.Logger.Trans (class MonadLogger, LoggerT(LoggerT), runLogge
 import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, asks, runReaderT)
 import Control.Monad.Rec.Class (class MonadRec)
 import Control.Monad.Trans.Class (class MonadTrans, lift)
+import Data.Identity (Identity)
 import Data.Log.Formatter.Pretty (prettyFormatter)
 import Data.Log.Message (Message)
 import Data.Maybe (Maybe(Just, Nothing))
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Set (Set)
 import Data.Set (empty) as Set
-import DelegateServer.Config (AppConfig, AppConfig'(AppConfig), Network(Testnet, Mainnet))
+import DelegateServer.Config (AppConfig, AppConfig'(AppConfig), networkToNetworkId)
 import DelegateServer.Lib.Contract (runContractNullCostsAff)
 import DelegateServer.State
   ( class App
@@ -61,14 +60,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Console (log)
 import Effect.Exception (Error)
-import HydraAuctionOffchain.Contract.Types
-  ( AuctionInfoExtended
-  , ContractOutput(ContractOutputError, ContractOutputResult)
-  , Utxo
-  , contractErrorCodec
-  )
-import HydraAuctionOffchain.Lib.Json (caEncodeString)
-import Node.Process (exit)
+import HydraAuctionOffchain.Contract.Types (AuctionInfoExtended, Utxo)
 import Type.Proxy (Proxy(Proxy))
 
 ----------------------------------------------------------------------
@@ -139,15 +131,6 @@ runContract contract = do
 runContractLift :: forall t m a. MonadTrans t => AppBase m => Contract a -> t m a
 runContractLift = lift <<< runContract
 
-runContractExitOnErr :: forall m a. AppBase m => Contract (ContractOutput a) -> m a
-runContractExitOnErr =
-  runContract >=> case _ of
-    ContractOutputResult res -> pure res
-    ContractOutputError err ->
-      liftEffect do
-        log $ caEncodeString contractErrorCodec err
-        exit one
-
 runContractNullCosts :: forall m a. AppBase m => Contract a -> m a
 runContractNullCosts contract = do
   contractEnv <- access (Proxy :: _ "contractEnv")
@@ -157,19 +140,19 @@ runContractNullCosts contract = do
 -- AppState
 
 type AppState =
-  { config :: AppConfig
+  { config :: AppConfig Identity
   , contractEnv :: ContractEnvWrapper
   , auctionInfo :: AVar AuctionInfoExtended
   , headStatus :: AVar HydraHeadStatus
   , livePeers :: AVar (Set String)
-  , exitSem :: AVar AppExitReason
+  , exit :: AVar (AppExitReason -> Effect Unit)
   , headCs :: AVar CurrencySymbol
   , collateralUtxo :: AVar Utxo
   , commitStatus :: AVar CommitStatus
   , snapshot :: AVar HydraSnapshot
   }
 
-instance MonadAccess AppM "config" AppConfig where
+instance MonadAccess AppM "config" (AppConfig Identity) where
   access _ = asks _.config
 
 instance MonadAccess AppM "contractEnv" ContractEnvWrapper where
@@ -184,8 +167,8 @@ instance MonadAccess AppM "headStatus" (AVar HydraHeadStatus) where
 instance MonadAccess AppM "livePeers" (AVar (Set String)) where
   access _ = asks _.livePeers
 
-instance MonadAccess AppM "exitSem" (AVar AppExitReason) where
-  access _ = asks _.exitSem
+instance MonadAccess AppM "exit" (AVar (AppExitReason -> Effect Unit)) where
+  access _ = asks _.exit
 
 instance MonadAccess AppM "headCs" (AVar CurrencySymbol) where
   access _ = asks _.headCs
@@ -199,13 +182,13 @@ instance MonadAccess AppM "commitStatus" (AVar CommitStatus) where
 instance MonadAccess AppM "snapshot" (AVar HydraSnapshot) where
   access _ = asks _.snapshot
 
-initApp :: AppConfig -> Aff AppState
-initApp config = do
-  contractEnv <- wrap <$> mkContractEnv (mkContractParams config)
+initApp :: AppConfig Identity -> Aff AppState
+initApp config@(AppConfig appConfig) = do
+  contractEnv <- wrap <$> mkContractEnv contractParams
   auctionInfo <- AVar.empty
   headStatus <- AVar.new HeadStatus_Unknown
   livePeers <- AVar.new Set.empty
-  exitSem <- AVar.empty
+  exit <- AVar.empty
   headCs <- AVar.empty
   collateralUtxo <- AVar.empty
   commitStatus <- AVar.new ShouldCommitCollateral
@@ -216,25 +199,24 @@ initApp config = do
     , auctionInfo
     , headStatus
     , livePeers
-    , exitSem
+    , exit
     , headCs
     , collateralUtxo
     , commitStatus
     , snapshot
     }
-
-mkContractParams :: AppConfig -> ContractParams
-mkContractParams (AppConfig appConfig) =
-  { backendParams: appConfig.queryBackend
-  , networkId:
-      case appConfig.network of
-        Testnet _ -> TestnetId
-        Mainnet -> MainnetId
-  , logLevel: appConfig.ctlLogLevel
-  , walletSpec: Just $ UseKeys (PrivatePaymentKeyFile appConfig.walletSk) Nothing
-  , customLogger: Nothing
-  , suppressLogs: true
-  , hooks: emptyHooks
-  , timeParams: defaultTimeParams
-  , synchronizationParams: disabledSynchronizationParams
-  }
+  where
+  contractParams :: ContractParams
+  contractParams =
+    { backendParams: appConfig.queryBackend
+    , networkId: networkToNetworkId appConfig.network
+    , logLevel: appConfig.ctlLogLevel
+    , walletSpec:
+        Just $ UseKeys (PrivatePaymentKeyFile appConfig.auctionConfig.cardanoSk) Nothing
+          Nothing
+    , customLogger: Nothing
+    , suppressLogs: true
+    , hooks: emptyHooks
+    , timeParams: defaultTimeParams
+    , synchronizationParams: disabledSynchronizationParams
+    }