Add support for Allegra era timelocks in the multi signature scripts

IntersectMBO · Oct 22, 2020 · 92c226d · 92c226d
1 parent 810c956
commit 92c226d
Show file tree

Hide file tree

Showing 4 changed files with 132 additions and 50 deletions.
diff --git a/cardano-api/src/Cardano/API.hs b/cardano-api/src/Cardano/API.hs
@@ -140,7 +140,7 @@ module Cardano.API (
     -- ** Multi-signature scripts
     -- | Making multi-signature scripts.
     MultiSigScript,
-    makeMultiSigScript,
+    makeMultiSigScriptShelley,
 
     -- * Serialisation
     -- | Support for serialising data in JSON, CBOR and text files.

diff --git a/cardano-api/src/Cardano/Api/Typed.hs b/cardano-api/src/Cardano/Api/Typed.hs
@@ -175,7 +175,8 @@ module Cardano.Api.Typed (
     -- ** Multi-signature scripts
     -- | Making multi-signature scripts.
     MultiSigScript(..),
-    makeMultiSigScript,
+    ScriptFeatureInEra(..),
+    makeMultiSigScriptShelley,
 
     -- * Serialisation
     -- | Support for serialising data in JSON, CBOR and text files.
@@ -519,6 +520,11 @@ data Byron
 -- | A type used as a tag to distinguish the Shelley era.
 data Shelley
 
+-- | A type used as a tag to distinguish the Allegra era.
+data Allegra
+
+  -- | A type used as a tag to distinguish the Mary era.
+data Mary
 
 class HasTypeProxy t where
   -- | A family of singleton types used in this API to indicate which type to
@@ -1642,14 +1648,65 @@ newtype Script = Script (Shelley.Script StandardShelley)
 newtype instance Hash Script = ScriptHash (Shelley.ScriptHash StandardShelley)
   deriving (Eq, Ord, Show)
 
-data MultiSigScript = RequireSignature (Hash PaymentKey)
-                    | RequireAllOf [MultiSigScript]
-                    | RequireAnyOf [MultiSigScript]
-                    | RequireMOf Int [MultiSigScript]
-  deriving (Eq, Show)
+data MultiSigScript era where
+  RequireSignature  :: Hash PaymentKey
+                     -> ScriptFeatureInEra SignatureFeature era
+                     -> MultiSigScript era
+
+  RequireTimeBefore :: SlotNo
+                    -> ScriptFeatureInEra TimeLocksFeature era
+                    -> MultiSigScript era
+
+  RequireTimeAfter  :: SlotNo
+                    -> ScriptFeatureInEra TimeLocksFeature era
+                    -> MultiSigScript era
+
+  RequireAllOf      ::        [MultiSigScript era] -> MultiSigScript era
+  RequireAnyOf      ::        [MultiSigScript era] -> MultiSigScript era
+  RequireMOf        :: Int -> [MultiSigScript era] -> MultiSigScript era
+
+-- Needed for roundtripping tests
+deriving instance Eq (MultiSigScript Shelley)
+deriving instance Show (MultiSigScript Shelley)
+
+-- | Script Features
+-- These are used within 'ScriptFeatureInEra' in conjunction with the era
+-- (e.g 'Shelley', 'Allegra' etc) to specify which script features are
+-- enabled in a particular era.
+data SignatureFeature
+data TimeLocksFeature
+
+
+data ScriptFeatureInEra sfeat era where
+     SignaturesInShelleyEra  :: ScriptFeatureInEra SignatureFeature Shelley
+     SignaturesInAllegraEra  :: ScriptFeatureInEra SignatureFeature Allegra
+     SignaturesInMaryEra     :: ScriptFeatureInEra SignatureFeature Mary
+
+     TimeLocksInAllegraEra   :: ScriptFeatureInEra TimeLocksFeature Allegra
+     TimeLocksInMaryEra      :: ScriptFeatureInEra TimeLocksFeature Mary
+
+deriving instance Eq (ScriptFeatureInEra SignatureFeature Shelley)
+deriving instance Show (ScriptFeatureInEra SignatureFeature Shelley)
+
+deriving instance Eq (ScriptFeatureInEra SignatureFeature Allegra)
+deriving instance Show (ScriptFeatureInEra SignatureFeature Allegra)
+
+deriving instance Eq (ScriptFeatureInEra SignatureFeature Mary)
+deriving instance Show (ScriptFeatureInEra SignatureFeature Mary)
+
+deriving instance Eq (ScriptFeatureInEra TimeLocksFeature Allegra)
+deriving instance Show (ScriptFeatureInEra TimeLocksFeature Allegra)
+
+deriving instance Eq (ScriptFeatureInEra TimeLocksFeature Mary)
+deriving instance Show (ScriptFeatureInEra TimeLocksFeature Mary)
+
+-- Needed for roundtripping tests
+deriving instance Eq (ScriptFeatureInEra TimeLocksFeature Shelley)
+deriving instance Show (ScriptFeatureInEra TimeLocksFeature Shelley)
 
-instance ToJSON MultiSigScript where
-  toJSON (RequireSignature pKeyHash) =
+-- TODO: Distinguish different instances for Shelley vs Allegra etc
+instance ToJSON (MultiSigScript Shelley) where
+  toJSON (RequireSignature pKeyHash SignaturesInShelleyEra) =
     object [ "keyHash" .= String (Text.decodeUtf8 . serialiseToRawBytesHex $ pKeyHash)
            , "type" .= String "sig"
            ]
@@ -1662,33 +1719,38 @@ instance ToJSON MultiSigScript where
            , "required" .= reqNum
            , "scripts" .= map toJSON reqScripts
            ]
+  toJSON (RequireTimeBefore _ _) =
+    error "Timelocks not available in Shelley era multi signature scripts"
+  toJSON (RequireTimeAfter _ _) =
+    error "Timelocks not available in Shelley era multi signature scripts"
 
-instance FromJSON MultiSigScript where
+-- TODO: Distinguish different instances for Shelley vs Allegra etc
+instance FromJSON (MultiSigScript Shelley) where
   parseJSON = parseScript
 
-parseScript :: Value -> Aeson.Parser MultiSigScript
+parseScript :: Value -> Aeson.Parser (MultiSigScript Shelley)
 parseScript v = parseScriptSig v
                   <|> parseScriptAny v
                   <|> parseScriptAll v
                   <|> parseScriptAtLeast v
 
-parseScriptAny :: Value -> Aeson.Parser MultiSigScript
+parseScriptAny :: Value -> Aeson.Parser (MultiSigScript Shelley)
 parseScriptAny = Aeson.withObject "any" $ \obj -> do
   t <- obj .: "type"
   case t :: Text of
     "any" -> do s <- obj .: "scripts"
                 RequireAnyOf <$> gatherMultiSigScripts s
     _ -> fail "\"any\" multi-signature script value not found"
 
-parseScriptAll :: Value -> Aeson.Parser MultiSigScript
+parseScriptAll :: Value -> Aeson.Parser (MultiSigScript Shelley)
 parseScriptAll = Aeson.withObject "all" $ \obj -> do
   t <- obj .: "type"
   case t :: Text of
     "all" -> do s <- obj .: "scripts"
                 RequireAllOf <$> gatherMultiSigScripts s
     _ -> fail "\"all\" multi-signature script value not found"
 
-parseScriptAtLeast :: Value -> Aeson.Parser MultiSigScript
+parseScriptAtLeast :: Value -> Aeson.Parser (MultiSigScript Shelley)
 parseScriptAtLeast = Aeson.withObject "atLeast" $ \obj -> do
   v <- obj .: "type"
   case v :: Text of
@@ -1712,20 +1774,20 @@ parseScriptAtLeast = Aeson.withObject "atLeast" $ \obj -> do
         _ -> fail "\"required\" value should be an integer"
     _        -> fail "\"atLeast\" multi-signature script value not found"
 
-parseScriptSig :: Value -> Aeson.Parser MultiSigScript
+parseScriptSig :: Value -> Aeson.Parser (MultiSigScript Shelley)
 parseScriptSig = Aeson.withObject "sig" $ \obj -> do
   v <- obj .: "type"
   case v :: Text of
     "sig" -> do k <- obj .: "keyHash"
-                RequireSignature <$> convertToHash k
+                flip RequireSignature SignaturesInShelleyEra <$> convertToHash k
     _     -> fail "\"sig\" multi-signature script value not found"
 
 convertToHash :: Text -> Aeson.Parser (Hash PaymentKey)
 convertToHash txt = case deserialiseFromRawBytesHex (AsHash AsPaymentKey) $ Text.encodeUtf8 txt of
                       Just payKeyHash -> return payKeyHash
                       Nothing -> fail $ "Error deserialising payment key hash: " <> Text.unpack txt
 
-gatherMultiSigScripts :: Vector Value -> Aeson.Parser [MultiSigScript]
+gatherMultiSigScripts :: Vector Value -> Aeson.Parser [MultiSigScript Shelley]
 gatherMultiSigScripts vs = sequence . Vector.toList $ Vector.map parseScript vs
 
 instance HasTypeProxy Script where
@@ -1757,15 +1819,17 @@ instance HasTextEnvelope Script where
 scriptHash :: Script -> Hash Script
 scriptHash (Script s) = ScriptHash (Shelley.hashAnyScript s)
 
-makeMultiSigScript :: MultiSigScript -> Script
-makeMultiSigScript = Script . Shelley.MultiSigScript . go
+makeMultiSigScriptShelley :: MultiSigScript Shelley -> Script
+makeMultiSigScriptShelley = Script . Shelley.MultiSigScript . go
   where
-    go :: MultiSigScript -> Shelley.MultiSig StandardShelley
-    go (RequireSignature (PaymentKeyHash kh))
+    go :: MultiSigScript Shelley -> Shelley.MultiSig StandardShelley
+    go (RequireSignature (PaymentKeyHash kh) SignaturesInShelleyEra)
                         = Shelley.RequireSignature (Shelley.coerceKeyRole kh)
     go (RequireAllOf s) = Shelley.RequireAllOf (map go s)
     go (RequireAnyOf s) = Shelley.RequireAnyOf (map go s)
     go (RequireMOf m s) = Shelley.RequireMOf m (map go s)
+    go (RequireTimeBefore _ _) = error "Timelocks not available in Shelley era"
+    go (RequireTimeAfter _ _) = error "Timelocks not available in Shelley era"
 
 makeShelleyScriptWitness :: Script -> Witness Shelley
 makeShelleyScriptWitness (Script s) = ShelleyScriptWitness s

diff --git a/cardano-api/test/Test/Cardano/Api/Examples.hs b/cardano-api/test/Test/Cardano/Api/Examples.hs
@@ -18,11 +18,11 @@ import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 
-import           Cardano.Api.Typed (MultiSigScript (..))
+import           Cardano.Api.Typed (MultiSigScript (..), ScriptFeatureInEra (..), Shelley)
 import qualified Cardano.Api.Typed as Api
 import           Cardano.Slotting.Slot (EpochSize (..))
-import           Ouroboros.Consensus.Shelley.Node (emptyGenesisStaking)
 import           Ouroboros.Consensus.Shelley.Eras (StandardShelley)
+import           Ouroboros.Consensus.Shelley.Node (emptyGenesisStaking)
 import           Ouroboros.Consensus.Util.Time
 
 import           Shelley.Spec.Ledger.Address (Addr (..))
@@ -37,53 +37,71 @@ import           Shelley.Spec.Ledger.PParams (PParams' (..), emptyPParams)
 import           Cardano.Api.Shelley.Genesis
 
 
-exampleAll :: MultiSigScript
+exampleAll :: MultiSigScript Shelley
 exampleAll =
   RequireAllOf [ RequireSignature
-                   $ convertToHash "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a"
+                   (convertToHash "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "a687dcc24e00dd3caafbeb5e68f97ca8ef269cb6fe971345eb951756"
+                   (convertToHash "a687dcc24e00dd3caafbeb5e68f97ca8ef269cb6fe971345eb951756")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "0bd1d702b2e6188fe0857a6dc7ffb0675229bab58c86638ffa87ed6d"
+                   (convertToHash "0bd1d702b2e6188fe0857a6dc7ffb0675229bab58c86638ffa87ed6d")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "dd0044a26cf7d4491ecea720fda11afb59d5725b53afa605fdf695e6"
+                   (convertToHash "dd0044a26cf7d4491ecea720fda11afb59d5725b53afa605fdf695e6")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "cf223afe150cc8e89f11edaacbbd55b011ba44fbedef66fbd37d8c9d"
+                   (convertToHash "cf223afe150cc8e89f11edaacbbd55b011ba44fbedef66fbd37d8c9d")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "372643e7ef4b41fd2649ada30a89d35cb90b7c14cb5de252e6ce6cb7"
+                   (convertToHash "372643e7ef4b41fd2649ada30a89d35cb90b7c14cb5de252e6ce6cb7")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "aa453dc184c5037d60e3fbbadb023f4a41bac112f249b76be9bb37ad"
+                   (convertToHash "aa453dc184c5037d60e3fbbadb023f4a41bac112f249b76be9bb37ad")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "6b732c60c267bab894854d6dd57a04a94e603fcc4c36274c9ed75952"
+                   (convertToHash "6b732c60c267bab894854d6dd57a04a94e603fcc4c36274c9ed75952")
+                   SignaturesInShelleyEra
                ]
 
 
-exampleAny :: MultiSigScript
+exampleAny :: MultiSigScript Shelley
 exampleAny =
   RequireAnyOf [ RequireSignature
-                   $ convertToHash "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09"
+                   (convertToHash "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "4d780ed1bfc88cbd4da3f48de91fe728c3530d662564bf5a284b5321"
+                   (convertToHash "4d780ed1bfc88cbd4da3f48de91fe728c3530d662564bf5a284b5321")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "3a94d6d4e786a3f5d439939cafc0536f6abc324fb8404084d6034bf8"
+                   (convertToHash "3a94d6d4e786a3f5d439939cafc0536f6abc324fb8404084d6034bf8")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "b12e094d1db7c0fba5121f22db193d0060efed8be43654f861bb68ae"
+                   (convertToHash "b12e094d1db7c0fba5121f22db193d0060efed8be43654f861bb68ae")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "9be49d56442b4b8b16cab4e43e238bbdefc6c803d554c82fcd5facc3"
+                   (convertToHash "9be49d56442b4b8b16cab4e43e238bbdefc6c803d554c82fcd5facc3")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "622be5fab3b5c3f371a50a535e4d3349c942a98cecee93b24e2fd11d"
+                   (convertToHash "622be5fab3b5c3f371a50a535e4d3349c942a98cecee93b24e2fd11d")
+                   SignaturesInShelleyEra
                ]
 
-exampleMofN :: MultiSigScript
+exampleMofN :: MultiSigScript Shelley
 exampleMofN =
   RequireMOf 2 [ RequireSignature
-                   $ convertToHash "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413"
+                   (convertToHash "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614"
+                   (convertToHash "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "b275b08c999097247f7c17e77007c7010cd19f20cc086ad99d398538"
+                   (convertToHash "b275b08c999097247f7c17e77007c7010cd19f20cc086ad99d398538")
+                   SignaturesInShelleyEra
                , RequireSignature
-                   $ convertToHash "686024aecb5884d73a11b9ae4e63931112ba737e878d74638b78513a"
+                   (convertToHash "686024aecb5884d73a11b9ae4e63931112ba737e878d74638b78513a")
+                   SignaturesInShelleyEra
                ]
 
 convertToHash :: Text -> Api.Hash Api.PaymentKey

diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs
@@ -57,26 +57,26 @@ genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded
 genLovelace :: Gen Lovelace
 genLovelace = Lovelace <$> Gen.integral (Range.linear 0 5000)
 
-genRequiredSig :: Gen MultiSigScript
+genRequiredSig :: Gen (MultiSigScript Shelley)
 genRequiredSig = do
   verKey <- genVerificationKey AsPaymentKey
-  return . RequireSignature $ verificationKeyHash verKey
+  return $ RequireSignature (verificationKeyHash verKey) SignaturesInShelleyEra
 
-genAllRequiredSig :: Gen MultiSigScript
+genAllRequiredSig :: Gen (MultiSigScript Shelley)
 genAllRequiredSig =
   RequireAllOf <$> Gen.list (Range.constant 1 10) genRequiredSig
 
-genAnyRequiredSig :: Gen MultiSigScript
+genAnyRequiredSig :: Gen (MultiSigScript Shelley)
 genAnyRequiredSig =
   RequireAnyOf <$> Gen.list (Range.constant 1 10) genRequiredSig
 
-genMofNRequiredSig :: Gen MultiSigScript
+genMofNRequiredSig :: Gen (MultiSigScript Shelley)
 genMofNRequiredSig = do
  required <- Gen.integral (Range.linear 2 15)
  total <- Gen.integral (Range.linear (required + 1) 15)
  RequireMOf required <$> Gen.list (Range.singleton total) genRequiredSig
 
-genMultiSigScript :: Gen MultiSigScript
+genMultiSigScript :: Gen (MultiSigScript Shelley)
 genMultiSigScript =
   Gen.choice [genAllRequiredSig, genAnyRequiredSig, genMofNRequiredSig]