Use MockHead instead of real one

Constructing the state machine requires a token which is more
complicated to build.

hydra-node/src/Hydra/Chain/Direct/Tx.hs

@@ -30,8 +30,8 @@ import qualified Data.Map as Map
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import Hydra.Chain (HeadParameters (..), OnChainTx (OnInitTx))
-import qualified Hydra.Contract.Head as Head
 import qualified Hydra.Contract.Initial as Initial
+import qualified Hydra.Contract.MockHead as Head
 import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime, contestationPeriodToDiffTime)
 import Hydra.Data.Party (partyFromVerKey, partyToVerKey)
 import Hydra.Party (anonymousParty, vkey)
@@ -187,7 +187,7 @@ abortTx (txIn, token, HeadParameters{contestationPeriod, parties}) initInputs =
           (map (partyFromVerKey . vkey) parties)
 
   initialDatum pkh =
-    let datum = Data $ toData $ pkh
+    let datum = Data $ toData pkh
      in (hashData @Era datum, datum)
 
 --

hydra-node/test/Hydra/Chain/Direct/TxSpec.hs

@@ -32,11 +32,10 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Hydra.Chain (HeadParameters (..), PostChainTx (..))
 import Hydra.Chain.Direct.Tx (OnChainHeadState (..), abortTx, initTx, observeInitTx, plutusScript, scriptAddr, threadToken)
 import Hydra.Chain.Direct.Util (Era)
-import qualified Hydra.Contract.Head as Head
 import qualified Hydra.Contract.Initial as Initial
+import qualified Hydra.Contract.MockHead as Head
 import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime)
 import Hydra.Data.Party (partyFromVerKey)
-import Hydra.Ledger.Simple (SimpleTx)
 import Hydra.Party (vkey)
 import Plutus.V1.Ledger.Api (PubKeyHash (PubKeyHash), toBuiltin, toBuiltinData, toData)
 import Shelley.Spec.Ledger.API (Coin (Coin), StrictMaybe (SJust), TxId (TxId), TxIn (TxIn), UTxO (UTxO))

hydra-plutus/hydra-plutus.cabal

@@ -74,6 +74,7 @@ library
     Hydra.Contract.Commit
     Hydra.Contract.Head
     Hydra.Contract.Initial
+    Hydra.Contract.MockHead
     Hydra.Data.ContestationPeriod
     Hydra.Data.HeadParameters
     Hydra.Data.Party

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

@@ -0,0 +1,76 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-specialize #-}
+
+-- | A mock Head contract not using a state machine for testing purpose.
+module Hydra.Contract.MockHead where
+
+import PlutusTx.Prelude
+
+import Data.Aeson (FromJSON, ToJSON)
+import GHC.Generics (Generic)
+import Hydra.Data.ContestationPeriod (ContestationPeriod)
+import Hydra.Data.Party (Party)
+import Ledger (Script, ScriptContext, ValidatorHash, unValidatorScript)
+import Ledger.Typed.Scripts (ValidatorType, ValidatorTypes (DatumType, RedeemerType))
+import qualified Ledger.Typed.Scripts as Scripts
+import Ledger.Value (AssetClass)
+import PlutusTx (CompiledCode)
+import qualified PlutusTx
+import Text.Show (Show)
+
+data Head
+
+data State
+  = Initial ContestationPeriod [Party]
+  | Open
+  | Final
+  deriving stock (Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
+
+PlutusTx.unstableMakeIsData ''State
+
+data Input
+  = CollectCom
+  | Abort
+  deriving (Generic, Show)
+
+PlutusTx.unstableMakeIsData ''Input
+
+instance Scripts.ValidatorTypes Head where
+  type DatumType Head = State
+  type RedeemerType Head = Input
+
+{-# INLINEABLE validator #-}
+validator ::
+  AssetClass ->
+  State ->
+  Input ->
+  ScriptContext ->
+  Bool
+validator _ _ _ _ctx =
+  True
+
+compiledValidator :: AssetClass -> CompiledCode (ValidatorType Head)
+compiledValidator token =
+  $$(PlutusTx.compile [||validator||])
+    `PlutusTx.applyCode` PlutusTx.liftCode token
+
+{- ORMOLU_DISABLE -}
+typedValidator :: AssetClass -> Scripts.TypedValidator Head
+typedValidator token = Scripts.mkTypedValidator @Head
+  (compiledValidator token)
+  $$(PlutusTx.compile [|| wrap ||])
+ where
+  wrap = Scripts.wrapValidator @(DatumType Head) @(RedeemerType Head)
+{- ORMOLU_ENABLE -}
+
+-- | Do not use this outside of plutus land.
+validatorHash :: AssetClass -> ValidatorHash
+validatorHash = Scripts.validatorHash . typedValidator
+
+-- | Get the actual plutus script. Mainly used to serialize and use in
+-- transactions.
+validatorScript :: AssetClass -> Script
+validatorScript = unValidatorScript . Scripts.validatorScript . typedValidator