From 4c2e0249d5be6f56368f93963607d00f336c7064 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 20 Oct 2020 12:14:52 +0100 Subject: [PATCH] Add support for Allegra era timelocks in the multi signature scripts --- cardano-api/src/Cardano/API.hs | 2 +- cardano-api/src/Cardano/Api/Typed.hs | 104 ++++++++++++++---- cardano-api/test/Test/Cardano/Api/Examples.hs | 64 +++++++---- .../test/Test/Cardano/Api/Typed/Gen.hs | 12 +- 4 files changed, 132 insertions(+), 50 deletions(-) diff --git a/cardano-api/src/Cardano/API.hs b/cardano-api/src/Cardano/API.hs index b303e70672c..36d039784ba 100644 --- 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 index 4696d7dcbf7..fa14c557c80 100644 --- 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,17 +1719,22 @@ 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 @@ -1680,7 +1742,7 @@ parseScriptAny = Aeson.withObject "any" $ \obj -> do 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 @@ -1688,7 +1750,7 @@ parseScriptAll = Aeson.withObject "all" $ \obj -> do 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,12 +1774,12 @@ 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) @@ -1725,7 +1787,7 @@ convertToHash txt = case deserialiseFromRawBytesHex (AsHash AsPaymentKey) $ Text 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 index c45a94de0e7..7c93dde2a3d 100644 --- 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 index 3d2d6fe95aa..04a43a1f05f 100644 --- 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]