WIP MA scripts

shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Scripts.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.Ledger.ShelleyMA.Scripts where
+
+import Cardano.Binary
+  ( Annotator,
+    FromCBOR (..),
+    ToCBOR (..),
+    annotatorSlice,
+    encodeListLen,
+  )
+import qualified Cardano.Ledger.Core as Core
+import qualified Cardano.Ledger.Crypto as CryptoClass
+import qualified Cardano.Ledger.Shelley as Shelley
+import Cardano.Ledger.ShelleyMA (ShelleyMAEra)
+import Cardano.Ledger.ShelleyMA.Timelocks
+  ( Timelock,
+    hashTimelockScript,
+    validateTimelock,
+  )
+import Data.Coders (decodeRecordSum)
+import Data.Typeable (Typeable)
+import Data.Word (Word8)
+import GHC.Generics (Generic)
+import Shelley.Spec.Ledger.Scripts (MultiSig)
+import Shelley.Spec.Ledger.Tx
+  ( ValidateScript (..),
+    hashMultiSigScript,
+    validateNativeMultiSigScript,
+  )
+
+data Script era
+  = ScriptMSig (MultiSig era)
+  | ScriptTimelock (Timelock era)
+  deriving (Show, Eq, Generic)
+
+instance ToCBOR (Script era) where
+  toCBOR = \case
+    ScriptMSig s -> encodeListLen 2 <> toCBOR (0 :: Word8) <> toCBOR s
+    ScriptTimelock s -> encodeListLen 2 <> toCBOR (1 :: Word8) <> toCBOR s
+
+instance FromCBOR (Annotator (Script era)) where
+  fromCBOR = annotatorSlice $
+    decodeRecordSum "Script" $
+      \case
+        0 -> ScriptMSig <$> fromCBOR
+        1 -> ScriptTimelock <$> fromCBOR
+
+type instance Core.Script (ShelleyMAEra ma c) = Script (ShelleyMAEra ma c)
+
+instance
+  ( CryptoClass.Crypto c,
+    Typeable ma,
+    Shelley.TxBodyConstraints (ShelleyMAEra ma c)
+  ) =>
+  ValidateScript (ShelleyMAEra ma c)
+  where
+  validateScript (ScriptMSig s) tx = validateNativeMultiSigScript s tx
+  validateScript (ScriptTimelock s) tx = validateTimelock s tx
+
+  hashScript (ScriptMSig s) = hashMultiSigScript s
+  hashScript (ScriptTimelock s) = hashTimelockScript s

shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Value.hs

@@ -46,8 +46,8 @@ import Data.Map.Internal
   )
 import Data.Map.Strict (assocs)
 import qualified Data.Map.Strict as Map
-import Data.Typeable (Typeable)
 import Data.Set (Set)
+import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
 import Shelley.Spec.Ledger.Coin (Coin (..))

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Utxow.hs

@@ -100,7 +100,8 @@ import Shelley.Spec.Ledger.Serialization
   )
 import qualified Shelley.Spec.Ledger.SoftForks as SoftForks
 import Shelley.Spec.Ledger.Tx
-  (ValidateScript,  Tx (..),
+  ( Tx (..),
+    ValidateScript,
     hashScript,
     txwitsScript,
     validateScript,

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Tx.hs

@@ -50,6 +50,8 @@ module Shelley.Spec.Ledger.Tx
     getKeyCombination,
     addrWits',
     evalNativeMultiSigScript,
+    hashMultiSigScript,
+    validateNativeMultiSigScript,
   )
 where