Skip to content

Commit 68925ef

Browse files
vlasinvlasin
authored
Merge pull request #7 from zkFold/5-zkpass-m4
zkPass server
2 parents db010a8 + 5f9ee3a commit 68925ef

File tree

19 files changed

+770
-20
lines changed

19 files changed

+770
-20
lines changed

‎.github/workflows/main-pull.yml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -116,7 +116,7 @@ jobs:
116116
cabal build all --dry-run
117117
118118
- name: Restore cached dependencies
119-
uses: actions/cache/restore@v4.0.1
119+
uses: actions/cache/restore@v4
120120
id: cache
121121
env:
122122
key: ${{ matrix.os }}-ghc-${{ matrix.ghc }}-cabal-${{ matrix.cabal }}
@@ -149,7 +149,7 @@ jobs:
149149
150150
# Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail.
151151
- name: Save cached dependencies
152-
uses: actions/cache/save@v4.0.1
152+
uses: actions/cache/save@v4
153153
# If we had an exact cache hit, trying to save the cache would error because of key clash.
154154
if: steps.cache.outputs.cache-hit != 'true'
155155
with:

‎.github/workflows/main-push.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,7 @@ jobs:
9999
cabal-version: '3.10.3.0'
100100

101101
- name: Cache
102-
uses: actions/cache@v4.0.1
102+
uses: actions/cache@v4
103103
env:
104104
cache-name: cache-cabal
105105
with:

‎.gitignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,5 @@ dist-*
22
*~
33
assets
44
test-data
5+
log/
6+
maestro-config.json

‎README.md

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,4 +2,18 @@
22

33
**zkPass** on Cardano is a smart contract that enables developers to post, verify, and utilize zkPass oracle attestations on the Cardano blockchain. It is a tool that makes new types of DApps possible on Cardano.
44

5-
This repository contains code to construct transactions for the zkPass smart contract. (Relevant executables are described [here](https://github.com/zkFold/zkpass-cardano/blob/main/backends/README.md).)
5+
This repository contains the zkPass onchain code, as well as the server side of the zkPass prototype DApp.
6+
7+
## zkPass server
8+
9+
To run the zkPass server, execute:
10+
```shell
11+
cabal run zkpass-server -- config.json
12+
```
13+
where `config.json` contains your configuration for network and provider. (File `config-template.json` provides a template configuration.)
14+
15+
The zkPass server on this repository was written using the [Atlas](https://atlas-app.io) framework.
16+
17+
## zkPass client
18+
19+
The zkPass client can be found [here](https://github.com/zkFold/zkpass-client).

‎app/Main.hs

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
{-# OPTIONS_GHC -Wno-unused-imports #-}
2+
3+
module Main where
4+
5+
import GeniusYield.GYConfig (coreConfigIO, withCfgProviders)
6+
import Network.Wai.Handler.Warp
7+
import Prelude
8+
import System.Environment (getArgs)
9+
import Test.QuickCheck.Arbitrary (Arbitrary (..))
10+
import Test.QuickCheck.Gen (generate)
11+
12+
import ZkPass.Api (app)
13+
import ZkPass.Api.Context (Ctx (..), SetupParams (..))
14+
import ZkPass.Utils (logSetupParams)
15+
16+
17+
-- | Getting path for our core configuration.
18+
parseArgs :: IO FilePath
19+
parseArgs = do
20+
args <- getArgs
21+
case args of
22+
coreCfg: _ -> return coreCfg
23+
_invalidArgument -> fail "Error: wrong arguments, needed a path to the CoreConfig JSON configuration file\n"
24+
25+
main :: IO ()
26+
main = do
27+
putStrLn "parsing Config ..."
28+
coreCfgPath <- parseArgs
29+
coreCfg <- coreConfigIO coreCfgPath
30+
31+
x <- generate arbitrary
32+
ps <- generate arbitrary
33+
let setupParams = SetupParams x ps
34+
35+
-- Uncomment to log setup parameters:
36+
-- logSetupParams setupParams
37+
38+
putStrLn "Loading Providers ..."
39+
withCfgProviders coreCfg "api-server" $ \providers -> do
40+
let port = 8080
41+
ctx = Ctx coreCfg providers
42+
putStrLn $ "Serving on http://localhost:" ++ show port
43+
run port $ app ctx setupParams

‎app/ZkPass/Api.hs

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
{-# LANGUAGE TypeOperators #-}
2+
3+
module ZkPass.Api where
4+
5+
import Control.Exception (try)
6+
import Control.Monad.Trans.Except (ExceptT (..))
7+
import qualified Network.HTTP.Types as HttpTypes
8+
import Network.Wai.Middleware.Cors
9+
import Prelude
10+
import Servant
11+
12+
import ZkPass.Api.Burn (BurnInput, handleBurn)
13+
import ZkPass.Api.Context (Ctx (..), OwnAddress,
14+
OwnAddresses, SetupParams,
15+
UnsignedTxResponse, handleOwnAddr)
16+
import ZkPass.Api.Mint (MintInput, ZkPassResponse,
17+
handleMint)
18+
import ZkPass.Api.Setup (SetupInput, SetupResponse,
19+
handleSetup)
20+
import ZkPass.Api.Transfer (TransferInput, handleTransfer)
21+
import ZkPass.Api.Tx (AddWitAndSubmitParams,
22+
SubmitTxResponse,
23+
handleAddWitAndSubmitTx)
24+
25+
26+
-- | Type for our Servant API.
27+
type API = "setup" :> ReqBody '[JSON] SetupInput
28+
:> Post '[JSON] SetupResponse
29+
:<|> "transfer" :> ReqBody '[JSON] TransferInput
30+
:> Post '[JSON] UnsignedTxResponse
31+
:<|> "mint" :> ReqBody '[JSON] MintInput
32+
:> Post '[JSON] ZkPassResponse
33+
:<|> "burn" :> ReqBody '[JSON] BurnInput
34+
:> Post '[JSON] UnsignedTxResponse
35+
:<|> "add-wit-and-submit" :> ReqBody '[JSON] AddWitAndSubmitParams
36+
:> Post '[JSON] SubmitTxResponse
37+
:<|> "own-addr" :> ReqBody '[JSON] OwnAddresses
38+
:> Post '[JSON] OwnAddress
39+
40+
-- | Server Handler
41+
server :: Ctx -> SetupParams -> ServerT API IO
42+
server ctx sp = handleSetup ctx sp
43+
:<|> handleTransfer ctx
44+
:<|> handleMint ctx sp
45+
:<|> handleBurn ctx sp
46+
:<|> handleAddWitAndSubmitTx ctx
47+
:<|> handleOwnAddr
48+
49+
appApi :: Proxy API
50+
appApi = Proxy
51+
52+
app :: Ctx -> SetupParams -> Application
53+
app ctx sp = cors (const $ Just simpleCorsResourcePolicy { corsRequestHeaders = [HttpTypes.hContentType] }) $
54+
serve appApi $ hoistServer appApi (Handler . ExceptT . try) $
55+
server ctx sp

‎app/ZkPass/Api/Burn.hs

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
module ZkPass.Api.Burn where
2+
3+
import Control.Exception (throwIO)
4+
import Data.Aeson
5+
import Data.String (fromString)
6+
import GeniusYield.GYConfig (GYCoreConfig (..))
7+
import GeniusYield.TxBuilder
8+
import GeniusYield.Types
9+
import GHC.Generics
10+
import PlutusLedgerApi.V3 (toBuiltinData)
11+
import Prelude
12+
import qualified ZkFold.Cardano.OnChain.BLS12_381.F as F
13+
import ZkFold.Cardano.OnChain.Plonkup.Data (ProofBytes (..))
14+
import ZkPass.Cardano.Example.IdentityCircuit (identityCircuitVerificationBytes)
15+
16+
import ZkPass.Api.Context
17+
import ZkPass.Cardano.UPLC.ZkPassToken (forwardingMintCompiled,
18+
zkPassTokenCompiled)
19+
20+
21+
-- | Burning input parameters.
22+
data BurnInput = BurnInput
23+
{ biUsedAddrs :: ![GYAddress]
24+
, biChangeAddr :: !GYAddress
25+
, biTaskId :: !Integer
26+
, biZkPassToken :: !String
27+
, biScriptsTxOutRef :: !String
28+
} deriving stock (Show, Generic)
29+
deriving anyclass FromJSON
30+
31+
handleBurn :: Ctx -> SetupParams -> BurnInput -> IO UnsignedTxResponse
32+
handleBurn Ctx{..} SetupParams{..} BurnInput{..} = do
33+
let nid = cfgNetworkId ctxCoreCfg
34+
providers = ctxProviders
35+
36+
let forwardingMintValidator = validatorFromPlutus @PlutusV3 $ forwardingMintCompiled biTaskId
37+
forwardingMintAddr = addressFromValidator nid forwardingMintValidator
38+
39+
let zkpassAsset = fromString biZkPassToken :: GYAssetClass
40+
41+
case zkpassAsset of
42+
GYToken zkpPolicy zkpTokenName -> do
43+
let cs = mintingPolicyIdToCurrencySymbol zkpPolicy
44+
inlineDatum = GYOutDatumInline $ datumFromPlutusData cs
45+
46+
utxosAtFM <- runGYTxQueryMonadIO nid
47+
providers
48+
(utxosAtAddress forwardingMintAddr (Just GYLovelace))
49+
50+
let utxosAtFMList = utxosToList $ filterUTxOs (\u -> utxoOutDatum u == inlineDatum) utxosAtFM
51+
52+
case utxosAtFMList of
53+
[utxoAtFM] -> do
54+
let (setup, _, _) = identityCircuitVerificationBytes spX spPS
55+
zkPassTokenValidator = validatorFromPlutus @PlutusV3 $ zkPassTokenCompiled setup
56+
57+
let setupTxOutRef = txOutRefFromTuple (fromString biScriptsTxOutRef, 0)
58+
forwardTxOutRef = txOutRefFromTuple (fromString biScriptsTxOutRef, 1)
59+
60+
let setupRef = GYBuildPlutusScriptReference @PlutusV3 setupTxOutRef zkPassTokenValidator
61+
forwardRef = GYBuildPlutusScriptReference @PlutusV3 forwardTxOutRef forwardingMintValidator
62+
forwardWit = GYTxInWitnessScript forwardRef Nothing unitRedeemer
63+
64+
let dummyRedeemer' = ProofBytes "" "" "" "" "" "" "" "" "" "" "" "" "" 0 0 0 0 0 0 0 0 0 0 0 0 (F.F 0)
65+
dummyRedeemer = redeemerFromPlutusData $ toBuiltinData dummyRedeemer'
66+
67+
let skeleton = mustHaveInput (GYTxIn @PlutusV3 (utxoRef utxoAtFM) forwardWit)
68+
<> mustMint (GYBuildPlutusScript setupRef) dummyRedeemer zkpTokenName (-1)
69+
70+
txBody <- runGYTxBuilderMonadIO nid
71+
providers
72+
biUsedAddrs
73+
biChangeAddr
74+
Nothing
75+
$ do
76+
ownAddrs <- ownAddresses
77+
let skeleton' = skeleton <> mustHaveOutput (GYTxOut (head ownAddrs) (utxoValue utxoAtFM) Nothing Nothing)
78+
buildTxBody skeleton'
79+
80+
return $ unSignedTxWithFee txBody
81+
82+
_ -> throwIO $ userError "No UTxO with expected datum found."
83+
_ -> throwIO $ userError "Missing native token specification."

‎app/ZkPass/Api/Context.hs

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
module ZkPass.Api.Context where
2+
3+
import Data.Aeson
4+
import qualified Data.Text as T
5+
import GeniusYield.GYConfig (GYCoreConfig (..))
6+
import GeniusYield.Types
7+
import GHC.Generics
8+
import Prelude
9+
10+
import ZkFold.Base.Algebra.EllipticCurve.BLS12_381 (BLS12_381_G1, Fr)
11+
import ZkFold.Base.Protocol.Plonkup.Prover.Secret (PlonkupProverSecret)
12+
13+
14+
------------------------- :Context & Setup: -------------------------
15+
16+
-- | Configuration context.
17+
data Ctx = Ctx
18+
{ ctxCoreCfg :: !GYCoreConfig
19+
, ctxProviders :: !GYProviders
20+
}
21+
22+
-- | Setup parameters.
23+
data SetupParams = SetupParams
24+
{ spX :: !Fr
25+
, spPS :: !(PlonkupProverSecret BLS12_381_G1)
26+
} deriving stock (Show, Generic)
27+
deriving anyclass (ToJSON, FromJSON)
28+
29+
------------------------- :Unsigned response: -------------------------
30+
31+
data UnsignedTxResponse = UnsignedTxResponse
32+
{ urspTxBodyHex :: !T.Text -- ^ Unsigned transaction cbor.
33+
, urspTxFee :: !(Maybe Integer) -- ^ Tx fees.
34+
} deriving stock (Show, Generic)
35+
deriving anyclass ToJSON
36+
37+
-- | Construct `UnsignedTxResponse` return type for our endpoint given the transaction body.
38+
unSignedTxWithFee :: GYTxBody -> UnsignedTxResponse
39+
unSignedTxWithFee txBody = UnsignedTxResponse
40+
{ urspTxBodyHex = T.pack . txToHex $ unsignedTx txBody
41+
, urspTxFee = Just $ txBodyFee txBody
42+
}
43+
44+
------------------------- :own address: -------------------------
45+
46+
-- | Own addresses input.
47+
data OwnAddresses = OwnAddresses { oaUsedAddrs :: ![GYAddress] }
48+
deriving stock (Show, Generic)
49+
deriving anyclass FromJSON
50+
51+
-- | Return own address as text.
52+
data OwnAddress = OwnAddress { oaOwnAddress :: !T.Text }
53+
deriving stock (Show, Generic)
54+
deriving anyclass ToJSON
55+
56+
-- | Handle to get own address.
57+
handleOwnAddr :: OwnAddresses -> IO OwnAddress
58+
handleOwnAddr OwnAddresses{..} = pure . OwnAddress . addressToText $ head oaUsedAddrs

‎app/ZkPass/Api/Mint.hs

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
module ZkPass.Api.Mint where
2+
3+
import Cardano.Api (AssetName (..),
4+
parseAddressAny)
5+
import Control.Exception (throwIO)
6+
import Data.Aeson
7+
import Data.Coerce (coerce)
8+
import qualified Data.Map.Strict as Map
9+
import Data.String (fromString)
10+
import GeniusYield.GYConfig (GYCoreConfig (..))
11+
import GeniusYield.TxBuilder
12+
import GeniusYield.Types
13+
import GHC.Generics
14+
import PlutusLedgerApi.V3 (fromBuiltin)
15+
import Prelude
16+
import Text.Parsec (parse)
17+
18+
import ZkFold.Cardano.OffChain.Utils (byteStringAsHex)
19+
import qualified ZkFold.Cardano.OnChain.BLS12_381.F as F
20+
import ZkPass.Api.Context
21+
import ZkPass.Cardano.Example.IdentityCircuit (zkPassResultVerificationBytes)
22+
import ZkPass.Cardano.Example.ZkPassResult (zkPassResult)
23+
import ZkPass.Cardano.UPLC.ZkPassToken (zkPassTokenCompiled)
24+
import ZkPass.Utils (asTuple)
25+
26+
27+
-- | Minting input parameters.
28+
data MintInput = MintInput
29+
{ miUsedAddrs :: ![GYAddress]
30+
, miChangeAddr :: !GYAddress
31+
, miBeneficiaryAddr :: !String
32+
, miScriptsTxOutRef :: !String
33+
} deriving stock (Show, Generic)
34+
deriving anyclass FromJSON
35+
36+
-- | ZkPass response parameters.
37+
data ZkPassResponse = ZkPassResponse
38+
{ zkprResult :: !String
39+
, zkprPolicyId :: !String
40+
, zkprTknName :: !String
41+
, zkprUnsigned :: !UnsignedTxResponse
42+
} deriving stock (Show, Generic)
43+
deriving anyclass ToJSON
44+
45+
handleMint :: Ctx -> SetupParams -> MintInput -> IO ZkPassResponse
46+
handleMint Ctx{..} SetupParams{..} MintInput{..} = do
47+
let nid = cfgNetworkId ctxCoreCfg
48+
providers = ctxProviders
49+
50+
case parse parseAddressAny "" miBeneficiaryAddr of
51+
Right benAddr -> do
52+
zkpr <- zkPassResult
53+
54+
let (setup, input, proof) = zkPassResultVerificationBytes spX spPS $ F.toInput zkpr
55+
zkPassTokenValidator = validatorFromPlutus @PlutusV3 $ zkPassTokenCompiled setup
56+
zkPassPolicyId = mintingPolicyId zkPassTokenValidator
57+
zkPassTokenName = coerce @AssetName @GYTokenName . AssetName . fromBuiltin $ F.fromInput input
58+
zkPassToken = GYToken zkPassPolicyId zkPassTokenName
59+
zkPassToken' = asTuple zkPassToken
60+
tokens = valueMake $ Map.singleton zkPassToken 1
61+
redeemer = redeemerFromPlutusData proof
62+
63+
let txOutRefSetup = txOutRefFromTuple (fromString miScriptsTxOutRef, 0)
64+
refScript = GYMintReference @PlutusV3 txOutRefSetup zkPassTokenValidator
65+
skeleton = mustHaveOutput (GYTxOut (addressFromApi benAddr) tokens Nothing Nothing)
66+
<> mustMint refScript redeemer zkPassTokenName 1
67+
68+
txBody <- runGYTxBuilderMonadIO nid
69+
providers
70+
miUsedAddrs
71+
miChangeAddr
72+
Nothing
73+
(buildTxBody skeleton)
74+
75+
return $ ZkPassResponse (byteStringAsHex $ fromBuiltin zkpr)
76+
(fst zkPassToken')
77+
(snd zkPassToken')
78+
(unSignedTxWithFee txBody)
79+
80+
Left err -> throwIO . userError . show $ err

0 commit comments

Comments
 (0)