Merge #1660

1660: Implement ToJSON/FromJSON instances of MultiSigScript r=Jimbo4350 a=Jimbo4350

In an effort to keep things simple, the multisig syntax will use JSON for now unless we need . This is not integrated into cardano-cli as yet. The format is as follows:

Require `all` signatures:
```
{ "all": [ "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413", "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614" ] }
```
Require `any` signature:
```
{ "any": [ "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413", "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614" ] }
```
Require `atLeast` signatures:
e.g 2 of 4:
```
{
    "atLeast": {
        "paymentKeyHashes": [
            "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413",
            "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614",
            "b275b08c999097247f7c17e77007c7010cd19f20cc086ad99d398538",
            "686024aecb5884d73a11b9ae4e63931112ba737e878d74638b78513a"
        ],
        "required": 2,
        "total": 4
    }
}
```


Co-authored-by: Jordan Millar <jordan.millar@iohk.io>

cardano-api/cardano-api.cabal

@@ -129,6 +129,7 @@ test-suite cardano-api-test
                         Test.Cardano.Api.Typed.CBOR
                         Test.Cardano.Api.Typed.Envelope
                         Test.Cardano.Api.Typed.Gen
+                        Test.Cardano.Api.Typed.MultiSigScript
                         Test.Cardano.Api.Typed.Orphans
                         Test.Cardano.Api.Typed.RawBytes
 

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

@@ -35,7 +35,6 @@ module Cardano.Api.Typed (
     Shelley,
     HasTypeProxy(..),
     AsType(..),
-
     -- * Cryptographic key interface
     -- $keys
     Key,
@@ -305,24 +304,23 @@ module Cardano.Api.Typed (
     toShelleyNetwork,
   ) where
 
-
 import           Prelude
 
 import           Data.Aeson.Encode.Pretty (encodePretty')
 import           Data.Bifunctor (first)
+import qualified Data.HashMap.Strict as HMS
 import           Data.Kind (Constraint)
 import           Data.List as List
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Maybe
 import           Data.Proxy (Proxy (..))
-import           Data.Typeable (Typeable)
-import           Data.Void (Void)
-import           Data.Word
---import           Data.Either
 import           Data.String (IsString (fromString))
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
+import           Data.Typeable (Typeable)
+import           Data.Void (Void)
+import           Data.Word
 import           Numeric.Natural
 
 import           Data.IP (IPv4, IPv6)
@@ -342,6 +340,7 @@ import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Sequence.Strict as Seq
 import qualified Data.Set as Set
+import           Data.Vector (Vector)
 import qualified Data.Vector as Vector
 
 import qualified Codec.Binary.Bech32 as Bech32
@@ -355,11 +354,10 @@ import           Control.Monad.Trans.Except (ExceptT (..))
 import           Control.Monad.Trans.Except.Extra
 import           Control.Tracer (nullTracer)
 
-import           Data.Aeson (FromJSON (..), ToJSON (..), (.:))
+import           Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.:), (.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 
-
 --
 -- Common types, consensus, network
 --
@@ -465,8 +463,6 @@ import           Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure
 import           Ouroboros.Network.Protocol.LocalTxSubmission.Client as TxSubmission
 
 
-
-
 -- ----------------------------------------------------------------------------
 -- Cardano eras, sometimes we have to distinguish them
 --
@@ -1563,6 +1559,114 @@ data MultiSigScript = RequireSignature (Hash PaymentKey)
                     | RequireMOf Int [MultiSigScript]
   deriving (Eq, Show)
 
+instance ToJSON MultiSigScript where
+  toJSON (RequireSignature payKeyHash) = String . Text.decodeUtf8 $ serialiseToRawBytesHex $ payKeyHash
+  toJSON (RequireAnyOf reqSigs) = object [ "any" .= map toJSON reqSigs ]
+  toJSON (RequireAllOf reqSigs) = object [ "all" .= map toJSON reqSigs ]
+  toJSON (RequireMOf reqNum reqSigs) = toJSONmOfnChecks reqSigs reqNum (length reqSigs)
+
+toJSONmOfnChecks :: [MultiSigScript] -> Int -> Int -> Value
+toJSONmOfnChecks keys required total
+  | length keys /= total = error $ "The number of payment key hashes submitted \
+                                 \does not equal total. " ++ " total: " ++ show total
+                                 ++ "Number of key hashes: " ++ show (length keys)
+
+  | length keys < required = error $ "required exceeds the number of payment key \
+                                   \hashes. Number of keys: " ++ show (length keys)
+                                   ++ " required: " ++ show required
+
+  | required <= 0 = error "The required number of payment key hashes cannot be less than or equal to 0."
+  | required == 1 = error "required is equal to one, you should use the \"any\" multisig script"
+
+  | required == total = error $ "required is equal to the total, you should use \
+                                \the \"all\" multisig script"
+
+  | length keys == total = object [ "atLeast" .= object
+                                    [ "required" .= required
+                                    , "total" .= total
+                                    , "paymentKeyHashes" .= keys
+                                    ]
+                                  ]
+
+  | otherwise = error $ "Cardano.Api.Typed.toJSONmofnChecks failure occured: " ++ " required: "
+                      ++ show required ++ " total: " ++  show total
+                      ++ " number of key hashes: " ++ show (length keys)
+
+instance FromJSON MultiSigScript where
+  parseJSON = Aeson.withObject "MultiSigScript" $ \obj ->
+   select [all' obj, any' obj, mofn (Object obj)]
+
+select :: [ParseMultiSigScript] -> Aeson.Parser MultiSigScript
+select [] = fail "No multisig scripts found"
+select (x : xs) = case x of
+                    All mss -> mss
+                    Any mss -> mss
+                    MofN mss  -> mss
+                    ScriptNotFound -> select xs
+
+data ParseMultiSigScript = All (Aeson.Parser MultiSigScript)
+                         | Any (Aeson.Parser MultiSigScript)
+                         | MofN (Aeson.Parser MultiSigScript)
+                         | ScriptNotFound
+
+-- Parse "all" multisig objects
+all' :: HMS.HashMap Text Value -> ParseMultiSigScript
+all' obj = case HMS.lookup "all" obj of
+             Just (Array vecAllReqHashes) ->
+               All . return . RequireAllOf $ gatherSignatures vecAllReqHashes
+             _ -> ScriptNotFound
+
+-- Parse "any" multisig objects
+any' :: HMS.HashMap Text Value -> ParseMultiSigScript
+any' obj = case HMS.lookup "any" obj of
+             Just (Array vecAnyReqHashes) ->
+               Any . return . RequireAnyOf $ gatherSignatures vecAnyReqHashes
+             _ -> ScriptNotFound
+
+-- Parse "mofn" multisig objects
+mofn :: Value -> ParseMultiSigScript
+mofn val =
+  MofN $ Aeson.withObject "mofn"
+           (\o -> do mofnObj <- o .: "atLeast"
+                     required <- mofnObj .: "required"
+                     total <- mofnObj .: "total"
+                     keyHashes <- case HMS.lookup "paymentKeyHashes" mofnObj of
+                                    Just (Array keyhashes) -> return $ gatherSignatures keyhashes
+                                    _ -> return []
+                     fromJSONmOfnChecks keyHashes required total)
+           val
+
+
+
+fromJSONmOfnChecks :: [MultiSigScript] -> Int -> Int -> Aeson.Parser MultiSigScript
+fromJSONmOfnChecks keys required total
+  | required <= 0 = error  "The required number of payment key hashes cannot be less than or equal to 0."
+  | required == 1 = fail "required is equal to one, you should use the \"any\" multisig script"
+  | required == total = fail $ "required is equal to the total, you should \
+                               \use the \"all\" multisig script"
+  | length keys < required = fail $ "required exceeds the number of payment key hashes. \
+                                    \Number of keys: " ++ show (length keys)
+                                  ++ " required: " ++ show required
+  | length keys == total = return $ RequireMOf required keys
+  | otherwise = fail $ "Cardano.Api.Typed.fromJSONmOfnChecks failure occured. required: "
+                     ++ show required ++ " total: " ++ show total
+                     ++ " keys: " ++ show keys
+
+gatherSignatures :: Vector Value -> [MultiSigScript]
+gatherSignatures anyList =
+  let mPaymentKeyHashes = Vector.map (fmap RequireSignature . filterValue) anyList
+  in catMaybes $ Vector.toList mPaymentKeyHashes
+ where
+  filterValue :: Value -> Maybe (Hash PaymentKey)
+  filterValue (String hpk) = Just $ convertToHash hpk
+  filterValue _ = Nothing
+
+convertToHash :: Text -> Hash PaymentKey
+convertToHash txt = case deserialiseFromRawBytesHex (AsHash AsPaymentKey) $ Text.encodeUtf8 txt of
+                      Just payKeyHash -> payKeyHash
+                      Nothing -> error $ "Error deserialising payment key hash: " <> Text.unpack txt
+
+
 instance HasTypeProxy Script where
     data AsType Script = AsScript
     proxyToAsType _ = AsScript

cardano-api/test/Golden/MultiSig/all

@@ -0,0 +1,12 @@
+{
+    "all": [
+        "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a",
+        "a687dcc24e00dd3caafbeb5e68f97ca8ef269cb6fe971345eb951756",
+        "0bd1d702b2e6188fe0857a6dc7ffb0675229bab58c86638ffa87ed6d",
+        "dd0044a26cf7d4491ecea720fda11afb59d5725b53afa605fdf695e6",
+        "cf223afe150cc8e89f11edaacbbd55b011ba44fbedef66fbd37d8c9d",
+        "372643e7ef4b41fd2649ada30a89d35cb90b7c14cb5de252e6ce6cb7",
+        "aa453dc184c5037d60e3fbbadb023f4a41bac112f249b76be9bb37ad",
+        "6b732c60c267bab894854d6dd57a04a94e603fcc4c36274c9ed75952"
+    ]
+}

cardano-api/test/Golden/MultiSig/any

@@ -0,0 +1,10 @@
+{
+    "any": [
+        "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09",
+        "4d780ed1bfc88cbd4da3f48de91fe728c3530d662564bf5a284b5321",
+        "3a94d6d4e786a3f5d439939cafc0536f6abc324fb8404084d6034bf8",
+        "b12e094d1db7c0fba5121f22db193d0060efed8be43654f861bb68ae",
+        "9be49d56442b4b8b16cab4e43e238bbdefc6c803d554c82fcd5facc3",
+        "622be5fab3b5c3f371a50a535e4d3349c942a98cecee93b24e2fd11d"
+    ]
+}

cardano-api/test/Golden/MultiSig/mofn

@@ -0,0 +1,12 @@
+{
+    "atLeast": {
+        "paymentKeyHashes": [
+            "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413",
+            "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614",
+            "b275b08c999097247f7c17e77007c7010cd19f20cc086ad99d398538",
+            "686024aecb5884d73a11b9ae4e63931112ba737e878d74638b78513a"
+        ],
+        "required": 2,
+        "total": 4
+    }
+}

cardano-api/test/Test/Cardano/Api/Examples.hs

@@ -4,14 +4,22 @@
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 
 module Test.Cardano.Api.Examples
-  ( exampleShelleyGenesis
+  ( exampleAll
+  , exampleAny
+  , exampleMofN
+  , exampleShelleyGenesis
   ) where
 
 import           Cardano.Prelude
+import           Prelude (error)
 
 import qualified Data.Map.Strict as Map
+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 qualified Cardano.Api.Typed as Api
 import           Cardano.Slotting.Slot (EpochSize (..))
 import           Ouroboros.Consensus.Shelley.Node (emptyGenesisStaking)
 import           Ouroboros.Consensus.Shelley.Protocol (TPraosStandardCrypto)
@@ -29,6 +37,62 @@ import           Shelley.Spec.Ledger.PParams (PParams' (..), emptyPParams)
 import           Cardano.Api.Shelley.Genesis
 
 
+exampleAll :: MultiSigScript
+exampleAll =
+  RequireAllOf [ RequireSignature
+                   $ convertToHash "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a"
+               , RequireSignature
+                   $ convertToHash "a687dcc24e00dd3caafbeb5e68f97ca8ef269cb6fe971345eb951756"
+               , RequireSignature
+                   $ convertToHash "0bd1d702b2e6188fe0857a6dc7ffb0675229bab58c86638ffa87ed6d"
+               , RequireSignature
+                   $ convertToHash "dd0044a26cf7d4491ecea720fda11afb59d5725b53afa605fdf695e6"
+               , RequireSignature
+                   $ convertToHash "cf223afe150cc8e89f11edaacbbd55b011ba44fbedef66fbd37d8c9d"
+               , RequireSignature
+                   $ convertToHash "372643e7ef4b41fd2649ada30a89d35cb90b7c14cb5de252e6ce6cb7"
+               , RequireSignature
+                   $ convertToHash "aa453dc184c5037d60e3fbbadb023f4a41bac112f249b76be9bb37ad"
+               , RequireSignature
+                   $ convertToHash "6b732c60c267bab894854d6dd57a04a94e603fcc4c36274c9ed75952"
+               ]
+
+
+exampleAny :: MultiSigScript
+exampleAny =
+  RequireAnyOf [ RequireSignature
+                   $ convertToHash "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09"
+               , RequireSignature
+                   $ convertToHash "4d780ed1bfc88cbd4da3f48de91fe728c3530d662564bf5a284b5321"
+               , RequireSignature
+                   $ convertToHash "3a94d6d4e786a3f5d439939cafc0536f6abc324fb8404084d6034bf8"
+               , RequireSignature
+                   $ convertToHash "b12e094d1db7c0fba5121f22db193d0060efed8be43654f861bb68ae"
+               , RequireSignature
+                   $ convertToHash "9be49d56442b4b8b16cab4e43e238bbdefc6c803d554c82fcd5facc3"
+               , RequireSignature
+                   $ convertToHash "622be5fab3b5c3f371a50a535e4d3349c942a98cecee93b24e2fd11d"
+               ]
+
+exampleMofN :: MultiSigScript
+exampleMofN =
+  RequireMOf 2 [ RequireSignature
+                   $ convertToHash "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413"
+               , RequireSignature
+                   $ convertToHash "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614"
+               , RequireSignature
+                   $ convertToHash "b275b08c999097247f7c17e77007c7010cd19f20cc086ad99d398538"
+               , RequireSignature
+                   $ convertToHash "686024aecb5884d73a11b9ae4e63931112ba737e878d74638b78513a"
+               ]
+
+convertToHash :: Text -> Api.Hash Api.PaymentKey
+convertToHash txt =
+  case Api.deserialiseFromRawBytesHex (Api.AsHash Api.AsPaymentKey) $ Text.encodeUtf8 txt of
+    Just payKeyHash -> payKeyHash
+    Nothing -> error $ "Test.Cardano.Api.Examples.convertToHash: Error deserialising payment key hash: "
+                     <> Text.unpack txt
+
 exampleShelleyGenesis :: ShelleyGenesis TPraosStandardCrypto
 exampleShelleyGenesis =
   ShelleyGenesis

cardano-api/test/Test/Cardano/Api/Typed/Gen.hs

@@ -2,6 +2,9 @@ module Test.Cardano.Api.Typed.Gen
   ( genAddressByron
   , genAddressShelley
   , genByronKeyWitness
+  , genRequiredSig
+  , genMofNRequiredSig
+  , genMultiSigScript
   , genOperationalCertificate
   , genOperationalCertificateIssueCounter
   , genShelleyWitness
@@ -54,6 +57,29 @@ genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded
 genLovelace :: Gen Lovelace
 genLovelace = Lovelace <$> Gen.integral (Range.linear 0 5000)
 
+genRequiredSig :: Gen MultiSigScript
+genRequiredSig = do
+  verKey <- genVerificationKey AsPaymentKey
+  return . RequireSignature $ verificationKeyHash verKey
+
+genAllRequiredSig :: Gen MultiSigScript
+genAllRequiredSig =
+  RequireAllOf <$> Gen.list (Range.constant 1 10) genRequiredSig
+
+genAnyRequiredSig :: Gen MultiSigScript
+genAnyRequiredSig =
+  RequireAnyOf <$> Gen.list (Range.constant 1 10) genRequiredSig
+
+genMofNRequiredSig :: Gen MultiSigScript
+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.choice [genAllRequiredSig, genAnyRequiredSig, genMofNRequiredSig]
+
 genNetworkId :: Gen NetworkId
 genNetworkId =
   Gen.choice