dump worwk for the night

cabal.project

@@ -34,7 +34,7 @@ package *
 
 -- Warnings as errors for local packages
 program-options
-  ghc-options: -Werror
+--  ghc-options: -Werror
 
 -- Always build tests and benchmarks of local packages
 tests: True

hydra-cluster/hydra-cluster.cabal

@@ -148,9 +148,11 @@ test-suite tests
   other-modules:
     Paths_hydra_cluster
     Spec
+    Test.ChainSpec
     Test.CardanoClientSpec
     Test.CardanoNodeSpec
     Test.DirectChainSpec
+    Test.OfflineChainSpec
     Test.EndToEndSpec
     Test.GeneratorSpec
     Test.Hydra.Cluster.FaucetSpec

hydra-cluster/src/Hydra/Cluster/Faucet.hs

@@ -98,6 +98,8 @@ seedFromFaucet_ ::
 seedFromFaucet_ node vk ll tracer =
   void $ seedFromFaucet node vk ll tracer
 
+--TODO(Elaine): we probably want a simplified but parallel version  of this/createOutputAddress for offline mode , that just constructs a UTxO
+-- actually no take a look at seedFromFaucet
 -- | Return the remaining funds to the faucet
 returnFundsToFaucet ::
   Tracer IO FaucetLog ->

hydra-cluster/src/Hydra/Cluster/Util.hs

@@ -1,3 +1,8 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+
 -- | Utilities used across hydra-cluster
 module Hydra.Cluster.Util where
 
@@ -22,8 +27,14 @@ import Hydra.Ledger.Cardano (genSigningKey)
 import Hydra.Options (ChainConfig (..), defaultChainConfig)
 import Paths_hydra_cluster qualified as Pkg
 import System.FilePath ((<.>), (</>))
-import Test.Hydra.Prelude (failure)
+import Test.Hydra.Prelude (failure, Expectation, shouldBe)
 import Test.QuickCheck (generate)
+import Hydra.Chain (PostChainTx)
+import Hydra.Chain (ChainEvent)
+import Hydra.Ledger (IsTx)
+import Hydra.Party (Party)
+import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties))
+import Hydra.Ledger (IsTx(UTxOType))
 
 -- | Lookup a config file similar reading a file from disk.
 -- If the env variable `HYDRA_CONFIG_DIR` is set, filenames will be
@@ -73,10 +84,21 @@ chainConfigFor me targetDir nodeSocket them cp = do
       { nodeSocket
       , cardanoSigningKey = skTarget me
       , cardanoVerificationKeys = [vkTarget himOrHer | himOrHer <- them]
-      , contestationPeriod = cp
+      , contestationPeriod = cp :: ContestationPeriod
       }
  where
   skTarget x = targetDir </> skName x
   vkTarget x = targetDir </> vkName x
   skName x = actorName x <.> ".sk"
   vkName x = actorName x <.> ".vk"
+
+seedInitialUTxOFromOffline :: IsTx tx => UTxOType tx -> FilePath -> IO ()
+seedInitialUTxOFromOffline utxo targetDir = do
+  -- i assume a static file might be too rigid ? we can keep around constants and then write them to disk for each test
+  -- readConfigFile "initial-utxo.json" >>= writeFileBS (targetDir </> "initial-utxo.json")
+
+  writeFileBS (targetDir </> "utxo.json") . toStrict . Aeson.encode $ utxo 
+
+  -- Aeson.throwDecodeStrict =<< readFileBS (targetDir </> "utxo.json")
+  pure ()
+

hydra-cluster/test/Test/ChainSpec.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
+module Test.ChainSpec
+  ( ChainTest(postTx, waitCallback)
+  , hasInitTxWith
+  , observesInTime
+  , observesInTimeSatisfying
+  ) where
+
+import Test.Hydra.Prelude
+import Hydra.Chain (ChainEvent(Observation, observedTx))
+import Hydra.Chain (PostChainTx)
+import Hydra.ContestationPeriod (ContestationPeriod)
+import Hydra.Party (Party)
+import Hydra.Chain (OnChainTx)
+import Hydra.Ledger (IsTx)
+import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties))
+import Hydra.Prelude
+-- import Test.DirectChainSpec (DirectChainTest(DirectChainTest))
+
+-- Abstract over DirectChainTest and OfflineChainTest
+class ChainTest c tx m | c -> tx m where --TODO(Elaine): additional constraints? alternative: manual vtable ChainTest, directchain wraps
+  postTx :: c -> PostChainTx tx -> m ()
+  waitCallback :: c -> m (ChainEvent tx)
+
+-- offlineConfigFor :: HasCallStack => Actor -> FilePath -> ContestationPeriod -> IO OfflineConfig
+-- offlineConfigFor me targetDir contestationPeriod = do
+--   undefined
+
+-- NOTE(Elaine): is this ther ight place for this??
+hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> Expectation
+hasInitTxWith expectedContestationPeriod expectedParties = \case
+  OnInitTx{contestationPeriod, parties} -> do
+    expectedContestationPeriod `shouldBe` contestationPeriod
+    expectedParties `shouldBe` parties
+  tx -> failure ("Unexpected observation: " <> show tx)
+
+observesInTime :: ChainTest c tx IO => IsTx tx => c -> OnChainTx tx -> IO ()
+observesInTime chain expected =
+  observesInTimeSatisfying chain (`shouldBe` expected)
+
+observesInTimeSatisfying :: ChainTest c tx IO => c -> (OnChainTx tx -> Expectation) -> IO ()
+observesInTimeSatisfying c check =
+  failAfter 10 go
+ where
+  go = do
+    e <- waitCallback c
+    case e of
+      Observation{observedTx} ->
+        check observedTx
+      _TickOrRollback ->
+        go
+
+waitMatch :: ChainTest c tx IO => c -> (ChainEvent tx -> Maybe b) -> IO b
+waitMatch c match = go
+ where
+  go = do
+    a <- waitCallback c
+    maybe go pure (match a)

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -5,6 +5,7 @@ module Test.DirectChainSpec where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
+
 import Cardano.Api.UTxO (UTxO' (UTxO, toMap))
 import CardanoClient (
   QueryPoint (QueryTip),
@@ -79,6 +80,8 @@ import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..))
 import System.Process (proc, readCreateProcess)
 import Test.QuickCheck (generate)
 
+import Test.ChainSpec
+
 spec :: Spec
 spec = around showLogsOnFailure $ do
   it "can init and abort a head given nothing has been committed" $ \tracer -> do
@@ -431,6 +434,10 @@ data DirectChainTest tx m = DirectChainTest
   , draftCommitTx :: UTxO' (TxOut CtxUTxO, Witness WitCtxTxIn) -> m tx
   }
 
+instance ChainTest DirectChainTest Tx IO  where
+  postTx = postTx
+  waitCallback = waitCallback
+
 -- | Wrapper around 'withDirectChain' that threads a 'ChainStateType tx' through
 -- 'postTx' and 'waitCallback' calls.
 withDirectChainTest ::
@@ -458,35 +465,6 @@ withDirectChainTest tracer config ctx action = do
               Right tx -> pure tx
         }
 
-hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> Expectation
-hasInitTxWith expectedContestationPeriod expectedParties = \case
-  OnInitTx{contestationPeriod, parties} -> do
-    expectedContestationPeriod `shouldBe` contestationPeriod
-    expectedParties `shouldBe` parties
-  tx -> failure ("Unexpected observation: " <> show tx)
-
-observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO ()
-observesInTime chain expected =
-  observesInTimeSatisfying chain (`shouldBe` expected)
-
-observesInTimeSatisfying :: DirectChainTest tx IO -> (OnChainTx tx -> Expectation) -> IO ()
-observesInTimeSatisfying DirectChainTest{waitCallback} check =
-  failAfter 10 go
- where
-  go = do
-    e <- waitCallback
-    case e of
-      Observation{observedTx} ->
-        check observedTx
-      _TickOrRollback ->
-        go
-
-waitMatch :: DirectChainTest tx IO -> (ChainEvent tx -> Maybe b) -> IO b
-waitMatch DirectChainTest{waitCallback} match = go
- where
-  go = do
-    a <- waitCallback
-    maybe go pure (match a)
 
 delayUntil :: (MonadDelay m, MonadTime m) => UTCTime -> m ()
 delayUntil target = do

hydra-cluster/test/Test/OfflineChainSpec.hs

@@ -0,0 +1,114 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.OfflineChainSpec where
+import Hydra.Prelude
+import Test.Hydra.Prelude
+import Hydra.Chain (PostChainTx, ChainEvent)
+import Hydra.Logging (showLogsOnFailure, Tracer)
+import Hydra.Chain.Offline (withOfflineChain)
+import Hydra.Options (defaultContestationPeriod)
+import Hydra.Party (deriveParty)
+import Hydra.Chain (PostChainTx(InitTx, headParameters))
+import Hydra.Options (OfflineConfig(OfflineConfig, initialUTxOFile, ledgerGenesisFile, utxoWriteBack), OfflineUTxOWriteBackConfig(), defaultOfflineConfig)
+import Hydra.Chain (HeadParameters(HeadParameters, contestationPeriod, parties))
+import Hydra.Cluster.Util (keysFor)
+import Hydra.Cluster.Fixture (Actor(Alice), aliceSk)
+import Hydra.Chain (initHistory)
+import Hydra.Chain.Direct.State (initialChainState)
+import Hydra.Node.EventQueue (EventQueue(putEvent))
+import Hydra.HeadLogic.Event (Event(OnChainEvent))
+import Control.Concurrent.STM (newEmptyTMVarIO, putTMVar, takeTMVar)
+import Hydra.Logging (nullTracer)
+import Hydra.Chain (Chain(Chain, postTx))
+import Hydra.Crypto (generateSigningKey)
+
+--TODO(Elaine): replace with some offlinechainlog?
+import Hydra.Chain.Direct.Handlers (DirectChainLog)
+import Hydra.Party (Party)
+import Hydra.Ledger.Cardano (Tx)
+import Hydra.Chain (HeadId(HeadId))
+import Hydra.ContestationPeriod (ContestationPeriod)
+import Hydra.Chain (OnChainTx(OnInitTx, OnCommitTx, party, committed))
+
+import Test.ChainSpec (hasInitTxWith, observesInTime)
+import Hydra.Ledger (IsTx(UTxOType))
+import Hydra.Chain (ChainEvent(Observation, observedTx))
+import Hydra.Chain (PostChainTx(AbortTx))
+import Hydra.Chain (OnChainTx(OnAbortTx))
+
+
+data OfflineChainTest tx m = OfflineChainTest
+  { postTx :: PostChainTx tx -> m ()
+  , waitCallback :: m (ChainEvent tx)
+  }
+
+withOfflineChainTest :: Tracer IO DirectChainLog -> OfflineConfig
+                  -> Party
+                  -> (OfflineChainTest Tx IO -> IO b)
+                  -> IO b
+withOfflineChainTest tracer offlineConfig party action = do
+  eventMVar <- newEmptyTMVarIO
+
+  let callback event = atomically $ putTMVar eventMVar event
+      globals = undefined
+      contestationPeriod = defaultContestationPeriod
+  withOfflineChain tracer offlineConfig globals (HeadId "HeadId") party contestationPeriod  (initHistory initialChainState) callback $ \Chain{postTx} -> do
+    action
+      OfflineChainTest
+        { postTx 
+        , waitCallback = atomically $ takeTMVar eventMVar
+        }
+
+spec :: Spec
+spec = around showLogsOnFailure $ do
+    it "can init and abort an offline head given nothing has been externally comitted" $ \tracer -> do
+        withTempDir "hydra-cluster" $ \tmp -> do
+            (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice
+            -- let aliceHydraKey = generateSigningKey . show $ (1::Integer) --based on EndToEnd.hs
+            let aliceParty = deriveParty aliceSk
+            --TODO(Elaine): i think we have to make this relative see readConfigFile
+            initialUTxO <- readJsonFileThrow (parseJSON @(UTxOType Tx)) $ initialUTxOFile defaultOfflineConfig
+
+            seedInitialUTxOFromOffline initialUtxo tmp
+
+            withOfflineChainTest tracer defaultOfflineConfig aliceParty $ \OfflineChainTest{postTx, waitCallback} -> do
+                -- postTx $ InitTx
+                --     { headParameters = HeadParameters
+                --         { contestationPeriod = defaultContestationPeriod
+                --         , parties = [aliceParty]
+                --         }
+                --     }
+                -- we should automatically have an init, commit, event play because withOfflineChain calls initializeStateIfOffline
+                -- but withDirectChain doesnt do this so it makes me wonder if we should revert the change
+
+
+
+                event <- waitCallback -- because we've got a tmvar the stuff in withOfflineChain should block until we've read out the remaining events
+                hasInitTxWith defaultContestationPeriod [aliceParty] $ observedTx event
+
+                event' <- waitCallback 
+                -- event' `shouldBe` Observation { observedTx = OnCommitTx { party = aliceParty, committed = initialUTxO } }
+                observedTx event' `observesInTime` OnCommitTx { party = aliceParty, committed = initialUTxO }
+
+                postTx $ AbortTx {-TODO(Elaine): what are the semantics of this again -} mempty
+                event'' <- waitCallback
+                -- need to make observesintime etc generic to get timeout on this
+                observedTx event'' `observesInTime` OnAbortTx
+
+
+
+
+                pure ()
+            pure ()
+
+    pure ()
+
+-- hasInitTxWith :: ContestationPeriod -> Party -> ChainEvent Tx -> Expectation
+-- hasInitTxWith expectedContestationPeriod expectedParty = \case
+--     OnInitTx {contestationPeriod, parties} -> pure ()
+--     _ -> expectationFailure $ "expected InitTx, got " <> show event

hydra-node/src/Hydra/Chain/Offline.hs

@@ -69,7 +69,7 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global
   initializeStateIfOffline chainStateHistory initialUTxO ownHeadId party contestationPeriod callback
 
   localChainState <- newLocalChainState chainStateHistory
-  let chainHandle = mkFakeL1Chain localChainState tracer ownHeadId callback
+  let chainHandle = mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback
 
   -- L2 ledger normally has fixed epoch info based on slot length from protocol params
   -- we're getting it from gen params here, it should match, but this might motivate generating shelleygenesis based on protocol params

hydra-node/src/Hydra/Chain/Offline/Handlers.hs

@@ -12,14 +12,16 @@ import Hydra.Ledger.Cardano (Tx)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Prelude
 import Hydra.Snapshot (Snapshot (number), getSnapshot)
+import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime)
 
 mkFakeL1Chain ::
+  ContestationPeriod ->
   LocalChainState IO Tx ->
   Tracer IO DirectChainLog ->
   HeadId ->
   (ChainEvent Tx -> IO ()) ->
   Chain Tx IO
-mkFakeL1Chain localChainState tracer ownHeadId callback =
+mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback =
   Chain
     { submitTx = const $ pure ()
     , draftCommitTx = const . pure $ Left FailedToDraftTxNotInitializing
@@ -29,19 +31,19 @@ mkFakeL1Chain localChainState tracer ownHeadId callback =
 
         let headId = ownHeadId
         _ <- case tx of
-          InitTx{headParameters = HeadParameters contestationPeriod parties} ->
-            callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId = headId, parties = parties, contestationPeriod}}
+          InitTx{headParameters = HeadParameters contestationPeriod' parties} ->
+            callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, parties, contestationPeriod = contestationPeriod'}}
           AbortTx{} ->
             callback $ Observation{newChainState = cst, observedTx = OnAbortTx{}}
           CollectComTx{} ->
             callback $ Observation{newChainState = cst, observedTx = OnCollectComTx{}}
           CloseTx{confirmedSnapshot} -> do
-            inOneMinute <- addUTCTime 60 <$> getCurrentTime
+            contestationDeadline <- addUTCTime (toNominalDiffTime contestationPeriod) <$> getCurrentTime
             callback $
               Observation
                 { newChainState = cst
                 , observedTx =
-                    OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline = inOneMinute} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ?
+                    OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ?
                 }
           ContestTx{confirmedSnapshot} ->
             -- this shouldnt really happen, i dont think we should allow contesting in offline mode

hydra-node/src/Hydra/Options.hs

@@ -179,6 +179,14 @@ data OfflineConfig = OfflineConfig
   }
   deriving (Eq, Show, Generic, FromJSON, ToJSON)
 
+defaultOfflineConfig :: OfflineConfig
+defaultOfflineConfig =
+  OfflineConfig
+    { initialUTxOFile = "utxo.json"
+    , ledgerGenesisFile = Nothing
+    , utxoWriteBack = Nothing
+    }
+
 offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig)
 offlineUTxOWriteBackOptionsParser =
   optional $