Add InitialParams and deserialize them as HeadParameters when watchin…

…g init

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

@@ -86,7 +86,7 @@ activateContract contract wallet =
  where
   reqBody = ActivateContractRequest (show contract) wallet
 
--- XXX(SN): Not using the same type on both ends as having a too complicated
+-- NOTE(SN): Not using the same type on both ends as having a too complicated
 -- 'Party' type to be able to use it properly in plutus ('Lift' and 'IsData'
 -- instances), and this would also be annoying in the dependency management.
 data PostInitParams = PostInitParams
@@ -121,7 +121,8 @@ postInitTx cid params =
 data ActivateContractRequest = ActivateContractRequest {caID :: Text, caWallet :: Wallet}
   deriving (Generic, ToJSON)
 
--- TODO(SN): DRY subscribers
+-- TODO(SN): DRY subscribers and proper error handling
+
 initTxSubscriber :: Wallet -> (OnChainTx tx -> IO ()) -> IO ()
 initTxSubscriber wallet callback = do
   cid <- unContractInstanceId <$> activateContract WatchInit wallet
@@ -133,10 +134,9 @@ initTxSubscriber wallet callback = do
           Error err -> say $ "decoding error json: " <> show err
           Success res -> case getLast res of
             Nothing -> pure ()
-            Just ((contestationPeriod, parties) :: (ContestationPeriod, [Party])) -> do
-              -- TODO(SN): add tests for checking correspondence of json serialization
-              say $ "Observed Init tx with datum:" ++ show (contestationPeriod, parties)
-              callback $ InitTx (HeadParameters contestationPeriod parties)
+            Just (parameters :: HeadParameters) -> do
+              say $ "Observed Init tx with parameters:" ++ show parameters
+              callback $ InitTx parameters
       Right _ -> pure ()
       Left err -> say $ "error decoding msg: " <> show err
 

hydra-node/test/Hydra/Chain/ExternalPABSpec.hs

@@ -26,15 +26,23 @@ spec = do
   -- We use slightly different types in off-chain and on-chain code, BUT, they
   -- have identical wire formats. We use (JSON) serialization as a mean to turn
   -- one into the other.
-  describe "OnChain / OffChain Serialization Roundtrips" $
-    prop "PostInitParams -> InitParams" $ \(params :: PostInitParams) ->
+  describe "OffChain <-> OnChain Serialization" $ do
+    prop "PostInitParams -> Onchain.InitParams" $ \(params :: PostInitParams) ->
       let bytes = Aeson.encode params
        in counterexample (decodeUtf8 bytes) $ case Aeson.eitherDecode bytes of
             Left e ->
               counterexample ("Failed to decode: " <> show e) $ property False
             Right (_ :: OnChain.InitParams) ->
               property True
 
+    prop "HeadParameters <- Onchain.InitialParams" $ \(params :: OnChain.InitialParams) ->
+      let bytes = Aeson.encode params
+       in counterexample (decodeUtf8 bytes) $ case Aeson.eitherDecode bytes of
+            Left e ->
+              counterexample ("Failed to decode: " <> show e) $ property False
+            Right (_ :: HeadParameters) ->
+              property True
+
   describe "ExternalPAB" $ do
     it "publishes init tx using wallet 1 and observes it also" $ do
       failAfter 40 $

hydra-plutus/src/Hydra/Contract/ContestationPeriod.hs

@@ -14,6 +14,10 @@ newtype ContestationPeriod = UnsafeContestationPeriod {picoseconds :: Integer}
 
 PlutusTx.unstableMakeIsData ''ContestationPeriod
 
+instance Arbitrary ContestationPeriod where
+  shrink = genericShrink
+  arbitrary = genericArbitrary
+
 instance FromJSON ContestationPeriod where
   parseJSON =
     fmap (UnsafeContestationPeriod . diffTimeToPicoseconds) . parseJSON

hydra-plutus/src/Hydra/Contract/Party.hs

@@ -20,6 +20,10 @@ newtype Party = UnsafeParty Integer -- (VerKeyDSIGN MockDSIGN)
 
 PlutusTx.makeLift ''Party
 
+instance Arbitrary Party where
+  shrink = genericShrink
+  arbitrary = genericArbitrary
+
 instance ToJSON Party where
   toJSON (UnsafeParty i) = toJSON i
 

hydra-plutus/src/Hydra/ContractSM.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-specialize #-}
@@ -6,15 +7,13 @@
 -- between Node and Chain
 module Hydra.ContractSM where
 
+import Hydra.Prelude hiding (State, find, fmap, foldMap, map, mapMaybe, mempty, pure, zip, ($), (&&), (+), (<$>), (<>), (==))
+import PlutusTx.Prelude hiding (Eq)
+
 import Control.Lens (makeClassyPrisms)
-import Control.Monad (forever)
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Either (rights)
 import qualified Data.Map as Map
-import GHC.Generics (Generic)
 import Hydra.Contract.ContestationPeriod (ContestationPeriod)
 import Hydra.Contract.Party (Party)
-import Hydra.Prelude (Eq, Last (..), Show, String, show, uncurry, void)
 import Ledger (CurrencySymbol, PubKeyHash (..), TxOut (txOutValue), TxOutTx (txOutTxOut), Value, pubKeyAddress, pubKeyHash)
 import Ledger.AddressMap (outputsMapFromTxForAddress)
 import Ledger.Constraints (mustPayToPubKey)
@@ -39,7 +38,6 @@ import Plutus.Contract.StateMachine (StateMachine, StateMachineClient, WaitingRe
 import qualified Plutus.Contract.StateMachine as SM
 import qualified Plutus.Contracts.Currency as Currency
 import qualified PlutusTx
-import PlutusTx.Prelude hiding (Eq)
 
 data State
   = Setup
@@ -158,7 +156,7 @@ data InitParams = InitParams
   , cardanoPubKeys :: [PubKeyHash]
   , hydraParties :: [Party]
   }
-  deriving (Show, Generic, FromJSON, ToJSON)
+  deriving (Generic, Show, FromJSON, ToJSON)
 
 setup :: Contract () (Endpoint "init" InitParams) HydraPlutusError ()
 setup = do
@@ -185,9 +183,20 @@ setup = do
   void $ SM.runStep client (Init contestationPeriod (zip cardanoPubKeys tokenValues) hydraParties)
   logInfo $ "Triggered Init " <> show @String cardanoPubKeys
 
+-- | Parameters as they are available in the 'Initial' state.
+data InitialParams = InitialParams
+  { contestationPeriod :: ContestationPeriod
+  , parties :: [Party]
+  }
+  deriving (Generic, Show, FromJSON, ToJSON)
+
+instance Arbitrary InitialParams where
+  shrink = genericShrink
+  arbitrary = genericArbitrary
+
 -- | Watch 'initialAddress' (with hard-coded parameters) and report all datums
 -- seen on each run.
-watchInit :: Contract (Last (ContestationPeriod, [Party])) Empty ContractError ()
+watchInit :: Contract (Last InitialParams) Empty ContractError ()
 watchInit = do
   logInfo @String $ "watchInit: Looking for an init tx and it's parties"
   pubKey <- ownPubKey
@@ -202,7 +211,8 @@ watchInit = do
         let datums = txs >>= rights . fmap (lookupDatum token) . Map.elems . outputsMapFromTxForAddress (scriptAddress token)
         logInfo @String $ "found init tx(s) with datums: " <> show datums
         case datums of
-          [Initial contestationPeriod parties] -> tell $ Last $ Just (contestationPeriod, parties)
+          [Initial contestationPeriod parties] ->
+            tell . Last . Just $ InitialParams{contestationPeriod, parties}
           _ -> pure ()
       _ -> pure ()
  where