cardano-addresses-4.0.0: test/Cardano/Address/ScriptSpec.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Cardano.Address.ScriptSpec
( spec
) where
import Prelude
import Cardano.Address.Derivation
( Depth (..)
, DerivationType (..)
, Index
, XPrv
, XPub
, indexFromWord32
, toXPub
, xpubFromBytes
)
import Cardano.Address.KeyHash
( KeyHash (..), KeyRole (..) )
import Cardano.Address.Script
( Cosigner (..)
, ErrRecommendedValidateScript (..)
, ErrValidateScript (..)
, ErrValidateScriptTemplate (..)
, Script (..)
, ScriptHash (..)
, ScriptTemplate (..)
, ValidationLevel (..)
, serializeScript
, toScriptHash
, validateScript
, validateScriptOfTemplate
, validateScriptTemplate
)
import Cardano.Address.Script.Parser
( requireCosignerOfParser, scriptFromString, scriptToText )
import Cardano.Address.Style.Shared
( Shared (..) )
import Cardano.Address.Style.Shelley
( Role (..), Shelley (..) )
import Cardano.Mnemonic
( mkSomeMnemonic )
import Codec.Binary.Encoding
( AbstractEncoding (..), encode, fromBase16 )
import Data.Aeson
( FromJSON, ToJSON )
import Data.Either
( isLeft )
import Data.Maybe
( fromJust )
import Data.Text
( Text )
import Test.Arbitrary
()
import Test.Hspec
( Spec, describe, expectationFailure, it, shouldBe, shouldContain )
import Test.QuickCheck
( Arbitrary (..)
, Gen
, Positive (..)
, Property
, choose
, classify
, elements
, genericShrink
, oneof
, property
, scale
, sized
, vectorOf
, (===)
)
import qualified Cardano.Address.Style.Shared as Shared
import qualified Cardano.Address.Style.Shelley as Shelley
import qualified Data.Aeson as Json
import qualified Data.ByteString as BS
import qualified Data.List as L
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
spec :: Spec
spec = do
let mnemonic = ["network","empty","cause","mean","expire","private","finger"
,"accident","session","problem","absurd","banner","stage","void","what"]
let (Right mw) = mkSomeMnemonic @'[9,15,18,21,24] mnemonic
let sndFactor = mempty
let rootK = Shared.genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv
let accXPrv = Shared.deriveAccountPrivateKey rootK minBound
let roleExt = UTxOExternal
let index1 = minBound
let multisigXPub1 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index1
let verKeyHash1 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub1
let Just index2 = indexFromWord32 @(Index 'Soft _) 0x00000001
let multisigXPub2 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index2
let verKeyHash2 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub2
let Just index3 = indexFromWord32 @(Index 'Soft _) 0x00000002
let multisigXPub3 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index3
let verKeyHash3 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub3
let Just index4 = indexFromWord32 @(Index 'Soft _) 0x00000003
let multisigXPub4 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index4
let verKeyHash4 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub4
let multisigXPub5 = toXPub <$> Shared.deriveDelegationPrivateKey accXPrv index4
let verKeyHash5 = RequireSignatureOf $ Shared.hashKey Delegation multisigXPub5
let rootK' = Shelley.genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv
let accXPrv' = Shelley.deriveAccountPrivateKey rootK' minBound
let roleRep = Representative
let repXPub5 = toXPub <$> Shelley.deriveDRepPrivateKey accXPrv'
let verKeyHash6 = RequireSignatureOf $ Shelley.hashKey roleRep repXPub5
let roleCCCold = CommitteeCold
let cccoldXPub5 = toXPub <$> Shelley.deriveCCColdPrivateKey accXPrv'
let verKeyHash7 = RequireSignatureOf $ Shelley.hashKey roleCCCold cccoldXPub5
let roleCCHot = CommitteeHot
let cchotXPub5 = toXPub <$> Shelley.deriveCCHotPrivateKey accXPrv'
let verKeyHash8 = RequireSignatureOf $ Shelley.hashKey roleCCHot cchotXPub5
describe "Multisig CBOR and hashes - golden tests" $ do
let checkCBORandScriptHash script cbor hash = do
(toHexText (serializeScript script)) `shouldBe` cbor
(toHexText' (toScriptHash script)) `shouldBe` hash
it "RequireSignatureOf index=0" $
checkCBORandScriptHash verKeyHash1
"008200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d2"
"2e768befb6e18e302a5d89fc4d4bcbd5d63ac256682f87246c06b1bb"
it "RequireSignatureOf index=1" $
checkCBORandScriptHash verKeyHash2
"008200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf"
"7b244224d7e6517ceb99bd2f83ccc4587285f276acb9caa484c9c306"
it "RequireSignatureOf index=2" $
checkCBORandScriptHash verKeyHash3
"008200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa5157479101"
"98530ec66e36061feabcf6b3ef730b75cf8bf13b9948506382272dc7"
it "RequireSignatureOf index=3" $
checkCBORandScriptHash verKeyHash4
"008200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b"
"547794e90ad105ea6dc75d0bac54c1473c663b7396dfc82fc34c5a9d"
it "RequireSignatureOf drep" $
checkCBORandScriptHash verKeyHash6
"008200581cb247280d6a0308ee718b19ff5f46046821d7b70c7222484e828f1134"
"c8f06e7f7392b361908aa245fbef6445f038387ac92783bf1c6b951d"
it "RequireSignatureOf cc cold" $
checkCBORandScriptHash verKeyHash7
"008200581c18bea75ea27fd18ff6172f73a5e9308f7058dc6bf0c7a9c86529097a"
"27428f9b61dbf6b01247af8df78fa3521e33a806667f5868cf5444cf"
it "RequireSignatureOf cc hot" $
checkCBORandScriptHash verKeyHash8
"008200581c052f7b12e4009db952a49f39e6661ba10c95687787c146a4306b7f02"
"a383a4d73664501059f8ac8862829ab65b8ae0bb76eac86cc76ab4c8"
it "RequireAllOf for index=0 and index=1 keys" $ do
let script = RequireAllOf [verKeyHash1, verKeyHash2]
checkCBORandScriptHash script
"008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf"
"0334c66ba3bada99c0bda26f88b8a1aea8c0aba87956d24e938a0f48"
it "RequireAllOf for index=0, index=1 and index=2 keys" $ do
let script = RequireAllOf [verKeyHash1, verKeyHash2, verKeyHash3]
checkCBORandScriptHash script
"008201838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb0232375240\
\0976cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa5157479101"
"d5913dca5953a9bba712fde99b4ebc59ac83f5734f73d0c3c528450d"
it "RequireAnyOf for index=0 and index=1 keys" $ do
let script = RequireAnyOf [verKeyHash1, verKeyHash2]
checkCBORandScriptHash script
"008202828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf"
"b17721daca904785d6f610df2d22dd949f0698561cd0463962bbcfa7"
it "RequireAllOf for index=0, index=1 and index=2 keys" $ do
let script = RequireAnyOf [verKeyHash1, verKeyHash2, verKeyHash3]
checkCBORandScriptHash script
"008202838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb0232375240\
\0976cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa5157479101"
"2149c366b64f75cf17dc25c77576e906b92d780bef9a985f9ecc9193"
it "RequireSomeOf 1 out of index=0 and index=1 keys" $ do
let script = RequireSomeOf 1 [verKeyHash1, verKeyHash2]
checkCBORandScriptHash script
"00830301828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf"
"8f81fd46f3fabb58dc2d72a31e239740dd5e09d268e752f11deeb460"
it "RequireAllOf 2 out of index=0, index=1, index=2 and index=3 keys" $ do
let script = RequireSomeOf 2 [verKeyHash1, verKeyHash2, verKeyHash3, verKeyHash4]
checkCBORandScriptHash script
"00830302848200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb023237524009\
\76cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa515747910\
\18200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b"
"ded625e186392b3dd432824a51bf4aedad188236ae3d475ee634c560"
it "nested 1" $ do
let nested = RequireAllOf [verKeyHash3, verKeyHash4]
let script = RequireSomeOf 2 [verKeyHash1, verKeyHash2, nested]
checkCBORandScriptHash script
"00830302838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb023237524009\
\76cf8201828200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa515\
\74791018200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b"
"3e4bdfb98e8e83a77350dbb546222dc9dec59a31fa413207270e60ea"
it "nested 2" $ do
let nested = RequireAnyOf [verKeyHash2, verKeyHash3, verKeyHash4]
let script = RequireAllOf [verKeyHash1, nested]
checkCBORandScriptHash script
"008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28202838200581c91e3548bc14b2947014d2060fe17eaf172b85efb0232\
\3752400976cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820eba\
\a51574791018200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b"
"f21e0e095cee196d45796e9108bc2a9ebc0f81082850ad4b82ae92ff"
it "nested 3" $ do
let nested' = RequireAnyOf [verKeyHash3, verKeyHash4]
let nested = RequireAllOf [verKeyHash1, nested']
let script = RequireSomeOf 1 [verKeyHash1, nested]
checkCBORandScriptHash script
"00830301828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\
\6ce33d28201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab\
\0986ce33d28202828200581c92d19fcb8f67c609f43aef8c53a2226dd141866820e\
\baa51574791018200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b"
"5cf0520d67e4ac52a47fdbf9efbb1a5b95a0df4595287bafdb099d5b"
it "ActivateFromSlot" $ do
let script = RequireAllOf [verKeyHash1, ActiveFromSlot 120]
checkCBORandScriptHash script
"008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d282041878"
"068bc5b5efb96ff9831d75a132de4b700f8b605ebce43b2f8e340305"
it "ActivateUntilSlot" $ do
let script = RequireAllOf [verKeyHash1, ActiveUntilSlot 150]
checkCBORandScriptHash script
"008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d282051896"
"83dee9daf83dd2dcff0b8e5aec72d256e05c283a1824e84485a0c726"
it "ActivateUntilSlot and ActivateUntilSlot" $ do
let script = RequireAllOf [verKeyHash1, ActiveFromSlot 120, ActiveUntilSlot 150]
checkCBORandScriptHash script
"008201838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d28204187882051896"
"37a5c4fe748ae7f01b9f029c875cbb2b407c559fd497786022a57019"
it "ActivateFromSlot drep" $ do
let script = RequireAllOf [verKeyHash6, ActiveFromSlot 5001]
checkCBORandScriptHash script
"008201828200581cb247280d6a0308ee718b19ff5f46046821d7b70c7222484e828f11348204191389"
"0cedcaa5d50d7987c7fb2ace9c15d28a779fbd1b1d5b9a0625f20534"
it "ActivateFromSlot cc cold" $ do
let script = RequireAllOf [verKeyHash7, ActiveFromSlot 5001]
checkCBORandScriptHash script
"008201828200581c18bea75ea27fd18ff6172f73a5e9308f7058dc6bf0c7a9c86529097a8204191389"
"4e3dcb55be145c1138bf231ca55c512be30b94e307b4b06d19bc9305"
it "ActivateFromSlot cc hot" $ do
let script = RequireAllOf [verKeyHash8, ActiveFromSlot 5001]
checkCBORandScriptHash script
"008201828200581c052f7b12e4009db952a49f39e6661ba10c95687787c146a4306b7f028204191389"
"e65f9c606223071ab07b08ca0733bdc8a69671737b05c04c481e082a"
it "ActivateFromSlot drep complex" $ do
let script = RequireAnyOf [verKeyHash6, RequireAllOf [ActiveFromSlot 5001, ActiveUntilSlot 6001] ]
checkCBORandScriptHash script
"008202828200581cb247280d6a0308ee718b19ff5f46046821d7b70c7222484e828f113482018282041913898205191771"
"7a94e934c1bed5fbf82579b59eac33c687a09ed4b5947f62365cdf65"
it "ActivateFromSlot cc cold complex" $ do
let script = RequireAnyOf [verKeyHash7, RequireAllOf [ActiveFromSlot 5001, ActiveUntilSlot 6001] ]
checkCBORandScriptHash script
"008202828200581c18bea75ea27fd18ff6172f73a5e9308f7058dc6bf0c7a9c86529097a82018282041913898205191771"
"89d52b7b0dc5ff707721ad926a296c30eb553d7009e9b2a1fd78e11a"
it "ActivateFromSlot cc hot complex" $ do
let script = RequireAnyOf [verKeyHash8, RequireAllOf [ActiveFromSlot 5001, ActiveUntilSlot 6001] ]
checkCBORandScriptHash script
"008202828200581c052f7b12e4009db952a49f39e6661ba10c95687787c146a4306b7f0282018282041913898205191771"
"8b3cafc36a32bffd3d3c62c502957d69609a8c4a2f42ba68034253a2"
describe "validateScript - expectations for RequiredValidation" $ do
it "incorrect RequireSignatureOf" $ do
let script = RequireSignatureOf (KeyHash Payment "<wrong key hash>")
validateScript RequiredValidation script `shouldBe` (Left WrongKeyHash)
it "incorrect RequireSignatureOf nested" $ do
let script = RequireAllOf [RequireAnyOf [ RequireSignatureOf (KeyHash Payment "<wrong key hash>")]]
validateScript RequiredValidation script `shouldBe` (Left WrongKeyHash)
it "correct RequireAllOf []" $ do
let script = RequireAllOf []
validateScript RequiredValidation script `shouldBe` (Right ())
it "incorrect RequireAnyOf []" $ do
let script = RequireAnyOf []
validateScript RequiredValidation script `shouldBe` (Left LedgerIncompatible)
it "incorrect RequireSomeOf 1" $ do
let script = RequireSomeOf 2 [verKeyHash1]
validateScript RequiredValidation script `shouldBe` (Left LedgerIncompatible)
it "incorrect RequireSomeOf 2" $ do
let script = RequireSomeOf 2 [verKeyHash1, verKeyHash1, RequireAnyOf [], RequireSignatureOf (KeyHash Payment "<wrong key hash>")]
validateScript RequiredValidation script `shouldBe` (Left WrongKeyHash)
it "correct RequireSomeOf" $ do
let script = RequireSomeOf 2 [verKeyHash1, verKeyHash1, RequireAnyOf []]
validateScript RequiredValidation script `shouldBe` Right ()
it "m=0 in RequireSomeOf is correct" $ do
let script = RequireSomeOf 0 [verKeyHash3, verKeyHash4]
validateScript RequiredValidation script `shouldBe` Right ()
it "timelocks are correct if timelocks are disjoint" $ do
let script = RequireSomeOf 2 [ActiveFromSlot 9, ActiveUntilSlot 8 ]
validateScript RequiredValidation script `shouldBe` Right ()
describe "validateScript - expectations for RecomendedValidation" $ do
it "incorrect RequireAllOf []" $ do
let script = RequireAllOf []
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList)
it "incorrect in nested 1" $ do
let script = RequireSomeOf 1 [verKeyHash1, RequireAllOf [] ]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList)
it "incorrect in nested 2" $ do
let script = RequireSomeOf 1
[ verKeyHash1
, RequireAnyOf [verKeyHash2, RequireAllOf [] ]
]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList)
it "m=0 in RequireSomeOf" $ do
let script = RequireSomeOf 0 [verKeyHash3, verKeyHash4]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended MZero)
it "duplicate content in RequireAllOf" $ do
let script = RequireAllOf [verKeyHash1, verKeyHash2, verKeyHash1]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "duplicate content in RequireAnyOf" $ do
let script = RequireAnyOf [verKeyHash1, verKeyHash2, verKeyHash1]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "duplicate content in RequireSomeOf" $ do
let script = RequireSomeOf 1 [verKeyHash1, verKeyHash2, verKeyHash1]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "duplicate in nested" $ do
let script = RequireSomeOf 1
[ verKeyHash1
, RequireAnyOf [ verKeyHash2
, RequireSomeOf 2 [verKeyHash3, verKeyHash3, verKeyHash4]
]
]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "redundant timelocks - too many" $ do
let script = RequireSomeOf 1 [verKeyHash1, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks)
it "redundant timelocks - nested" $ do
let script = RequireSomeOf 1
[ verKeyHash1
, RequireAnyOf [ verKeyHash2
, RequireSomeOf 2 [verKeyHash3, verKeyHash4, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120, ActiveUntilSlot 125, verKeyHash1]
]
]
validateScript RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks)
it "content in RequireAllOf - 1" $ do
let script = RequireAllOf [verKeyHash1]
validateScript RecommendedValidation script `shouldBe` Right ()
it "content in RequireAllOf - 2" $ do
let script = RequireAllOf [verKeyHash1, verKeyHash2]
validateScript RecommendedValidation script `shouldBe` Right ()
it "nested 1" $ do
let script = RequireSomeOf 1
[ verKeyHash1
, RequireAnyOf
[ verKeyHash2
, RequireSomeOf 1 [verKeyHash3, verKeyHash4]
]
]
validateScript RecommendedValidation script `shouldBe` Right ()
it "nested 2" $ do
let script = RequireSomeOf 1
[ RequireAnyOf
[ verKeyHash1
, verKeyHash2
]
, RequireAnyOf
[ verKeyHash1
, verKeyHash3
]
]
validateScript RecommendedValidation script `shouldBe` Right ()
it "not uniform prefixes in script" $ do
let script = RequireAllOf
[ RequireAnyOf
[ verKeyHash1, verKeyHash5 ]
]
validateScript RequiredValidation script `shouldBe` (Left NotUniformKeyType)
describe "validateScriptTemplate - errors" $ do
let accXpub0 =
"7eebe6dfa9a1530248400eb6a1adaca166ab1d723e9618d989d22a9219a364\
\cb4c745e128fdc98a5039893f704cf67f58c59cea97241a5c7ec7b4606253e5523"
let accXpub1 =
"417236c94b3ad73557a4df690527f77bebd203de7a208fb3be9c5efa675aaa\
\967ca13a50a2f2e95364d0b7fdc75a82e8cc97b499ecd6b9ba12529dd63a2ca7d5"
let accXpub2 =
"ebf69a16263b741240d3a3d67b44be3a70516adc1a7422b214d0e379314692\
\9eb053c9d5500fdcc4088b6a2c3b20b145d84ca77d5ad59343ddf4ba6c9b482d7c"
let accXpub3 =
"30a71e7919e9c409811efe8d818b831096ac44678397e8911c921a19f2e9b7\
\f45b45a93ec2432ed0d314e356a69409c21823f152ae898a97b9b6f72ecd9c2400"
let cosigners' = Map.fromList $
zipWith (\ix accXpub -> (Cosigner ix, encodeXPubFromTxtUnsafe accXpub))
[0, 1, 2, 3] [accXpub0, accXpub1, accXpub2, accXpub3]
let cosignersWrong = Map.fromList $
zipWith (\ix accXpub -> (Cosigner ix, encodeXPubFromTxtUnsafe accXpub))
[0, 1, 2, 3] [accXpub0, accXpub1, accXpub2, accXpub0]
let cosigner0 = RequireSignatureOf (Cosigner 0)
let cosigner1 = RequireSignatureOf (Cosigner 1)
let cosigner2 = RequireSignatureOf (Cosigner 2)
let cosigner3 = RequireSignatureOf (Cosigner 3)
let cosigner4 = RequireSignatureOf (Cosigner 4)
it "no cosigners in script of script template" $ do
let scriptTemplate = ScriptTemplate Map.empty (RequireAnyOf [ActiveFromSlot 21, ActiveUntilSlot 10])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left NoCosignerInScript)
it "no cosigners xpub in script template" $ do
let scriptTemplate = ScriptTemplate Map.empty (RequireAllOf [cosigner0, cosigner1])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left NoCosignerXPub)
it "unknown cosigner xpub in script template - 1" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSignatureOf (Cosigner 4))
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left UnknownCosigner)
it "unknown cosigner xpub in script template - 2" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAnyOf [cosigner0, cosigner1, cosigner2] )
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left UnknownCosigner)
it "duplicated xpub in cosigners in script template" $ do
let scriptTemplate = ScriptTemplate cosignersWrong (RequireAnyOf [cosigner0, cosigner1, cosigner2, cosigner3])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left DuplicateXPubs)
it "missing cosigner's xpub in script template" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAnyOf [cosigner0, cosigner1, cosigner2, cosigner3, cosigner4] )
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left MissingCosignerXPub)
it "no content in RequireAnyOf" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2, cosigner3, RequireAnyOf []])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript LedgerIncompatible)
it "no content in RequireSomeOf" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2, cosigner3, RequireSomeOf 1 []])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript LedgerIncompatible)
it "too high m in RequireSomeOf" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 5 [cosigner0, cosigner1, cosigner2, cosigner3])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript LedgerIncompatible)
it "m=0 in RequireSomeOf" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 0 [cosigner0, cosigner1, cosigner2, cosigner3])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe`Left (WrongScript $ NotRecommended MZero)
it "wrong in nested 1" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 [cosigner0, cosigner1, cosigner2, cosigner3, RequireAllOf [] ])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended EmptyList)
it "wrong in nested 2" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner0, cosigner1, cosigner2, cosigner3
, RequireAnyOf [cosigner2, RequireAllOf [] ]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended EmptyList)
it "wrong in nested 3" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner0, cosigner1, cosigner2, cosigner3
, RequireAnyOf [ cosigner2
, RequireSomeOf 3 [cosigner0, cosigner3]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended ListTooSmall)
it "duplicate content in RequireAllOf" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner1, cosigner2, cosigner1,cosigner0, cosigner3 ])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures)
it "duplicate content in RequireAnyOf" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAnyOf [cosigner1, cosigner2, cosigner1,cosigner0, cosigner3 ])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures)
it "duplicate content in RequireSomeOf" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 [cosigner1, cosigner2, cosigner1,cosigner0, cosigner3 ])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures)
it "duplicate in nested" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireSomeOf 2 [cosigner0, cosigner0, cosigner3]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures)
it "invalid timelocks - too many" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 25])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended RedundantTimelocks)
it "valid timelocks" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 11, ActiveUntilSlot 11])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right ()
it "valid timelocks when using all 1" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 25]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right ()
it "valid timelocks when using all 2" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 21]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right ()
it "invalid timelocks when using all" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 25, ActiveUntilSlot 21]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended TimelockTrap)
it "valid timelocks when using any" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireAnyOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 25, ActiveUntilSlot 21]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right ()
it "invalid timelocks when using any 1" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireAnyOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 25]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended RedundantTimelocks)
it "invalid timelocks when using any 2" $ do
let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireAnyOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 21]
]
])
validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended RedundantTimelocks)
describe "validateScriptOfTemplate - errors" $ do
let cosigner0 = RequireSignatureOf (Cosigner 0)
let cosigner1 = RequireSignatureOf (Cosigner 1)
let cosigner2 = RequireSignatureOf (Cosigner 2)
let cosigner3 = RequireSignatureOf (Cosigner 3)
it "correct RequireAllOf []" $ do
let script = RequireAllOf []
validateScriptOfTemplate RequiredValidation script `shouldBe` (Right ())
it "incorrect RequireAnyOf []" $ do
let script = RequireAnyOf []
validateScriptOfTemplate RequiredValidation script `shouldBe` (Left LedgerIncompatible)
it "incorrect RequireSomeOf 1" $ do
let script = RequireSomeOf 2 [cosigner0]
validateScriptOfTemplate RequiredValidation script `shouldBe` (Left LedgerIncompatible)
it "incorrect RequireSomeOf 2" $ do
let script = RequireSomeOf 2 [cosigner0, cosigner0, RequireAnyOf []]
validateScriptOfTemplate RequiredValidation script `shouldBe` Right ()
it "correct RequireSomeOf" $ do
let script = RequireSomeOf 2 [cosigner0, cosigner1, RequireAnyOf []]
validateScriptOfTemplate RequiredValidation script `shouldBe` Right ()
it "m=0 in RequireSomeOf is correct" $ do
let script = RequireSomeOf 0 [cosigner2, cosigner3]
validateScriptOfTemplate RequiredValidation script `shouldBe` Right ()
it "timelocks are correct if timelocks are disjoint" $ do
let script = RequireSomeOf 2 [ActiveFromSlot 9, ActiveUntilSlot 8 ]
validateScriptOfTemplate RequiredValidation script `shouldBe` Right ()
it "incorrect RequireAllOf []" $ do
let script = RequireAllOf []
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList)
it "incorrect in nested 1" $ do
let script = RequireSomeOf 1 [cosigner1, RequireAllOf [] ]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList)
it "incorrect in nested 2" $ do
let script = RequireSomeOf 1
[ cosigner1
, RequireAnyOf [cosigner2, RequireAllOf [] ]
]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList)
it "m=0 in RequireSomeOf" $ do
let script = RequireSomeOf 0 [cosigner2, cosigner3]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended MZero)
it "duplicate content in RequireAllOf" $ do
let script = RequireAllOf [cosigner1, cosigner2, cosigner1]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "duplicate content in RequireAnyOf" $ do
let script = RequireAnyOf [cosigner1, cosigner2, cosigner1]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "duplicate content in RequireSomeOf" $ do
let script = RequireSomeOf 1 [cosigner1, cosigner2, cosigner1]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "duplicate in nested" $ do
let script = RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireSomeOf 2 [cosigner3, cosigner3, cosigner0]
]
]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures)
it "redundant timelocks - too many" $ do
let script = RequireSomeOf 1 [cosigner1, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks)
it "redundant timelocks - nested" $ do
let script = RequireSomeOf 1
[ cosigner1
, RequireAnyOf [ cosigner2
, RequireSomeOf 2 [cosigner2, cosigner3, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120, ActiveUntilSlot 125, cosigner1]
]
]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks)
it "content in RequireAllOf - 1" $ do
let script = RequireAllOf [cosigner0]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Right ()
it "content in RequireAllOf - 2" $ do
let script = RequireAllOf [cosigner1, cosigner2]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Right ()
it "nested 1" $ do
let script = RequireSomeOf 1
[ cosigner1
, RequireAnyOf
[ cosigner2
, RequireSomeOf 1 [cosigner2, cosigner3]
]
]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Right ()
it "nested 2" $ do
let script = RequireSomeOf 1
[ RequireAnyOf
[ cosigner1
, cosigner2
]
, RequireAnyOf
[ cosigner1
, cosigner3
]
]
validateScriptOfTemplate RecommendedValidation script `shouldBe` Right ()
describe "can perform roundtrip JSON serialization & deserialization - Script KeyHash" $
it "fromJSON . toJSON === pure" $
property (prop_jsonRoundtrip @(Script KeyHash))
describe "can perform roundtrip JSON serialization & deserialization - Script KeyHash validated" $
it "fromJSON . toJSON === pure" $
property (prop_jsonRoundtripWithValidation (validateScript RequiredValidation))
describe "can perform roundtrip JSON serialization & deserialization - Script Cosigner" $
it "fromJSON . toJSON === pure" $
property (prop_jsonRoundtrip @(Script Cosigner))
describe "can perform roundtrip JSON serialization & deserialization - ScriptTemplate" $
it "fromJSON . toJSON === pure" $
property (prop_jsonRoundtrip @ScriptTemplate)
describe "can perform roundtrip JSON serialization & deserialization - ScriptTemplate validated" $
it "fromJSON . toJSON === pure" $
property (prop_jsonRoundtripWithValidation (validateScriptTemplate RequiredValidation))
describe "can perform text roundtrip - Script Cosigner" $
it "scriptFromString . T.unpack . scriptToText === pure" $ property prop_scriptTextRoundtrip
describe "some JSON parsing error" $ do
it "Invalid type" $ do
let err = "Error in $.all[0].any[0]: expected Object or String, but encountered Number"
Json.eitherDecode @(Script KeyHash) "{ \"all\": [ { \"any\": [1,2,3] } ] }"
`shouldBe` Left err
it "Multiple 'any', 'all'" $ do
let err = "Error in $.all[0].any[0]: expected Object or String, but encountered Number"
Json.eitherDecode @(Script KeyHash) "{ \"all\": [ { \"any\": [1,2,3] } ] }"
`shouldBe` Left err
it "Multiple keys" $ do
let err = "Error in $: Found multiple keys 'any', 'all' and/or 'some' at the same level"
Json.eitherDecode @(Script KeyHash) "{ \"all\": [null], \"some\": {} }"
`shouldBe` Left err
it "Unknown keys" $ do
let err = "Error in $: Found object with unknown key. Expecting 'any', 'all' or 'some'"
Json.eitherDecode @(Script KeyHash) "{ \"patate\": {} }"
`shouldBe` Left err
it "Invalid JSON" $ do
let err = "'';[]["
case Json.eitherDecode @(Script KeyHash) "'';[][" of
Right _ -> expectationFailure "Parsed invalid json?"
Left msg -> msg `shouldContain` err
where
toHexText = T.decodeUtf8 . encode EBase16
toHexText' (ScriptHash bytes) = toHexText bytes
prop_jsonRoundtripWithValidation
:: (Eq a, Show a, ToJSON a, FromJSON a)
=> (a -> Either err ())
-> a
-> Property
prop_jsonRoundtripWithValidation validate script =
classify (isLeft $ validate script) "invalid" $
Json.decode (Json.encode script) === Just script
prop_jsonRoundtrip :: (Eq a, Show a, FromJSON a, ToJSON a) => a -> Property
prop_jsonRoundtrip val =
Json.decode (Json.encode val) === Just val
prop_scriptTextRoundtrip
:: Script Cosigner
-> Property
prop_scriptTextRoundtrip script =
scriptFromString requireCosignerOfParser (T.unpack $ scriptToText script)
=== Right script
instance Arbitrary (Script KeyHash) where
arbitrary = genScript (RequireSignatureOf <$> arbitrary)
shrink = genericShrink
instance Arbitrary (Script Cosigner) where
arbitrary = genScript (RequireSignatureOf <$> arbitrary)
shrink = genericShrink
genScript :: Gen (Script elem) -> Gen (Script elem)
genScript elemGen = scale (`div` 3) $ sized scriptTree
where
scriptTree 0 = oneof
[ elemGen
, ActiveFromSlot <$> arbitrary
, ActiveUntilSlot <$> arbitrary
]
scriptTree n = do
Positive m <- arbitrary
let n' = n `div` (m + 1)
scripts <- vectorOf m (scriptTree n')
let hasTimelocks = \case
ActiveFromSlot _ -> True
ActiveUntilSlot _ -> True
_ -> False
let scriptsWithValidTimelocks = case L.partition hasTimelocks scripts of
([], rest) -> rest
([ActiveFromSlot s1, ActiveUntilSlot s2], rest) ->
if s2 <= s1 then
rest ++ [ActiveFromSlot s2, ActiveUntilSlot s1]
else
scripts
([ActiveUntilSlot s2, ActiveFromSlot s1], rest) ->
if s2 <= s1 then
rest ++ [ActiveFromSlot s2, ActiveUntilSlot s1]
else
scripts
([ActiveFromSlot _], _) -> scripts
([ActiveUntilSlot _], _) -> scripts
(_,rest) -> rest
case fromIntegral (L.length (filter (not . hasTimelocks) scriptsWithValidTimelocks)) of
0 -> scriptTree 0
num -> do
atLeast <- choose (1, num)
elements
[ RequireAllOf scriptsWithValidTimelocks
, RequireAnyOf scriptsWithValidTimelocks
, RequireSomeOf atLeast scriptsWithValidTimelocks
]
instance Arbitrary KeyHash where
-- always generate valid hashes, because json decoding will immediately fail
-- on these.
arbitrary = do
payload' <- BS.pack <$> vectorOf 28 arbitrary
flip KeyHash payload' <$>
oneof [ pure Payment, pure Delegation, pure Policy
, pure Representative, pure CommitteeCold
, pure CommitteeHot, pure Unknown]
instance Arbitrary Cosigner where
arbitrary = Cosigner <$> arbitrary
instance Arbitrary ScriptTemplate where
arbitrary = do
n <- choose (1,5)
cosignerPairs <- vectorOf n arbitrary
ScriptTemplate (Map.fromList cosignerPairs) <$> arbitrary
encodeXPubFromTxtUnsafe :: Text -> XPub
encodeXPubFromTxtUnsafe txt =
case fromBase16 (T.encodeUtf8 txt) of
Left _ -> error "encodeXPubFromTxtUnsafe: expecting hex-encoded text"
Right hex -> fromJust $ xpubFromBytes hex