Add Allegra Scripts and more module creation/grouping

cardano-api/src/Cardano/API.hs

@@ -135,7 +135,7 @@ module Cardano.API (
 
     -- ** Script addresses
     -- | Making addresses from scripts.
-    scriptHash,
+    scriptHashShelley,
 
     -- ** Multi-signature scripts
     -- | Making multi-signature scripts.

cardano-api/src/Cardano/Api/HasTypeProxy.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TypeFamilies #-}
 
 module Cardano.Api.HasTypeProxy
-  ( HasTypeProxy(..)
+  ( HasTypeProxy(AsType, proxyToAsType)
   ) where
 
 import           Data.Proxy (Proxy (..))

cardano-api/src/Cardano/Api/MultiSig.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -10,7 +11,7 @@ module Cardano.Api.MultiSig
     -- | Both 'PaymentCredential's and 'StakeCredential's can use scripts.
     -- Shelley supports multi-signatures via scripts.
     Script(..),
-    Hash(ScriptHash),
+    Hash(ScriptHashShelley, ScriptHashAllegra),
     parseScript,
     parseScriptAny,
     parseScriptAll,
@@ -19,7 +20,8 @@ module Cardano.Api.MultiSig
 
     -- ** Script addresses
     -- | Making addresses from scripts.
-    scriptHash,
+    scriptHashShelley,
+    scriptHashAllegra,
 
     -- ** Multi-signature scripts
     -- | Making multi-signature scripts.
@@ -34,15 +36,20 @@ import           Prelude (error)
 import           Control.Monad (fail)
 import           Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.:), (.=))
 import qualified Data.Aeson.Types as Aeson
+import qualified Data.ByteString.Lazy as LBS
 import           Data.Scientific (toBoundedInteger)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Data.Vector (Vector)
 import qualified Data.Vector as Vector
 
 import           Cardano.Api.Eras
+import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Serialisation
 
+import           Cardano.Binary (FromCBOR (fromCBOR))
+import qualified Cardano.Binary as CBOR
+import qualified Cardano.Crypto.Hash.Class as Crypto
 import           Cardano.Slotting.Slot (SlotNo (..))
 
 --
@@ -52,24 +59,85 @@ import           Ouroboros.Consensus.Shelley.Eras (StandardShelley)
 import qualified Shelley.Spec.Ledger.Keys as Shelley
 import qualified Shelley.Spec.Ledger.Scripts as Shelley
 
---
--- Common types, consensus, network
---
-import           Cardano.Binary (ToCBOR)
-
 -- ----------------------------------------------------------------------------
 -- Scripts
 --
 
-newtype Script = Script (Shelley.Script StandardShelley)
-  deriving stock (Eq, Ord, Show)
-  deriving newtype (ToCBOR)
+data Script era where
+  ShelleyScript :: Shelley.Script StandardShelley -> Script Shelley
+  AllegraScript :: Shelley.Script StandardShelley -> Script Allegra
+
+
+deriving instance Eq (Script Shelley)
+deriving instance Show (Script Shelley)
+
+deriving instance Eq (Script Allegra)
+deriving instance Show (Script Allegra)
+
+--deriving instance ToCBOR (Script Shelley) ?
+
+instance HasTypeProxy (Script Shelley) where
+    data AsType (Script Shelley) = AsShelleyScript
+    proxyToAsType _ = AsShelleyScript
+
+instance SerialiseAsRawBytes (Hash (Script Shelley)) where
+    serialiseToRawBytes (ScriptHashShelley (Shelley.ScriptHash h)) =
+      Crypto.hashToBytes h
+
+    deserialiseFromRawBytes (AsHash AsShelleyScript) bs =
+      ScriptHashShelley . Shelley.ScriptHash <$> Crypto.hashFromBytes bs
+
+instance SerialiseAsCBOR (Script Shelley) where
+    serialiseToCBOR (ShelleyScript s) =
+      CBOR.serialize' s
 
-newtype instance Hash Script = ScriptHash (Shelley.ScriptHash StandardShelley)
+    deserialiseFromCBOR AsShelleyScript bs =
+      ShelleyScript <$>
+        CBOR.decodeAnnotator "ShelleyScript" fromCBOR (LBS.fromStrict bs)
+
+instance HasTextEnvelope (Script Shelley) where
+    textEnvelopeType _ = "Shelley Script"
+    textEnvelopeDefaultDescr (ShelleyScript script) =
+      case script of
+        Shelley.MultiSigScript {} -> "Shelley Multi-signature script"
+
+instance HasTypeProxy (Script Allegra) where
+    data AsType (Script Allegra) = AsAllegraScript
+    proxyToAsType _ = AsAllegraScript
+
+instance SerialiseAsRawBytes (Hash (Script Allegra)) where
+    serialiseToRawBytes (ScriptHashAllegra (Shelley.ScriptHash h)) =
+      Crypto.hashToBytes h
+
+    deserialiseFromRawBytes (AsHash AsAllegraScript) bs =
+      ScriptHashAllegra . Shelley.ScriptHash <$> Crypto.hashFromBytes bs
+
+instance SerialiseAsCBOR (Script Allegra) where
+    serialiseToCBOR (AllegraScript s) =
+      CBOR.serialize' s
+
+    deserialiseFromCBOR AsAllegraScript bs =
+      AllegraScript <$>
+        CBOR.decodeAnnotator "AllegraScript" fromCBOR (LBS.fromStrict bs)
+
+instance HasTextEnvelope (Script Allegra) where
+    textEnvelopeType _ = "Allegra Script"
+    textEnvelopeDefaultDescr (AllegraScript script) =
+      case script of
+        -- TODO: Need to pattern match on TimeLock script
+        Shelley.MultiSigScript {} -> "Allegra Multi-signature script"
+
+newtype instance Hash (Script Shelley) = ScriptHashShelley (Shelley.ScriptHash StandardShelley)
   deriving (Eq, Ord, Show)
 
-scriptHash :: Script -> Hash Script
-scriptHash (Script s) = ScriptHash (Shelley.hashAnyScript s)
+newtype instance Hash (Script Allegra) = ScriptHashAllegra (Shelley.ScriptHash StandardShelley)
+  deriving (Eq, Ord, Show)
+
+scriptHashShelley :: Script Shelley -> Hash (Script Shelley)
+scriptHashShelley (ShelleyScript s) = ScriptHashShelley (Shelley.hashAnyScript s)
+
+scriptHashAllegra :: Script Allegra -> Hash (Script Allegra)
+scriptHashAllegra (AllegraScript s) = ScriptHashAllegra (Shelley.hashAnyScript s)
 
 data MultiSigScript era where
   RequireSignature  :: Hash PaymentKey
@@ -127,8 +195,8 @@ deriving instance Show (ScriptFeatureInEra TimeLocksFeature Mary)
 deriving instance Eq (ScriptFeatureInEra TimeLocksFeature Shelley)
 deriving instance Show (ScriptFeatureInEra TimeLocksFeature Shelley)
 
-makeMultiSigScriptShelley :: MultiSigScript Shelley -> Script
-makeMultiSigScriptShelley = Script . Shelley.MultiSigScript . go
+makeMultiSigScriptShelley :: MultiSigScript Shelley -> Script Shelley
+makeMultiSigScriptShelley = ShelleyScript . Shelley.MultiSigScript . go
   where
     go :: MultiSigScript Shelley -> Shelley.MultiSig StandardShelley
     go (RequireSignature (PaymentKeyHash kh) SignaturesInShelleyEra)