Skip to content

Commit 670fa14

Browse files
vlasinvlasin
authored
Merge pull request #122 from zkFold/120-script-improvements
Improved circuit
2 parents 974a5e0 + bfc8757 commit 670fa14

File tree

20 files changed

+541
-416
lines changed

20 files changed

+541
-416
lines changed

‎cabal.project‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ benchmarks: true
2828
source-repository-package
2929
type: git
3030
location: https://github.com/zkFold/symbolic.git
31-
tag: aa91cef1474493235e16262218b63c2f18b21ddf
31+
tag: 2f513daa5d4e9de083adc602e5f9c22922f25221
3232
subdir:
3333
symbolic-base
3434
symbolic-examples

‎zkfold-cardano-scripts-common/README.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
# Motivation
2+
3+
This module contains types for the Smart Wallet so that wallet off-chain code does not depend on plutus-tx-plugin.

‎zkfold-cardano-scripts-common/data/compiled-scripts/smart-wallet.blueprint‎

Lines changed: 27 additions & 74 deletions
Large diffs are not rendered by default.

‎zkfold-cardano-scripts-common/src/ZkFold/Cardano/UPLC/Wallet/Types.hs‎

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
module ZkFold.Cardano.UPLC.Wallet.Types (
55
Web2Creds (..),
66
JWTParts (..),
7+
KeyId (..),
78
Web2Auth (..),
89
Signature (..),
910
) where
@@ -35,7 +36,15 @@ data JWTParts = JWTParts
3536

3637
PlutusTx.Blueprint.TH.makeIsDataSchemaIndexed ''JWTParts [('JWTParts, 0)]
3738

38-
data Web2Auth = Web2Auth JWTParts ProofBytes TokenName
39+
newtype KeyId = KeyId
40+
{ keyId :: BuiltinByteString
41+
}
42+
deriving stock (Show, Generic)
43+
deriving anyclass HasBlueprintDefinition
44+
45+
PlutusTx.Blueprint.TH.makeIsDataSchemaIndexed ''KeyId [('KeyId, 0)]
46+
47+
data Web2Auth = Web2Auth JWTParts ProofBytes TokenName KeyId
3948
deriving stock (Show, Generic)
4049
deriving anyclass HasBlueprintDefinition
4150

‎zkfold-cardano-scripts-common/zkfold-cardano-scripts-common.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -67,3 +67,4 @@ library
6767
plutus-ledger-api,
6868
plutus-tx,
6969
zkfold-cardano,
70+

‎zkfold-cardano-scripts/src/ZkFold/Cardano/UPLC/Wallet.hs‎

Lines changed: 36 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -28,39 +28,67 @@ import ZkFold.Cardano.UPLC.Wallet.Internal (base64urlEncode)
2828
import ZkFold.Cardano.UPLC.Wallet.Types
2929
import ZkFold.Protocol.NonInteractiveProof (NonInteractiveProof (..))
3030

31-
-- TODO: Account for rotation of public keys
32-
-- TODO: Check the client Id
33-
-- TODO: Check the suffix length (must be a predefined size)
34-
-- TODO: Do we need to split bytestrings further due to ledger rules?
31+
3532
{-# INLINEABLE web2Auth #-}
3633

3734
-- | Mints tokens paramterized by the user's email and a public key selected by the user.
3835
web2Auth ::
39-
-- | 'SetupBytes'.
36+
-- | Beacon token Currency Symbol (or minting policy id)
37+
BuiltinData ->
38+
-- | Beacon token name
4039
BuiltinData ->
4140
-- | 'Web2Creds'.
4241
BuiltinData ->
4342
-- | 'ScriptContext'.
4443
BuiltinData ->
4544
BuiltinUnit
46-
web2Auth (unsafeFromBuiltinData -> (expModCircuit :: SetupBytes)) (unsafeFromBuiltinData -> Web2Creds {..}) sc =
45+
web2Auth beaconSymbol beaconName (unsafeFromBuiltinData -> Web2Creds {..}) sc =
4746
check
4847
$ let
48+
payloadLen = lengthOfByteString jwtPrefix
49+
emailFieldName = sliceByteString (payloadLen - 9) 9 jwtPrefix
4950
encodedJwt = base64urlEncode jwtHeader <> "." <> base64urlEncode (jwtPrefix <> w2cEmail <> jwtSuffix)
5051
jwtHash = sha2_256 encodedJwt
5152
publicInput = toInput jwtHash * toInput bs
5253
in
5354
-- Check that the user knows an RSA signature for a JWT containing the email
54-
verify @PlonkupPlutus expModCircuit [publicInput] proof
55+
verify @PlonkupPlutus expModCircuit [publicInput] proof
56+
&& emailFieldName == "\"email\":\""
5557
-- Check that we mint a token with the correct name
5658
&& AssocMap.lookup (toBuiltinData symb) txInfoMint
5759
== Just (toBuiltinData $ AssocMap.singleton tn (1 :: Integer))
5860
&& elem (PubKeyHash bs) txInfoSignatories
5961
where
62+
-- tx reference inputs
63+
refInput = txInfo & BI.tail & BI.head & BI.unsafeDataAsList & BI.head -- TxInInfo
64+
refInputResolved = refInput & BI.unsafeDataAsConstr & BI.snd & BI.tail & BI.head -- TxOut
65+
txOutL = refInputResolved & BI.unsafeDataAsConstr & BI.snd & BI.tail
66+
txValue = txOutL & BI.head & unsafeFromBuiltinData
67+
68+
correctCurrencySymbol = CurrencySymbol $ unsafeFromBuiltinData beaconSymbol
69+
correctTokenName = TokenName $ unsafeFromBuiltinData beaconName
70+
71+
-- find beacon datum
72+
beaconDatum =
73+
if valueOf txValue correctCurrencySymbol correctTokenName == 0
74+
then error ()
75+
else txOutL & BI.tail & BI.head & unsafeFromBuiltinData
76+
77+
-- decode beacon datum
78+
setupBytesMap =
79+
case beaconDatum of
80+
OutputDatum datum -> unsafeFromBuiltinData $ getDatum datum
81+
_ -> error ()
82+
83+
Just setupBytes = AssocMap.lookup (toBuiltinData kid) setupBytesMap
84+
85+
expModCircuit :: SetupBytes
86+
expModCircuit = unsafeFromBuiltinData setupBytes
87+
6088
txInfoL = BI.unsafeDataAsConstr sc & BI.snd
6189
txInfo = txInfoL & BI.head & BI.unsafeDataAsConstr & BI.snd
6290
redL = txInfoL & BI.tail
63-
Web2Auth JWTParts {..} proof tn@(TokenName bs) = redL & BI.head & unsafeFromBuiltinData
91+
Web2Auth JWTParts {..} proof tn@(TokenName bs) (KeyId kid) = redL & BI.head & unsafeFromBuiltinData
6492
(MintingScript symb) = redL & BI.tail & BI.head & unsafeFromBuiltinData
6593
txInfoMintL =
6694
txInfo

‎zkfold-cardano-scripts/src/ZkFold/Cardano/UPLC/Wallet/Compile.hs‎

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -16,10 +16,9 @@ import qualified Data.Set as Set
1616
import PlutusLedgerApi.V3
1717
import qualified PlutusTx
1818
import PlutusTx.Blueprint
19-
import qualified PlutusTx.Prelude as PlutusTx (BuiltinUnit)
19+
import qualified PlutusTx.Prelude as PlutusTx
2020
import Prelude (FilePath, IO, ($))
2121

22-
import ZkFold.Cardano.OnChain.Plonkup.Data (SetupBytes)
2322
import ZkFold.Cardano.UPLC.Wallet
2423

2524
smartWalletBP :: ContractBlueprint
@@ -47,8 +46,14 @@ smartWalletBP =
4746
}
4847
, validatorParameters =
4948
[ MkParameterBlueprint
50-
{ parameterTitle = Just "SetupBytes"
51-
, parameterSchema = definitionRef @SetupBytes
49+
{ parameterTitle = Just "Beacon token policy id"
50+
, parameterSchema = definitionRef @PlutusTx.BuiltinByteString
51+
, parameterPurpose = Set.singleton Mint
52+
, parameterDescription = Nothing
53+
}
54+
, MkParameterBlueprint
55+
{ parameterTitle = Just "Beacon token name"
56+
, parameterSchema = definitionRef @PlutusTx.BuiltinByteString
5257
, parameterPurpose = Set.singleton Mint
5358
, parameterDescription = Nothing
5459
}
@@ -113,7 +118,7 @@ smartWalletBP =
113118
, validatorCompiled = Just $ compiledValidator commonPlutusVersion checkSigSerialisedScript
114119
}
115120
]
116-
, contractDefinitions = deriveDefinitions @'[Web2Auth, SetupBytes, Web2Creds, (), ScriptHash, PlutusTx.BuiltinData, Signature, CurrencySymbol]
121+
, contractDefinitions = deriveDefinitions @'[Web2Auth, Web2Creds, PlutusTx.BuiltinByteString, (), ScriptHash, PlutusTx.BuiltinData, Signature, CurrencySymbol]
117122
}
118123
where
119124
commonPlutusVersion = PlutusV3
@@ -124,7 +129,7 @@ writeSmartWalletBP fp = writeBlueprint fp smartWalletBP
124129
web2AuthSerialisedScript :: ByteString
125130
web2AuthSerialisedScript = serialiseCompiledCode web2AuthCompiledCode & fromShort
126131

127-
web2AuthCompiledCode :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit)
132+
web2AuthCompiledCode :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit)
128133
web2AuthCompiledCode = $$(PlutusTx.compile [||web2Auth||])
129134

130135
walletSerialisedScript :: ByteString

‎zkfold-cardano-scripts/zkfold-cardano-scripts.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ common lang
3636
RecordWildCards
3737
ScopedTypeVariables
3838
StandaloneDeriving
39+
Strict
3940
TemplateHaskell
4041
TypeApplications
4142
ViewPatterns
@@ -87,6 +88,7 @@ library
8788
base >=4.9 && <5,
8889
bytestring ,
8990
containers ,
91+
file-embed ,
9092
plutus-core ,
9193
plutus-ledger-api ,
9294
plutus-tx ,

‎zkfold-cardano/src/ZkFold/Cardano/OffChain/Plonkup.hs‎

Lines changed: 55 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -26,62 +26,63 @@ import ZkFold.Protocol.Plonkup.Verifier.Setup
2626

2727
type PlonkupN i o n = Plonkup i o n BLS12_381_G1_Point BLS12_381_G2_Point BuiltinByteString (PolyVec Fr)
2828

29-
mkSetup :: forall i o n . KnownNat n => SetupVerify (PlonkupN i o n) -> SetupBytes
30-
mkSetup PlonkupVerifierSetup {..} =
31-
let PlonkupCircuitCommitments {..} = commitments
32-
in SetupBytes
33-
{ n = fromIntegral (value @n)
34-
, nPrv = fromIntegral $ prvNum relation
35-
, pow = log2ceiling (value @n)
36-
, omega = F $ convertZp omega
37-
, omegaNPrv = F $ convertZp (omega ^ (prvNum relation + 1))
38-
, k1 = F $ convertZp k1
39-
, k2 = F $ convertZp k2
40-
, h1_bytes = convertG2 h1
41-
, cmQm_bytes = convertG1 cmQm
42-
, cmQl_bytes = convertG1 cmQl
43-
, cmQr_bytes = convertG1 cmQr
44-
, cmQo_bytes = convertG1 cmQo
45-
, cmQc_bytes = convertG1 cmQc
46-
, cmQk_bytes = convertG1 cmQk
47-
, cmS1_bytes = convertG1 cmS1
48-
, cmS2_bytes = convertG1 cmS2
49-
, cmS3_bytes = convertG1 cmS3
50-
, cmT1_bytes = convertG1 cmT1
51-
, cmT2_bytes = convertG1 cmT2
52-
, cmT3_bytes = convertG1 cmT3
53-
}
29+
mkSetup :: forall i o n. (KnownNat n) => SetupVerify (PlonkupN i o n) -> SetupBytes
30+
mkSetup PlonkupVerifierSetup{..} =
31+
let PlonkupCircuitCommitments{..} = commitments
32+
in SetupBytes
33+
{ n = fromIntegral (value @n)
34+
, nPrv = fromIntegral $ prvNum relation
35+
, pow = log2ceiling (value @n)
36+
, omega = F $ convertZp omega
37+
, omegaNPrv = F $ convertZp (omega ^ (prvNum relation + 1))
38+
, k1 = F $ convertZp k1
39+
, k2 = F $ convertZp k2
40+
, h1_bytes = convertG2 h1
41+
, cmQm_bytes = convertG1 cmQm
42+
, cmQl_bytes = convertG1 cmQl
43+
, cmQr_bytes = convertG1 cmQr
44+
, cmQo_bytes = convertG1 cmQo
45+
, cmQc_bytes = convertG1 cmQc
46+
, cmQk_bytes = convertG1 cmQk
47+
, cmS1_bytes = convertG1 cmS1
48+
, cmS2_bytes = convertG1 cmS2
49+
, cmS3_bytes = convertG1 cmS3
50+
, cmT1_bytes = convertG1 cmT1
51+
, cmT2_bytes = convertG1 cmT2
52+
, cmT3_bytes = convertG1 cmT3
53+
}
5454

5555
mkInput :: Input (PlonkupN i o n) -> InputBytes
5656
mkInput (PlonkupInput input) = map (F . convertZp) input
5757

5858
mkProof :: Proof (PlonkupN i o n) -> ProofBytes
59-
mkProof PlonkupProof {..} = ProofBytes
60-
{ cmA_bytes = convertG1 cmA
61-
, cmB_bytes = convertG1 cmB
62-
, cmC_bytes = convertG1 cmC
63-
, cmF_bytes = convertG1 cmF
64-
, cmH1_bytes = convertG1 cmH1
65-
, cmH2_bytes = convertG1 cmH2
66-
, cmZ1_bytes = convertG1 cmZ1
67-
, cmZ2_bytes = convertG1 cmZ2
68-
, cmQlow_bytes = convertG1 cmQlow
69-
, cmQmid_bytes = convertG1 cmQmid
70-
, cmQhigh_bytes = convertG1 cmQhigh
71-
, proof1_bytes = convertG1 proof1
72-
, proof2_bytes = convertG1 proof2
73-
, a_xi_int = convertZp a_xi
74-
, b_xi_int = convertZp b_xi
75-
, c_xi_int = convertZp c_xi
76-
, s1_xi_int = convertZp s1_xi
77-
, s2_xi_int = convertZp s2_xi
78-
, f_xi_int = convertZp f_xi
79-
, t_xi_int = convertZp t_xi
80-
, t_xi'_int = convertZp t_xi'
81-
, z1_xi'_int = convertZp z1_xi'
82-
, z2_xi'_int = convertZp z2_xi'
83-
, h1_xi'_int = convertZp h1_xi'
84-
, h2_xi_int = convertZp h2_xi
85-
, l1_xi = F $ convertZp l1_xi
86-
, l_xi = map (F . convertZp) l_xi
87-
}
59+
mkProof PlonkupProof{..} =
60+
ProofBytes
61+
{ cmA_bytes = convertG1 cmA
62+
, cmB_bytes = convertG1 cmB
63+
, cmC_bytes = convertG1 cmC
64+
, cmF_bytes = convertG1 cmF
65+
, cmH1_bytes = convertG1 cmH1
66+
, cmH2_bytes = convertG1 cmH2
67+
, cmZ1_bytes = convertG1 cmZ1
68+
, cmZ2_bytes = convertG1 cmZ2
69+
, cmQlow_bytes = convertG1 cmQlow
70+
, cmQmid_bytes = convertG1 cmQmid
71+
, cmQhigh_bytes = convertG1 cmQhigh
72+
, proof1_bytes = convertG1 proof1
73+
, proof2_bytes = convertG1 proof2
74+
, a_xi_int = convertZp a_xi
75+
, b_xi_int = convertZp b_xi
76+
, c_xi_int = convertZp c_xi
77+
, s1_xi_int = convertZp s1_xi
78+
, s2_xi_int = convertZp s2_xi
79+
, f_xi_int = convertZp f_xi
80+
, t_xi_int = convertZp t_xi
81+
, t_xi'_int = convertZp t_xi'
82+
, z1_xi'_int = convertZp z1_xi'
83+
, z2_xi'_int = convertZp z2_xi'
84+
, h1_xi'_int = convertZp h1_xi'
85+
, h2_xi_int = convertZp h2_xi
86+
, l1_xi = F $ convertZp l1_xi
87+
, l_xi = map (F . convertZp) l_xi
88+
}

‎zkfold-cardano/src/ZkFold/Cardano/OffChain/Utils.hs‎

Lines changed: 36 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -15,49 +15,70 @@ import Prelude hiding (Bool, Eq (..), Fractional (..), Num
1515
import Text.Printf (printf)
1616

1717
-- | Write serialized script to a file.
18-
writePlutusScriptToFile :: IsPlutusScriptLanguage lang => FilePath -> PlutusScript lang -> IO ()
18+
writePlutusScriptToFile :: (IsPlutusScriptLanguage lang) => FilePath -> PlutusScript lang -> IO ()
1919
writePlutusScriptToFile filePath script = void $ writeFileTextEnvelope (File filePath) Nothing script
2020

2121
-- | Serialize plutus script.
2222
savePlutus :: FilePath -> CompiledCode a -> IO ()
2323
savePlutus filePath =
24-
writePlutusScriptToFile @PlutusScriptV3 filePath . PlutusScriptSerialised . serialiseCompiledCode
24+
writePlutusScriptToFile @PlutusScriptV3 filePath . PlutusScriptSerialised . serialiseCompiledCode
2525

2626
-- | Serialise data to CBOR and then wrap it in a JSON object.
27-
dataToJSON :: ToData a => a -> Aeson.Value
27+
dataToJSON :: (ToData a) => a -> Aeson.Value
2828
dataToJSON = scriptDataToJsonDetailedSchema . unsafeHashableScriptData . fromPlutusData . toData
2929

3030
-- | Serialise data to CBOR.
31-
dataToCBOR :: ToData a => a -> BS.ByteString
31+
dataToCBOR :: (ToData a) => a -> BS.ByteString
3232
dataToCBOR = toStrictByteString . toCBOR . fromPlutusData . toData
3333

3434
-- | Credential of compiled validator script
3535
credentialOf :: CompiledCode a -> V3.Credential
36-
credentialOf = ScriptCredential . V3.ScriptHash . toBuiltin . serialiseToRawBytes . hashScript
37-
. PlutusScript plutusScriptVersion . PlutusScriptSerialised @PlutusScriptV3 . serialiseCompiledCode
36+
credentialOf =
37+
ScriptCredential
38+
. V3.ScriptHash
39+
. toBuiltin
40+
. serialiseToRawBytes
41+
. hashScript
42+
. PlutusScript plutusScriptVersion
43+
. PlutusScriptSerialised @PlutusScriptV3
44+
. serialiseCompiledCode
3845

3946
-- | Currency symbol of compiled minting script
4047
currencySymbolOf :: CompiledCode a -> V3.CurrencySymbol
41-
currencySymbolOf = CurrencySymbol . toBuiltin . serialiseToRawBytes . hashScript
42-
. PlutusScript plutusScriptVersion . PlutusScriptSerialised @PlutusScriptV3 . serialiseCompiledCode
48+
currencySymbolOf =
49+
CurrencySymbol
50+
. toBuiltin
51+
. serialiseToRawBytes
52+
. hashScript
53+
. PlutusScript plutusScriptVersion
54+
. PlutusScriptSerialised @PlutusScriptV3
55+
. serialiseCompiledCode
4356

4457
-- | Parse address in era
4558
parseAddress :: String -> Either String V3.Address
4659
parseAddress addressStr = do
47-
shellyAddr <- either (const $ Left "Failed to parse Shelly address") Right $
48-
deserialiseFromBech32 (AsAddress AsShelleyAddr) (T.pack addressStr)
49-
pkh <- maybe (Left "Failed to parse address pubkey hash") Right $
50-
shelleyPayAddrToPlutusPubKHash shellyAddr
60+
shellyAddr <-
61+
either (const $ Left "Failed to parse Shelly address") Right $
62+
deserialiseFromBech32 (AsAddress AsShelleyAddr) (T.pack addressStr)
63+
pkh <-
64+
maybe (Left "Failed to parse address pubkey hash") Right $
65+
shelleyPayAddrToPlutusPubKHash shellyAddr
5166
return $ V3.Address (PubKeyCredential pkh) Nothing
5267

5368
-- | Get hex representation of bytestring
5469
byteStringAsHex :: BS.ByteString -> String
55-
byteStringAsHex bs = concat $ BS.foldr' (\w s -> printf "%02x" w:s) [] bs
70+
byteStringAsHex bs = concat $ BS.foldr' (\w s -> printf "%02x" w : s) [] bs
5671

5772
-- | Script hash of compiled validator
5873
scriptHashOf :: CompiledCode a -> V3.ScriptHash
59-
scriptHashOf = V3.ScriptHash . toBuiltin . serialiseToRawBytes . hashScript . PlutusScript plutusScriptVersion
60-
. PlutusScriptSerialised @PlutusScriptV3 . serialiseCompiledCode
74+
scriptHashOf =
75+
V3.ScriptHash
76+
. toBuiltin
77+
. serialiseToRawBytes
78+
. hashScript
79+
. PlutusScript plutusScriptVersion
80+
. PlutusScriptSerialised @PlutusScriptV3
81+
. serialiseCompiledCode
6182

6283
-- | Compare function for 'TxOutRef'
6384
outRefCompare :: TxOutRef -> TxOutRef -> Ordering

0 commit comments

Comments
 (0)