PLT-7586 [DO NOT MERGE] Marlowe semantics validator with `PlutusTx.As…

…Data` (#10)

PLT-7585 Ported `PlutusTx.AsData` validator from IntersectMBO/plutus@107c9a6.

marlowe-plutus/marlowe-plutus.cabal

@@ -69,6 +69,13 @@ flag check-duplicate-bindings
   default:     True
   manual:      False
 
+flag plutus-asdata
+  description:
+    Experimental! Use alternative implementation relying on `PlutusTx.asData`.
+
+  default:     False
+  manual:      True
+
 common lang
   default-language:   Haskell2010
   default-extensions:
@@ -120,6 +127,7 @@ library
     , flat
     , lens
     , marlowe-cardano ==0.2.1.0
+    , newtype-generics
     , plutus-core ==1.15.0.0
     , plutus-ledger-api ==1.15.0.0
     , plutus-tx ==1.15.0.0
@@ -128,12 +136,19 @@ library
 
   exposed-modules:
     Language.Marlowe.Plutus
+    Language.Marlowe.Plutus.Alt.ScriptTypes
+    Language.Marlowe.Plutus.Alt.Semantics
+    Language.Marlowe.Plutus.Alt.Semantics.Types
+    Language.Marlowe.Plutus.Alt.Semantics.Types.Address
     Language.Marlowe.Plutus.OpenRoles
     Language.Marlowe.Plutus.RolePayout
     Language.Marlowe.Plutus.RoleTokens
     Language.Marlowe.Plutus.RoleTokens.Types
     Language.Marlowe.Plutus.Semantics
 
+  if flag(plutus-asdata)
+    cpp-options: -DPLUTUS_ASDATA
+
 executable marlowe-validators
   import:         lang
   hs-source-dirs: app

marlowe-plutus/src/Language/Marlowe/Plutus/Alt/ScriptTypes.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Marlowe validators.
+--
+-- Module      :  $Headers
+-- License     :  Apache 2.0
+--
+-- Stability   :  Experimental
+-- Portability :  Portable
+module Language.Marlowe.Plutus.Alt.ScriptTypes (
+  -- * Types
+  MarloweInput,
+  MarloweTxInput (..),
+
+  -- * Utilities
+  marloweTxInputsFromInputs,
+) where
+
+import GHC.Generics (Generic)
+import Language.Marlowe.Plutus.Alt.Semantics.Types as Semantics
+import PlutusTx (makeIsDataIndexed, makeLift)
+import PlutusTx.Prelude as PlutusTxPrelude hiding (traceError, traceIfFalse)
+import Prelude qualified as Haskell
+
+-- | Input to a Marlowe transaction.
+type MarloweInput = [MarloweTxInput]
+
+-- | A single input applied in the Marlowe semantics validator.
+data MarloweTxInput
+  = Input InputContent
+  | MerkleizedTxInput InputContent BuiltinByteString
+  deriving stock (Haskell.Show, Haskell.Eq, Generic)
+
+-- | Convert semantics input to transaction input.
+marloweTxInputFromInput :: Input -> MarloweTxInput
+marloweTxInputFromInput (NormalInput i) = Input i
+marloweTxInputFromInput (MerkleizedInput i h _) = MerkleizedTxInput i h
+
+-- | Convert semantics inputs to transaction inputs.
+marloweTxInputsFromInputs :: [Input] -> [MarloweTxInput]
+marloweTxInputsFromInputs = fmap marloweTxInputFromInput
+
+-- Lifting data types to Plutus Core
+makeLift ''MarloweTxInput
+makeIsDataIndexed ''MarloweTxInput [('Input, 0), ('MerkleizedTxInput, 1)]