Feat/hydra

.env.example

@@ -0,0 +1,5 @@
+HYDRA_IP=172.16.238.10
+HYDRA_PORT=4001
+SERVER_PORT=8081
+CARDANO_NODE_SOCKET_PATH=/media/reeshav/084ef290-597c-4168-b443-49fba520fcb5/cardano-node/preview/node.socket
+NETWORK=2

.gitignore

@@ -3,4 +3,5 @@
 /.cluster
 # vscode related
 .vscode
-.history
+.history
+.env

cabal.project

@@ -1,8 +1,8 @@
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2025-01-06T06:07:18Z
-  , cardano-haskell-packages 2025-01-04T13:50:25Z
+  , hackage.haskell.org 2025-05-07T06:09:46Z
+  , cardano-haskell-packages 2025-04-29T20:52:57Z
 
 -- Custom repository for cardano haskell packages, see CONTRIBUTING for more
 repository cardano-haskell-packages

docs/docs/scenarioTests.md

@@ -0,0 +1,49 @@
+---
+sidebar_position: 2
+---
+
+# Scenario Tests
+
+We have tested the following scenarios in Hydra:
+
+## 1. Mint a token and close hydra head
+
+- A token was minted using a plutusV3 always pass script
+- The snapshot was confirmed for minting token
+- Head was closed
+- Error during fanout
+
+```json
+"postTxError": {
+        "failureReason": "TxValidationErrorInCardanoMode (ShelleyTxValidationError ShelleyBasedEraConway (ApplyTxError (ConwayUtxowFailure (UtxoFailure (ValueNotConservedUTxO (MaryValue (Coin 325709888) (MultiAsset (fromList [(PolicyID {policyID = ScriptHash \"29c699a1d8dc832504e4ec37a41286176820c9221c5505f7005bae68\"},fromList [(\"4879647261486561645631\",1),(\"e696fc821063f9b7311bb350539e67c8fad1bd571605e75b5a353eab\",1),(\"fce240ccfcb839aa37e5b04206a84530e027b0d3bfb596e7d0685f6a\",1)])]))) (MaryValue (Coin 325709888) (MultiAsset (fromList [(PolicyID {policyID = ScriptHash \"29c699a1d8dc832504e4ec37a41286176820c9221c5505f7005bae68\"},fromList [(\"4879647261486561645631\",1),(\"e696fc821063f9b7311bb350539e67c8fad1bd571605e75b5a353eab\",1),(\"fce240ccfcb839aa37e5b04206a84530e027b0d3bfb596e7d0685f6a\",1)]),(PolicyID {policyID = ScriptHash \"3a888d65f16790950a72daee1f63aa05add6d268434107cfa5b67712\"},fromList [(\"68796472612d6b75626572\",1)])]))))) :| [])))",
+        "tag": "FailedToPostTx"
+    }
+```
+
+## 2. Mint a token, burn it and close hydra head
+- A token was minted using a plutusV3 always pass script.  
+- The snapshot was confirmed for minting token
+- Token was burnt
+- The snapshot was confirmed for burning token
+- Head was closed
+- Fanout Successful
+
+## 3. Pay to script and close hydra head
+- Paid **10 ₳** to script address `addr_test1wqag3rt979nep9g2wtdwu8mr4gz6m4kjdpp5zp705km8wys6t2kla`
+- Snapshot was confirmed for this transaction
+- Head was closed
+- Fanout Successful: [21f398e9a5a7661c326036d5e9577b64f28554da9e26387e780a032fdb77e99a](https://preview.cexplorer.io/tx/21f398e9a5a7661c326036d5e9577b64f28554da9e26387e780a032fdb77e99a)
+
+## 4. Pay to 500 addresses and close hydra head
+- Transactions for 500 addresses were done within the hydra head
+- Snapshot was confirmed for each transaction
+- Head was closed
+- Error during fanout
+
+```json
+{
+   "postTxError": {
+        "failureReason": "ValidationFailure (WrapExUnits {unWrapExUnits = ExUnits' {exUnitsMem' = 0, exUnitsSteps' = 0}}) (CekError An error has occurred:\nThe machine terminated part way through evaluation due to overspending the budget.\nThe budget when the machine terminated was:\n({cpu: 6396337807\n| mem: -2582})\nNegative numbers indicate the overspent budget; note that this only indicates the budget that was needed for the next step, not to run the program to completion.) [] ..."
+     }
+}
+```

kuber-hydra/app/Api/Spec.hs

@@ -0,0 +1,254 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Api.Spec where
+
+import Cardano.Api
+import Cardano.Kuber.Api
+import Cardano.Kuber.Data.Models
+import qualified Data.Aeson as A
+import Data.ByteString (toStrict)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy as BSL
+import Data.Maybe
+import Data.String
+import qualified Data.Text as T hiding (map)
+import GHC.Generics
+import Network.HTTP.Types (status201, status400)
+import Network.Wai
+import Network.Wai.Middleware.Cors
+import Network.Wai.Middleware.Rewrite
+import Network.Wai.Middleware.Static
+import Servant
+import Servant.Exception
+import Websocket.Aeson
+import Websocket.Commands
+import Websocket.Middleware
+import Websocket.TxBuilder (hydraProtocolParams, queryUTxO, toValidHydraTxBuilder)
+import Websocket.Utils
+
+-- Define CORS policy
+corsMiddlewarePolicy :: CorsResourcePolicy
+corsMiddlewarePolicy =
+  CorsResourcePolicy
+    { corsOrigins = Nothing,
+      corsMethods = [BS.pack "GET", BS.pack "POST", BS.pack "OPTIONS"],
+      corsRequestHeaders = [fromString "content-type", fromString "api-key"],
+      corsExposedHeaders = Nothing,
+      corsMaxAge = Just 3600,
+      corsVaryOrigin = True,
+      corsRequireOrigin = False,
+      corsIgnoreFailures = True
+    }
+
+newtype ResponseMessage = ResponseMessage
+  { result :: String
+  }
+  deriving (Show, Generic)
+
+instance ToJSON ResponseMessage
+
+data CommitUTxOs = CommitUTxOs
+  { utxos :: [TxIn],
+    signKey :: Maybe A.Value
+  }
+  deriving (Show, Generic, FromJSON, ToJSON)
+
+instance ToServantErr FrameworkError where
+  status (FrameworkError _ _) = status400
+  status (FrameworkErrors _) = status400
+
+instance MimeRender PlainText FrameworkError where
+  mimeRender ct = mimeRender ct . show
+
+type GetResp = UVerb 'GET '[JSON] UVerbResponseTypes
+
+type PostResp = UVerb 'POST '[JSON] UVerbResponseTypes
+
+type WithWait sub = QueryParam "wait" Bool :> sub
+
+type WithSubmit sub = QueryParam "submit" Bool :> sub
+
+type API =
+  "hydra" :> HydraCommandAPI
+    :<|> "hydra" :> "query" :> HydraQueryAPI
+
+type HydraCommandAPI =
+  "init" :> WithWait PostResp
+    :<|> "abort" :> WithWait PostResp
+    :<|> "commit" :> WithSubmit (ReqBody '[JSON] CommitUTxOs :> PostResp)
+    :<|> "decommit" :> WithSubmit (WithWait (ReqBody '[JSON] CommitUTxOs :> PostResp))
+    :<|> "close" :> WithWait PostResp
+    :<|> "contest" :> WithWait PostResp
+    :<|> "fanout" :> WithWait PostResp
+    :<|> "tx" :> WithSubmit (ReqBody '[JSON] TxBuilder :> Post '[JSON] TxModal)
+    :<|> "submit" :> ReqBody '[JSON] TxModal :> PostResp
+
+type HydraQueryAPI =
+  "utxo" :> QueryParams "address" T.Text :> QueryParams "txin" T.Text :> GetResp
+    :<|> "protocol-parameters" :> GetResp
+    :<|> "state" :> GetResp
+
+frameworkErrorHandler valueOrFe = case valueOrFe of
+  Left fe -> throwError $ err500 {errBody = BSL.fromStrict $ prettyPrintJSON fe}
+  Right val -> respond $ WithStatus @200 val
+
+toServerError :: FrameworkError -> Handler a
+toServerError err =
+  throwError $
+    err500 {errBody = BSL.fromStrict $ prettyPrintJSON err}
+
+hydraErrorHandler (msg, status) = do
+  let jsonResponseOrError = textToJSON msg
+  case jsonResponseOrError of
+    Left fe -> toServerError fe
+    Right jsonResponse ->
+      case status of
+        200 -> respond $ WithStatus @200 jsonResponse
+        201 -> respond $ WithStatus @201 jsonResponse
+        _ ->
+          throwError $
+            (errorMiddleware status)
+              { errHTTPCode = status,
+                errReasonPhrase = "",
+                errBody = A.encode jsonResponse,
+                errHeaders = [("Content-Type", "application/json")]
+              }
+
+-- Define Handlers
+server appConfig =
+  commandServer appConfig
+    :<|> queryServer appConfig
+  where
+    -- Commands: POSTs and state-changing GETs
+    commandServer :: AppConfig -> Server HydraCommandAPI
+    commandServer appConfig =
+      initHandler appConfig
+        :<|> abortHandler appConfig
+        :<|> commitHandler appConfig
+        :<|> decommitHandler appConfig
+        :<|> closeHandler appConfig
+        :<|> contestHandler appConfig
+        :<|> fanoutHandler appConfig
+        :<|> txHandler appConfig
+        :<|> submitHandler appConfig
+    -- Queries: GET-only, read-only endpoints
+    queryServer :: AppConfig -> Server HydraQueryAPI
+    queryServer appConfig =
+      queryUtxoHandler appConfig
+        :<|> queryProtocolParameterHandler appConfig
+        :<|> queryStateHandler appConfig
+
+initHandler :: AppConfig -> Maybe Bool -> Handler (Union UVerbResponseTypes)
+initHandler appConfig wait = do
+  initResponse <- liftIO $ initialize appConfig (fromMaybe False wait)
+  hydraErrorHandler initResponse
+
+abortHandler :: AppConfig -> Maybe Bool -> Handler (Union UVerbResponseTypes)
+abortHandler appConfig wait = do
+  abortResponse <- liftIO $ abort appConfig (fromMaybe False wait)
+  hydraErrorHandler abortResponse
+
+queryUtxoHandler :: AppConfig -> [T.Text] -> [T.Text] -> Handler (Union UVerbResponseTypes)
+queryUtxoHandler appConfig address txin = do
+  parsedTxIns <- liftIO $ listOfTextToTxIn txin
+  parsedAddresses <- liftIO $ listOfTextToAddressInEra address
+  eitherErrorOrUTxOs <- case parsedTxIns of
+    Left fe -> pure $ Left fe
+    Right txins -> case parsedAddresses of
+      Left fe -> pure $ Left fe
+      Right address' -> do
+        queryUtxoResponse <- liftIO $ queryUTxO appConfig address' txins
+        case queryUtxoResponse of
+          Left fe -> pure $ Left fe
+          Right utxos -> case bytestringToJSON $ BSL.fromStrict $ serialiseToJSON utxos of
+            Left fe' -> pure $ Left fe'
+            Right json -> pure $ Right json
+  frameworkErrorHandler eitherErrorOrUTxOs
+
+commitHandler :: AppConfig -> Maybe Bool -> CommitUTxOs -> Handler (Union UVerbResponseTypes)
+commitHandler appConfig submit commits = do
+  commitResult <- liftIO $ commitUTxO appConfig commits.utxos (signKey commits) (fromMaybe False submit)
+  commitResultToJSON <- case commitResult of
+    Left fe -> pure $ Left fe
+    Right res ->
+      case bytestringToJSON $ A.encode res of
+        Left fe -> pure $ Left fe
+        Right val -> pure $ Right val
+  frameworkErrorHandler commitResultToJSON
+
+decommitHandler :: AppConfig -> Maybe Bool -> Maybe Bool -> CommitUTxOs -> Handler (Union UVerbResponseTypes)
+decommitHandler appConfig submit wait decommits = do
+  decommitResult <- liftIO $ decommitUTxO appConfig decommits.utxos (signKey decommits) (fromMaybe False wait) (fromMaybe False submit)
+  frameworkErrorHandler decommitResult
+
+closeHandler :: AppConfig -> Maybe Bool -> Handler (Union UVerbResponseTypes)
+closeHandler appConfig wait = do
+  closeResponse <- liftIO $ close appConfig (fromMaybe False wait)
+  hydraErrorHandler closeResponse
+
+contestHandler :: AppConfig -> Maybe Bool -> Handler (Union UVerbResponseTypes)
+contestHandler appConfig wait = do
+  closeResponse <- liftIO $ contest appConfig (fromMaybe False wait)
+  hydraErrorHandler closeResponse
+
+fanoutHandler :: AppConfig -> Maybe Bool -> Handler (Union UVerbResponseTypes)
+fanoutHandler appConfig wait = do
+  fanoutResponse <- liftIO $ fanout appConfig (fromMaybe False wait)
+  hydraErrorHandler fanoutResponse
+
+queryProtocolParameterHandler :: AppConfig -> Handler (Union UVerbResponseTypes)
+queryProtocolParameterHandler appConfig = do
+  pParamResponse <- liftIO (hydraProtocolParams appConfig :: IO (Either FrameworkError HydraProtocolParameters))
+  pParamsToJSON <- case pParamResponse of
+    Left fe -> pure $ Left fe
+    Right pparams -> case bytestringToJSON $ A.encode pparams of
+      Left fe -> pure $ Left fe
+      Right val -> pure $ Right val
+  frameworkErrorHandler pParamsToJSON
+
+queryStateHandler :: AppConfig -> Handler (Union UVerbResponseTypes)
+queryStateHandler appConfig = do
+  stateResponse <- liftIO $ getHydraState appConfig
+  stateResponseJSON <- case stateResponse of
+    Left fe -> pure $ Left fe
+    Right stateInfo -> case bytestringToJSON $ A.encode stateInfo of
+      Left fe -> pure $ Left fe
+      Right val -> pure $ Right val
+  frameworkErrorHandler stateResponseJSON
+
+txHandler :: AppConfig -> Maybe Bool -> TxBuilder_ ConwayEra -> Handler TxModal
+txHandler appConfig submit txb = do
+  hydraTxModal <- liftIO $ toValidHydraTxBuilder appConfig txb (fromMaybe False submit)
+  case hydraTxModal of
+    Left fe -> toServerError fe
+    Right txm -> pure txm
+
+submitHandler :: AppConfig -> TxModal -> Handler (Union UVerbResponseTypes)
+submitHandler appConfig txm = do
+  submitResponse <- liftIO $ submit appConfig txm
+  hydraErrorHandler submitResponse
+
+-- Create API Proxy
+deployAPI :: Proxy API
+deployAPI = Proxy
+
+-- Define Hydra application
+hydraApp :: AppConfig -> Application
+hydraApp appConfig = rewriteRoot (T.pack "index.html") $ static $ cors (const $ Just corsMiddlewarePolicy) $ serve deployAPI (server appConfig)

kuber-hydra/app/Main.hs

@@ -1,7 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
 module Main where
-import Websocket.Connect
+
+import Api.Spec (hydraApp)
+import Configuration.Dotenv
+import Network.Wai.Handler.Warp
+import Network.Wai.Handler.WebSockets
+import qualified Network.WebSockets as WS
+import System.Environment
+import Websocket.Aeson
+import Websocket.Middleware
+import Websocket.SocketConnection
 
 main :: IO ()
-main = 
-    putStrLn "hello hydra"
-    -- webSocketProxy "172.16.238.10" 4001
+main = do
+  loadFile defaultConfig
+  hydraIp <- getEnv "HYDRA_IP"
+  hydraPort <- getEnv "HYDRA_PORT"
+  serverPort <- getEnv "SERVER_PORT"
+  putStrLn $ "Starting HTTP and WebSocket server on port " ++ show serverPort
+  putStrLn $ "Hydra node running on " <> hydraIp <> ":" <> hydraPort
+  let host = AppConfig hydraIp (read hydraPort) "0.0.0.0" (read serverPort)
+      noCacheApp = noCacheMiddleware (hydraApp host)
+  run (read serverPort) $ websocketsOr WS.defaultConnectionOptions (proxyServer host) noCacheApp