├── scripts
    ├── buy-token.sh
    ├── market-utxos.sh
    ├── balance.sh
    ├── create-collateral.sh
    └── sell-token.sh
├── frontend
    ├── env.d.ts
    ├── src
    │   ├── assets
    │   │   ├── base.css
    │   │   └── logo.svg
    │   ├── scripts
    │   │   ├── sotre.ts
    │   │   ├── blockfrost.ts
    │   │   └── database.ts
    │   ├── main.ts
    │   ├── router
    │   │   └── index.ts
    │   ├── types.ts
    │   ├── App.vue
    │   ├── components
    │   │   ├── App.vue
    │   │   └── Listing.vue
    │   └── config.ts
    ├── .vscode
    │   └── extensions.json
    ├── public
    │   ├── cardano.png
    │   ├── favicon.ico
    │   ├── disconnect.svg
    │   └── clipboard.svg
    ├── postcss.config.js
    ├── tsconfig.vite-config.json
    ├── tailwind.config.js
    ├── index.html
    ├── vite.config.ts
    ├── .gitignore
    ├── tsconfig.json
    ├── package.json
    └── README.md
├── .dockerignore
├── .vscode
    └── settings.json
├── marketplace-cli
    └── Main.hs
├── .gitignore
├── marketplace-core
    └── Cardano
    │   └── Marketplace
    │       ├── Common
    │           ├── TextUtils.hs
    │           └── TransactionUtils.hs
    │       ├── SimpleMarketplace.hs
    │       ├── ConfigurableMarketplace.hs
    │       ├── V2
    │           └── Core.hs
    │       ├── V3
    │           └── Core.hs
    │       └── V1
    │           └── Core.hs
├── test
    ├── Test
    │   ├── TestContext.hs
    │   ├── TestStorySimpleMarket.hs
    │   ├── Common.hs
    │   ├── TestStoryConfigurableMarket.hs
    │   └── Reporting.hs
    └── Main.hs
├── .devcontainer
    ├── devcontainer.json
    └── Dockerfile
├── docs
    ├── build.md
    ├── RunOnPrivateTestnet.md
    ├── cli.md
    ├── cli.svg
    └── frontend.svg
├── address-setup.sh
├── README.MD
├── cabal.project
├── cardano-marketplace.cabal
├── reports
    ├── test-sanchonet-cardano-api-8.46
    │   ├── 2024-06-26_07-39-33-transaction-report.md
    │   └── 2024-06-26_07-39-33-junit.xml
    └── benchmark-conway-cardano-node-9.1.0
    │   └── 10-wallets
    │       └── 2024-08-13_06-49-22-transaction-bench.log
├── marketplace-plutus
    └── Plutus
    │   └── Contracts
    │       ├── V2
    │           ├── MarketplaceConfig.hs
    │           └── SimpleMarketplace.hs
    │       ├── V1
    │           └── SimpleMarketplace.hs
    │       └── V3
    │           └── MarketplaceConfig.hs
└── benchmark
    ├── Wallet.hs
    ├── Main.hs
    └── Reporting.hs


/scripts/buy-token.sh:
--------------------------------------------------------------------------------
1 | 


--------------------------------------------------------------------------------
/frontend/env.d.ts:
--------------------------------------------------------------------------------
1 | /// <reference types="vite/client" />
2 | 


--------------------------------------------------------------------------------
/.dockerignore:
--------------------------------------------------------------------------------
1 | **
2 | !./dist-newstyle/build/docker/chroot-env
3 | !./.ci


--------------------------------------------------------------------------------
/.vscode/settings.json:
--------------------------------------------------------------------------------
1 | {
2 |   "extensions": [
3 |     "DevContainers"
4 |   ]
5 | }


--------------------------------------------------------------------------------
/marketplace-cli/Main.hs:
--------------------------------------------------------------------------------
1 | module Main
2 | where
3 | 
4 | import Cli
5 | main= do runCli


--------------------------------------------------------------------------------
/frontend/src/assets/base.css:
--------------------------------------------------------------------------------
1 | @tailwind base;
2 | @tailwind components;
3 | @tailwind utilities;


--------------------------------------------------------------------------------
/frontend/.vscode/extensions.json:
--------------------------------------------------------------------------------
1 | {
2 |   "recommendations": ["Vue.volar", "Vue.vscode-typescript-vue-plugin"]
3 | }


--------------------------------------------------------------------------------
/frontend/public/cardano.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/dQuadrant/cardano-marketplace/HEAD/frontend/public/cardano.png


--------------------------------------------------------------------------------
/frontend/public/favicon.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/dQuadrant/cardano-marketplace/HEAD/frontend/public/favicon.ico


--------------------------------------------------------------------------------
/scripts/market-utxos.sh:
--------------------------------------------------------------------------------
1 | export NETWORK="9"
2 | export BASE="${BASE:-$HOME/projects/cardano-marketplace}"
3 | 
4 | cd "$BASE"
5 | cabal run market-cli -- ls 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | dist-newstyle/
 2 | .cluster-address/
 3 | .idea/
 4 | cabal.project.local
 5 | *.addr
 6 | *.skey
 7 | *.vkey
 8 | 
 9 | .history
10 | test-reports/


--------------------------------------------------------------------------------
/scripts/balance.sh:
--------------------------------------------------------------------------------
1 | export NETWORK="9"
2 | export BASE="${BASE:-$HOME/projects/cardano-marketplace}"
3 | 
4 | cd "$BASE"
5 | cabal run market-cli -- balance --signing-key-file pay.skey


--------------------------------------------------------------------------------
/scripts/create-collateral.sh:
--------------------------------------------------------------------------------
1 | export NETWORK="9"
2 | export BASE="${BASE:-$HOME/projects/cardano-marketplace}"
3 | 
4 | cd "$BASE"
5 | cabal run market-cli -- createcollateral --signing-key-file pay.skey


--------------------------------------------------------------------------------
/frontend/postcss.config.js:
--------------------------------------------------------------------------------
1 | const autoprefixer = require('autoprefixer');
2 | const tailwindcss = require('tailwindcss');
3 | 
4 | module.exports = {
5 |   plugins: [
6 |     tailwindcss,
7 |     autoprefixer,
8 |   ],
9 | };


--------------------------------------------------------------------------------
/frontend/tsconfig.vite-config.json:
--------------------------------------------------------------------------------
1 | {
2 |   "extends": "@vue/tsconfig/tsconfig.node.json",
3 |   "include": ["vite.config.*"],
4 |   "compilerOptions": {
5 |     "composite": true,
6 |     "types": ["node"]
7 |   }
8 | }
9 | 


--------------------------------------------------------------------------------
/frontend/src/scripts/sotre.ts:
--------------------------------------------------------------------------------
1 | import { reactive, ref } from 'vue'
2 | export const walletState = ref(false) 
3 | export const walletAction = reactive({
4 |     enable: false,
5 |     callback :null,
6 |     message : null,
7 | })
8 | 


--------------------------------------------------------------------------------
/frontend/tailwind.config.js:
--------------------------------------------------------------------------------
 1 | module.exports = {
 2 |     content: [
 3 |       "./index.html",
 4 |       "./src/**/*.{vue,js,ts}",
 5 |     ],
 6 |     theme: {
 7 |       extend: {},
 8 |     },
 9 |     plugins: [
10 |         require('@tailwindcss/forms'),
11 |     ],
12 |   }


--------------------------------------------------------------------------------
/frontend/src/assets/logo.svg:
--------------------------------------------------------------------------------
1 | <svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 261.76 226.69"  xmlns:v="https://vecta.io/nano"><path d="M161.096.001l-30.225 52.351L100.647.001H-.005l130.877 226.688L261.749.001z" fill="#41b883"/><path d="M161.096.001l-30.225 52.351L100.647.001H52.346l78.526 136.01L209.398.001z" fill="#34495e"/></svg>


--------------------------------------------------------------------------------
/frontend/src/main.ts:
--------------------------------------------------------------------------------
 1 | import { createApp } from 'vue'
 2 | import router from "./router"
 3 | import App from './App.vue'
 4 | import './assets/base.css';
 5 | import '@dafcoe/vue-notification/dist/vue-notification.css'
 6 | 
 7 | 
 8 | // @ts-ignore
 9 | import VueNotificationList from '@dafcoe/vue-notification'
10 | const app=createApp(App)
11 | app.use(VueNotificationList)
12 | app.use(router)
13 | app.mount('#app')
14 | 


--------------------------------------------------------------------------------
/frontend/index.html:
--------------------------------------------------------------------------------
 1 | <!DOCTYPE html>
 2 | <html lang="en">
 3 |   <head>
 4 |     <meta charset="UTF-8" />
 5 |     <link rel="icon" href="/favicon.ico" />
 6 |     <meta name="viewport" content="width=device-width, initial-scale=1.0" />
 7 |     <title>Simple Marketplace</title>
 8 |   </head>
 9 |   <body>
10 |     <div id="app"></div>
11 |     <script type="module" src="/src/main.ts"></script>
12 |   </body>
13 | </html>
14 | 


--------------------------------------------------------------------------------
/frontend/vite.config.ts:
--------------------------------------------------------------------------------
 1 | import { fileURLToPath, URL } from 'url'
 2 | 
 3 | import { defineConfig } from 'vite'
 4 | import vue from '@vitejs/plugin-vue'
 5 | 
 6 | // https://vitejs.dev/config/
 7 | export default defineConfig({
 8 |   base: process.env.BASE_URL ||  "/",
 9 |   plugins: [vue()],
10 |   resolve: {
11 |     alias: {
12 |       '@': fileURLToPath(new URL('./src', import.meta.url))
13 |     }
14 |   }
15 | })
16 | 


--------------------------------------------------------------------------------
/frontend/.gitignore:
--------------------------------------------------------------------------------
 1 | # Logs
 2 | logs
 3 | *.log
 4 | npm-debug.log*
 5 | yarn-debug.log*
 6 | yarn-error.log*
 7 | pnpm-debug.log*
 8 | lerna-debug.log*
 9 | 
10 | node_modules
11 | .DS_Store
12 | dist
13 | dist-ssr
14 | coverage
15 | *.local
16 | 
17 | /cypress/videos/
18 | /cypress/screenshots/
19 | 
20 | # Editor directories and files
21 | .vscode/*
22 | !.vscode/extensions.json
23 | .history/*
24 | .idea
25 | *.suo
26 | *.ntvs*
27 | *.njsproj
28 | *.sln
29 | *.sw?
30 | 


--------------------------------------------------------------------------------
/marketplace-core/Cardano/Marketplace/Common/TextUtils.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE FlexibleContexts #-}
 2 | module Cardano.Marketplace.Common.TextUtils
 3 | where
 4 | 
 5 | import Data.ByteString (ByteString)
 6 | import Data.Text.Conversions (ToText (toText), FromText (fromText), Base16 (unBase16, Base16), convertText, UTF8 (UTF8), DecodeText (decodeText))
 7 | import Data.Functor ((<&>))
 8 | 
 9 | import Data.Text.Lazy (Text)
10 | import qualified Data.Text as Data.Text.Internal
11 | 
12 | toHexString :: (FromText a1, ToText (Base16 a2)) => a2 -> a1
13 | toHexString bs = fromText $  toText (Base16 bs)
14 | 
15 |   
16 |   


--------------------------------------------------------------------------------
/scripts/sell-token.sh:
--------------------------------------------------------------------------------
 1 | export NETWORK="9"
 2 | export TESTNET_MAGIC="9"
 3 | export CARDANO_CLI="${CARDANO_CLI:-cardano-cli-33}"
 4 | export BASE="${BASE:-$HOME/projects/cardano-marketplace}"
 5 | 
 6 | export WORK="${WORK:-$HOME/work}"
 7 | export UTXO_VKEY="${UTXO_VKEY:-$HOME/projects/cardano-marketplace/pay.vkey}"
 8 | export UTXO_SKEY="${UTXO_SKEY:-$HOME/projects/cardano-marketplace/pay.skey}"
 9 | export UTXO_ADDR="${UTXO_ADDR:-$HOME/projects/cardano-marketplace/pay.addr}"
10 | 
11 | utxoaddr=$(cat $UTXO_ADDR)
12 | 
13 | txin=
14 | 
15 | cd "$BASE"
16 | # cabal run market-cli -- sell "$txin" 2000000 --signing-key-file pay.skey


--------------------------------------------------------------------------------
/frontend/src/router/index.ts:
--------------------------------------------------------------------------------
 1 | import { createRouter, createWebHistory } from 'vue-router'
 2 | import Listing from '@/components/Listing.vue'
 3 | import Wallet from '@/components/Wallet.vue'
 4 | 
 5 | 
 6 | console.log(import.meta.env.BASE_URL)
 7 | 
 8 | const pathregex  = new RegExp('.*')
 9 | const router = createRouter({
10 |   history: createWebHistory(import.meta.env.BASE_URL),
11 |   routes: [
12 |     {
13 |       // @ts-ignore
14 |       path: '/',
15 |       name: 'home',
16 |       component: Listing
17 |     },
18 |       {
19 |           path:"/wallet",
20 |           name : "walet",
21 |           component: Wallet
22 |       }
23 |   ]
24 | })
25 | 
26 | export default router
27 | 


--------------------------------------------------------------------------------
/frontend/src/types.ts:
--------------------------------------------------------------------------------
 1 | export type HexString  = string;
 2 | 
 3 | export  interface CIP30Provider {
 4 |     apiVersion: String ;
 5 |     enable : ()=> Promise<CIP30Instace>;
 6 |     icon: string;
 7 |     isEnabled:()=> Promise<Boolean>;
 8 |     name: string;
 9 | }
10 | 
11 | export  interface CIP30Instace {
12 |     submitTx:(tx:string) =>   Promise <any>
13 |     signTx: (tx: string,partial?: Boolean) => Promise<HexString>
14 |     getChangeAddress: ()=> Promise<HexString>
15 |     getNetworkId: ()=>Promise<number>
16 |     getRewardAddresses: ()=>Promise<HexString>
17 |     getUnusedAddresses: ()=>Promise<Array<HexString>>
18 |     getUsedAddresses: ()=>Promise<Array<HexString>>
19 |     getUtxos: ()=>Promise<Array<HexString>>
20 |     getCollateral: () => Promise<Array<HexString>>
21 | }
22 | 


--------------------------------------------------------------------------------
/frontend/tsconfig.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "extends": "@vue/tsconfig/tsconfig.web.json",
 3 |   "skipLibCheck": true,
 4 |   "include": ["env.d.ts", "src/**/*", "src/**/*.vue"],
 5 |   "compilerOptions": {
 6 |     "baseUrl": ".",
 7 |     "lib": [
 8 |       "es2020",
 9 |       "dom",
10 |       "scripthost"
11 |     ],
12 |     "paths": {
13 |       "@/*": ["./src/*"]
14 |     },
15 | 
16 |       "target": "es5",
17 |       "allowJs": true,
18 |       "skipLibCheck": true,
19 |       "strict": false,
20 |       "forceConsistentCasingInFileNames": true,
21 |       "noEmit": true,
22 |       "esModuleInterop": true,
23 |       "moduleResolution": "node",
24 |       "resolveJsonModule": true,
25 |       "isolatedModules": true,
26 |   },
27 | 
28 |   "references": [
29 |     {
30 |       "path": "./tsconfig.vite-config.json"
31 |     }
32 |   ],
33 |   "exclude": ["node_modules/**"]
34 | 
35 | }
36 | 


--------------------------------------------------------------------------------
/test/Test/TestContext.hs:
--------------------------------------------------------------------------------
 1 | module Test.TestContext where
 2 | import Cardano.Api
 3 | import GHC.Conc (TVar)
 4 | import Data.Map (Map)
 5 | 
 6 | data TagMetric = TagMetric {
 7 |   tmTestGroup :: String,
 8 |   tmTag :: String,
 9 |   tmMetricName :: String,
10 |   tmMetric :: String 
11 | }
12 | 
13 | 
14 | data TestReport = TestReport {
15 |     trTestGroup :: String 
16 |     , trTag :: String
17 |     , trTxDetail :: [TxDetail]
18 | } deriving Show
19 | 
20 | data TxDetail = TxDetail {
21 |     tdTestName :: String
22 |   , td:: Tx ConwayEra
23 | } deriving Show
24 | 
25 | 
26 | 
27 | data TestContext a= TestContext{
28 |     tcChainInfo:: a
29 |   , tcNetworkId :: NetworkId
30 |   , tcSignKey :: SigningKey PaymentKey
31 |   , tcWalletAddr :: AddressInEra ConwayEra
32 |   , tcReports :: TVar [TestReport]
33 |   , tcTempReport :: TVar [TxDetail]
34 |   , tcTagMetrics :: TVar [TagMetric]
35 | }


--------------------------------------------------------------------------------
/frontend/package.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "frontend",
 3 |   "version": "0.0.0",
 4 |   "scripts": {
 5 |     "start": "vite",
 6 |     "dev": "vite",
 7 |     "build": "vue-tsc --noEmit && vite build",
 8 |     "preview": "vite preview --port 5050",
 9 |     "typecheck": "vue-tsc --noEmit"
10 |   },
11 |   "dependencies": {
12 |     "@dafcoe/vue-notification": "^0.1.6",
13 |     "@emurgo/cardano-serialization-lib-asmjs": "11.1.0",
14 |     "@headlessui/vue": "^1.6.4",
15 |     "bootstrap-vue": "^2.22.0",
16 |     "buffer": "^6.0.3",
17 |     "vue": "^3.2.37",
18 |     "vue-router": "^4.0.14"
19 |   },
20 |   "devDependencies": {
21 |     "@tailwindcss/forms": "^0.5.2",
22 |     "@types/node": "^16.11.38",
23 |     "@vitejs/plugin-vue": "^2.3.1",
24 |     "@vue/tsconfig": "^0.1.3",
25 |     "autoprefixer": "^10.4.7",
26 |     "postcss": "^8.4.14",
27 |     "tailwindcss": "^3.0.24",
28 |     "typescript": "~4.6.3",
29 |     "vite": "^2.9.10",
30 |     "vue-tsc": "^0.34.17"
31 |   }
32 | }
33 | 


--------------------------------------------------------------------------------
/frontend/README.md:
--------------------------------------------------------------------------------
 1 | # Marketplace Frontend
 2 | 
 3 | Vue project for interacting with marketplace contract on cardano testnet. Frontend project runs independ of the `marketplace-cli` or `marketplace-core` and only needs a running    [kuber](https://github.com/dQuadrant/kuber) API server instance.
 4 | 
 5 | ![](../docs/frontend.svg)
 6 | 
 7 | ## Recommended IDE Setup
 8 | 
 9 | [VSCode](https://code.visualstudio.com/) + [Volar](https://marketplace.visualstudio.com/items?itemName=johnsoncodehk.volar) (and disable Vetur) + [TypeScript Vue Plugin (Volar)](https://marketplace.visualstudio.com/items?itemName=johnsoncodehk.vscode-typescript-vue-plugin).
10 | 
11 | 
12 | 
13 | ### Project Setup
14 | 
15 | ```sh
16 | npm install
17 | ```
18 | 
19 | #### Compile and Hot-Reload for Development
20 | 
21 | ```sh
22 | npm run dev
23 | ```
24 |         
25 | **Configuration file : [src/config.ts](./src/config.ts)**
26 | 
27 | You can either use `https://testnet.cnftregistry.io/kuber`  for apiServer. Better approach is to run your own kuber server and cardano-node instance locally.
28 | 
29 | 


--------------------------------------------------------------------------------
/.devcontainer/devcontainer.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "Cardano & Plutus",
 3 |   "image": "dquadrant/cardano-devcontainer:1.35.0",
 4 |   // Update the 'dockerfile' property if you aren't using the standard 'Dockerfile' filename.
 5 |   // "build": {
 6 |   //         "dockerfile": "Dockerfile"
 7 |   // },
 8 | 
 9 | 	// Configure tool-specific properties.
10 | 	"customizations": {
11 | 		// Configure properties specific to VS Code.
12 | 		"vscode": {
13 | 			// Add the IDs of extensions you want installed when the container is created.
14 | 			"extensions": [
15 | 				"haskell.haskell"
16 | 			],
17 |       "settings": {
18 |         "haskell.manageHLS": "GHCup"
19 |       }
20 | 		}
21 | 	}
22 | 
23 |   // Use 'forwardPorts' to make a list of ports inside the container available locally.
24 |   // "forwardPorts": [],
25 | 
26 |   // Use 'postCreateCommand' to run commands after the container is created.
27 |   // "postCreateCommand": "uname -a",
28 | 
29 | 
30 |   // Comment out to connect as root instead. To add a non-root user, see: https://aka.ms/vscode-remote/containers/non-root.
31 |   //"remoteUser": "vscode"
32 | }
33 | 


--------------------------------------------------------------------------------
/frontend/public/disconnect.svg:
--------------------------------------------------------------------------------
1 | <svg xmlns="http://www.w3.org/2000/svg" color="red" viewBox="0 0 512 512"><!-- Font Awesome Pro 5.15.4 by @fontawesome - https://fontawesome.com License - https://fontawesome.com/license (Commercial License) -->
2 |     <path style="fill:darkred" d="M304.083 405.907c4.686 4.686 4.686 12.284 0 16.971l-44.674 44.674c-59.263 59.262-155.693 59.266-214.961 0-59.264-59.265-59.264-155.696 0-214.96l44.675-44.675c4.686-4.686 12.284-4.686 16.971 0l39.598 39.598c4.686 4.686 4.686 12.284 0 16.971l-44.675 44.674c-28.072 28.073-28.072 73.75 0 101.823 28.072 28.072 73.75 28.073 101.824 0l44.674-44.674c4.686-4.686 12.284-4.686 16.971 0l39.597 39.598zm-56.568-260.216c4.686 4.686 12.284 4.686 16.971 0l44.674-44.674c28.072-28.075 73.75-28.073 101.824 0 28.072 28.073 28.072 73.75 0 101.823l-44.675 44.674c-4.686 4.686-4.686 12.284 0 16.971l39.598 39.598c4.686 4.686 12.284 4.686 16.971 0l44.675-44.675c59.265-59.265 59.265-155.695 0-214.96-59.266-59.264-155.695-59.264-214.961 0l-44.674 44.674c-4.686 4.686-4.686 12.284 0 16.971l39.597 39.598zm234.828 359.28l22.627-22.627c9.373-9.373 9.373-24.569 0-33.941L63.598 7.029c-9.373-9.373-24.569-9.373-33.941 0L7.029 29.657c-9.373 9.373-9.373 24.569 0 33.941l441.373 441.373c9.373 9.372 24.569 9.372 33.941 0z"/>
3 | </svg>
4 | 


--------------------------------------------------------------------------------
/frontend/public/clipboard.svg:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="iso-8859-1"?>
 2 | <!-- Generator: Adobe Illustrator 18.0.0, SVG Export Plug-In . SVG Version: 6.00 Build 0)  -->
 3 | <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
 4 | <svg version="1.1" id="Capa_1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" x="0px" y="0px"
 5 | 	 viewBox="0 0 512 512" style="enable-background:new 0 0 512 512;" xml:space="preserve">
 6 | <g>
 7 | 	<path d="M192,224c-17.672,0-32,14.328-32,32s14.328,32,32,32h128c17.672,0,32-14.328,32-32s-14.328-32-32-32H192z"/>
 8 | 	<path d="M256,320h-64c-17.672,0-32,14.328-32,32s14.328,32,32,32h64c17.672,0,32-14.328,32-32S273.672,320,256,320z"/>
 9 | 	<path d="M416,32h-80c0-17.674-11.938-32-26.668-32H202.668C187.938,0,176,14.326,176,32H96c-17.672,0-32,14.328-32,32v416
10 | 		c0,17.672,14.328,32,32,32h320c17.672,0,32-14.328,32-32V64C448,46.328,433.672,32,416,32z M256,32c17.672,0,32,14.326,32,32
11 | 		c0,17.673-14.328,32-32,32s-32-14.327-32-32C224,46.326,238.328,32,256,32z M384,448H128V96h48v32h160V96h48V448z"/>
12 | </g>
13 | <g>
14 | </g>
15 | <g>
16 | </g>
17 | <g>
18 | </g>
19 | <g>
20 | </g>
21 | <g>
22 | </g>
23 | <g>
24 | </g>
25 | <g>
26 | </g>
27 | <g>
28 | </g>
29 | <g>
30 | </g>
31 | <g>
32 | </g>
33 | <g>
34 | </g>
35 | <g>
36 | </g>
37 | <g>
38 | </g>
39 | <g>
40 | </g>
41 | <g>
42 | </g>
43 | </svg>
44 | 


--------------------------------------------------------------------------------
/docs/build.md:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | ### Setting Up Locally
 4 | 
 5 | To prepare your system for building kuber from sources, follow these instructions:
 6 | 
 7 |     The steps can be summarized as 
 8 |     - install system dependencies for ghc and cardano-node
 9 |     - install ghc compiler and tools with ghcup
10 |     - install iokhk patch of libsodium on the system
11 |  
12 |  The steps are described in detailed in the documentation of [building-cardano-node-from-soruces](https://developers.cardano.org/docs/get-started/installing-cardano-node/)
13 | 
14 | <h3><b>Install ghcup</b></h3>
15 | 
16 | **Important :** Check if ghc is installed using os package manager and uninstall it. (in case of ubuntu: `sudo apt remove ghc`)
17 | 
18 | Check [this page](https://www.haskell.org/ghcup/install/) for further explanation on the installation process.
19 | 
20 | #### Setup ghc and cabal 
21 | 
22 | ```bash
23 | ghcup install ghc 8.10.7
24 | ghcup install cabal 3.6.2.0 
25 | ghcup install hls # for language support in vs-code
26 | ghcup set ghc 8.10.7
27 | ghcup set cabal 3.6.2.0
28 | ```
29 | 
30 | #### Configuring the build options
31 | 
32 | We explicitly use the GHC version that we installed earlier.  This avoids defaulting to a system version of GHC that might be older than the one you have installed.
33 | 
34 | ```bash
35 | cabal configure --with-compiler=ghc-8.10.7
36 | ```
37 | 
38 | #### Running the project
39 | ```
40 |   cabal install market-cli
41 |   market-cli --help
42 | ```
43 | For detaied options [Cli-docs](./cli.md)


--------------------------------------------------------------------------------
/address-setup.sh:
--------------------------------------------------------------------------------
 1 | echo "CARDANO_NODE_SOCKET_PATH = $CARDANO_NODE_SOCKET_PATH"
 2 | echo "GENESIS_ADDRESS = $GENESIS_ADDRESS"
 3 | echo "GENESIS_SKEY_FILE = $GENESIS_SKEY_FILE"
 4 | echo "WALLET_ADDRESS = $WALLET_ADDRESS"
 5 | 
 6 | # fund from cluster
 7 | mkdir .cluster-address
 8 | cardano-cli query utxo \
 9 |     --address $GENESIS_ADDRESS \
10 |     --testnet-magic 42 \
11 |     --socket-path $CARDANO_NODE_SOCKET_PATH \
12 |     --out-file .cluster-address/genesis-utxos.json
13 | 
14 | export GENESIS_TXIN=$(jq -r 'keys[0]' .cluster-address/genesis-utxos.json)
15 | echo "GENESIS_TXIN = $GENESIS_TXIN"
16 | 
17 | cardano-cli conway transaction build \
18 |     --tx-in $GENESIS_TXIN \
19 |     --tx-out $WALLET_ADDRESS+300000000000000 \
20 |     --out-file .cluster-address/fund-wallet-address.tx \
21 |     --change-address $GENESIS_ADDRESS \
22 |     --testnet-magic 42 \
23 |     --socket-path $CARDANO_NODE_SOCKET_PATH
24 | 
25 | cardano-cli conway transaction sign \
26 |     --tx-body-file .cluster-address/fund-wallet-address.tx \
27 |     --signing-key-file $GENESIS_SKEY_FILE \
28 |     --testnet-magic 42 \
29 |     --out-file .cluster-address/fund-wallet-address.tx \
30 | 
31 | cardano-cli transaction submit \
32 |     --tx-file .cluster-address/fund-wallet-address.tx \
33 |     --testnet-magic 42 \
34 |     --socket-path $CARDANO_NODE_SOCKET_PATH
35 | 
36 | echo "Funding Wallet..."
37 | sleep 5
38 | 
39 | echo "WALLET BALANCE:"
40 | cardano-cli query utxo --address $WALLET_ADDRESS --testnet-magic 42 --socket-path $CARDANO_NODE_SOCKET_PATH
41 | 


--------------------------------------------------------------------------------
/README.MD:
--------------------------------------------------------------------------------
 1 | Cardano Simple Marketplace
 2 | ==========================
 3 | 
 4 | Webapp and cli for marketplace in cardano testnet using Kuber libarary.
 5 | 
 6 | #### marketplace-cli
 7 | This  component is command line tool for interacting with the marketplace. Cli used kuber library, which handles transaction creation and submission to node 
 8 | 
 9 | ![something](./docs/cli.svg)
10 | 
11 | 
12 | #### marketplace-frontend
13 | Frontend vue project is located [here](./frontend).
14 | - It connects to an existing kuber server to construct transactions.
15 | - Lists tokens onSale using blockfrost APIs.
16 | 
17 | ![something](./docs/frontend.svg)
18 | 
19 | 
20 | 
21 | ### Project structure
22 | 
23 | - **marketplace-plutus/** - contains plutus contract codes for  marketplace
24 | - **marketplace-cli/** - Cli to perform marketplace operations with cardano-node connection.
25 | - **marketplace-core/** - contains marketplace core functions and  interaction with kuber library
26 | - **frontend/** - contains client side for marketplace
27 | 
28 | 
29 | ### IDE Setup
30 |  
31 | VS code  with devcontainer enabled is the fastest way to get started with the project. To Use the cli, cardano-node should also be installed and running.
32 | 
33 | ## Usage:
34 | - [Using frontend](./frontend) : (Preferred Way) Its easier to get started.
35 | - [Using Cli](./docs/cli.md)
36 | 
37 | 
38 | ## Building locally
39 |  [Building locally](./docs/build.md)
40 | 
41 | ## Running on a private testnet
42 | [Running on a private testnet](./docs/RunOnPrivateTestnet.md) 
43 | 


--------------------------------------------------------------------------------
/cabal.project:
--------------------------------------------------------------------------------
 1 | -- See CONTRIBUTING for information about these, including some Nix commands
 2 | -- you need to run if you change them
 3 | index-state:
 4 |   , hackage.haskell.org 2024-10-10T00:52:24Z
 5 |   , cardano-haskell-packages 2024-10-30T10:23:17Z
 6 | 
 7 | -- Custom repository for cardano haskell packages, see CONTRIBUTING for more
 8 | repository cardano-haskell-packages
 9 |   url: https://chap.intersectmbo.org/
10 |   secure: True
11 |   root-keys:
12 |     3e0cce471cf09815f930210f7827266fd09045445d65923e6d0238a6cd15126f
13 |     443abb7fb497a134c343faf52f0b659bd7999bc06b7f63fa76dc99d631f9bea1
14 |     a86a1f6ce86c449c46666bda44268677abf29b5b2d2eb5ec7af903ec2f117a82
15 |     bcec67e8e99cabfa7764d75ad9b158d72bfacf70ca1d0ec8bc6b4406d1bf8413
16 |     c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56
17 |     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
18 | 
19 | packages:
20 |   .
21 |   
22 | -- You never, ever, want this.
23 | write-ghc-environment-files: never
24 | 
25 | package cardano-crypto-praos
26 |   flags: -external-libsodium-vrf
27 |   
28 | -- Always build tests and benchmarks.
29 | tests: True
30 | benchmarks: True
31 | test-show-details: streaming
32 | 
33 | package cryptonite
34 |   -- Using RDRAND instead of /dev/urandom as an entropy source for key
35 |   -- generation is dubious. Set the flag so we use /dev/urandom by default.
36 |   flags: -support_rdrand
37 | 
38 | 
39 | source-repository-package
40 |   type: git
41 |   location: https://github.com/dquadrant/kuber
42 |   tag: 105353e962de36f581dd1260e9e0d410b57f79e9


--------------------------------------------------------------------------------
/frontend/src/scripts/blockfrost.ts:
--------------------------------------------------------------------------------
 1 | 
 2 | import {blockfrost,market} from    "@/config"
 3 | 
 4 | 
 5 | export function listMarket() {
 6 |     return getBlockfrost("/addresses/" + market.address + "/utxos?order=desc")
 7 | }
 8 | 
 9 | export function getAssetDetail(asset: string) {
10 |     return getBlockfrost("/assets/" + asset)
11 | }
12 | 
13 | export function getDatum(hash: string) {
14 |     return getBlockfrost("/scripts/datum/" + hash)
15 | }
16 | 
17 | function getBlockfrost(path) {
18 |     const url= blockfrost.apiUrl + path
19 |     return fetch(url, {
20 |         headers: {project_id: blockfrost.apiKey}
21 |     }).then(res => {
22 |         if (res.status === 200) {
23 |             return res.json()
24 |         } else {
25 |             return res.text().then(txt => {
26 |                 let err
27 |                 let json: any
28 |                 try {
29 |                     json = JSON.parse(txt)
30 |                     if (json) {
31 |                         err = Error(`BlockfrostApi [Status ${res.status}] : ${json.message ? json.message : txt}`)
32 |                         err.json = json
33 |                     } else {
34 |                         err = Error(`BlockfrostApi [Status ${res.status}] : ${txt}`)
35 |                         err.text = txt
36 |                     }
37 |                 } catch (e) {
38 |                     err = Error(`BlockfrostApi [Status ${res.status}] : ${txt}`)
39 |                     err.text = txt
40 |                 }
41 |                 err.response=res
42 |                 err.url=url
43 |                 err.status_code=res.status
44 |                 throw(err)
45 |             })
46 |         }
47 |     })
48 | }
49 | 


--------------------------------------------------------------------------------
/frontend/src/App.vue:
--------------------------------------------------------------------------------
 1 | <script setup lang="ts">
 2 | import { RouterView } from "vue-router";
 3 | import Wallet from "./components/Wallet.vue";
 4 | import { walletState } from "@/scripts/sotre";
 5 | import { explorerUrl, market } from "@/config";
 6 | </script>
 7 | 
 8 | <template>
 9 |   <div>
10 |     <nav
11 |       class="pl-5 w-full flex flex-wrap items-center justify-between py-2 bg-gray-100 text-gray-500 hover:text-gray-700 focus:text-gray-700 shadow-lg navbar navbar-expand-lg navbar-light sticky"
12 |     >
13 |       <div class="flex-grow items-center" id="navbarSupportedContent">
14 |         <!-- Left links -->
15 |         <ul class="navbar-nav flex flex-column pl-0 list-style-none mr-auto">
16 |           <li class="nav-item px-2">
17 |             <a class="nav-link active" aria-current="page" href="/">Marketplace</a>
18 |           </li>
19 |           <li class="nav-item border-l-2 border-l-gray-300 pl-2">
20 |             <a
21 |               class="nav-link text-gray-500 hover:text-gray-700 focus:text-gray-700 p-0"
22 |               @click="walletState = true"
23 |               >Wallet</a
24 |             >
25 |           </li>
26 |         </ul>
27 |         <!-- Left links -->
28 |       </div>
29 |       <!-- Collapsible wrapper -->
30 |       <div>
31 |         <a
32 |           :href="explorerUrl + '/address/' + market.address"
33 |           class="items-center text-sm mr-2 underline text-blue-500"
34 |         >
35 |           View in explorer
36 |         </a>
37 |       </div>
38 |     </nav>
39 |     <RouterView class="flex-grow" />
40 |     <footer class="bg-gray-200 text-center lg:text-left">
41 |       <div
42 |         class="text-gray-700 text-center p-4 absolute bottom-0 w-full"
43 |         style="background-color: rgba(0, 0, 0, 0.2)"
44 |       >
45 |         Simple Marketplace |
46 |         <a class="text-gray-800 underline" href="https://github.com/dquadrant/kuber"
47 |           >Powered by Kuber</a
48 |         >
49 |       </div>
50 |     </footer>
51 |     <Wallet />
52 |   </div>
53 | </template>
54 | 


--------------------------------------------------------------------------------
/test/Main.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | 
 3 | import Test.TestStorySimpleMarket (makeSimpleMarketSpecs)
 4 | import Test.TestStoryConfigurableMarket  (makeConfigurableMarketSpecs)
 5 | import System.Environment (setEnv)
 6 | import Test.Common (testContextFromEnv)
 7 | import Test.Hspec (sequential)
 8 | import Test.Hspec.JUnit (hspecJUnit)
 9 | import Test.Hspec (hspec)
10 | import System.IO
11 |     ( stdout, hSetBuffering, stderr, BufferMode(LineBuffering), openFile, IOMode (WriteMode) )
12 | import Data.Time (formatTime, getCurrentTime)
13 | import Data.Time.Format (defaultTimeLocale)
14 | import GHC.IO.Handle (hDuplicateTo)
15 | import System.Directory (createDirectoryIfMissing)
16 | import Test.Reporting (writeReports)
17 | import Control.Exception (finally)
18 | 
19 | main :: IO ()
20 | main = do
21 |     currentTime <- getCurrentTime
22 |     let dateStr = formatTime defaultTimeLocale "%Y-%m-%d_%H-%M-%S" currentTime
23 |     let reportDir = "./test-reports"
24 |     
25 |     let junitFileName = dateStr ++ "-marketplace-test"  ++ ".xml"
26 |     let logFileName = dateStr ++ "-marketplace-test" ++ ".log"
27 |     let transactionReports =  dateStr ++ "-transaction-report" ++ ".md"
28 | 
29 |     createDirectoryIfMissing True reportDir
30 | 
31 |         -- Set environment variables
32 |     setEnv "JUNIT_ENABLED" "1"
33 |     setEnv "JUNIT_OUTPUT_DIRECTORY" reportDir
34 |     setEnv "JUNIT_SUITE_NAME" "Marketplace Scenario Test"
35 | 
36 | 
37 |     testContext <- testContextFromEnv
38 |     simpleMarketSpecs <-  makeSimpleMarketSpecs 1 testContext 
39 |     configurableMarketSpecs <- makeConfigurableMarketSpecs 3 testContext
40 | 
41 |     logFile <- openFile (reportDir ++ "/" ++ logFileName) WriteMode
42 |     hSetBuffering stdout LineBuffering
43 |     hSetBuffering stderr LineBuffering
44 |     
45 |     hDuplicateTo logFile stdout
46 |     hDuplicateTo logFile stderr
47 |     
48 | 
49 |     finally (hspecJUnit $ sequential  $ do
50 |                 sequence_  simpleMarketSpecs
51 |                 sequence_ configurableMarketSpecs
52 |             )
53 |         (writeReports testContext  ( reportDir <> "/" <>transactionReports))
54 | 


--------------------------------------------------------------------------------
/.devcontainer/Dockerfile:
--------------------------------------------------------------------------------
 1 | ARG UBUNTU_VERSION=20.04
 2 | FROM ubuntu:${UBUNTU_VERSION}
 3 | ENV DEBIAN_FRONTEND=nonintercative
 4 | RUN mkdir -p /app/src
 5 | WORKDIR /app
 6 | 
 7 | # development dependencies
 8 | RUN apt-get update -y && apt-get install -y \
 9 |   automake \
10 |   build-essential \
11 |   g++\
12 |   git \
13 |   jq \
14 |   libicu-dev \
15 |   libffi-dev \
16 |   libgmp-dev \
17 |   libncursesw5 \
18 |   libpq-dev \
19 |   libssl-dev \
20 |   libsystemd-dev \
21 |   libtinfo-dev \
22 |   libtool \
23 |   make \
24 |   pkg-config \
25 |   tmux \
26 |   wget \
27 |   zlib1g-dev libreadline-dev llvm libnuma-dev \
28 |   && rm -rf /var/lib/apt/lists/*
29 | 
30 | ARG CABAL_VERSION=3.6.2.0
31 | ARG GHC_VERSION=8.10.7
32 | ARG HLS_VERSION=1.7.0.0
33 | ARG IOHK_LIBSODIUM_GIT_REV=66f017f16633f2060db25e17c170c2afa0f2a8a1
34 | ARG IOKH_LIBSECP251_GIT_REV=ac83be33d0956faf6b7f61a60ab524ef7d6a473a
35 | 
36 | # install secp2561k library with prefix '/'
37 | RUN git clone https://github.com/bitcoin-core/secp256k1 &&\
38 |   cd secp256k1 \
39 |   && git fetch --all --tags &&\
40 |   git checkout ${IOKH_LIBSECP251_GIT_REV} \
41 |   && ./autogen.sh && \
42 |   ./configure --prefix=/usr --enable-module-schnorrsig --enable-experimental && \
43 |   make && \
44 |   make install  && cd .. && rm -rf ./secp256k1
45 | 
46 | 
47 | # install libsodium from sources with prefix '/'
48 | RUN git clone https://github.com/input-output-hk/libsodium.git &&\
49 |   cd libsodium \
50 |   && git fetch --all --tags &&\
51 |   git checkout ${IOHK_LIBSODIUM_GIT_REV} \
52 |   && ./autogen.sh && \
53 |   ./configure --prefix=/usr && \
54 |   make && \
55 |   make install  && cd .. && rm -rf ./libsodium
56 | 
57 | 
58 | # install ghcup
59 | ENV PATH=${PATH}:${HOME:-/root}/.ghcup/bin
60 | RUN wget --secure-protocol=TLSv1_2 \
61 |   https://downloads.haskell.org/~ghcup/$(arch)-linux-ghcup  \ 
62 |   && chmod +x $(arch)-linux-ghcup \
63 |   && mkdir -p ${HOME:-/root}/.ghcup/bin \
64 |   && mv $(arch)-linux-ghcup ${HOME:-/root}/.ghcup/bin/ghcup 
65 | 
66 | RUN ghcup config set downloader Wget \
67 |   &&  ghcup install ghc ${GHC_VERSION} \
68 |   &&  ghcup install cabal ${CABAL_VERSION} \
69 |   && ghcup set ghc
70 | RUN ghcup install hls ${HLS_VERSION}
71 | 


--------------------------------------------------------------------------------
/frontend/src/components/App.vue:
--------------------------------------------------------------------------------
 1 | <script setup lang="ts">
 2 | import { Buffer } from "buffer";
 3 | import { RouterView } from "vue-router";
 4 | import { ref } from 'vue'
 5 | import { Dialog, DialogPanel, DialogTitle, TransitionChild, TransitionRoot } from '@headlessui/vue'
 6 | import {decodeAssetName, listProviders, walletValue} from "@/scripts/wallet";
 7 | import type {CIP30Provider} from "@/types";
 8 | import {BigNum} from "@emurgo/cardano-serialization-lib-asmjs";
 9 | import {getAssetDetail} from "@/scripts/blockfrost";
10 | 
11 | const open = ref(true)
12 | 
13 | </script>
14 | 
15 | <template>
16 |   <div class="">
17 |     <nav class="
18 |       pl-5
19 |             w-full
20 |             flex flex-wrap
21 |             items-center
22 |             justify-between
23 |             py-2
24 |             bg-gray-100cod
25 |             text-gray-500
26 |             hover:text-gray-700
27 |             focus:text-gray-700
28 |             shadow-lg
29 |             navbar navbar-expand-lg navbar-light
30 |             sticky
31 |             ">
32 |       <div class="collapse navbar-collapse flex-grow items-center" id="navbarSupportedContent">
33 |         <!-- Left links -->
34 |         <ul class=" navbar-nav flex flex-column pl-0 list-style-none mr-auto">
35 | 
36 |           <li class="nav-item px-2">
37 |             <a class="nav-link active" aria-current="page" href="/">Marketplace</a>
38 |           </li>
39 |           <li class="nav-item  border-l-2 border-l-gray-300 pl-2">
40 |             <a class="nav-link text-gray-500 hover:text-gray-700 focus:text-gray-700 p-0" @click="open=true">Wallet</a>
41 |           </li>
42 |         </ul>
43 |         <!-- Left links -->
44 |       </div>
45 |       <!-- Collapsible wrapper -->
46 |     </nav>
47 |     <RouterView class="flex-grow" />
48 |     <footer class="bg-gray-200 text-center lg:text-left">
49 |       <div class="text-gray-700 text-center p-4" style="background-color: rgba(0, 0, 0, 0.2);">
50 |         Simple Marketplace |
51 |         <a class="text-gray-800" href="https://github.com/dquadrant/kuber">Powered by Kuber</a>
52 |       </div>
53 |     </footer>
54 |   </div>
55 |   <!-- This example requires Tailwind CSS v2.0+ -->
56 |   </template>
57 | 


--------------------------------------------------------------------------------
/frontend/src/scripts/database.ts:
--------------------------------------------------------------------------------
 1 | export function openDB():Promise<IDBDatabase> {
 2 |     return new Promise((resolve, reject) => {
 3 |         try {
 4 | 
 5 |             let request :IDBOpenDBRequest = window.indexedDB.open("marketDB", 2);
 6 | 
 7 |             request.onerror = e => {
 8 |                 console.log('Error opening db', e);
 9 |                 reject('Error');
10 |             };
11 | 
12 |             request.onsuccess = (e:any ) => {
13 |                 console.log("Success opening db",e)
14 |                 resolve(e.target.result);
15 |             };
16 | 
17 |             request.onupgradeneeded = (event: any) => {
18 |                 console.log("Upgrading db",event)
19 |                 var db: IDBDatabase = event.target.result;
20 | 
21 |                 // create objectstore for holding utxo content
22 |                 var objectStore = db.createObjectStore("utxoContent", { keyPath: "utxo" });
23 | 
24 |                 // create utxo as the index.
25 |                 objectStore.createIndex("utxo", "utxo", { unique: true });
26 | 
27 |                 // Use transaction oncomplete to make sure the objectStore creation is
28 |                 // finished before adding data into it.
29 |                 objectStore.transaction.oncomplete = event => {
30 |                     Promise.resolve(db)
31 |                 }
32 |             };
33 |         } catch (e) {
34 |             reject(e.message)
35 |         }
36 |     });
37 | }
38 | export function saveUtxos(db: IDBDatabase| undefined|null ,objects:Array<any>): Promise<any>{
39 |     if(!db){
40 |         return Promise.reject("Null db instance")
41 |     }
42 |     return new Promise((resolve, reject):void => {
43 |         console.log("Starting to save")
44 |         let trans: IDBTransaction = db.transaction('utxoContent', 'readwrite');
45 |         trans.oncomplete = () => {
46 |             resolve(objects);
47 |         };
48 |         trans.onerror=(e)=>{
49 |             console.log("Saving error",e)
50 |             reject("Error")
51 |         }
52 | 
53 |         let store = trans.objectStore('utxoContent');
54 |         objects.forEach(x =>{
55 |             console.log("putting",x)
56 |             store.put(x);
57 |         })
58 |         trans.commit()
59 |     })
60 | }
61 | export function getReadHandle(db:IDBDatabase): IDBObjectStore{
62 |     const trans=db.transaction('utxoContent');
63 |     return trans.objectStore('utxoContent')
64 | 
65 | }
66 | export function getUtxo(handle: IDBObjectStore,id) {
67 |     if(!handle){
68 |         return Promise.reject(" Null Object store handle")
69 |     }
70 |     return new Promise((resolve, reject) => {
71 | 
72 |         var request = handle.get(id);
73 |         request.onerror = event => {
74 |             reject(event)
75 |         };
76 |         request.onsuccess = event => {
77 |             // Do something with the request.result!
78 |             console.log("returning from db",request.result)
79 |             if(request.result)
80 |                 resolve(request.result)
81 |             else
82 |                 reject("Not found")
83 |         }
84 |     })
85 | }
86 | 


--------------------------------------------------------------------------------
/marketplace-core/Cardano/Marketplace/SimpleMarketplace.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE AllowAmbiguousTypes #-}
 2 | {-# LANGUAGE ConstraintKinds #-}
 3 | {-# LANGUAGE FlexibleContexts #-}
 4 | {-# LANGUAGE NumericUnderscores #-}
 5 | {-# LANGUAGE OverloadedStrings #-}
 6 | {-# LANGUAGE ScopedTypeVariables #-}
 7 | {-# LANGUAGE TypeFamilies #-}
 8 | {-# LANGUAGE TypeApplications #-}
 9 | 
10 | module Cardano.Marketplace.SimpleMarketplace where
11 | 
12 | import Cardano.Api
13 | import Cardano.Api.Shelley (ProtocolParameters, ReferenceScript (ReferenceScriptNone), fromPlutusData, scriptDataToJsonDetailedSchema, toPlutusData, Address (ShelleyAddress))
14 | import qualified Cardano.Api.Shelley as Shelley
15 | import Cardano.Kuber.Api
16 | import Cardano.Kuber.Data.Parsers
17 | import Cardano.Kuber.Util
18 | import Cardano.Marketplace.Common.TextUtils
19 | import Cardano.Marketplace.Common.TransactionUtils
20 | import Codec.Serialise (serialise)
21 | import qualified Data.Aeson as Aeson
22 | import qualified Data.Aeson.Text as Aeson
23 | import qualified Data.Map as Map
24 | import Data.Text (Text)
25 | import qualified Data.Text as T
26 | import qualified Data.Text.Lazy as TLE
27 | import Plutus.Contracts.V2.SimpleMarketplace hiding (Withdraw)
28 | import qualified Plutus.Contracts.V2.SimpleMarketplace as SMP
29 | import qualified Plutus.Contracts.V2.ConfigurableMarketplace as Config
30 | import qualified Debug.Trace as Debug
31 | import Data.Functor ((<&>))
32 | import Control.Exception (throw)
33 | import qualified Data.Set as Set
34 | import qualified Plutus.Contracts.V2.SimpleMarketplace as Marketplace
35 | import PlutusLedgerApi.V2 (toData, dataToBuiltinData, FromData (fromBuiltinData))
36 | 
37 | data SimpleMarketHelper api w = SimpleMarketHelper {
38 |     simpleMarketScript :: TxPlutusScript
39 |   , sell :: AddressInEra ConwayEra -> Value -> Integer -> AddressInEra ConwayEra -> Kontract api w FrameworkError TxBuilder
40 |   , buy :: TxIn -> Kontract api w FrameworkError TxBuilder
41 |   , buyWithRefScript :: TxIn -> TxIn -> Kontract api w FrameworkError TxBuilder
42 |   , withdraw :: TxIn -> Kontract api w FrameworkError TxBuilder
43 |   , withdrawWithRefScript :: TxIn -> TxIn -> Kontract api w FrameworkError TxBuilder
44 | }
45 | 
46 | assetInfo :: TxOut CtxUTxO ConwayEra -> (AddressInEra ConwayEra, Integer)
47 | assetInfo assetUTxO = do 
48 |   case getSimpleSaleInfo (Testnet (NetworkMagic 4)) assetUTxO of 
49 |     Right sellerAndPrice -> sellerAndPrice
50 |     Left str -> error (str)
51 | 
52 | placeOnSell' marketAddr saleItem datum = 
53 |   txPayToScriptWithData marketAddr saleItem datum
54 | 
55 | buyFromMarket' spendTxIn buyUtxo script buyRedeemer = 
56 |   txRedeemUtxo spendTxIn buyUtxo script buyRedeemer  Nothing
57 |   <> txPayTo   (sellerAddr) (valueFromList [ (AdaAssetId, Quantity price)])
58 |   where 
59 |     (sellerAddr, price) = assetInfo buyUtxo
60 | 
61 | withdrawFromMarket' withdrawTxIn withdrawUTxO script withdrawRedeemer = 
62 |   txRedeemUtxo withdrawTxIn withdrawUTxO script withdrawRedeemer  Nothing
63 |   <> txSignBy (sellerAddr)
64 |   where 
65 |     (sellerAddr, _) = assetInfo withdrawUTxO
66 | 
67 | buyFromMarketWithRefScript' spendTxIn refTxIn buyUtxo buyRedeemer =
68 |   txRedeemUtxoWithReferenceScript refTxIn spendTxIn buyUtxo buyRedeemer  Nothing
69 |   <> txPayTo (sellerAddr) (valueFromList [ (AdaAssetId, Quantity price)])
70 |   where 
71 |     (sellerAddr, price) = assetInfo buyUtxo
72 | 
73 | withdrawFromMarketWithRefScript' withdrawTxIn refTxIn withdrawUTxO withdrawRedeemer = 
74 |   txRedeemUtxoWithReferenceScript refTxIn withdrawTxIn withdrawUTxO withdrawRedeemer Nothing
75 |   <> txSignBy (sellerAddr)  
76 |   where 
77 |     (sellerAddr, price) = assetInfo withdrawUTxO


--------------------------------------------------------------------------------
/docs/RunOnPrivateTestnet.md:
--------------------------------------------------------------------------------
 1 | ## Running Cardano-Marketplace Test and BenchMark on Private Testnet
 2 | 
 3 | ### Step1: Setting up Testnet
 4 | 
 5 | - clone the IntersectMBO/cardano-node-tests repository
 6 |     ```sh
 7 |     git clone https://github.com/IntersectMBO/cardano-node-tests.git
 8 |     ```
 9 | - To run tests on the latest cardano-node 
10 |     ```sh
11 |     ~/cardano-node-tests$ nix flake update --accept-flake-config --override-input cardano-node "github:IntersectMBO/cardano-node/master"
12 |     ```
13 |     > you may change 'master' to the rev you want. For example, to run on cardano-node-8.9.4, use "github:IntersectMBO/cardano-node/8.9.4"
14 |     ```sh 
15 |     ~/cardano-node-tests$ nix develop --accept-flake-config .#venv
16 |     ```
17 | - to setup test environment
18 |     ```sh
19 |     ~/cardano-node-tests$ source ./prepare_test_env.sh conway # 'babbage' is also supported
20 |     ```
21 | - start testnet
22 |   ```sh 
23 |   ~/cardano-node-tests$ ./dev_workdir/conway_fast/start-cluster
24 |   ```
25 | 
26 | ### Step 2: Creating necessary Keys
27 | You will need to create an address and necessaey keys in order to operate the marketplace. We can do that using cardano-cli. These keys can be created in the root folder i.e. the `cardano-marketplace` folder. 
28 | 
29 | ```sh
30 | cardano-cli address key-gen \
31 |     --verification-key-file payment.vkey \
32 |     --signing-key-file payment.skey
33 | 
34 | cardano-cli stake-address key-gen \
35 |     --verification-key-file stake.vkey \
36 |     --signing-key-file stake.skey
37 | 
38 | cardano-cli address build \
39 |     --payment-verification-key-file payment.vkey \
40 |     --stake-verification-key-file stake.vkey \
41 |     --out-file payment.addr \
42 |     --testnet-magic 42
43 | ```
44 | 
45 | ### Step 3: Funding the address from private testnet
46 | To run the marketplace on the private testnet, you'll need funds in your address, which must be sourced from the private testnet. You can use the genesis UTxO to transfer an adequate amount of funds to the address. However, be aware that these funds will be lost if the testnet is terminated or restarted.
47 | 
48 | export the following variables: 
49 | - CARDANO_NODE_SOCKET_PATH
50 |   - set the location of the socket created while starting the private testnet. This is in the dev_workdir folder of cardano-node-tests. 
51 |   - Example:
52 |     ```sh
53 |     export CARDANO_NODE_SOCKET_PATH=/cardano-node-tests/dev_workdir/state-cluster0/bft1.socket`
54 |     ```
55 | - GENESIS_ADDRESS
56 |   - set the private testnet's genesis UTxO's address in this variable
57 |   - Example:
58 |     ```sh
59 |     export GENESIS_ADDRESS=$(cat /cardano-node-tests/dev_workdir/state-cluster0/shelley/genesis-utxo.addr)
60 |     ```
61 | - GENESIS_SKEY_FILE
62 |   - set the private testnet's genesis address's payment signing key file location in this variable
63 |   - Example:
64 |     ```sh
65 |     export GENESIS_SKEY_FILE='/cardano-node-tests/dev_workdir/state-cluster0/shelley/genesis-utxo.skey'
66 |     ```
67 | - WALLET_ADDRESS
68 |   - set your own wallet address which was created in step 2. 
69 |   - Example:
70 |     ```sh
71 |     export WALLET_ADDRESS=$(cat /cardano-marketplace/payment.addr)
72 |     ```
73 | - SIGNKEY_FILE
74 |   - set your payment signing key file.
75 |   - Example:
76 |     ```sh
77 |     export SIGNKEY_FILE='./cardano-marketplace/payment.skey'
78 |     ```
79 | After exporting these variables, run the address-setup script. 
80 | ```sh
81 | ./address-setup.sh
82 | ```
83 | The address will be funded with 300000000000000 lovelace from the private testnet. 
84 | 
85 | ## Step 4: Run Benchmark and Tests
86 | To run the marketplace benchmark,
87 | ```sh
88 | NETWORK=42 cabal bench
89 | ```
90 | To run marketplace test,
91 | ```sh
92 | NETWORK=42 cabal test market-test
93 | ```
94 | 
95 | 


--------------------------------------------------------------------------------
/marketplace-core/Cardano/Marketplace/ConfigurableMarketplace.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE AllowAmbiguousTypes #-}
 2 | {-# LANGUAGE ConstraintKinds #-}
 3 | {-# LANGUAGE FlexibleContexts #-}
 4 | {-# LANGUAGE NumericUnderscores #-}
 5 | {-# LANGUAGE OverloadedStrings #-}
 6 | {-# LANGUAGE ScopedTypeVariables #-}
 7 | {-# LANGUAGE TypeFamilies #-}
 8 | {-# LANGUAGE TypeApplications #-}
 9 | {-# LANGUAGE DeriveGeneric #-}
10 | 
11 | module Cardano.Marketplace.ConfigurableMarketplace where
12 | 
13 | import Cardano.Api
14 | import Cardano.Api.Shelley (ProtocolParameters, ReferenceScript (ReferenceScriptNone), fromPlutusData, scriptDataToJsonDetailedSchema, toPlutusData, Address (ShelleyAddress))
15 | import qualified Cardano.Api.Shelley as Shelley
16 | import Cardano.Kuber.Api
17 | import Cardano.Kuber.Data.Parsers
18 | import Cardano.Kuber.Util
19 | import Cardano.Marketplace.Common.TextUtils
20 | import Cardano.Marketplace.Common.TransactionUtils
21 | import Codec.Serialise (serialise)
22 | import qualified Data.Aeson as Aeson
23 | import qualified Data.Aeson.Text as Aeson
24 | import qualified Data.Map as Map
25 | import Data.Text (Text)
26 | import qualified Data.Text as T
27 | import qualified Data.Text.Lazy as TLE
28 | import Plutus.Contracts.V2.SimpleMarketplace hiding (Withdraw)
29 | import qualified Plutus.Contracts.V2.SimpleMarketplace as SMP
30 | import qualified Plutus.Contracts.V2.ConfigurableMarketplace as Config
31 | import qualified Debug.Trace as Debug
32 | import Data.Functor ((<&>))
33 | import Control.Exception (throw)
34 | import qualified Data.Set as Set
35 | import qualified Plutus.Contracts.V2.SimpleMarketplace as Marketplace
36 | import PlutusLedgerApi.V2 (toData, dataToBuiltinData, FromData (fromBuiltinData))
37 | import GHC.Generics (Generic)
38 | 
39 | 
40 | data ConfigurableMarketHelper = ConfigurableMarketHelper {
41 |     cmMarketScript :: !TxPlutusScript
42 |   , cmConfigScript :: !TxPlutusScript
43 |   , cmMakeSaleDatum :: AddressInEra ConwayEra -> Integer -> HashableScriptData
44 |   , cmWithdrawRedeemer :: HashableScriptData
45 |   , cmBuyRedeemer :: HashableScriptData
46 |   , cmConfigDatum :: HashableScriptData
47 | }deriving (Generic)
48 | 
49 | instance Show ConfigurableMarketHelper where
50 |     show (ConfigurableMarketHelper marketScript configScript _ withdrawRedeemer buyRedeemer configDatum) =
51 |         "ConfigurableMarketHelper {\n" ++
52 |         "  cmMarketScript = " ++ show (hashTxScript$  TxScriptPlutus marketScript) ++ ",\n" ++
53 |         "  cmConfigScript = " ++ show (hashTxScript$  TxScriptPlutus configScript) ++ ",\n" ++
54 |         "  cmMakeSaleDatum = <function>,\n" ++
55 |         "  cmWithdrawRedeemer = " ++ show withdrawRedeemer ++ ",\n" ++
56 |         "  cmBuyRedeemer = " ++ show buyRedeemer ++ ",\n" ++
57 |         "  cmConfigDatum = " ++ show configDatum ++ "\n" ++
58 |         "}"
59 | 
60 | sellBuilder :: ConfigurableMarketHelper -> AddressInEra ConwayEra ->  Value -> Integer -> AddressInEra  ConwayEra  -> TxBuilder
61 | sellBuilder smHelper marketAddr saleItem cost  sellerAddr 
62 |   = txPayToScriptWithData marketAddr saleItem (cmMakeSaleDatum smHelper sellerAddr cost)
63 | 
64 | buyTokenBuilder ::  HasChainQueryAPI api => 
65 |   ConfigurableMarketHelper ->
66 |   Maybe TxIn -> 
67 |   TxIn -> 
68 |   Maybe (AddressInEra ConwayEra, Integer, TxIn) -> 
69 |   Kontract api w FrameworkError TxBuilder
70 | buyTokenBuilder mHelper refTxIn txin  feeInfo = do
71 |   netid<- kGetNetworkId
72 |   (tin, tout) <- resolveTxIn txin
73 |   kWrapParser $ buyTokenBuilder' (cmMarketScript mHelper ) (cmBuyRedeemer mHelper )  netid refTxIn txin tout feeInfo
74 | 
75 | withdrawTokenBuilder ::  HasChainQueryAPI api => ConfigurableMarketHelper -> Maybe TxIn -> TxIn  -> Kontract api w FrameworkError TxBuilder
76 | withdrawTokenBuilder mHelper refTxIn txin  = do
77 |   netid<- kGetNetworkId
78 |   (tin, tout) <- resolveTxIn txin
79 |   kWrapParser $ withdrawTokenBuilder' (cmMarketScript mHelper ) (cmWithdrawRedeemer mHelper) netid refTxIn txin tout


--------------------------------------------------------------------------------
/docs/cli.md:
--------------------------------------------------------------------------------
  1 | Running the cli
  2 | =================
  3 | 
  4 | 1. Clone this repositroy. And build the project.
  5 | 
  6 |     ```bash
  7 |     git clone git@github.com:dquadrant/cardano-marketplace.git
  8 |     cd cardano-marketplace
  9 |     cabal update
 10 |     cabal build
 11 |     ```
 12 | 2. Now you can run the cli commands
 13 | 
 14 | **Note** before using market-cli, You should be failiar with  `cardano-cli`  and be able to at last  following : 
 15 | - generate signing key
 16 | - obtain enterprise address corresponding to the signkey
 17 | - querying account balance 
 18 | 
 19 | market-cli required two environment variables to be properly configured for it to be able to work
 20 | - `CARDANO_NODE_SOCKET_PATH` : Cardano node's socket file path. (&nbsp;Default&nbsp;:&nbsp;$HOME/.cardano/testnet/node.socket&nbsp;)
 21 | - `NETWORK : ` `testnet` or `mainnet` or networkMagic  number (&nbsp;Defaault&nbsp;:&nbsp;testnet&nbsp;)
 22 | 
 23 | ### List Market Utxos
 24 | 
 25 | ```
 26 | $ CARDANO_NODE_SOCKET_PATH=./node.socket  cabal run market-cli ls
 27 | ```
 28 | 
 29 | 
 30 | ### Place Token on Sell
 31 | <hr>
 32 | For placing token on sell - sell command first argument is assetId and second argument is price of the token to be placed
 33 | 
 34 | ```
 35 | cabal run market-cli sell '<PolicyId.AssetName>' <Cost in Interger>
 36 | ```
 37 | Example 
 38 | ```bash
 39 | $ cabal run market-cli sell 'fe0f87df483710134f34045b516763bad1249307dfc543bc56a9e738.testtoken' 2000000
 40 | 
 41 | Transaction submitted sucessfully with transaction hash  `eba7d070d45a90402b8f289ba5324bc425fe87c25d98c7bfaccac2802e1da7fa`
 42 | Datum to be used for buying :
 43 | {"fields":[{"fields":[{"fields":[{"bytes":"edea1516f727e4dd650833f37b80109d55b64529244595612aacf62c"}],"constructor":0},{"fields":[],"constructor":1}],"constructor":0},{"int":2000000}],"constructor":0}
 44 | 
 45 | ```
 46 | 
 47 | 
 48 | ### Buy From Marketplace
 49 | For buying token from the market, first find out the utxo that contains the asset you want to buy using
 50 | 
 51 | ```
 52 | cabal run market-cli ls
 53 | ```
 54 | 
 55 | Example output:
 56 | 
 57 | ```
 58 | Market Address : addr_test1wqsewsqrurhxer8wx598p7naf9mmcwhr2jchkq6srtf78hctj0p2r
 59 | Market UTXOs:
 60 |   5e1f2e5a8844040a892b30135c667fa9ea74df41dc278bd9195c4efdf6ea19c3#0       [Cost 10.0Ada] f75cdb5143473e94ef9d11221909c0d69187e4ac97039474fa526091.token1
 61 |   65bc523e93c22ffe8f104707505f48633a26f8efcd1f5c99febfbadf67a829f3#0     [Cost 20.0Ada] f75cdb5143473e94ef9d11221909c0d69187e4ac97039474fa526091.token2
 62 | ```
 63 | 
 64 | Note the string containig #0 in format txId#txIndex copy that as txIn
 65 | 
 66 | 
 67 | ```bash
 68 | cabal run market-cli buy '<txIn>' 
 69 | ```
 70 | 
 71 | Example
 72 | 
 73 | ```
 74 | cabal run market-cli buy 'eba7d070d45a90402b8f289ba5324bc425fe87c25d98c7bfaccac2802e1da7fa#0' '{"fields":[{"fields":[{"fields":[{"bytes":"edea1516f727e4dd650833f37b80109d55b64529244595612aacf62c"}],"constructor":0},{"fields":[],"constructor":1}],"constructor":0},{"int":2000000}],"constructor":0}'
 75 | Transaction submitted sucessfully with transaction hash 172cbdd784d3eaa70d000688cd290356ebf52136ccd7dbc55b33788ca10e7f05
 76 | ```
 77 | 
 78 | ### Withdraw Token
 79 | <hr>
 80 | - For withdrawing token from the market - First find out the utxo that contains the asset you want to buy using. For withdraw to work it must be signed by the seller.
 81 | 
 82 | ```
 83 | cabal run market-cli ls
 84 | ```
 85 | 
 86 | Example output:
 87 | 
 88 | ```
 89 | Market Address : addr_test1wzd8ssap4l5rge4aq59fh92gh7ey2zghxa6mzrpju38tw6g4p8ym9
 90 |   eba7d070d45a90402b8f289ba5324bc425fe87c25d98c7bfaccac2802e1da7fa#0	:	2 Ada +1 fe0f87df483710134f34045b516763bad1249307dfc543bc56a9e738.testtoken
 91 | ```
 92 | 
 93 | Note the string containig #0 in format txId#txIndex copy that as txIn
 94 | 
 95 | Copy the datum printed from the sell output.
 96 | 
 97 | 
 98 | Now execute the following command.
 99 | 
100 | ```bash
101 | cabal run market-cli withdraw '<txIn>' '<datum>'
102 | ```
103 | 
104 | For example command
105 | 
106 | ```bash
107 | $ cabal run market-cli withdraw 'eba7d070d45a90402b8f289ba5324bc425fe87c25d98c7bfaccac2802e1da7fa#0' '{"fields":[{"fields":[{"fields":[{"bytes":"edea1516f727e4dd650833f37b80109d55b64529244595612aacf62c"}],"constructor":0},{"fields":[],"constructor":1}],"constructor":0},{"int":2000000}],"constructor":0}'
108 | Transaction submitted sucessfully with transaction hash 172cbdd784d3eaa70d000688cd290356ebf52136ccd7dbc55b33788ca10e7f05
109 | ```


--------------------------------------------------------------------------------
/cardano-marketplace.cabal:
--------------------------------------------------------------------------------
  1 | cabal-version:      2.4
  2 | name:               cardano-marketplace
  3 | version:            3.0.0.0
  4 | 
  5 | -- A short (one-line) description of the package.
  6 | -- synopsis: Simple marketplace for buying and selling of tokens.
  7 | 
  8 | -- A longer description of the package.
  9 | -- description: Simple marketplace for buying and selling of tokens.
 10 | 
 11 | -- A URL where users can report bugs.
 12 | -- bug-reports:
 13 | 
 14 | license: Apache-2.0
 15 | 
 16 | author:             Sireto
 17 | maintainer:         Sireto
 18 | 
 19 | -- A copyright notice.
 20 | -- copyright:
 21 | -- category:
 22 | -- extra-source-files: CHANGELOG.md
 23 | 
 24 | library marketplace-plutus
 25 |   exposed-modules:
 26 |     Plutus.Contracts.V1.SimpleMarketplace
 27 | 
 28 |     Plutus.Contracts.V2.ConfigurableMarketplace
 29 |     Plutus.Contracts.V2.SimpleMarketplace
 30 |     Plutus.Contracts.V2.MarketplaceConfig
 31 | 
 32 |     Plutus.Contracts.V3.ConfigurableMarketplace
 33 |     Plutus.Contracts.V3.SimpleMarketplace
 34 |     Plutus.Contracts.V3.MarketplaceConfig
 35 | 
 36 |   hs-source-dirs: marketplace-plutus
 37 |   build-depends:
 38 |       base  -any
 39 |     , plutus-tx    
 40 |     , cardano-ledger-alonzo
 41 |     , plutus-ledger-api
 42 |     , plutus-tx-plugin
 43 |     , plutus-core
 44 |     , aeson
 45 |     , bytestring
 46 |     , cardano-api 
 47 |     , serialise
 48 |     , kuber
 49 | 
 50 | library marketplace-core
 51 |   exposed-modules:
 52 |     Cardano.Marketplace.V1.Core
 53 |     Cardano.Marketplace.V2.Core
 54 |     Cardano.Marketplace.V3.Core
 55 |     
 56 |     Cardano.Marketplace.Common.TextUtils
 57 |     Cardano.Marketplace.Common.TransactionUtils
 58 |     
 59 |     Cardano.Marketplace.SimpleMarketplace
 60 |     Cardano.Marketplace.ConfigurableMarketplace
 61 |   
 62 |   hs-source-dirs: marketplace-core
 63 |   build-depends:
 64 |       base -any
 65 |     , aeson
 66 |     , bytestring
 67 |     , containers
 68 |     , unordered-containers
 69 |     , filepath
 70 |     , serialise
 71 |     , http-types
 72 |     , marketplace-plutus
 73 |     , cardano-api 
 74 |     , plutus-ledger-api
 75 |     , text 
 76 |     , text-conversions
 77 |     , plutus-tx
 78 |     , mtl
 79 |     , kuber
 80 | 
 81 | executable  market-cli
 82 |   main-is:  Main.hs
 83 |   hs-source-dirs: marketplace-cli
 84 |   other-modules:
 85 |       Cli
 86 |   build-depends:
 87 |       base -any
 88 |     , directory
 89 |     , cmdargs
 90 |     , plutus-ledger-api
 91 |     , text
 92 |     , containers
 93 |     , bytestring
 94 |     , aeson
 95 |     , serialise
 96 |     , cardano-ledger-shelley
 97 |     , cardano-ledger-core
 98 |     , cardano-ledger-alonzo
 99 |     , cardano-api 
100 |     , kuber
101 |     , marketplace-plutus
102 |     , marketplace-core
103 | 
104 | test-suite market-test
105 |   default-language: Haskell2010
106 |   type: exitcode-stdio-1.0
107 |   main-is:  Main.hs
108 |   hs-source-dirs: test
109 |   test-options:  -v2
110 |   other-modules:
111 |     Test.Common
112 |     Test.TestStoryConfigurableMarket
113 |     Test.Reporting
114 |     Test.TestContext
115 |     Test.TestStorySimpleMarket
116 |   build-depends:
117 |     base >= 4.9 && <5
118 |     , hspec
119 |     , hspec-junit-formatter >= 1.0
120 |     , kuber
121 |     , lens
122 |     , containers
123 |     , directory
124 |     , bytestring
125 |     , serialise
126 |     , cborg
127 |     , cardano-binary
128 |     , text
129 |     , aeson
130 |     , text-conversions
131 |     , cardano-api 
132 |     , cardano-ledger-alonzo
133 |     , cardano-ledger-shelley
134 |     , cardano-slotting
135 |     , plutus-ledger-api
136 |     , plutus-tx
137 |     , ouroboros-network
138 |     , cardano-binary
139 |     , vector
140 |     , unordered-containers
141 |     , marketplace-plutus
142 |     , marketplace-core
143 |     , time
144 |     , cardano-ledger-babbage
145 |     , exceptions  
146 | 
147 | 
148 | benchmark marketplace
149 |   type:                exitcode-stdio-1.0
150 |   hs-source-dirs:      benchmark
151 |   Main-is:             Main.hs
152 |   default-language:    Haskell2010
153 |   other-modules: 
154 |       Reporting
155 |       ParallelUtils
156 |       Wallet
157 |   build-depends:        
158 |       base
159 |     , cardano-api 
160 |     , aeson
161 |     , statistics
162 |     , vector
163 |     , text
164 |     , containers
165 |     , criterion
166 |     , plutus-tx
167 |     , cborg
168 |     , cardano-binary
169 |     , mtl
170 |     , split
171 |     , clock
172 |     , time
173 |     , async
174 |     , cardano-ledger-core
175 |     , random
176 |     , kuber
177 |     , marketplace-core
178 |     , marketplace-plutus
179 |     , plutus-ledger-api
180 |     , plutus-tx
181 |     , directory
182 |     , random-shuffle
183 |     , bytestring
184 |     , cardano-ledger-babbage
185 |     , cardano-ledger-alonzo
186 |     , cardano-ledger-shelley
187 |     , cardano-crypto
188 |     , cardano-crypto-class
189 |     , cardano-addresses
190 |     , memory
191 |     , lens
192 | 


--------------------------------------------------------------------------------
/reports/test-sanchonet-cardano-api-8.46/2024-06-26_07-39-33-transaction-report.md:
--------------------------------------------------------------------------------
  1 | # Test Transaction Report
  2 | <style>
  3 |   .improved {
  4 |     background-color: #d4edda;
  5 |   }
  6 |   .declined {
  7 |     background-color: #f8d7da;
  8 |   }
  9 | </style>
 10 | 
 11 | ### Simple Market (Single Script)
 12 | <table border="1">
 13 | <thead>
 14 |   <tr>
 15 |     <th rowspan="2">Test Name</th>
 16 |     <th colspan="2">Ex-Units (Mem)</th>
 17 |     <th colspan="2">Ex-Units (CPU)</th>
 18 |     <th colspan="2">Fee</th>
 19 |     <th colspan="2">Tx Bytes</th>
 20 |   </tr>
 21 |   <tr>
 22 |     <th>V2</th>
 23 |     <th>V3</th>
 24 |     <th>V2</th>
 25 |     <th>V3</th>
 26 |     <th>V2</th>
 27 |     <th>V3</th>
 28 |     <th>V2</th>
 29 |     <th>V3</th>
 30 |   </tr>
 31 | </thead>
 32 | <tr>
 33 |   <td>Mint Native Asset</td>
 34 | <td>-</td>
 35 | <td>-</td>
 36 | <td>-</td>
 37 | <td>-</td>
 38 | <td>332261</td>
 39 | <td>332261</td>
 40 | <td>3920</td>
 41 | <td>3920</td>
 42 | </tr>
 43 | <tr>
 44 |   <td>Create reference script UTxO</td>
 45 | <td>-</td>
 46 | <td>-</td>
 47 | <td>-</td>
 48 | <td>-</td>
 49 | <td>374413</td>
 50 | <td class="declined">488769</td>
 51 | <td>4878</td>
 52 | <td class="declined">7477</td>
 53 | </tr>
 54 | <tr>
 55 |   <td>Place on Sell</td>
 56 | <td>-</td>
 57 | <td>-</td>
 58 | <td>-</td>
 59 | <td>-</td>
 60 | <td>201361</td>
 61 | <td>201361</td>
 62 | <td>945</td>
 63 | <td>945</td>
 64 | </tr>
 65 | <tr>
 66 |   <td>Withdraw</td>
 67 | <td>405388323</td>
 68 | <td class="improved">317076469</td>
 69 | <td>1498042</td>
 70 | <td class="improved">1129900</td>
 71 | <td>497823</td>
 72 | <td class="declined">584526</td>
 73 | <td>5054</td>
 74 | <td class="declined">7652</td>
 75 | </tr>
 76 | <tr>
 77 |   <td>Buy</td>
 78 | <td>515692034</td>
 79 | <td class="improved">392098180</td>
 80 | <td>1935358</td>
 81 | <td class="improved">1413816</td>
 82 | <td>532021</td>
 83 | <td class="declined">607329</td>
 84 | <td>5077</td>
 85 | <td class="declined">7675</td>
 86 | </tr>
 87 | <tr>
 88 |   <td>Withdraw with RefScript</td>
 89 | <td>466682379</td>
 90 | <td class="improved">364975651</td>
 91 | <td>1722420</td>
 92 | <td class="improved">1299152</td>
 93 | <td>516641</td>
 94 | <td class="declined">599197</td>
 95 | <td>488</td>
 96 | <td>488</td>
 97 | </tr>
 98 | <tr>
 99 |   <td>Buy with RefScript</td>
100 | <td>576986090</td>
101 | <td class="improved">439997362</td>
102 | <td>2159736</td>
103 | <td class="improved">1583068</td>
104 | <td>550839</td>
105 | <td class="declined">622000</td>
106 | <td>511</td>
107 | <td>511</td>
108 | </tr>
109 | </table>
110 | 
111 | ### Configurable Market  (Multi Script)
112 | <table border="1">
113 | <thead>
114 |   <tr>
115 |     <th rowspan="2">Test Name</th>
116 |     <th colspan="2">Ex-Units (Mem)</th>
117 |     <th colspan="2">Ex-Units (CPU)</th>
118 |     <th colspan="2">Fee</th>
119 |     <th colspan="2">Tx Bytes</th>
120 |   </tr>
121 |   <tr>
122 |     <th>V2</th>
123 |     <th>V3</th>
124 |     <th>V2</th>
125 |     <th>V3</th>
126 |     <th>V2</th>
127 |     <th>V3</th>
128 |     <th>V2</th>
129 |     <th>V3</th>
130 |   </tr>
131 | </thead>
132 | <tr>
133 |   <td>Mint Native Asset</td>
134 | <td>-</td>
135 | <td>-</td>
136 | <td>-</td>
137 | <td>-</td>
138 | <td>332217</td>
139 | <td>332217</td>
140 | <td>3919</td>
141 | <td>3919</td>
142 | </tr>
143 | <tr>
144 |   <td>Create reference script UTxO</td>
145 | <td>-</td>
146 | <td>-</td>
147 | <td>-</td>
148 | <td>-</td>
149 | <td>336001</td>
150 | <td class="declined">367197</td>
151 | <td>4005</td>
152 | <td class="declined">4714</td>
153 | </tr>
154 | <tr>
155 |   <td>Place on Sell</td>
156 | <td>-</td>
157 | <td>-</td>
158 | <td>-</td>
159 | <td>-</td>
160 | <td>201361</td>
161 | <td class="declined">203297</td>
162 | <td>945</td>
163 | <td class="declined">989</td>
164 | </tr>
165 | <tr>
166 |   <td>Create market configuration</td>
167 | <td>-</td>
168 | <td>-</td>
169 | <td>-</td>
170 | <td>-</td>
171 | <td>179317</td>
172 | <td>179317</td>
173 | <td>444</td>
174 | <td>444</td>
175 | </tr>
176 | <tr>
177 |   <td>Withdraw</td>
178 | <td>186901421</td>
179 | <td class="improved">162557664</td>
180 | <td>607754</td>
181 | <td class="improved">515792</td>
182 | <td>392288</td>
183 | <td class="declined">416423</td>
184 | <td>4181</td>
185 | <td class="declined">4890</td>
186 | </tr>
187 | <tr>
188 |   <td>Withdraw with RefScript</td>
189 | <td>210522935</td>
190 | <td class="improved">183508377</td>
191 | <td>679816</td>
192 | <td class="improved">578424</td>
193 | <td>399602</td>
194 | <td class="declined">423000</td>
195 | <td>488</td>
196 | <td>488</td>
197 | </tr>
198 | <tr>
199 |   <td>Buy</td>
200 | <td>552474306</td>
201 | <td class="improved">420119748</td>
202 | <td>2026392</td>
203 | <td class="improved">1467000</td>
204 | <td>506178</td>
205 | <td class="improved">495554</td>
206 | <td>4310</td>
207 | <td class="declined">5019</td>
208 | </tr>
209 | <tr>
210 |   <td>Buy with RefScript</td>
211 | <td>576095820</td>
212 | <td class="improved">441898461</td>
213 | <td>2098454</td>
214 | <td class="improved">1533232</td>
215 | <td>513271</td>
216 | <td class="improved">502178</td>
217 | <td>612</td>
218 | <td>612</td>
219 | </tr>
220 | </table>
221 | 


--------------------------------------------------------------------------------
/marketplace-plutus/Plutus/Contracts/V2/MarketplaceConfig.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE TypeApplications #-}
  2 | {-# LANGUAGE EmptyDataDecls #-}
  3 | {-# LANGUAGE NoImplicitPrelude  #-}
  4 | {-# LANGUAGE TemplateHaskell    #-}
  5 | {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
  6 | {-# LANGUAGE NamedFieldPuns #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE DeriveAnyClass #-}
  9 | {-# LANGUAGE DeriveGeneric #-}
 10 | {-# LANGUAGE ScopedTypeVariables #-}
 11 | {-# LANGUAGE MultiParamTypeClasses #-}
 12 | {-# LANGUAGE DataKinds #-}
 13 | {-# LANGUAGE FlexibleContexts  #-}
 14 | {-# LANGUAGE NumericUnderscores#-}
 15 | {-# LANGUAGE OverloadedStrings #-}
 16 | {-# LANGUAGE TupleSections #-}
 17 | {-# LANGUAGE ConstraintKinds #-}
 18 | {-# LANGUAGE AllowAmbiguousTypes #-}
 19 | {-# LANGUAGE ViewPatterns #-}
 20 | module Plutus.Contracts.V2.MarketplaceConfig(
 21 |   marketConfigPlutusScript,
 22 |   marketConfigPlutusScriptSuperLazy,
 23 |   marketConfigScript,
 24 |   MarketConfig(..)
 25 | )
 26 | where
 27 | 
 28 | import GHC.Generics (Generic)
 29 | import PlutusTx.Prelude
 30 | import Prelude(Show)
 31 | import qualified Prelude
 32 | import  PlutusTx hiding( txOutDatum)
 33 | import Data.Aeson (FromJSON, ToJSON)
 34 | import qualified PlutusTx.AssocMap as AssocMap
 35 | import qualified Data.Bifunctor
 36 | import qualified Data.ByteString.Short as SBS
 37 | import qualified Data.ByteString.Lazy  as LBS
 38 | import Codec.Serialise ( serialise )
 39 | import Cardano.Api (IsCardanoEra,BabbageEra,NetworkId, AddressInEra, ShelleyAddr, BabbageEra, Script (PlutusScript), PlutusScriptVersion (PlutusScriptV2), hashScript, PaymentCredential (PaymentCredentialByScript), StakeAddressReference (NoStakeAddress), makeShelleyAddressInEra, makeShelleyAddress, ConwayEra)
 40 | import qualified Cardano.Api.Shelley
 41 | import PlutusLedgerApi.V2
 42 | import PlutusLedgerApi.V2.Contexts
 43 | import qualified PlutusTx.Builtins.Internal as BI
 44 | 
 45 | data MarketConfig=MarketConfig{
 46 |     marketOwner :: Address,
 47 |     marketFeeReceiverAddress:: Address, 
 48 |     marketFee:: Integer  
 49 |   } deriving(Show,Generic)
 50 | 
 51 | PlutusTx.makeIsDataIndexed ''MarketConfig [('MarketConfig, 0)]    
 52 | 
 53 | {-# INLINABLE parseData #-}
 54 | parseData ::FromData a =>  BuiltinData -> BuiltinString -> a
 55 | parseData d s = case fromBuiltinData  d of
 56 |   Just d -> d
 57 |   _      -> traceError s
 58 | 
 59 | {-# INLINABLE constrArgs #-}
 60 | constrArgs :: BuiltinData -> BI.BuiltinList BuiltinData
 61 | constrArgs bd = BI.snd (BI.unsafeDataAsConstr bd)
 62 | 
 63 | {-# INLINABLE marketConfigScriptBS #-}
 64 | marketConfigScriptBS :: SerialisedScript -> SBS.ShortByteString
 65 | marketConfigScriptBS  script =  SBS.toShort . LBS.toStrict $ serialise $ script
 66 | 
 67 | {-# INLINABLE mkMarketConfig #-}
 68 | mkMarketConfig ::  MarketConfig   -> ScriptContext    -> Bool
 69 | mkMarketConfig  MarketConfig{marketOwner}  ctx = 
 70 |   case marketOwner of {Address cre m_sc -> case cre of
 71 |     PubKeyCredential pkh ->traceIfFalse "Missing owner signature" (txSignedBy info pkh)
 72 |     ScriptCredential vh -> traceError "NotOperator"  }
 73 |   where
 74 |     info  =  scriptContextTxInfo ctx
 75 | 
 76 | {-# INLINABLE mkMarketConfigSuperLazy #-}
 77 | mkMarketConfigSuperLazy :: MarketConfig -> [PubKeyHash] -> Bool
 78 | mkMarketConfigSuperLazy MarketConfig{marketOwner} signatures = 
 79 |   case marketOwner of {Address cre m_sc -> case cre of
 80 |     PubKeyCredential pkh ->traceIfFalse "Missing owner signature" (pkh `elem` signatures)
 81 |     ScriptCredential vh -> traceError "NotOperator"  }
 82 | 
 83 | {-# INLINABLE mkWrappedMarketConfig #-}
 84 | mkWrappedMarketConfig ::  BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
 85 | mkWrappedMarketConfig  d r c = 
 86 |   check $ mkMarketConfig (parseData d "Invalid data") (unsafeFromBuiltinData c)
 87 | 
 88 | {-# INLINABLE mkWrappedMarketConfigSuperLazy #-}
 89 | mkWrappedMarketConfigSuperLazy :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
 90 | mkWrappedMarketConfigSuperLazy d r c = 
 91 |   check $ mkMarketConfigSuperLazy (parseData d "Invalid data") signatures 
 92 |   where 
 93 |     context = constrArgs c
 94 |     
 95 |     txInfoData :: BuiltinData 
 96 |     txInfoData = BI.head context
 97 | 
 98 |     lazyTxInfo :: BI.BuiltinList BuiltinData
 99 |     lazyTxInfo = constrArgs txInfoData
100 | 
101 |     signatures :: [PubKeyHash]
102 |     signatures = parseData 
103 |       (BI.head $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail lazyTxInfo) 
104 |       "txInfoSignatories: Invalid [PubKeyHash] type"
105 | 
106 | 
107 | marketConfigValidator =  
108 |   $$(PlutusTx.compile [|| mkWrappedMarketConfig ||])
109 | 
110 | marketConfigValidatorSuperLazy = 
111 |   $$(PlutusTx.compile [|| mkWrappedMarketConfigSuperLazy ||])
112 | 
113 | marketConfigScript  =  serialiseCompiledCode  marketConfigValidator
114 | marketConfigScriptSuperLazy = serialiseCompiledCode  marketConfigValidatorSuperLazy
115 | 
116 | marketConfigPlutusScript  = PlutusScript PlutusScriptV2  $ Cardano.Api.Shelley.PlutusScriptSerialised $ marketConfigScriptBS marketConfigScript
117 | 
118 | marketConfigPlutusScriptSuperLazy  = PlutusScript PlutusScriptV2  $ Cardano.Api.Shelley.PlutusScriptSerialised $ marketConfigScriptBS marketConfigScriptSuperLazy


--------------------------------------------------------------------------------
/benchmark/Wallet.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | {-# LANGUAGE DataKinds #-}
 3 | {-# LANGUAGE TypeApplications #-}
 4 | {-# LANGUAGE TypeFamilies #-}
 5 | {-# LANGUAGE TemplateHaskell #-}
 6 | {-# LANGUAGE ScopedTypeVariables #-}
 7 | module Wallet where
 8 | import Cardano.Api (SigningKey (..), AsType (..), serialiseToRawBytesHex, SerialiseAddress (serialiseAddress), AddressInEra)
 9 | import qualified Cardano.Address.Style.Shelley as Shelley 
10 | import Cardano.Mnemonic (Mnemonic, mkSomeMnemonic, SomeMnemonic (..), MkMnemonicError(..))
11 | import Data.ByteArray (convert, ScrubbedBytes)
12 | import Data.ByteString (ByteString)
13 | import qualified Data.ByteString.Char8 as BS
14 | import Data.Text (Text)
15 | import qualified Data.Text as T
16 | import qualified Data.Text.IO as TIO
17 | import GHC.TypeNats (Nat)
18 | import Cardano.Address.Derivation (Depth(PaymentK, RootK))
19 | import Cardano.Address.Derivation
20 | import Cardano.Address.Style.Shelley (Role(..), deriveAccountPrivateKeyShelley, genMasterKeyFromMnemonicShelley, deriveAddressPrivateKeyShelley, liftXPub, delegationAddress)
21 | import Cardano.Api.Shelley (PaymentKey, StakeCredential (StakeCredentialByKey))
22 | import Cardano.Address.Style.Shelley (paymentAddress,Credential(..))
23 | import Cardano.Address (unAddress, bech32)
24 | import Cardano.Kuber.Util (toHexString)
25 | import Cardano.Kuber.Data.Parsers (parseAddressBinary, parseSignKey, parseAddressRaw)
26 | import Cardano.Api (ConwayEra, SerialiseAsRawBytes (deserialiseFromRawBytes))
27 | import Control.Exception (throwIO)
28 | import Cardano.Api (StakeKey, AddressInEra (AddressInEra), ShelleyBasedEra (ShelleyBasedEraConway), makeShelleyAddress, NetworkId (Testnet), NetworkMagic (NetworkMagic), PaymentCredential (PaymentCredentialByKey), Key (verificationKeyHash, getVerificationKey), StakeAddressReference (StakeAddressByValue), AddressTypeInEra (ShelleyAddressInEra))
29 | import Cardano.Ledger.Address (serialiseAddr)
30 | import GHC.Word (Word32)
31 | import Cardano.Address.Style.Shared (hashKey)
32 | import Cardano.Address.Script (KeyRole(..), KeyHash (KeyHash))
33 | -- Replace these with your seed words
34 | seedWords :: [Text]
35 | seedWords =
36 |     ["safe","key","donate","table","foot","finish","original","firm","stairs",
37 |     "gospel","illness","friend","pull","useful","process","sea","beef","mesh",
38 |     "blast","shadow","wealth","rather","certain","lab"]
39 | 
40 | data ShelleyWallet = ShelleyWallet {
41 |       wPaymentSkey :: SigningKey PaymentKey
42 |     , wStakeSkey :: SigningKey StakeKey
43 |     , wAddress :: AddressInEra ConwayEra
44 | } deriving (Show)
45 | 
46 | 
47 | genWallet :: Word32 -> IO ShelleyWallet
48 | genWallet index =  do   
49 |     let mnemonicResult = mkSomeMnemonic @'[ 24 ] seedWords
50 |     descriminant <- case Shelley.mkNetworkDiscriminant 0 of 
51 |         Left e -> error (show e)
52 |         Right v -> pure v
53 | 
54 |     case mnemonicResult of
55 |         Left err -> do
56 |             putStrLn $ "Error creating mnemonic: " ++ show err
57 |             error $ show  err
58 |                 
59 |         Right mnemonic ->
60 |             let
61 |                 rootXPrv = genMasterKeyFromMnemonicShelley @ScrubbedBytes mnemonic mempty 
62 |                 accountIndex ::  (Index 'Hardened 'AccountK) =(unsafeMkIndex $  (index + 0x80000000))
63 |                 stakeIndex :: (Index 'Soft 'DelegationK) = (unsafeMkIndex $  2)
64 |                 addressIndex :: (Index 'Soft 'PaymentK) = (unsafeMkIndex $  0)
65 | 
66 |                 shelleyAccountRootKey = deriveAccountPrivateKeyShelley rootXPrv accountIndex 0x8000073c
67 |                 paymentKey = deriveAddressPrivateKeyShelley shelleyAccountRootKey UTxOExternal addressIndex
68 |                 addrPubKey = liftXPub $  toXPub paymentKey
69 |                 stakeKey = deriveAddressPrivateKeyShelley shelleyAccountRootKey Stake addressIndex
70 |                 -- xprvAccount  = deriveAccountPrivateKey rootXPrv (unsafeMkIndex @Soft 0 )
71 | 
72 |                 -- addrXPub1 = toXPub <$> deriveAddressPrivateKey accXPrv UTxOExternal (unsafeMkIndex 0)
73 |                 -- addrXPub2 = deriveAddressPublicKey (toXPub <$> accXPrv) UTxOExternal (unsafeMkIndex 0)
74 |                 pSignkeyBytes = xprvPrivateKey paymentKey
75 |                 sSignkeyBytes = xprvPrivateKey stakeKey
76 |                 baseAddr =   delegationAddress 
77 |                                 descriminant  
78 |                                 (Shelley.PaymentFromKeyHash $ KeyHash Payment (xpubPublicKey $ toXPub paymentKey))
79 |                                 (Shelley.DelegationFromKeyHash $ KeyHash Delegation (xpubPublicKey $ toXPub stakeKey))
80 |                 in do
81 |                     psKey<- errorOnLeft $ deserialiseFromRawBytes (AsSigningKey AsPaymentKey) $ BS.drop 32 pSignkeyBytes
82 |                     ssKey <- errorOnLeft $ deserialiseFromRawBytes (AsSigningKey AsStakeKey) $ BS.drop 32 sSignkeyBytes
83 |                     let paymentCred = PaymentCredentialByKey (verificationKeyHash $ getVerificationKey psKey)
84 |                         stakeCred = StakeCredentialByKey (verificationKeyHash $ getVerificationKey ssKey)
85 |                         walletAddress = makeShelleyAddress (Testnet $ NetworkMagic 1) paymentCred (StakeAddressByValue stakeCred)
86 |                     pure $ ShelleyWallet psKey ssKey (AddressInEra (ShelleyAddressInEra ShelleyBasedEraConway) walletAddress  )
87 | 
88 | 
89 | errorOnLeft (Left e) = error $ show e
90 | errorOnLeft (Right v) = pure v


--------------------------------------------------------------------------------
/docs/cli.svg:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="UTF-8"?>
2 | <!-- Do not edit this file with editors other than diagrams.net -->
3 | <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
4 | <svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="497px" height="87px" viewBox="-0.5 -0.5 497 87" content="&lt;mxfile host=&quot;app.diagrams.net&quot; modified=&quot;2022-06-10T09:16:59.506Z&quot; agent=&quot;5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/102.0.5005.99 Safari/537.36&quot; etag=&quot;AEXUpUUaH-pKifPnM0jm&quot; version=&quot;19.0.3&quot; type=&quot;device&quot;&gt;&lt;diagram id=&quot;DdDiiuxN7HgPZ1fbYOx7&quot; name=&quot;Page-1&quot;&gt;zVZNc9owEP01PpLxB6b0GCBpDm2GGTolPSrW1tZEtjxCxHZ/fddY8pcgSZnS5MTu0+5Kevu02AmWaflFkjz5Jihwx3dp6QQrx/e9cObjT41UGnGDsEFiyajGOmDDfoMJ1OieUdgNApUQXLF8CEYiyyBSA4xIKYph2C/Bh7vmJAYL2ESE2+iWUZU06Dx0O/wOWJyYnT1Xr6TEBGtglxAqih4U3DjBUgqhGistl8Br9gwvTd7tidX2YBIy9ZaE6+9rmS1/3Mfltvp657Ktih4nuj3PhO/1hVMin0BNIs70sVVluJBin1Goy7lOsCgSpmCTk6heLbD9iCUq5eh5aOrCIBWUJ0/stTyggkCkoGSFITqhFYERz2ftF10nWr6TXhdMd4huftyW7vhBQ1P0F3QFFl0WSZDR61p36EWc7HYsGvIyJBGZkNVD3/lZO1ehcVdlf3FVGa9k6kFXrO1eFnpdUu2YnOaoQC3Bj/qB1xF7GcHrslFExqBeiJse72+vf+EL7ZPAiWLPw+Me66neYS0YXqSVTzCST/sSTYnmmjqr/3LGhWYjHX4aFWp4sAodJNZe+3zVTS3VRURSkolJhgP33Z/p1P1ozzS0CFs2hDn+jOPmi0eJVlxb96AKIZ/sBfthc45/OugscJLncHjfYk//C8Xh/IQC+xT7RyieX4ri2eUm4ZU3Gw3DS0zDQ4U1SIZ8gPz3I3L6xhEZvuuI9McjMjxvRE6tWTsqdPaIRLf7RmrCu0/N4OYP&lt;/diagram&gt;&lt;/mxfile&gt;" style="background-color: rgb(255, 255, 255);"><defs/><g><rect x="3" y="23" width="100" height="50" fill="rgb(255, 255, 255)" stroke="rgb(0, 0, 0)" pointer-events="all"/><g transform="translate(-0.5 -0.5)"><switch><foreignObject pointer-events="none" width="100%" height="100%" requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility" style="overflow: visible; text-align: left;"><div xmlns="http://www.w3.org/1999/xhtml" style="display: flex; align-items: unsafe center; justify-content: unsafe center; width: 98px; height: 1px; padding-top: 48px; margin-left: 4px;"><div data-drawio-colors="color: rgb(0, 0, 0); " style="box-sizing: border-box; font-size: 0px; text-align: center;"><div style="display: inline-block; font-size: 12px; font-family: Helvetica; color: rgb(0, 0, 0); line-height: 1.2; pointer-events: all; white-space: normal; overflow-wrap: normal;">market-cli</div></div></div></foreignObject><text x="53" y="52" fill="rgb(0, 0, 0)" font-family="Helvetica" font-size="12px" text-anchor="middle">market-cli</text></switch></g><path d="M 103 48 L 186.63 48" fill="none" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="stroke"/><path d="M 191.88 48 L 184.88 51.5 L 186.63 48 L 184.88 44.5 Z" fill="rgb(0, 0, 0)" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="all"/><rect x="193" y="23" width="100" height="50" fill="rgb(255, 255, 255)" stroke="rgb(0, 0, 0)" pointer-events="all"/><g transform="translate(-0.5 -0.5)"><switch><foreignObject pointer-events="none" width="100%" height="100%" requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility" style="overflow: visible; text-align: left;"><div xmlns="http://www.w3.org/1999/xhtml" style="display: flex; align-items: unsafe center; justify-content: unsafe center; width: 98px; height: 1px; padding-top: 48px; margin-left: 194px;"><div data-drawio-colors="color: rgb(0, 0, 0); " style="box-sizing: border-box; font-size: 0px; text-align: center;"><div style="display: inline-block; font-size: 12px; font-family: Helvetica; color: rgb(0, 0, 0); line-height: 1.2; pointer-events: all; white-space: normal; overflow-wrap: normal;">cardano-node</div></div></div></foreignObject><text x="243" y="52" fill="rgb(0, 0, 0)" font-family="Helvetica" font-size="12px" text-anchor="middle">cardano-node</text></switch></g><path d="M 403 23 C 379 23 373 43 392.2 47 C 373 55.8 394.6 75 410.2 67 C 421 83 457 83 469 67 C 493 67 493 51 478 43 C 493 27 469 11 448 19 C 433 7 409 7 403 23 Z" fill="rgb(255, 255, 255)" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="all"/><g transform="translate(-0.5 -0.5)"><switch><foreignObject pointer-events="none" width="100%" height="100%" requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility" style="overflow: visible; text-align: left;"><div xmlns="http://www.w3.org/1999/xhtml" style="display: flex; align-items: unsafe center; justify-content: unsafe center; width: 118px; height: 1px; padding-top: 43px; margin-left: 374px;"><div data-drawio-colors="color: rgb(0, 0, 0); " style="box-sizing: border-box; font-size: 0px; text-align: center;"><div style="display: inline-block; font-size: 12px; font-family: Helvetica; color: rgb(0, 0, 0); line-height: 1.2; pointer-events: all; white-space: normal; overflow-wrap: normal;">Cardano<br />Network<br /></div></div></div></foreignObject><text x="433" y="47" fill="rgb(0, 0, 0)" font-family="Helvetica" font-size="12px" text-anchor="middle">Cardano...</text></switch></g><path d="M 293 48 L 385.83 47.06" fill="none" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="stroke"/><path d="M 391.08 47.01 L 384.12 50.58 L 385.83 47.06 L 384.05 43.58 Z" fill="rgb(0, 0, 0)" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="all"/></g><switch><g requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility"/><a transform="translate(0,-5)" xlink:href="https://www.diagrams.net/doc/faq/svg-export-text-problems" target="_blank"><text text-anchor="middle" font-size="10px" x="50%" y="100%">Text is not SVG - cannot display</text></a></switch></svg>


--------------------------------------------------------------------------------
/reports/test-sanchonet-cardano-api-8.46/2024-06-26_07-39-33-junit.xml:
--------------------------------------------------------------------------------
1 | <testsuites name="Marketplace Scenario Test"><testsuite name="ConfigurableMarketV2 Flow" package="ConfigurableMarketV2 Flow" id="0" time="325.814902875" timestamp="2024-06-26T07:52:31.00274496Z" hostname="localhost" tests="8" failures="0" errors="0" skipped="0"><properties/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="124" name="Should buy 1 token from sale with reference script" classname="ConfigurableMarketV2 Flow" time="18.163615423"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="116" name="Should buy 1 token from sale" classname="ConfigurableMarketV2 Flow" time="148.503240668"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="108" name="Should withdraw 1 token from sale with reference script" classname="ConfigurableMarketV2 Flow" time="18.192028028"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="103" name="Should withdraw 1 token from sale" classname="ConfigurableMarketV2 Flow" time="4.102542472"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="96" name="Should create market configuration" classname="ConfigurableMarketV2 Flow" time="6.145554265"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="89" name="Should place 4 tokens on sale" classname="ConfigurableMarketV2 Flow" time="108.382485441"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="83" name="Should create reference script UTxO" classname="ConfigurableMarketV2 Flow" time="12.157291429"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="76" name="Should mint  4 Native Assets" classname="ConfigurableMarketV2 Flow" time="10.168145149"/></testsuite><testsuite name="ConfigurableMarketV3 Flow" package="ConfigurableMarketV3 Flow" id="1" time="195.507589773" timestamp="2024-06-26T07:52:31.00274496Z" hostname="localhost" tests="8" failures="0" errors="0" skipped="0"><properties/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="124" name="Should buy 1 token from sale with reference script" classname="ConfigurableMarketV3 Flow" time="10.110050685"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="116" name="Should buy 1 token from sale" classname="ConfigurableMarketV3 Flow" time="4.100065188"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="108" name="Should withdraw 1 token from sale with reference script" classname="ConfigurableMarketV3 Flow" time="36.223714998"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="103" name="Should withdraw 1 token from sale" classname="ConfigurableMarketV3 Flow" time="16.151029454"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="96" name="Should create market configuration" classname="ConfigurableMarketV3 Flow" time="42.271231601"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="89" name="Should place 4 tokens on sale" classname="ConfigurableMarketV3 Flow" time="20.169979093"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="83" name="Should create reference script UTxO" classname="ConfigurableMarketV3 Flow" time="26.232195869"/><testcase file="test/Test/TestStoryConfigurableMarket.hs" line="76" name="Should mint  4 Native Assets" classname="ConfigurableMarketV3 Flow" time="40.249322885"/></testsuite><testsuite name="SimpleMarketV2 Flow" package="SimpleMarketV2 Flow" id="2" time="131.300815501" timestamp="2024-06-26T07:52:31.00274496Z" hostname="localhost" tests="7" failures="0" errors="0" skipped="0"><properties/><testcase file="test/Test/TestStorySimpleMarket.hs" line="96" name="Should buy 1 token from sale with reference script" classname="SimpleMarketV2 Flow" time="6.151661745"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="91" name="Should withdraw 1 token from sale with reference script" classname="SimpleMarketV2 Flow" time="10.143203476"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="86" name="Should buy 1 token from sale" classname="SimpleMarketV2 Flow" time="24.197053837"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="81" name="Should withdraw 1 token from sale" classname="SimpleMarketV2 Flow" time="12.198547546"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="74" name="Should place 4 tokens on sale" classname="SimpleMarketV2 Flow" time="30.246143062"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="68" name="Should create reference script UTxO" classname="SimpleMarketV2 Flow" time="38.214814603"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="61" name="Should mint  4 Native Assets" classname="SimpleMarketV2 Flow" time="10.149391232"/></testsuite><testsuite name="SimpleMarketV3 Flow" package="SimpleMarketV3 Flow" id="3" time="125.259040404" timestamp="2024-06-26T07:52:31.00274496Z" hostname="localhost" tests="7" failures="0" errors="0" skipped="0"><properties/><testcase file="test/Test/TestStorySimpleMarket.hs" line="96" name="Should buy 1 token from sale with reference script" classname="SimpleMarketV3 Flow" time="10.124633257"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="91" name="Should withdraw 1 token from sale with reference script" classname="SimpleMarketV3 Flow" time="8.255617229"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="86" name="Should buy 1 token from sale" classname="SimpleMarketV3 Flow" time="20.155451339"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="81" name="Should withdraw 1 token from sale" classname="SimpleMarketV3 Flow" time="46.268301113"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="74" name="Should place 4 tokens on sale" classname="SimpleMarketV3 Flow" time="14.166724703"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="68" name="Should create reference script UTxO" classname="SimpleMarketV3 Flow" time="8.138815416"/><testcase file="test/Test/TestStorySimpleMarket.hs" line="61" name="Should mint  4 Native Assets" classname="SimpleMarketV3 Flow" time="18.149497347"/></testsuite></testsuites>


--------------------------------------------------------------------------------
/marketplace-core/Cardano/Marketplace/V2/Core.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE AllowAmbiguousTypes #-}
  2 | {-# LANGUAGE ConstraintKinds #-}
  3 | {-# LANGUAGE FlexibleContexts #-}
  4 | {-# LANGUAGE NumericUnderscores #-}
  5 | {-# LANGUAGE OverloadedStrings #-}
  6 | {-# LANGUAGE ScopedTypeVariables #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE TypeApplications #-}
  9 | 
 10 | module Cardano.Marketplace.V2.Core where
 11 | 
 12 | import Cardano.Api
 13 | import Cardano.Api.Shelley (ProtocolParameters, ReferenceScript (ReferenceScriptNone), fromPlutusData, scriptDataToJsonDetailedSchema, toPlutusData, Address (ShelleyAddress))
 14 | import qualified Cardano.Api.Shelley as Shelley
 15 | import Cardano.Kuber.Api
 16 | import Cardano.Kuber.Data.Parsers
 17 | import Cardano.Kuber.Util
 18 | import Cardano.Marketplace.Common.TextUtils
 19 | import Cardano.Marketplace.Common.TransactionUtils
 20 | import Codec.Serialise (serialise)
 21 | import qualified Data.Aeson as Aeson
 22 | import qualified Data.Aeson.Text as Aeson
 23 | import qualified Data.Map as Map
 24 | import Data.Text (Text)
 25 | import qualified Data.Text as T
 26 | import qualified Data.Text.Lazy as TLE
 27 | import Plutus.Contracts.V2.SimpleMarketplace hiding (Withdraw)
 28 | import qualified Plutus.Contracts.V2.ConfigurableMarketplace as Config
 29 | import qualified Debug.Trace as Debug
 30 | import Data.Functor ((<&>))
 31 | import Control.Exception (throw)
 32 | import qualified Data.Set as Set
 33 | import qualified Plutus.Contracts.V2.SimpleMarketplace as Marketplace
 34 | import qualified Plutus.Contracts.V2.ConfigurableMarketplace as V2ConfigurableMarketplace
 35 | import qualified Plutus.Contracts.V2.MarketplaceConfig as V2MarketConfig
 36 | import PlutusLedgerApi.V2 (toData, dataToBuiltinData, FromData (fromBuiltinData))
 37 | import Cardano.Marketplace.SimpleMarketplace
 38 | import qualified PlutusLedgerApi.V2 as PlutusV2
 39 | import Cardano.Marketplace.ConfigurableMarketplace
 40 | 
 41 | simpleMarketV2Helper' :: (HasChainQueryAPI api) => PlutusScript PlutusScriptV2 -> SimpleMarketHelper api w 
 42 | simpleMarketV2Helper' script = SimpleMarketHelper {
 43 |     simpleMarketScript = toTxPlutusScript script
 44 |   , sell = placeOnSell
 45 |   , buy = buyf
 46 |   , buyWithRefScript = buyFromMarketWithRefScript
 47 |   , withdraw = withdrawf
 48 |   , withdrawWithRefScript = withdrawFromMarketWithRefScript
 49 | }
 50 |   where 
 51 |     buyf buyTxIn =  buyFromMarket buyTxIn script
 52 |     withdrawf withdrawTxIn = withdrawFromMarket withdrawTxIn script
 53 | 
 54 | buyRedeemer :: HashableScriptData
 55 | buyRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData Marketplace.Buy
 56 | 
 57 | withdrawRedeemer :: HashableScriptData
 58 | withdrawRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData Marketplace.Withdraw
 59 | 
 60 | buyFromMarket spendTxIn script = do
 61 |   (tin, tout) <- resolveTxIn spendTxIn 
 62 |   kWrapParser $ Right $ buyFromMarket' tin tout script buyRedeemer
 63 | 
 64 | withdrawFromMarket withdrawTxIn script = do
 65 |   (tin, tout) <- resolveTxIn withdrawTxIn
 66 |   kWrapParser $ Right $ withdrawFromMarket' tin tout script withdrawRedeemer
 67 | 
 68 | placeOnSell marketAddr saleItem cost sellerAddress = 
 69 |   kWrapParser $ Right $ placeOnSell' marketAddr saleItem (createV2SaleDatum sellerAddress cost)
 70 | 
 71 | buyFromMarketWithRefScript spendTxIn refTxIn = do
 72 |   (tin, tout) <- resolveTxIn spendTxIn 
 73 |   kWrapParser $ Right $ buyFromMarketWithRefScript' tin refTxIn tout buyRedeemer
 74 | 
 75 | withdrawFromMarketWithRefScript withdrawTxIn refTxIn = do
 76 |   (tin, tout) <- resolveTxIn withdrawTxIn 
 77 |   kWrapParser $ Right $ withdrawFromMarketWithRefScript' tin refTxIn tout withdrawRedeemer 
 78 | 
 79 | simpleMarketV2Helper :: SimpleMarketHelper ChainConnectInfo w 
 80 | simpleMarketV2Helper = simpleMarketV2Helper' simpleMarketplacePlutusV2
 81 | 
 82 | simpleMarketV2HelperSuperLazy :: SimpleMarketHelper ChainConnectInfo w 
 83 | simpleMarketV2HelperSuperLazy = simpleMarketV2Helper' simpleMarketplacePlutusV2SuperLazy
 84 | 
 85 | makeConfigurableMarketV2Helper' :: 
 86 |   AddressInEra era -> 
 87 |   Integer -> 
 88 |   Script PlutusScriptV2 -> 
 89 |   (V2ConfigurableMarketplace.MarketConstructor -> PlutusScript PlutusScriptV2) -> 
 90 |   ConfigurableMarketHelper
 91 | makeConfigurableMarketV2Helper' operatorAddr fee marketConfigScript configurableMarketScript = 
 92 |   let operatorAddress = addrInEraToPlutusAddress operatorAddr
 93 |       ownerAddress = operatorAddress
 94 |       marketConfig = V2MarketConfig.MarketConfig operatorAddress operatorAddress fee
 95 |       marketConstructor = V2ConfigurableMarketplace.MarketConstructor  ( 
 96 |         PlutusV2.ScriptHash $ PlutusV2.toBuiltin $ serialiseToRawBytes $ hashTxScript  $ TxScriptPlutus mConfigScript)
 97 |       mConfigScript = toTxPlutusScript $ marketConfigScript
 98 |     in
 99 |     ConfigurableMarketHelper {
100 |         cmMarketScript = toTxPlutusScript $ configurableMarketScript marketConstructor 
101 |       , cmConfigScript = mConfigScript
102 |       , cmMakeSaleDatum = createV2SaleDatum
103 |       , cmWithdrawRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData V2ConfigurableMarketplace.Withdraw
104 |       , cmBuyRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData V2ConfigurableMarketplace.Buy
105 |       , cmConfigDatum = unsafeHashableScriptData $ fromPlutusData$ toData marketConfig
106 |       }
107 | 
108 | makeConfigurableMarketV2Helper :: AddressInEra era -> Integer -> ConfigurableMarketHelper
109 | makeConfigurableMarketV2Helper operatorAddr fee =
110 |   makeConfigurableMarketV2Helper' operatorAddr fee 
111 |   V2MarketConfig.marketConfigPlutusScript 
112 |   V2ConfigurableMarketplace.configurableMarketPlutusScript
113 | 
114 | makeConfigurableMarketV2HelperSuperLazy :: AddressInEra era -> Integer -> ConfigurableMarketHelper
115 | makeConfigurableMarketV2HelperSuperLazy operatorAddr fee =
116 |   makeConfigurableMarketV2Helper' operatorAddr fee 
117 |   V2MarketConfig.marketConfigPlutusScriptSuperLazy 
118 |   V2ConfigurableMarketplace.configurableMarketPlutusScriptSuperLazy
119 | 
120 | createV2SaleDatum :: AddressInEra ConwayEra -> Integer -> HashableScriptData
121 | createV2SaleDatum sellerAddr costOfAsset =
122 |   -- Convert  to Plutus.Address
123 |   let plutusAddr =  addrInEraToPlutusAddress sellerAddr
124 |       datum = SimpleSale plutusAddr costOfAsset
125 |    in unsafeHashableScriptData $  fromPlutusData $ toData datum


--------------------------------------------------------------------------------
/marketplace-core/Cardano/Marketplace/V3/Core.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE AllowAmbiguousTypes #-}
  2 | {-# LANGUAGE ConstraintKinds #-}
  3 | {-# LANGUAGE FlexibleContexts #-}
  4 | {-# LANGUAGE NumericUnderscores #-}
  5 | {-# LANGUAGE OverloadedStrings #-}
  6 | {-# LANGUAGE ScopedTypeVariables #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE TypeApplications #-}
  9 | 
 10 | module Cardano.Marketplace.V3.Core where
 11 | 
 12 | 
 13 | import Cardano.Marketplace.SimpleMarketplace
 14 | import Cardano.Api
 15 | import Cardano.Api.Shelley
 16 | import Cardano.Kuber.Api
 17 | import Plutus.Contracts.V3.SimpleMarketplace (simpleMarketplacePlutusV3, simpleMarketplacePlutusV3Lazy, simpleMarketplacePlutusV3SuperLazy, SimpleSale (SimpleSale), MarketRedeemer (Withdraw, Buy))
 18 | import PlutusTx
 19 | import Cardano.Kuber.Util (toPlutusAddress, addrInEraToPlutusAddress)
 20 | import Cardano.Marketplace.ConfigurableMarketplace
 21 | import qualified Plutus.Contracts.V3.SimpleMarketplace as Marketplace
 22 | import qualified Plutus.Contracts.V3.ConfigurableMarketplace as V3ConfigurableMarketplace
 23 | import qualified Plutus.Contracts.V3.MarketplaceConfig as V3MarketConfig
 24 | import qualified PlutusLedgerApi.V3 as PlutusV3
 25 | import Cardano.Marketplace.Common.TransactionUtils (resolveTxIn)
 26 | 
 27 | simpleMarketV3Helper' :: (HasChainQueryAPI api) => PlutusScript PlutusScriptV3 -> SimpleMarketHelper api w
 28 | simpleMarketV3Helper' script = SimpleMarketHelper {
 29 |     simpleMarketScript = toTxPlutusScript script
 30 |   , sell = placeOnSell
 31 |   , buy = buyf
 32 |   , buyWithRefScript = buyFromMarketWithRefScript
 33 |   , withdraw = withdrawf
 34 |   , withdrawWithRefScript = withdrawFromMarketWithRefScript
 35 | }
 36 |   where 
 37 |     buyf buyTxIn =  buyFromMarket buyTxIn script
 38 |     withdrawf withdrawTxIn = withdrawFromMarket withdrawTxIn script
 39 | 
 40 | buyRedeemer :: HashableScriptData
 41 | buyRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData Marketplace.Buy
 42 | 
 43 | withdrawRedeemer :: HashableScriptData
 44 | withdrawRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData Marketplace.Withdraw
 45 | 
 46 | -- buyFromMarket :: IsPlutusScript sc => TxIn -> sc -> TxBuilder
 47 | buyFromMarket spendTxIn script = do
 48 |   (tin, tout) <- resolveTxIn spendTxIn
 49 |   pure $ buyFromMarket' tin tout script buyRedeemer
 50 | 
 51 | withdrawFromMarket withdrawTxIn script = do
 52 |   (tin, tout) <- resolveTxIn withdrawTxIn
 53 |   kWrapParser $ Right $ withdrawFromMarket' tin tout script withdrawRedeemer
 54 | 
 55 | placeOnSell marketAddr saleItem cost sellerAddress = do 
 56 |   kWrapParser $ Right $ placeOnSell' marketAddr saleItem (createV3SaleDatum sellerAddress cost)
 57 | 
 58 | buyFromMarketWithRefScript spendTxIn refTxIn = do 
 59 |   (tin, tout) <- resolveTxIn spendTxIn
 60 |   kWrapParser $ Right $ buyFromMarketWithRefScript' tin refTxIn tout buyRedeemer
 61 | 
 62 | withdrawFromMarketWithRefScript withdrawTxIn refTxIn = do
 63 |   (tin, tout) <- resolveTxIn withdrawTxIn
 64 |   kWrapParser $ Right $ withdrawFromMarketWithRefScript' tin refTxIn tout withdrawRedeemer 
 65 | 
 66 | simpleMarketV3Helper :: SimpleMarketHelper ChainConnectInfo w 
 67 | simpleMarketV3Helper = simpleMarketV3Helper' simpleMarketplacePlutusV3
 68 | 
 69 | simpleMarketV3HelperLazy :: SimpleMarketHelper ChainConnectInfo w 
 70 | simpleMarketV3HelperLazy = simpleMarketV3Helper' simpleMarketplacePlutusV3Lazy
 71 | 
 72 | simpleMarketV3HelperSuperLazy :: SimpleMarketHelper ChainConnectInfo w 
 73 | simpleMarketV3HelperSuperLazy = simpleMarketV3Helper' simpleMarketplacePlutusV3SuperLazy
 74 | 
 75 | makeConfigurableMarketV3Helper' :: 
 76 |   AddressInEra era -> 
 77 |   Integer -> 
 78 |   Script PlutusScriptV3 -> 
 79 |   (V3ConfigurableMarketplace.MarketConstructor -> PlutusScript PlutusScriptV3) -> 
 80 |   ConfigurableMarketHelper
 81 | makeConfigurableMarketV3Helper' operatorAddr fee marketConfigScript configurableMarketScript= 
 82 |   let operatorAddress = addrInEraToPlutusAddress operatorAddr
 83 |       ownerAddress = operatorAddress
 84 |       marketConfig = V3MarketConfig.MarketConfig operatorAddress operatorAddress fee
 85 |       marketConstructor = V3ConfigurableMarketplace.MarketConstructor  ( 
 86 |         PlutusV3.ScriptHash $ PlutusV3.toBuiltin $ serialiseToRawBytes $ hashTxScript  $ TxScriptPlutus mConfigScript)
 87 |       mConfigScript = toTxPlutusScript marketConfigScript
 88 |     in
 89 |     ConfigurableMarketHelper {
 90 |         cmMarketScript = toTxPlutusScript $ configurableMarketScript marketConstructor 
 91 |       , cmConfigScript = mConfigScript
 92 |       , cmMakeSaleDatum = createV3SaleDatum
 93 |       , cmWithdrawRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData V3ConfigurableMarketplace.Withdraw
 94 |       , cmBuyRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData V3ConfigurableMarketplace.Buy
 95 |       , cmConfigDatum = unsafeHashableScriptData $ fromPlutusData$ toData marketConfig
 96 |       }
 97 | 
 98 | makeConfigurableMarketV3Helper :: AddressInEra era -> Integer -> ConfigurableMarketHelper
 99 | makeConfigurableMarketV3Helper operatorAddr fee = 
100 |   makeConfigurableMarketV3Helper' operatorAddr fee 
101 |   V3MarketConfig.marketConfigPlutusScript 
102 |   V3ConfigurableMarketplace.configurableMarketPlutusScript
103 | 
104 | makeConfigurableMarketV3HelperLazy :: AddressInEra era -> Integer -> ConfigurableMarketHelper
105 | makeConfigurableMarketV3HelperLazy operatorAddr fee = 
106 |   makeConfigurableMarketV3Helper' operatorAddr fee 
107 |   V3MarketConfig.marketConfigPlutusScriptLazy 
108 |   V3ConfigurableMarketplace.configurableMarketPlutusScriptLazy
109 | 
110 | makeConfigurableMarketV3HelperSuperLazy :: AddressInEra era -> Integer -> ConfigurableMarketHelper
111 | makeConfigurableMarketV3HelperSuperLazy operatorAddr fee = 
112 |   makeConfigurableMarketV3Helper' operatorAddr fee 
113 |   V3MarketConfig.marketConfigPlutusScriptSuperLazy 
114 |   V3ConfigurableMarketplace.configurableMarketPlutusScriptSuperLazy  
115 | 
116 | createV3SaleDatum :: AddressInEra ConwayEra -> Integer -> HashableScriptData
117 | createV3SaleDatum sellerAddr costOfAsset =
118 |   -- Convert AddressInEra to Plutus.Address
119 |   let plutusAddr =  toPlutusAddress sellerAddrShelley
120 |       sellerAddrShelley = case sellerAddr of {
121 |          AddressInEra atie ad -> case ad of
122 |           addr@(ShelleyAddress net cre sr )-> addr  
123 |           _  -> error "Byron era address Not supported"
124 | 
125 |           }
126 |       datum = SimpleSale plutusAddr costOfAsset
127 |    in unsafeHashableScriptData $  fromPlutusData $ toData datum


--------------------------------------------------------------------------------
/marketplace-core/Cardano/Marketplace/Common/TransactionUtils.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE AllowAmbiguousTypes #-}
  2 | {-# LANGUAGE ConstraintKinds #-}
  3 | {-# LANGUAGE FlexibleContexts #-}
  4 | {-# LANGUAGE NamedFieldPuns #-}
  5 | {-# LANGUAGE OverloadedStrings #-}
  6 | {-# LANGUAGE ScopedTypeVariables #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE NumericUnderscores #-}
  9 | {-# LANGUAGE TypeApplications #-}
 10 | 
 11 | module Cardano.Marketplace.Common.TransactionUtils where
 12 | 
 13 | 
 14 | import Cardano.Kuber.Data.Parsers
 15 |   ( parseAssetId,
 16 | 
 17 |     parseAssetNQuantity,
 18 |     parseScriptData,
 19 |     parseValueText, scriptDataParser, parseSignKey
 20 |   )
 21 | import Cardano.Kuber.Util
 22 | import qualified Data.Text as T
 23 | import qualified Data.ByteString.Char8 as BS8
 24 | 
 25 | import qualified Plutus.Contracts.V2.SimpleMarketplace as V2 
 26 | import qualified Plutus.Contracts.V3.SimpleMarketplace as V3
 27 | 
 28 | import Control.Exception (throwIO)
 29 | import Data.Maybe (fromMaybe)
 30 | import qualified Data.Set as Set
 31 | import qualified Data.Map as Map
 32 | import Data.List (intercalate)
 33 | import Cardano.Kuber.Console.ConsoleWritable (showStr)
 34 | import qualified Data.Text.Lazy as TLE
 35 | import qualified Data.Aeson.Text as Aeson
 36 | import qualified Data.Text.IO as T
 37 | import System.Environment (getEnv)
 38 | import qualified Data.Aeson as A
 39 | import qualified Data.Aeson.Text as A
 40 | import Cardano.Api
 41 | import Cardano.Api.Shelley (Address(..), toPlutusData)
 42 | import qualified PlutusLedgerApi.V2 as PlutusV2
 43 | import qualified PlutusLedgerApi.V3 as PlutusV3
 44 | import Cardano.Kuber.Util (fromPlutusData, fromPlutusAddress)
 45 | import Cardano.Kuber.Api 
 46 | import qualified Debug.Trace as Debug
 47 | 
 48 | maybeExUnits :: Maybe ExecutionUnits
 49 | maybeExUnits =  (Just $ ExecutionUnits {executionSteps=976270061, executionMemory=5718298})
 50 | 
 51 | getTxIdFromTx :: Tx ConwayEra -> String
 52 | getTxIdFromTx tx = T.unpack $ serialiseToRawBytesHexText $ getTxId $ getTxBody tx
 53 | 
 54 | getSignKey :: [Char] -> IO (SigningKey PaymentKey)
 55 | getSignKey skeyfile =
 56 |   getPath >>=  T.readFile  >>= parseSignKey
 57 |   where
 58 |   getPath = if not (null skeyfile) && head skeyfile == '~'
 59 |                           then (do
 60 |                             home <- getEnv "HOME"
 61 |                             pure  $ home ++  drop 1 skeyfile
 62 |                             )
 63 |                           else pure skeyfile
 64 | 
 65 | withdrawTokenBuilder' :: IsPlutusScript script => script -> HashableScriptData ->  NetworkId -> Maybe TxIn ->   TxIn -> TxOut CtxUTxO ConwayEra -> Either String  TxBuilder
 66 | withdrawTokenBuilder' script redeemer netId refTxIn txIn tout = do 
 67 |     (sellerAddr , price) <- getSimpleSaleInfo netId tout
 68 |     case refTxIn of 
 69 |       Nothing -> pure $ txRedeemUtxo txIn tout script redeemer  Nothing
 70 |         <> txSignBy (sellerAddr)
 71 |       Just referenceScriptTxIn -> pure $ txRedeemUtxoWithReferenceScript referenceScriptTxIn txIn tout redeemer Nothing
 72 |         <> txSignBy (sellerAddr)  
 73 | 
 74 | getSimpleSaleInfo :: NetworkId -> TxOut CtxUTxO ConwayEra -> Either String (AddressInEra ConwayEra, Integer)
 75 | getSimpleSaleInfo netId (TxOut addr val datum refscript) = do
 76 |     (seller, price) <- case datum of
 77 |         TxOutDatumInline _ sd -> case PlutusV2.fromBuiltinData $ PlutusV2.dataToBuiltinData $ toPlutusData $ getScriptData sd of
 78 |             Just (V2.SimpleSale seller price) -> Right (seller, price)
 79 |             Nothing -> case PlutusV3.fromBuiltinData $ PlutusV3.dataToBuiltinData $ toPlutusData $ getScriptData sd of
 80 |                 Just (V3.SimpleSale seller price) -> Right (seller, price)
 81 |                 Nothing -> Left "Unable to parse datum as V2 or V3 SimpleSale"
 82 |         _ -> Left "Unexpected datum type"
 83 |     
 84 |     sellerAddr <- case fromPlutusAddress netId seller of
 85 |         Just addr -> Right addr
 86 |         Nothing -> Left "Invalid address present in datum of the Utxo to be bought"
 87 |     
 88 |     Right (AddressInEra (ShelleyAddressInEra ShelleyBasedEraConway) sellerAddr, price)
 89 | 
 90 | createReferenceScript ::  IsPlutusScript script => script->AddressInEra ConwayEra -> TxBuilder
 91 | createReferenceScript script receiverAddr = do
 92 |     txPayToWithReferenceScript  receiverAddr mempty ( TxScriptPlutus $ toTxPlutusScript $ script)
 93 | 
 94 | buyTokenBuilder' :: IsPlutusScript script => script -> HashableScriptData -> NetworkId -> Maybe TxIn -> TxIn -> TxOut CtxUTxO ConwayEra -> Maybe (AddressInEra ConwayEra, Integer, TxIn) -> Either String  TxBuilder
 95 | buyTokenBuilder' script buyRedeemer netId refTxIn txIn tout feeInfo = do 
 96 |     (sellerAddr , price) <- getSimpleSaleInfo netId tout 
 97 |     let marketFeeOutput = case feeInfo of 
 98 |           Just (operator, fee, txin) -> txPayTo operator (valueFromList[(AdaAssetId, Quantity fee)])
 99 |               <> txReferenceTxIn txin
100 |           Nothing -> mempty
101 |     case refTxIn of 
102 |           Nothing -> pure $ txRedeemUtxo txIn tout script buyRedeemer  Nothing
103 |             <> txPayTo   (sellerAddr) (valueFromList [ (AdaAssetId, Quantity price)])
104 |             <> marketFeeOutput
105 |           Just referenceTxIn -> pure $ txRedeemUtxoWithReferenceScript referenceTxIn txIn tout buyRedeemer  Nothing
106 |             <> txPayTo   (sellerAddr) (valueFromList [ (AdaAssetId, Quantity price)])
107 |             <> marketFeeOutput
108 |             
109 | resolveTxIn:: HasChainQueryAPI api => TxIn -> Kontract api w FrameworkError (TxIn, TxOut CtxUTxO ConwayEra)
110 | resolveTxIn txin = do 
111 |   (UTxO uMap) :: UTxO ConwayEra <- kQueryUtxoByTxin  $ Set.singleton txin
112 |   case Map.toList uMap  of 
113 |     [] -> kError NodeQueryError $ "Provided Utxo not found " ++  T.unpack (renderTxIn txin )
114 |     [(_,tout)]-> pure (txin,tout)
115 | 
116 | mintNativeAsset ::  VerificationKey PaymentKey -> AssetName -> Integer -> (AssetId, TxBuilder)
117 | mintNativeAsset vKey assetName amount = 
118 |   let script = RequireSignature $ verificationKeyHash vKey
119 |       scriptHash = hashScript $ SimpleScript  script
120 |       assetId = AssetId  (PolicyId scriptHash ) assetName 
121 |   in (assetId, txMintSimpleScript  script [(assetName, Quantity amount)])
122 | 
123 | runBuildAndSubmit :: (HasKuberAPI api, HasSubmitApi api) => TxBuilder -> Kontract api w FrameworkError (Tx ConwayEra)
124 | runBuildAndSubmit txBuilder =  do 
125 |         tx<- kBuildTx txBuilder     
126 |         kSubmitTx (InAnyCardanoEra ConwayEra tx) 
127 |         liftIO $ putStrLn $ "Tx Submitted :" ++  (getTxIdFromTx tx)
128 |         pure tx


--------------------------------------------------------------------------------
/marketplace-core/Cardano/Marketplace/V1/Core.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE AllowAmbiguousTypes #-}
  2 | {-# LANGUAGE ConstraintKinds #-}
  3 | {-# LANGUAGE FlexibleContexts #-}
  4 | {-# LANGUAGE NumericUnderscores #-}
  5 | {-# LANGUAGE OverloadedStrings #-}
  6 | {-# LANGUAGE ScopedTypeVariables #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE TypeApplications #-}
  9 | 
 10 | module Cardano.Marketplace.V1.Core where
 11 | 
 12 | import Cardano.Api
 13 | import Cardano.Api.Shelley (ProtocolParameters, ReferenceScript (ReferenceScriptNone), fromPlutusData, scriptDataToJsonDetailedSchema, toPlutusData, Address (ShelleyAddress))
 14 | import qualified Cardano.Api.Shelley as Shelley
 15 | import Cardano.Kuber.Api
 16 | import Cardano.Kuber.Data.Parsers
 17 | import Cardano.Kuber.Util
 18 | import Cardano.Marketplace.Common.TextUtils ()
 19 | import Cardano.Marketplace.Common.TransactionUtils
 20 | import Codec.Serialise (serialise)
 21 | import qualified Data.Aeson as Aeson
 22 | import qualified Data.Aeson.Text as Aeson
 23 | import qualified Data.Map as Map
 24 | import Data.Text (Text)
 25 | import qualified Data.Text as T
 26 | import qualified Data.Text.Lazy as TLE
 27 | import Plutus.Contracts.V1.SimpleMarketplace hiding (Withdraw)
 28 | import qualified Debug.Trace as Debug
 29 | import Data.Functor ((<&>))
 30 | import Control.Exception (throw)
 31 | import qualified Data.Set as Set
 32 | import qualified Plutus.Contracts.V1.SimpleMarketplace as Marketplace
 33 | import PlutusLedgerApi.V1 (toData, dataToBuiltinData, FromData (fromBuiltinData))
 34 | import Cardano.Marketplace.SimpleMarketplace
 35 | import qualified PlutusLedgerApi.V1 as PlutusV1
 36 | import Cardano.Marketplace.ConfigurableMarketplace
 37 | import qualified Data.ByteString.Lazy as LBS
 38 | import qualified Data.ByteString.Char8 as BS8
 39 | import GHC.IO (unsafePerformIO)
 40 | import GHC.Conc (newTVarIO, atomically)
 41 | import GHC.Conc.Sync (readTVar, writeTVar)
 42 | import Data.Maybe (fromJust)
 43 | 
 44 | simpleMarketV1Helper' :: (HasChainQueryAPI api) => PlutusScript PlutusScriptV1 -> IO (SimpleMarketHelper api w)
 45 | simpleMarketV1Helper' script = do
 46 |   datumVar <- newTVarIO Nothing
 47 |   let sellf marketAddress saleItem cost sellerAddress = do 
 48 |         liftIO $ atomically $ do 
 49 |           writeTVar datumVar (Just $ (snd $ createV1SaleDatum (sellerAddress, cost)))
 50 |         placeOnSell marketAddress saleItem cost sellerAddress
 51 | 
 52 |       buyf assetTxIn = do 
 53 |         datum <- liftIO $ atomically $ do 
 54 |           readTVar datumVar
 55 |         buyFromMarket assetTxIn script datum
 56 | 
 57 |       buyWithRefScriptf assetTxIn referenceTxIn = do 
 58 |         datum <- liftIO $ atomically $ do 
 59 |           readTVar datumVar
 60 |         buyFromMarketWithRefScript assetTxIn referenceTxIn datum
 61 | 
 62 |       withdrawf withdrawTxIn = do 
 63 |         datum <- liftIO $ atomically $ do 
 64 |           readTVar datumVar
 65 |         withdrawFromMarket withdrawTxIn script datum
 66 | 
 67 |       withdrawWithRefScriptf withdrawTxIn refTxIn = do 
 68 |         datum <- liftIO $ atomically $ do 
 69 |           readTVar datumVar
 70 |         withdrawFromMarketWithRefScript withdrawTxIn refTxIn datum
 71 | 
 72 | 
 73 |   pure $ SimpleMarketHelper {
 74 |       simpleMarketScript = toTxPlutusScript script
 75 |     , sell = sellf
 76 |     , buy = buyf
 77 |     , buyWithRefScript = buyWithRefScriptf
 78 |     , withdraw = withdrawf
 79 |     , withdrawWithRefScript = withdrawWithRefScriptf
 80 |   }
 81 | 
 82 | buyRedeemer :: HashableScriptData
 83 | buyRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData Marketplace.Buy
 84 | 
 85 | withdrawRedeemer :: HashableScriptData
 86 | withdrawRedeemer = unsafeHashableScriptData $ fromPlutusData$ toData Marketplace.Withdraw
 87 | 
 88 | parseAssetInfo :: HashableScriptData -> (AddressInEra ConwayEra, Integer)
 89 | parseAssetInfo sd = 
 90 |   case PlutusV1.fromBuiltinData $ PlutusV1.dataToBuiltinData $ toPlutusData $ getScriptData sd of
 91 |             Just (Marketplace.SimpleSale seller price) ->  
 92 |               (
 93 |                   AddressInEra (ShelleyAddressInEra ShelleyBasedEraConway) 
 94 |                   (fromJust $ fromPlutusAddress (Testnet (NetworkMagic 4)) seller)
 95 |                 
 96 |                 , price
 97 |               )
 98 | 
 99 | buyFromMarket spendTxIn script datum = do 
100 |   (tin, tout)<- resolveTxIn spendTxIn
101 |   kWrapParser $ Right $ txRedeemUtxoWithDatum tin tout script (fromJust datum) buyRedeemer  Nothing
102 |     <> txPayTo (sellerAddr) (valueFromList [ (AdaAssetId, Quantity price)]) 
103 |   where 
104 |     (sellerAddr, price) = parseAssetInfo (fromJust datum)
105 | 
106 | withdrawFromMarket withdrawTxIn script datum = do
107 |   (tin, tout) <- resolveTxIn (withdrawTxIn)
108 |   kWrapParser $ Right $ txRedeemUtxoWithDatum tin tout script (v1SaleDatumInline datum) withdrawRedeemer  Nothing
109 |     <> txSignBy (sellerAddr)
110 |   where 
111 |     (sellerAddr, _) = parseAssetInfo (fromJust datum)
112 | 
113 | placeOnSell marketAddr saleItem cost sellerAddress = 
114 |   kWrapParser $ Right $ txPayToScript marketAddr saleItem (v1SaleDatumHash (sellerAddress, cost))
115 | 
116 | buyFromMarketWithRefScript spendTxIn refTxIn datum = do
117 |   (tin, tout) <- resolveTxIn spendTxIn
118 |   kWrapParser $ Right $ txRedeemUtxoWithDatumAndReferenceScript refTxIn tin tout (v1SaleDatumInline datum) buyRedeemer  Nothing
119 |       <> txPayTo (sellerAddr) (valueFromList [ (AdaAssetId, Quantity price)])
120 |   where 
121 |     (sellerAddr, price) = parseAssetInfo (fromJust datum)
122 | 
123 | withdrawFromMarketWithRefScript withdrawTxIn refTxIn datum = do 
124 |   (tin, tout) <- resolveTxIn withdrawTxIn
125 |   kWrapParser $ Right $ txRedeemUtxoWithDatumAndReferenceScript refTxIn tin tout (v1SaleDatumInline datum) withdrawRedeemer Nothing
126 |     <> txSignBy (sellerAddr)  
127 |   where 
128 |     (sellerAddr, price) = parseAssetInfo (fromJust datum)
129 | 
130 | simpleMarketV1Helper :: SimpleMarketHelper ChainConnectInfo w
131 | simpleMarketV1Helper = unsafePerformIO $ simpleMarketV1Helper' simpleMarketplacePlutusV1
132 | 
133 | simpleMarketV1HelperSuperLazy :: SimpleMarketHelper ChainConnectInfo w
134 | simpleMarketV1HelperSuperLazy = unsafePerformIO $ simpleMarketV1Helper' simpleMarketplacePlutusV1SuperLazy
135 | 
136 | v1SaleDatumInline datum = (snd $ createV1SaleDatum (parseAssetInfo (fromJust datum)))
137 | 
138 | v1SaleDatumHash sellerAndCost = (fst $ createV1SaleDatum sellerAndCost)
139 | 
140 | createV1SaleDatum :: (AddressInEra ConwayEra, Integer) -> (Hash ScriptData, HashableScriptData)
141 | createV1SaleDatum (sellerAddr, costOfAsset) =
142 |   unsafePerformIO $ do
143 |     let plutusAddr = addrInEraToPlutusAddress sellerAddr
144 |         datum = SimpleSale plutusAddr costOfAsset
145 |         inline = unsafeHashableScriptData $ fromPlutusData $ toData datum
146 |         hash = hashScriptDataBytes inline
147 |     return (hash, inline)


--------------------------------------------------------------------------------
/marketplace-plutus/Plutus/Contracts/V1/SimpleMarketplace.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE TypeApplications #-}
  2 | {-# LANGUAGE EmptyDataDecls #-}
  3 | {-# LANGUAGE NoImplicitPrelude  #-}
  4 | {-# LANGUAGE TemplateHaskell    #-}
  5 | {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
  6 | {-# LANGUAGE NamedFieldPuns #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE DeriveAnyClass #-}
  9 | {-# LANGUAGE DeriveGeneric #-}
 10 | {-# LANGUAGE ScopedTypeVariables #-}
 11 | {-# LANGUAGE MultiParamTypeClasses #-}
 12 | {-# LANGUAGE DataKinds #-}
 13 | {-# LANGUAGE FlexibleContexts  #-}
 14 | {-# LANGUAGE NumericUnderscores#-}
 15 | {-# LANGUAGE OverloadedStrings #-}
 16 | {-# LANGUAGE TupleSections #-}
 17 | {-# LANGUAGE ConstraintKinds #-}
 18 | {-# LANGUAGE AllowAmbiguousTypes #-}
 19 | {-# LANGUAGE ViewPatterns #-}
 20 | {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}
 21 | 
 22 | module Plutus.Contracts.V1.SimpleMarketplace(
 23 |   simpleMarketplacePlutusV1,
 24 |   simpleMarketplacePlutusV1SuperLazy,
 25 |   MarketRedeemer(..),
 26 |   SimpleSale(..)
 27 | )
 28 | where
 29 | 
 30 | import GHC.Generics (Generic)
 31 | import PlutusTx.Prelude
 32 | import Prelude(Show)
 33 | import qualified Prelude
 34 | import  PlutusTx hiding( txOutDatum)
 35 | import Data.Aeson (FromJSON, ToJSON)
 36 | import qualified PlutusTx.AssocMap as AssocMap
 37 | import qualified Data.Bifunctor
 38 | import qualified Data.ByteString.Short as SBS
 39 | import qualified Data.ByteString.Lazy  as LBS
 40 | import qualified PlutusTx.Builtins.Internal as BI
 41 | import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
 42 | import Codec.Serialise ( serialise )
 43 | import PlutusLedgerApi.V1
 44 | import PlutusLedgerApi.V1.Value
 45 | import PlutusLedgerApi.V1.Contexts
 46 | 
 47 | 
 48 | {-# INLINABLE allScriptInputsCount #-}
 49 | allScriptInputsCount:: [TxInInfo] ->Integer
 50 | allScriptInputsCount inputs=
 51 |     foldl (\c txOutTx-> c + countTxOut txOutTx) 0 inputs
 52 |   where
 53 |   countTxOut input = case txInInfoResolved input of 
 54 |     (TxOut addr _ _ ) -> case addr of 
 55 |       { Address cre m_sc -> case cre of
 56 |           PubKeyCredential pkh -> 0
 57 |           ScriptCredential vh -> 1  
 58 |       } 
 59 | 
 60 | {-# INLINABLE parseData #-}
 61 | parseData ::FromData a =>  BuiltinData -> BuiltinString -> a
 62 | parseData d s = case fromBuiltinData  d of
 63 |   Just d -> d
 64 |   _      -> traceError s
 65 | 
 66 | {-# INLINABLE constrArgs #-}
 67 | constrArgs :: BuiltinData -> BI.BuiltinList BuiltinData
 68 | constrArgs bd = BI.snd (BI.unsafeDataAsConstr bd)
 69 | 
 70 | data MarketRedeemer =  Buy | Withdraw
 71 |     deriving (Generic,FromJSON,ToJSON,Show,Prelude.Eq)
 72 | PlutusTx.makeIsDataIndexed ''MarketRedeemer [('Buy, 0), ('Withdraw,1)]
 73 | 
 74 | 
 75 | data SimpleSale=SimpleSale{
 76 |     sellerAddress:: Address, -- The main seller Note that we are using address 
 77 |     priceOfAsset:: Integer  -- cost of the value in it
 78 |   } deriving(Show,Generic)
 79 | 
 80 | PlutusTx.makeIsDataIndexed ''SimpleSale [('SimpleSale, 0)]    
 81 | 
 82 | {-# INLINABLE mkMarket #-}
 83 | mkMarket ::  SimpleSale   -> MarketRedeemer -> ScriptContext    -> Bool
 84 | mkMarket  ds@SimpleSale{sellerAddress,priceOfAsset}  action ctx =
 85 |   case sellerPkh of 
 86 |     Nothing -> traceError "Script Address in seller"
 87 |     Just pkh -> case  action of
 88 |         Buy       -> traceIfFalse "Multiple script inputs" (allScriptInputsCount  (txInfoInputs info) == 1)  && 
 89 |                      traceIfFalse "Seller not paid" (assetClassValueOf   (valuePaidTo info pkh) adaAsset >= priceOfAsset)
 90 |         Withdraw -> traceIfFalse "Seller Signature Missing" $ txSignedBy info pkh
 91 | 
 92 |     where
 93 |       sellerPkh= case sellerAddress of { Address cre m_sc -> case cre of
 94 |                                                            PubKeyCredential pkh -> Just pkh
 95 |                                                            ScriptCredential vh -> Nothing  }
 96 |       info  =  scriptContextTxInfo ctx
 97 |       adaAsset=AssetClass (adaSymbol,adaToken )
 98 | 
 99 | {-# INLINABLE mkMarketSuperLazy #-}
100 | mkMarketSuperLazy :: SimpleSale -> MarketRedeemer -> [TxInInfo] -> [TxOut] -> [PubKeyHash] -> Bool
101 | mkMarketSuperLazy ds@SimpleSale{sellerAddress,priceOfAsset} action allInputs allOutputs signatures = 
102 |   case sellerPkh of 
103 |     Nothing -> traceError "Script Address in seller"
104 |     Just pkh -> case  action of
105 |         Buy       -> traceIfFalse "Multiple script inputs" (allScriptInputsCount allInputs == 1)  && 
106 |                      traceIfFalse "Seller not paid" (assetClassValueOf  (valuePaidTo' pkh) adaAsset >= priceOfAsset)
107 |         Withdraw -> traceIfFalse "Seller Signature Missing" $ pkh `elem` signatures
108 | 
109 |     where
110 |       sellerPkh= case sellerAddress of { Address cre m_sc -> case cre of
111 |                                                            PubKeyCredential pkh -> Just pkh
112 |                                                            ScriptCredential vh -> Nothing  }
113 |       adaAsset=AssetClass (adaSymbol,adaToken )
114 | 
115 |       valuePaidTo' pkh' = foldMap(\(TxOut _ val _ ) -> val ) filteredOutputs
116 |         where
117 |           filteredOutputs = mapMaybe (\x -> case x of 
118 |             (TxOut addr _ _) -> case addr of 
119 |               { Address cre m_sc -> case cre of
120 |                 PubKeyCredential pkh -> if pkh == pkh' then Just x else Nothing
121 |                 ScriptCredential vh -> Nothing }) allOutputs
122 |    
123 | 
124 | {-# INLINABLE mkWrappedMarket #-}
125 | mkWrappedMarket ::  BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
126 | mkWrappedMarket  d r c = check $ mkMarket (parseData d "Invalid data") (parseData r "Invalid redeemer") (parseData c "Invalid context")
127 | 
128 | {-# INLINABLE mkWrappedMarketSuperLazy #-}
129 | mkWrappedMarketSuperLazy ::  BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
130 | mkWrappedMarketSuperLazy  d r c = 
131 |   check $ mkMarketSuperLazy 
132 |   (parseData d "Invalid data") 
133 |   (parseData r "Invalid redeemer") 
134 |   inputs 
135 |   outputs 
136 |   signatures
137 |   where 
138 |     context = constrArgs c
139 | 
140 |     txInfoData :: BuiltinData 
141 |     txInfoData = BI.head context
142 | 
143 |     lazyTxInfo :: BI.BuiltinList BuiltinData
144 |     lazyTxInfo = constrArgs txInfoData 
145 | 
146 |     inputs :: [TxInInfo]
147 |     inputs = parseData (BI.head lazyTxInfo) "txInfoInputs: Invalid [TxInInfo] type"
148 | 
149 |     outputs :: [TxOut] 
150 |     outputs = parseData (BI.head (BI.tail lazyTxInfo)) "txInfoOutputs: Invalid [TxOut] type"
151 | 
152 |     signatures :: [PubKeyHash]
153 |     signatures = parseData 
154 |       (BI.head $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail lazyTxInfo) 
155 |       "txInfoSignatories: Invalid [PubKeyHash] type"
156 | 
157 | simpleMarketValidator = 
158 |             $$(PlutusTx.compile [|| mkWrappedMarket ||])
159 | 
160 | simpleMarketValidatorSuperLazy = 
161 |             $$(PlutusTx.compile [|| mkWrappedMarketSuperLazy ||])
162 | 
163 | simpleMarketplacePlutusV1 ::  PlutusScript PlutusScriptV1
164 | simpleMarketplacePlutusV1  = PlutusScriptSerialised $ serialiseCompiledCode  simpleMarketValidator
165 | 
166 | simpleMarketplacePlutusV1SuperLazy ::  PlutusScript PlutusScriptV1
167 | simpleMarketplacePlutusV1SuperLazy  = PlutusScriptSerialised $ serialiseCompiledCode  simpleMarketValidatorSuperLazy


--------------------------------------------------------------------------------
/docs/frontend.svg:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="UTF-8"?>
2 | <!-- Do not edit this file with editors other than diagrams.net -->
3 | <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
4 | <svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="607px" height="87px" viewBox="-0.5 -0.5 607 87" content="&lt;mxfile host=&quot;app.diagrams.net&quot; modified=&quot;2022-06-10T09:20:04.742Z&quot; agent=&quot;5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/102.0.5005.99 Safari/537.36&quot; etag=&quot;o65pbUaLD0WLxhBvOQ48&quot; version=&quot;19.0.3&quot; type=&quot;device&quot;&gt;&lt;diagram id=&quot;DdDiiuxN7HgPZ1fbYOx7&quot; name=&quot;Page-1&quot;&gt;1VjbbuMgEP0aPzbyJdfHXNqttG0VKatt96kihtio2FiYNM5+/Q42vpK22SpJd9WHeA7DAGcOA9Ty5lH2TaAkvOeYMMu1cWZ5C8t1ncHQhR+F7AtkMnIKIBAUa6caWNHfRIO2RrcUk7TlKDlnkiZt0OdxTHzZwpAQfNd223DWHjVBATGAlY+YiT5SLMMCHQ/sGr8lNAjLkR1bt0SodNZAGiLMdw3Iu7a8ueBcFl9RNidMkVfyUvS7eaO1mpggsTymw/THUsTznw9B9ri/u7Xpo/TXV6MiyitiW73g79s1EZY7RFFiebN4naofsBkMMlurlkB9TRMK/VZEvCrvfH1yX5Im+DbGRI1rg+supJKsEuSr1h3IBLBQRgwsJ4+dz4AISbI3l+ZUhIHSCI+IFHtw0R3cseZYi8zra3tXp6xKTNhIV5lGpFUSVKFrIuFDc/kXvI4NXg2SSIynSqBg+QylKfXbvLRJBCbE/qlp/FJGb1Cai6zZuNiXVkblk46ovhu9wKo7KaPsU0yVYGNndPIBy+Fb4ZOP9SWRCIh8x29yOL+N/A3eSZ8gDEn62p7uoZzqEZacwkIq+XheRz6jjiyKZepezS3WDdTVodsJVPBgBMolVi3786qbGKrzkcAo5lcxFOYv36b9wb+2TctTpsHYvGDMrHgPRO64eDEbzJ3NGBxPYMyg5ick3+B8iy/C8dB+Q4JNjt0DHI/PxrFzvlrYc4adcniOephHWBJBgRA47U5eJCdHFknHPpz6C1XJfrdKDj5XJftGue0EOnOVdMxLzz0SL0QmTG3MD68+N4LHEhR7RCW4dIV1ujn6+go7/Hj3p8C9H2qSMErDijF9q0fr3NVu87WhjM054yKPAipSf6roSsFfSNkS87hZiaMsUA+VXuAnbm+jM/kMmZcbLqLnFC601FcPjhmwLvVIDK0JW/KUSspjwERB3EzlisJb4a7THlGM1YxniNFAAYxsmv5TDVd+KYiCxsFd7rZQi9jAzPRryHFPJA63K46JIQ7PNbVRYifXhnvGk+G/uiU7x16TR196AExOdQAMz3UAgFk/qAv3+t8S3vUf&lt;/diagram&gt;&lt;/mxfile&gt;" style="background-color: rgb(255, 255, 255);"><defs/><g><rect x="163" y="23" width="100" height="50" fill="rgb(255, 255, 255)" stroke="rgb(0, 0, 0)" pointer-events="all"/><g transform="translate(-0.5 -0.5)"><switch><foreignObject pointer-events="none" width="100%" height="100%" requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility" style="overflow: visible; text-align: left;"><div xmlns="http://www.w3.org/1999/xhtml" style="display: flex; align-items: unsafe center; justify-content: unsafe center; width: 98px; height: 1px; padding-top: 48px; margin-left: 164px;"><div data-drawio-colors="color: rgb(0, 0, 0); " style="box-sizing: border-box; font-size: 0px; text-align: center;"><div style="display: inline-block; font-size: 12px; font-family: Helvetica; color: rgb(0, 0, 0); line-height: 1.2; pointer-events: all; white-space: normal; overflow-wrap: normal;">Kuber <br />Api Server</div></div></div></foreignObject><text x="213" y="52" fill="rgb(0, 0, 0)" font-family="Helvetica" font-size="12px" text-anchor="middle">Kuber...</text></switch></g><path d="M 263 48 L 326.63 48" fill="none" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="stroke"/><path d="M 331.88 48 L 324.88 51.5 L 326.63 48 L 324.88 44.5 Z" fill="rgb(0, 0, 0)" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="all"/><rect x="333" y="23" width="100" height="50" fill="rgb(255, 255, 255)" stroke="rgb(0, 0, 0)" pointer-events="all"/><g transform="translate(-0.5 -0.5)"><switch><foreignObject pointer-events="none" width="100%" height="100%" requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility" style="overflow: visible; text-align: left;"><div xmlns="http://www.w3.org/1999/xhtml" style="display: flex; align-items: unsafe center; justify-content: unsafe center; width: 98px; height: 1px; padding-top: 48px; margin-left: 334px;"><div data-drawio-colors="color: rgb(0, 0, 0); " style="box-sizing: border-box; font-size: 0px; text-align: center;"><div style="display: inline-block; font-size: 12px; font-family: Helvetica; color: rgb(0, 0, 0); line-height: 1.2; pointer-events: all; white-space: normal; overflow-wrap: normal;">cardano-node</div></div></div></foreignObject><text x="383" y="52" fill="rgb(0, 0, 0)" font-family="Helvetica" font-size="12px" text-anchor="middle">cardano-node</text></switch></g><path d="M 513 23 C 489 23 483 43 502.2 47 C 483 55.8 504.6 75 520.2 67 C 531 83 567 83 579 67 C 603 67 603 51 588 43 C 603 27 579 11 558 19 C 543 7 519 7 513 23 Z" fill="rgb(255, 255, 255)" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="all"/><g transform="translate(-0.5 -0.5)"><switch><foreignObject pointer-events="none" width="100%" height="100%" requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility" style="overflow: visible; text-align: left;"><div xmlns="http://www.w3.org/1999/xhtml" style="display: flex; align-items: unsafe center; justify-content: unsafe center; width: 118px; height: 1px; padding-top: 43px; margin-left: 484px;"><div data-drawio-colors="color: rgb(0, 0, 0); " style="box-sizing: border-box; font-size: 0px; text-align: center;"><div style="display: inline-block; font-size: 12px; font-family: Helvetica; color: rgb(0, 0, 0); line-height: 1.2; pointer-events: all; white-space: normal; overflow-wrap: normal;">Cardano<br />Network<br /></div></div></div></foreignObject><text x="543" y="47" fill="rgb(0, 0, 0)" font-family="Helvetica" font-size="12px" text-anchor="middle">Cardano...</text></switch></g><path d="M 433 48 L 495.83 47.09" fill="none" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="stroke"/><path d="M 501.08 47.02 L 494.13 50.62 L 495.83 47.09 L 494.03 43.62 Z" fill="rgb(0, 0, 0)" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="all"/><rect x="23" y="23" width="100" height="50" fill="rgb(255, 255, 255)" stroke="rgb(0, 0, 0)" pointer-events="all"/><g transform="translate(-0.5 -0.5)"><switch><foreignObject pointer-events="none" width="100%" height="100%" requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility" style="overflow: visible; text-align: left;"><div xmlns="http://www.w3.org/1999/xhtml" style="display: flex; align-items: unsafe center; justify-content: unsafe center; width: 98px; height: 1px; padding-top: 48px; margin-left: 24px;"><div data-drawio-colors="color: rgb(0, 0, 0); " style="box-sizing: border-box; font-size: 0px; text-align: center;"><div style="display: inline-block; font-size: 12px; font-family: Helvetica; color: rgb(0, 0, 0); line-height: 1.2; pointer-events: all; white-space: normal; overflow-wrap: normal;">Marketplace <br />Frontend<br /></div></div></div></foreignObject><text x="73" y="52" fill="rgb(0, 0, 0)" font-family="Helvetica" font-size="12px" text-anchor="middle">Marketplace...</text></switch></g><path d="M 19.04 64 C 10.36 64 3 57.23 3 47.89 C 3 38.84 10.54 32 19.01 32 C 27.8 32 35 39.67 35 47.92 C 35 56.63 27.91 64 19.04 64 Z" fill="#757575" stroke="none" pointer-events="all"/><path d="M 12.02 39.9 C 10.82 39.9 9.86 40.86 9.86 42.06 L 9.86 53.94 C 9.86 55.14 10.82 56.1 12.02 56.1 L 25.98 56.1 C 27.18 56.1 28.14 55.14 28.14 53.94 L 28.14 42.06 C 28.14 40.86 27.18 39.9 25.98 39.9 Z M 12.03 44.05 L 25.88 44.05 L 25.88 53.84 L 12.03 53.84 Z" fill="#ffffff" stroke="none" pointer-events="all"/><path d="M 123 48 L 156.63 48" fill="none" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="stroke"/><path d="M 161.88 48 L 154.88 51.5 L 156.63 48 L 154.88 44.5 Z" fill="rgb(0, 0, 0)" stroke="rgb(0, 0, 0)" stroke-miterlimit="10" pointer-events="all"/></g><switch><g requiredFeatures="http://www.w3.org/TR/SVG11/feature#Extensibility"/><a transform="translate(0,-5)" xlink:href="https://www.diagrams.net/doc/faq/svg-export-text-problems" target="_blank"><text text-anchor="middle" font-size="10px" x="50%" y="100%">Text is not SVG - cannot display</text></a></switch></svg>


--------------------------------------------------------------------------------
/marketplace-plutus/Plutus/Contracts/V2/SimpleMarketplace.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE TypeApplications #-}
  2 | {-# LANGUAGE EmptyDataDecls #-}
  3 | {-# LANGUAGE NoImplicitPrelude  #-}
  4 | {-# LANGUAGE TemplateHaskell    #-}
  5 | {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
  6 | {-# LANGUAGE NamedFieldPuns #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE DeriveAnyClass #-}
  9 | {-# LANGUAGE DeriveGeneric #-}
 10 | {-# LANGUAGE ScopedTypeVariables #-}
 11 | {-# LANGUAGE MultiParamTypeClasses #-}
 12 | {-# LANGUAGE DataKinds #-}
 13 | {-# LANGUAGE FlexibleContexts  #-}
 14 | {-# LANGUAGE NumericUnderscores#-}
 15 | {-# LANGUAGE OverloadedStrings #-}
 16 | {-# LANGUAGE TupleSections #-}
 17 | {-# LANGUAGE ConstraintKinds #-}
 18 | {-# LANGUAGE AllowAmbiguousTypes #-}
 19 | {-# LANGUAGE ViewPatterns #-}
 20 | {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}
 21 | module Plutus.Contracts.V2.SimpleMarketplace(
 22 |   simpleMarketplacePlutusV2,
 23 |   simpleMarketplacePlutusV2SuperLazy,
 24 |   MarketRedeemer(..),
 25 |   SimpleSale(..)
 26 | )
 27 | where
 28 | 
 29 | import GHC.Generics (Generic)
 30 | import PlutusTx.Prelude
 31 | import Prelude(Show)
 32 | import qualified Prelude
 33 | import  PlutusTx hiding( txOutDatum)
 34 | import Data.Aeson (FromJSON, ToJSON)
 35 | import qualified PlutusTx.AssocMap as AssocMap
 36 | import qualified Data.Bifunctor
 37 | import qualified Data.ByteString.Short as SBS
 38 | import qualified Data.ByteString.Lazy  as LBS
 39 | import qualified PlutusTx.Builtins.Internal as BI
 40 | import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV2)
 41 | import Codec.Serialise ( serialise )
 42 | import PlutusLedgerApi.V2
 43 | import PlutusLedgerApi.V1.Value
 44 | import PlutusLedgerApi.V2.Contexts
 45 | 
 46 | 
 47 | {-# INLINABLE allScriptInputsCount #-}
 48 | allScriptInputsCount:: [TxInInfo] ->Integer
 49 | allScriptInputsCount inputs=
 50 |     foldl (\c txOutTx-> c + countTxOut txOutTx) 0 inputs
 51 |   where
 52 |   countTxOut (TxInInfo _ (TxOut addr _ _ _)) = case addr of { Address cre m_sc -> case cre of
 53 |                                                               PubKeyCredential pkh -> 0
 54 |                                                               ScriptCredential vh -> 1  } 
 55 | 
 56 | {-# INLINABLE parseData #-}
 57 | parseData ::FromData a =>  BuiltinData -> BuiltinString -> a
 58 | parseData d s = case fromBuiltinData  d of
 59 |   Just d -> d
 60 |   _      -> traceError s
 61 | 
 62 | {-# INLINABLE constrArgs #-}
 63 | constrArgs :: BuiltinData -> BI.BuiltinList BuiltinData
 64 | constrArgs bd = BI.snd (BI.unsafeDataAsConstr bd)
 65 | 
 66 | data MarketRedeemer =  Buy | Withdraw
 67 |     deriving (Generic,FromJSON,ToJSON,Show,Prelude.Eq)
 68 | PlutusTx.makeIsDataIndexed ''MarketRedeemer [('Buy, 0), ('Withdraw,1)]
 69 | 
 70 | 
 71 | data SimpleSale=SimpleSale{
 72 |     sellerAddress:: Address, -- The main seller Note that we are using address 
 73 |     priceOfAsset:: Integer  -- cost of the value in it
 74 |   } deriving(Show,Generic)
 75 | 
 76 | PlutusTx.makeIsDataIndexed ''SimpleSale [('SimpleSale, 0)]    
 77 | 
 78 | {-# INLINABLE mkMarket #-}
 79 | mkMarket ::  SimpleSale   -> MarketRedeemer -> ScriptContext    -> Bool
 80 | mkMarket  ds@SimpleSale{sellerAddress,priceOfAsset}  action ctx =
 81 |   case sellerPkh of 
 82 |     Nothing -> traceError "Script Address in seller"
 83 |     Just pkh -> case  action of
 84 |         Buy       -> traceIfFalse "Multiple script inputs" (allScriptInputsCount  (txInfoInputs info) == 1)  && 
 85 |                      traceIfFalse "Seller not paid" (assetClassValueOf   (valuePaidTo info pkh) adaAsset >= priceOfAsset)
 86 |         Withdraw -> traceIfFalse "Seller Signature Missing" $ txSignedBy info pkh
 87 | 
 88 |     where
 89 |       sellerPkh= case sellerAddress of { Address cre m_sc -> case cre of
 90 |                                                            PubKeyCredential pkh -> Just pkh
 91 |                                                            ScriptCredential vh -> Nothing  }
 92 |       info  =  scriptContextTxInfo ctx
 93 |       adaAsset=AssetClass (adaSymbol,adaToken )
 94 | 
 95 | {-# INLINABLE mkMarketSuperLazy #-}
 96 | mkMarketSuperLazy :: SimpleSale -> MarketRedeemer -> [TxInInfo] -> [TxOut] -> [PubKeyHash] -> Bool
 97 | mkMarketSuperLazy ds@SimpleSale{sellerAddress,priceOfAsset} action allInputs allOutputs signatures = 
 98 |   case sellerPkh of 
 99 |     Nothing -> traceError "Script Address in seller"
100 |     Just pkh -> case  action of
101 |         Buy       -> traceIfFalse "Multiple script inputs" (allScriptInputsCount allInputs == 1)  && 
102 |                      traceIfFalse "Seller not paid" (assetClassValueOf  (valuePaidTo' pkh) adaAsset >= priceOfAsset)
103 |         Withdraw -> traceIfFalse "Seller Signature Missing" $ pkh `elem` signatures
104 | 
105 |     where
106 |       sellerPkh= case sellerAddress of { Address cre m_sc -> case cre of
107 |                                                            PubKeyCredential pkh -> Just pkh
108 |                                                            ScriptCredential vh -> Nothing  }
109 |       adaAsset=AssetClass (adaSymbol,adaToken )
110 | 
111 |       valuePaidTo' pkh' = foldMap(\(TxOut _ val _ _) -> val ) filteredOutputs
112 |         where
113 |           filteredOutputs = mapMaybe (\x -> case x of 
114 |             (TxOut addr _ _ _) -> case addr of 
115 |               { Address cre m_sc -> case cre of
116 |                 PubKeyCredential pkh -> if pkh == pkh' then Just x else Nothing
117 |                 ScriptCredential vh -> Nothing }) allOutputs
118 |    
119 | 
120 | {-# INLINABLE mkWrappedMarket #-}
121 | mkWrappedMarket ::  BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
122 | mkWrappedMarket  d r c = check $ mkMarket (parseData d "Invalid data") (parseData r "Invalid redeemer") (parseData c "Invalid context")
123 | 
124 | {-# INLINABLE mkWrappedMarketSuperLazy #-}
125 | mkWrappedMarketSuperLazy ::  BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
126 | mkWrappedMarketSuperLazy  d r c = 
127 |   check $ mkMarketSuperLazy 
128 |   (parseData d "Invalid data") 
129 |   (parseData r "Invalid redeemer") 
130 |   inputs 
131 |   outputs 
132 |   signatures
133 |   where 
134 |     context = constrArgs c
135 | 
136 |     txInfoData :: BuiltinData 
137 |     txInfoData = BI.head context
138 | 
139 |     lazyTxInfo :: BI.BuiltinList BuiltinData
140 |     lazyTxInfo = constrArgs txInfoData 
141 | 
142 |     inputs :: [TxInInfo]
143 |     inputs = parseData (BI.head lazyTxInfo) "txInfoInputs: Invalid [TxInInfo] type"
144 | 
145 |     outputs :: [TxOut] 
146 |     outputs = parseData (BI.head (BI.tail (BI.tail lazyTxInfo))) "txInfoOutputs: Invalid [TxOut] type"
147 | 
148 |     signatures :: [PubKeyHash]
149 |     signatures = parseData 
150 |       (BI.head $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail lazyTxInfo) 
151 |       "txInfoSignatories: Invalid [PubKeyHash] type"
152 | 
153 | simpleMarketValidator = 
154 |             $$(PlutusTx.compile [|| mkWrappedMarket ||])
155 | 
156 | simpleMarketValidatorSuperLazy :: CompiledCode
157 |   (BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit)
158 | simpleMarketValidatorSuperLazy = 
159 |             $$(PlutusTx.compile [|| mkWrappedMarketSuperLazy ||])
160 | 
161 | simpleMarketplacePlutusV2 ::  PlutusScript PlutusScriptV2
162 | simpleMarketplacePlutusV2  = PlutusScriptSerialised $ serialiseCompiledCode  simpleMarketValidator
163 | 
164 | simpleMarketplacePlutusV2SuperLazy ::  PlutusScript PlutusScriptV2
165 | simpleMarketplacePlutusV2SuperLazy  = PlutusScriptSerialised $ serialiseCompiledCode  simpleMarketValidatorSuperLazy


--------------------------------------------------------------------------------
/marketplace-plutus/Plutus/Contracts/V3/MarketplaceConfig.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE TypeApplications #-}
  2 | {-# LANGUAGE EmptyDataDecls #-}
  3 | {-# LANGUAGE NoImplicitPrelude  #-}
  4 | {-# LANGUAGE TemplateHaskell    #-}
  5 | {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
  6 | {-# LANGUAGE NamedFieldPuns #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | {-# LANGUAGE DeriveAnyClass #-}
  9 | {-# LANGUAGE DeriveGeneric #-}
 10 | {-# LANGUAGE ScopedTypeVariables #-}
 11 | {-# LANGUAGE MultiParamTypeClasses #-}
 12 | {-# LANGUAGE DataKinds #-}
 13 | {-# LANGUAGE FlexibleContexts  #-}
 14 | {-# LANGUAGE NumericUnderscores#-}
 15 | {-# LANGUAGE OverloadedStrings #-}
 16 | {-# LANGUAGE TupleSections #-}
 17 | {-# LANGUAGE ConstraintKinds #-}
 18 | {-# LANGUAGE AllowAmbiguousTypes #-}
 19 | {-# LANGUAGE ViewPatterns #-}
 20 | module Plutus.Contracts.V3.MarketplaceConfig(
 21 |   marketConfigPlutusScript,
 22 |   marketConfigPlutusScriptLazy,
 23 |   marketConfigPlutusScriptSuperLazy,
 24 |   marketConfigScript,
 25 |   MarketConfig(..)
 26 | )
 27 | where
 28 | 
 29 | import GHC.Generics (Generic)
 30 | import PlutusTx.Prelude
 31 | import Prelude(Show)
 32 | import qualified Prelude
 33 | import  PlutusTx hiding( txOutDatum)
 34 | import Data.Aeson (FromJSON, ToJSON)
 35 | import qualified PlutusTx.AssocMap as AssocMap
 36 | import qualified Data.Bifunctor
 37 | import qualified Data.ByteString.Short as SBS
 38 | import qualified Data.ByteString.Lazy  as LBS
 39 | import Codec.Serialise ( serialise )
 40 | import Cardano.Api (IsCardanoEra,NetworkId, AddressInEra, ShelleyAddr, Script (PlutusScript), PlutusScriptVersion (PlutusScriptV3), hashScript, PaymentCredential (PaymentCredentialByScript), StakeAddressReference (NoStakeAddress), makeShelleyAddressInEra, makeShelleyAddress, ConwayEra)
 41 | import qualified Cardano.Api.Shelley
 42 | import PlutusLedgerApi.V3
 43 | import PlutusLedgerApi.V3.Contexts
 44 | import qualified PlutusTx.Builtins.Internal as BI
 45 | 
 46 | 
 47 | data MarketConfig=MarketConfig{
 48 |     marketOwner :: Address,
 49 |     marketFeeReceiverAddress:: Address, 
 50 |     marketFee:: Integer  
 51 |   } deriving(Show,Generic)
 52 | 
 53 | PlutusTx.makeIsDataIndexed ''MarketConfig [('MarketConfig, 0)]    
 54 | 
 55 | {-# INLINABLE mkMarketConfig #-}
 56 | mkMarketConfig ::  MarketConfig   -> ScriptContext    -> Bool
 57 | mkMarketConfig  MarketConfig{marketOwner}  ctx = 
 58 |   case marketOwner of {Address cre m_sc -> case cre of
 59 |     PubKeyCredential pkh ->traceIfFalse "Missing owner signature" (txSignedBy info pkh)
 60 |     ScriptCredential vh -> traceError "NotOperator"  }
 61 |   where
 62 |     info  =  scriptContextTxInfo ctx
 63 | 
 64 | {-# INLINABLE expectSpending #-}
 65 | expectSpending :: FromData a => ScriptContext -> a
 66 | expectSpending ctx =  case (scriptContextScriptInfo ctx ) of
 67 |         SpendingScript outRef datum -> case datum of 
 68 |           Just d ->  case fromBuiltinData  (getDatum d) of
 69 |             Nothing -> traceError "Invalid datum format"
 70 |             Just v -> v
 71 |           _ -> traceError "Missing datum" 
 72 |         _ -> traceError "Script used for other than spending" 
 73 | 
 74 | 
 75 | {-# INLINABLE parseData #-}
 76 | parseData ::FromData a =>  BuiltinData -> BuiltinString -> a
 77 | parseData d s = case fromBuiltinData  d of
 78 |   Just d -> d
 79 |   _      -> traceError s
 80 | 
 81 | {-# INLINABLE constrArgs #-}
 82 | constrArgs :: BuiltinData -> BI.BuiltinList BuiltinData
 83 | constrArgs bd = BI.snd (BI.unsafeDataAsConstr bd)
 84 | 
 85 | {-# INLINABLE marketConfigScriptBS #-}
 86 | marketConfigScriptBS :: SerialisedScript -> SBS.ShortByteString
 87 | marketConfigScriptBS  script =  SBS.toShort . LBS.toStrict $ serialise $ script
 88 | 
 89 | {-# INLINABLE mkWrappedMarketConfig #-}
 90 | mkWrappedMarketConfig ::   BuiltinData -> BuiltinUnit
 91 | mkWrappedMarketConfig   ctx = 
 92 |   check $ mkMarketConfig (expectSpending context) context
 93 |   where
 94 |     context = parseData ctx "Invalid Context"
 95 | 
 96 | 
 97 | {-# INLINABLE mkMarketConfigLazy #-}
 98 | mkMarketConfigLazy ::  MarketConfig   -> TxInfo    -> Bool
 99 | mkMarketConfigLazy  MarketConfig{marketOwner}  info = 
100 |   case marketOwner of {Address cre m_sc -> case cre of
101 |     PubKeyCredential pkh ->traceIfFalse "Missing owner signature" (txSignedBy info pkh)
102 |     ScriptCredential vh -> traceError "NotOperator"  }
103 | 
104 | {-# INLINABLE mkMarketConfigSuperLazy #-}
105 | mkMarketConfigSuperLazy :: MarketConfig -> [PubKeyHash] -> Bool 
106 | mkMarketConfigSuperLazy MarketConfig{marketOwner} signatures = 
107 |   case marketOwner of {Address cre m_sc -> case cre of
108 |     PubKeyCredential pkh ->traceIfFalse "Missing owner signature" (pkh `elem` signatures)
109 |     ScriptCredential vh -> traceError "NotOperator"  }
110 | 
111 | {-# INLINABLE mkWrappedMarketConfigLazy #-}
112 | mkWrappedMarketConfigLazy ::   BuiltinData -> BuiltinUnit
113 | mkWrappedMarketConfigLazy ctx = 
114 |   check $ mkMarketConfigLazy datum info
115 |   where
116 |     context = constrArgs ctx
117 | 
118 |     redeemerFollowedByScriptInfo :: BI.BuiltinList BuiltinData
119 |     redeemerFollowedByScriptInfo = BI.tail context
120 | 
121 |     scriptInfoData :: BuiltinData
122 |     scriptInfoData = BI.head (BI.tail redeemerFollowedByScriptInfo)
123 | 
124 |     txInfoData :: BuiltinData 
125 |     txInfoData = BI.head context
126 | 
127 |     datumData :: BuiltinData
128 |     datumData = BI.head (constrArgs (BI.head (BI.tail (constrArgs scriptInfoData))))
129 | 
130 |     datum :: MarketConfig
131 |     datum = parseData (getDatum (unsafeFromBuiltinData datumData)) "Invalid Datum Type"
132 | 
133 |     info :: TxInfo 
134 |     info = parseData txInfoData "Invalid TxInfo Type"
135 | 
136 | {-# INLINABLE mkWrappedMarketConfigSuperLazy #-}
137 | mkWrappedMarketConfigSuperLazy :: BuiltinData -> BuiltinUnit
138 | mkWrappedMarketConfigSuperLazy ctx = check $ mkMarketConfigSuperLazy datum signatures 
139 |   where 
140 |     context = constrArgs ctx
141 | 
142 |     redeemerFollowedByScriptInfo :: BI.BuiltinList BuiltinData
143 |     redeemerFollowedByScriptInfo = BI.tail context
144 | 
145 |     scriptInfoData :: BuiltinData
146 |     scriptInfoData = BI.head (BI.tail redeemerFollowedByScriptInfo)
147 | 
148 |     txInfoData :: BuiltinData 
149 |     txInfoData = BI.head context
150 | 
151 |     datumData :: BuiltinData
152 |     datumData = BI.head (constrArgs (BI.head (BI.tail (constrArgs scriptInfoData))))
153 | 
154 |     datum :: MarketConfig
155 |     datum = parseData (getDatum (unsafeFromBuiltinData datumData)) "Invalid Datum Type"
156 | 
157 |     lazyTxInfo :: BI.BuiltinList BuiltinData
158 |     lazyTxInfo = constrArgs txInfoData
159 | 
160 |     signatures :: [PubKeyHash]
161 |     signatures = parseData 
162 |       (BI.head $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail $ BI.tail lazyTxInfo) 
163 |       "txInfoSignatories: Invalid [PubKeyHash] type"
164 | 
165 | marketConfigValidator =  
166 |   $$(PlutusTx.compile [|| mkWrappedMarketConfig ||])
167 | 
168 | marketConfigValidatorLazy =  
169 |   $$(PlutusTx.compile [|| mkWrappedMarketConfigLazy ||])
170 | 
171 | marketConfigValidatorSuperLazy = 
172 |   $$(PlutusTx.compile [|| mkWrappedMarketConfigSuperLazy ||])
173 | 
174 | 
175 | marketConfigScript  =  serialiseCompiledCode  marketConfigValidator
176 | marketConfigScriptLazy = serialiseCompiledCode  marketConfigValidatorLazy
177 | marketConfigScriptSuperLazy = serialiseCompiledCode  marketConfigValidatorSuperLazy
178 | 
179 | marketConfigPlutusScript  = PlutusScript PlutusScriptV3  $ Cardano.Api.Shelley.PlutusScriptSerialised $ marketConfigScriptBS marketConfigScript 
180 | 
181 | marketConfigPlutusScriptLazy  = PlutusScript PlutusScriptV3  $ Cardano.Api.Shelley.PlutusScriptSerialised $ marketConfigScriptBS marketConfigScriptLazy 
182 | 
183 | marketConfigPlutusScriptSuperLazy = PlutusScript PlutusScriptV3  $ Cardano.Api.Shelley.PlutusScriptSerialised $ marketConfigScriptBS marketConfigScriptSuperLazy 


--------------------------------------------------------------------------------
/benchmark/Main.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE LambdaCase #-}
  2 | {-# LANGUAGE ScopedTypeVariables #-}
  3 | {-# LANGUAGE TypeApplications #-}
  4 | {-# LANGUAGE NumericUnderscores #-}
  5 | module Main where
  6 | import Cardano.Api
  7 | import Cardano.Kuber.Api
  8 | import System.Environment (getEnv, setEnv)
  9 | import Cardano.Marketplace.Common.TransactionUtils (getSignKey, createReferenceScript, mintNativeAsset)
 10 | import Cardano.Kuber.Util (skeyToAddrInEra, utxoSum, addressInEraToAddressAny)
 11 | import Cardano.Kuber.Data.Parsers (parseAddress)
 12 | import qualified System.Environment.Blank as Blank
 13 | import qualified Data.Text as T
 14 | import qualified Data.Set as Set
 15 | import Cardano.Kuber.Console.ConsoleWritable (toConsoleText)
 16 | import Wallet (genWallet, ShelleyWallet (..))
 17 | import ParallelUtils (runOperations, runBuildAndSubmit, waitTxConfirmation, BenchRun, monitoredSubmitTx, monitoredSubmitTx', TransactionTime (ttTx))
 18 | -- import Cardano.Marketplace.V3.Core (simpleMarketV3Helper)
 19 | import Cardano.Marketplace.V2.Core (simpleMarketV2Helper)
 20 | import Cardano.Marketplace.SimpleMarketplace (SimpleMarketHelper(..))
 21 | import qualified Data.ByteString.Char8 as BS8
 22 | import Control.Concurrent.Async (forConcurrently, async, Async, wait)
 23 | import System.Directory (createDirectoryIfMissing)
 24 | import System.IO
 25 | import GHC.IO.Handle
 26 | import Data.Time.Clock (getCurrentTime)
 27 | import Data.Time (formatTime, defaultTimeLocale)
 28 | import qualified Data.Aeson as A
 29 | import qualified Data.ByteString.Lazy as BSL
 30 | import GHC.IO.Handle.FD (handleToFd)
 31 | import Reporting (writeBenchmarkReport)
 32 | import Control.Exception (SomeException, catch, Exception (displayException))
 33 | import GHC.Exception (prettyCallStack)
 34 | import GHC.Stack (callStack)
 35 | import Cardano.Ledger.BaseTypes (Globals(networkId))
 36 | import Control.Concurrent (threadDelay)
 37 | import qualified Data.Text.IO as T
 38 | import GHC.Word (Word32)
 39 | 
 40 | 
 41 | main' = do
 42 |   wallets<- mapM genWallet [0.. 99]
 43 |   let addrs =  map (\(ShelleyWallet pskey sskey addr)->
 44 |              addressInEraToAddressAny addr
 45 |         ) wallets
 46 |       addrSet = Set.fromList addrs
 47 |   putStrLn ("Len addrs =" ++ show (length  addrs) )
 48 |   putStrLn ("Len addrSet =" ++ show (length  addrSet) )
 49 | 
 50 |   mapM_  (T.putStrLn . serialiseAddress) addrs
 51 | 
 52 | 
 53 | main= do
 54 |   currentTime <- getCurrentTime
 55 |   let dateStr = formatTime defaultTimeLocale "%Y-%m-%d_%H-%M-%S" currentTime
 56 |   let reportDir = "./test-reports"
 57 | 
 58 | 
 59 |   let transactionReportJson =   reportDir <> "/" <> (dateStr ++ "-transaction-bench" ++ ".json")
 60 |   let transactionReportMd =  reportDir <>  "/" <>  dateStr ++ "-transaction-bench" ++ ".md"
 61 |   let logFileName =  dateStr ++ "-transaction-bench" ++ ".log"
 62 | 
 63 | 
 64 |   createDirectoryIfMissing True reportDir
 65 |   logFile <- openFile (reportDir ++ "/" ++ logFileName) WriteMode
 66 |   hSetBuffering stdout LineBuffering
 67 |   hSetBuffering stderr LineBuffering
 68 |   hDuplicateTo logFile stdout
 69 |   hDuplicateTo logFile stderr
 70 |   hSetBuffering logFile LineBuffering
 71 | 
 72 | 
 73 |   chainInfo <- chainInfoFromEnv
 74 |   networkId <- evaluateKontract chainInfo  kGetNetworkId >>= throwFrameworkError
 75 |   sKey <-  getEnv "SIGNKEY_FILE" >>= getSignKey
 76 |   walletAddr <- Blank.getEnv "WALLET_ADDRESS" >>= (\case
 77 |         Just addrStr -> parseAddress @ConwayEra $ T.pack addrStr
 78 |         Nothing -> pure ( skeyToAddrInEra sKey networkId)
 79 |       )
 80 | 
 81 | 
 82 |   let marketHelper = simpleMarketV2Helper
 83 |       walletBuilder =
 84 |             txWalletSignKey sKey
 85 |         <>  txWalletAddress walletAddr
 86 | 
 87 |       refScriptBuilder =
 88 |         createReferenceScript (simpleMarketScript marketHelper) (plutusScriptAddr  (simpleMarketScript marketHelper) networkId )
 89 |         <> walletBuilder
 90 | 
 91 |   result <- evaluateKontract chainInfo $ do
 92 |     walletUtxo :: UTxO ConwayEra <- kQueryUtxoByAddress $ Set.singleton (addressInEraToAddressAny walletAddr)
 93 |     liftIO $ do
 94 |       putStrLn $ "WalletAddress  : " ++ T.unpack (serialiseAddress walletAddr)
 95 |       putStrLn $ "Wallet Balance :" ++ toConsoleText "  " (utxoSum walletUtxo)
 96 | 
 97 | 
 98 |     refTx <- monitoredSubmitTx' 0 "Create Ref Script"  (pure refScriptBuilder)
 99 |     case ttTx refTx  of
100 |       Left e -> throwError e
101 |       Right v -> do
102 |         let refTxId = getTxId $ getTxBody $ v
103 |         batches <- mapM (\i ->  setupBenchBatch i simpleMarketV2Helper (TxIn refTxId (TxIx 0)) sKey walletAddr ) [0]
104 |         let runBatch batch = do
105 |               task <- kAsync batch
106 |               liftIO $ threadDelay 0
107 |               pure task
108 |         taskList <- mapM runBatch batches
109 |         resultList <- mapM kWait taskList
110 | 
111 |         let results = concat resultList
112 |         liftIO $ do
113 |           BSL.writeFile transactionReportJson  (A.encode results)
114 |           writeBenchmarkReport  results transactionReportMd
115 | 
116 |   case result of
117 |     Right _ -> pure ()
118 |     Left e -> putStrLn $ "Bench run Kontract error : "  ++ show e
119 | 
120 | 
121 | kAsync :: Exception e => Kontract a w1 FrameworkError r -> Kontract a w2 e (Async (Either FrameworkError r))
122 | kAsync k = do
123 |   backend <- kGetBackend
124 |   liftIO $  async $ evaluateKontract backend k
125 | 
126 | kWait :: Exception e => Async (Either e b) -> Kontract api w e b
127 | kWait results = do
128 |   result <- liftIO $ wait results
129 |   case result of
130 |         Left e -> KError e
131 |         Right v -> pure v
132 | 
133 | 
134 | 
135 | setupBenchBatch :: (HasChainQueryAPI api, HasKuberAPI api, HasSubmitApi api) => Integer -> SimpleMarketHelper api w -> TxIn  -> SigningKey PaymentKey ->
136 |    AddressInEra ConwayEra -> Kontract api w FrameworkError (Kontract api w FrameworkError [Either FrameworkError BenchRun])
137 | setupBenchBatch  _batchNo marketHelper refScriptTxin sKey walletAddress   = do
138 |   let walletCount ::Word32 = 10
139 |   let startIndex = fromInteger $  _batchNo *  (toInteger walletCount * 2)
140 |   networkId <- kGetNetworkId
141 |   backend <- kGetBackend
142 |   buyers <- liftIO $  mapM genWallet [ startIndex .. (startIndex + walletCount -1 )]
143 |   sellers <- liftIO $ mapM genWallet [ startIndex + walletCount ..(startIndex + walletCount * 2 -1 )]
144 |   liftIO $ putStrLn $ show _batchNo ++" Generated wallets for batch " ++
145 |       " buyers : " ++ show startIndex ++ "-" ++ show (startIndex + walletCount -1)
146 |       ++ " sellers : " ++ show (startIndex + walletCount) ++ "-" ++ show (startIndex + walletCount * 2 -1)
147 |   let
148 |       (mintedAsset, mintBuilder) = mintNativeAsset (getVerificationKey sKey) (AssetName $ BS8.pack "TestToken") (toInteger $  length sellers)
149 | 
150 |   let fundWallet =
151 |         createReferenceScript (simpleMarketScript marketHelper) (plutusScriptAddr  (simpleMarketScript marketHelper) networkId )
152 |         <> foldMap
153 |             (\w ->  txPayTo  (wAddress w)  (valueFromList [(AdaAssetId,2_000_000),(mintedAsset, 1)])
154 |                   <> txPayTo  (wAddress w)  (valueFromList [(AdaAssetId,5_000_000)]))
155 |             sellers
156 |         <>foldMap
157 |               (\w ->  txPayTo  (wAddress w)  (valueFromList [(AdaAssetId,5_000_000)])
158 |                     <> txPayTo  (wAddress w)  (valueFromList [(AdaAssetId,5_000_000)])
159 |           )
160 |             buyers
161 |         <> mintBuilder
162 |         <> txWalletAddress walletAddress
163 |         <> txWalletSignKey sKey
164 |   monitoredSubmitTx'  _batchNo "Fund Wallets" (pure fundWallet)
165 | 
166 |   let
167 |       evaluator (index, wallets) =
168 |         evaluateKontract backend  (runOperations index  refScriptTxin marketHelper mintedAsset wallets)
169 |       refund = foldMap (\w -> txWalletAddress (wAddress w) <> txWalletSignKey (wPaymentSkey w)) (buyers <> sellers)
170 |                 <> txChangeAddress walletAddress
171 |   return $ do
172 |     result <- liftIO $
173 |       forConcurrently  ( zip [(_batchNo * toInteger  walletCount)..] $ zip  sellers buyers)  evaluator
174 | 
175 |     catchError  ( do
176 |           monitoredSubmitTx' _batchNo "Refund Wallet" (pure refund)
177 |           pure result
178 |       )
179 |       (\e -> pure result)


--------------------------------------------------------------------------------
/test/Test/TestStorySimpleMarket.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE NumericUnderscores #-}
  2 | {-# LANGUAGE LambdaCase #-}
  3 | {-# LANGUAGE ScopedTypeVariables #-}
  4 | module Test.TestStorySimpleMarket(makeSimpleMarketSpecs) where
  5 | 
  6 | import Test.Hspec
  7 | import Test.Hspec.JUnit 
  8 | import Cardano.Kuber.Api 
  9 | import System.Environment.Blank (getEnvDefault)
 10 | import Cardano.Kuber.Data.Parsers
 11 | import qualified Data.Text as T
 12 | import System.Environment (getEnv)
 13 | import Cardano.Marketplace.Common.TransactionUtils
 14 | import Cardano.Api 
 15 | import qualified Data.ByteString.Char8 as BS8
 16 | import qualified Data.Set as Set
 17 | import GHC.Conc ( atomically, newTVarIO, readTVarIO, writeTVar, newTVar, TVar ) 
 18 | import Cardano.Kuber.Util 
 19 | import Cardano.Kuber.Console.ConsoleWritable 
 20 | import qualified Debug.Trace as Debug
 21 | import Test.Common
 22 | import Cardano.Marketplace.SimpleMarketplace
 23 | import Cardano.Marketplace.V2.Core (simpleMarketV2Helper, simpleMarketV2HelperSuperLazy)
 24 | import Cardano.Marketplace.V1.Core (simpleMarketV1Helper, simpleMarketV1HelperSuperLazy)
 25 | import Cardano.Marketplace.V3.Core (simpleMarketV3Helper, simpleMarketV3HelperLazy, simpleMarketV3HelperSuperLazy)
 26 | import Test.TestContext
 27 | import Test.Reporting (collectReports, addTagMetric)
 28 | import qualified Data.Map as Map
 29 | 
 30 | 
 31 | makeSimpleMarketSpecs :: Integer -> TestContext ChainConnectInfo -> IO [SpecWith ()]
 32 | makeSimpleMarketSpecs start_index tContext = do 
 33 |   let makeVars = do 
 34 |         saleVar <- newTVarIO Nothing
 35 |         refVar <- newTVarIO Nothing
 36 |         pure (saleVar,refVar)
 37 |   v1Vars <- makeVars
 38 |   v1VarsSuperLazy <- makeVars
 39 |   v2Vars <- makeVars
 40 |   v2VarsSuperLazy <- makeVars
 41 |   v3Vars <- makeVars
 42 |   v3VarsLazy <- makeVars
 43 |   v3VarsSuperLazy <- makeVars
 44 | 
 45 | 
 46 |   addTagMetric tContext (TagMetric "Simple Market" "V1" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ simpleMarketScript simpleMarketV1Helper ))
 47 |   addTagMetric tContext (TagMetric "Simple Market" "V1 Super Lazy" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ simpleMarketScript simpleMarketV1HelperSuperLazy ))
 48 |   addTagMetric tContext (TagMetric "Simple Market" "V2" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ simpleMarketScript simpleMarketV2Helper ))
 49 |   addTagMetric tContext (TagMetric "Simple Market" "V2 Super Lazy" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ simpleMarketScript simpleMarketV2HelperSuperLazy ))
 50 |   addTagMetric tContext (TagMetric "Simple Market" "V3" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ simpleMarketScript simpleMarketV3Helper ))
 51 |   addTagMetric tContext (TagMetric "Simple Market" "V3 Lazy" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ simpleMarketScript simpleMarketV3HelperLazy ))
 52 |   addTagMetric tContext (TagMetric "Simple Market" "V3 Super Lazy" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ simpleMarketScript simpleMarketV3HelperSuperLazy ))
 53 | 
 54 |   pure [
 55 |     afterAll
 56 |         (\x -> collectReports  "Simple Market" "V1" tContext ) 
 57 |         $ simpleMarketSpecs "SimpleMarketV1 Flow" start_index simpleMarketV1Helper tContext (pure v1Vars)
 58 |     , afterAll
 59 |         (\x -> collectReports  "Simple Market" "V1 Super Lazy" tContext ) 
 60 |         $ simpleMarketSpecs "SimpleMarketV1SuperLazy Flow" (start_index + 1) simpleMarketV1HelperSuperLazy tContext (pure v1VarsSuperLazy)
 61 |     , afterAll
 62 |         (\x -> collectReports  "Simple Market" "V2" tContext ) 
 63 |         $ simpleMarketSpecs "SimpleMarketV2 Flow" (start_index + 2) simpleMarketV2Helper tContext (pure v2Vars)
 64 |     , afterAll
 65 |         (\x -> collectReports  "Simple Market" "V2 Super Lazy" tContext ) 
 66 |         $ simpleMarketSpecs "SimpleMarketV2SuperLazy Flow" (start_index + 3) simpleMarketV2HelperSuperLazy tContext (pure v2VarsSuperLazy)
 67 |     , afterAll
 68 |         (\x -> collectReports  "Simple Market" "V3" tContext ) 
 69 |         $ simpleMarketSpecs "SimpleMarketV3 Flow" (start_index + 4) simpleMarketV3Helper tContext (pure  v3Vars)
 70 |     , afterAll
 71 |         (\x -> collectReports  "Simple Market" "V3 Lazy" tContext ) 
 72 |         $ simpleMarketSpecs "SimpleMarketV3Lazy Flow" (start_index + 5) simpleMarketV3HelperLazy tContext (pure  v3VarsLazy)
 73 |     , afterAll
 74 |         (\x -> collectReports  "Simple Market" "V3 Super Lazy" tContext ) 
 75 |         $ simpleMarketSpecs "SimpleMarketV3SuperLazy Flow" (start_index + 6) simpleMarketV3HelperSuperLazy tContext (pure  v3VarsSuperLazy)
 76 |     ]
 77 | 
 78 | simpleMarketSpecs:: String-> Integer -> SimpleMarketHelper ChainConnectInfo w -> TestContext ChainConnectInfo -> IO (TVar (Maybe TxId), TVar (Maybe TxId)) -> SpecWith ()
 79 | simpleMarketSpecs scriptName testIndex marketHelper context@(TestContext chainInfo networkId sKey walletAddr _ _ _ )  ioAction =
 80 |   let 
 81 |       (mintedAsset,mintBuilder) = mintNativeAsset (getVerificationKey sKey) (AssetName $ BS8.pack "TestToken") 4
 82 |       runTest_ index mRef str tb = do 
 83 |         putStrLn $ (show testIndex ++ "." ++ show index ++" "++scriptName ++ " : " ++ show str)
 84 |         runTestContext_  context mRef str tb
 85 |       marketAddressInEra = plutusScriptAddr  (simpleMarketScript marketHelper)  networkId
 86 |       evaluateAndRunTest kontract testActions = do
 87 |         kontractTx <- evaluateKontract chainInfo kontract 
 88 |         case kontractTx of 
 89 |           Left fErr -> error (show fErr)
 90 |           Right txb ->  testActions txb
 91 | 
 92 |     in do 
 93 |     let 
 94 |     describe scriptName $ do
 95 |       -- Setup shared variable with `before` hook
 96 |       before ioAction $ do
 97 |         it  "Should mint  4 Native Assets" $ \(saleTx, refUtxo) -> do
 98 |           runTest_  1 Nothing "Mint Native Asset"  (do 
 99 |               (UTxO utxos) ::UTxO ConwayEra <- kQueryUtxoByAddress (Set.singleton $ addressInEraToAddressAny walletAddr)
100 |               pure $ mintBuilder   <> txConsumeUtxos (UTxO $ Map.fromList $ take 100  $ Map.toList utxos)
101 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,5_000_000)])
102 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,10_000_000)])
103 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,20_000_000)])
104 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,30_000_000)])
105 |                       -- create extra utxos that might be required
106 | 
107 |               )
108 | 
109 | 
110 |         it "Should create reference script UTxO" $ \(saleTx, refUtxo) -> do
111 |           runTest_ 2
112 |                 (Just refUtxo)
113 |                 "Create reference script UTxO" 
114 |                 (pure $ createReferenceScript (simpleMarketScript marketHelper) marketAddressInEra )
115 | 
116 |         it "Should place 4 tokens on sale" $ \(saleTx, refUtxo) -> do
117 |           let sellBuilder = sell marketHelper  
118 |               sellTxBuilder = sellBuilder marketAddressInEra (valueFromList [(mintedAsset,1)] ) 10_000_000 walletAddr
119 |               testActions txb = runTest_ 3 (Just saleTx) "Place on Sell" (pure $ mconcat $ take 4 $ repeat txb)
120 |           evaluateAndRunTest sellTxBuilder testActions
121 | 
122 |         it "Should withdraw 1 token from sale" $ \(saleTx, refUtxo) -> do
123 |           saleTxId <- readSaleTxVar saleTx 
124 |           let withdrawBuilder = withdraw marketHelper 
125 |               withdrawTokenBuilder = withdrawBuilder (TxIn saleTxId (TxIx 0))
126 |           runTest_ 4 Nothing "Withdraw" withdrawTokenBuilder 
127 |               
128 |         it "Should buy 1 token from sale" $ \(saleTx, refUtxo) -> do
129 |           saleTxId <- readSaleTxVar saleTx 
130 |           let buyBuilder = buy marketHelper
131 |               buyTokenBuilder = buyBuilder (TxIn saleTxId (TxIx 1) ) 
132 |           runTest_ 5 Nothing "Buy" buyTokenBuilder
133 |         
134 |         it "Should withdraw 1 token from sale with reference script" $ \vars -> do
135 |           (saleTxId,refUtxoId ) <- readSaleAndRefScriptVar vars
136 |           let withdrawWithRefScriptBuilder = withdrawWithRefScript marketHelper
137 |               withdrawTokenBuilder = withdrawWithRefScriptBuilder (TxIn saleTxId (TxIx 2)) (TxIn refUtxoId (TxIx 0)) 
138 |           runTest_  6 Nothing "Withdraw with RefScript" withdrawTokenBuilder 
139 |         
140 |         it "Should buy 1 token from sale with reference script" $ \vars -> do
141 |           (saleTxId,refUtxoId ) <- readSaleAndRefScriptVar vars
142 |           let buyWithRefScriptBuilder = buyWithRefScript marketHelper
143 |               buyTokenBuilder = buyWithRefScriptBuilder (TxIn saleTxId (TxIx 3)) (TxIn refUtxoId (TxIx 0))
144 |           runTest_  7 Nothing "Buy with RefScript" buyTokenBuilder
145 | 
146 | 


--------------------------------------------------------------------------------
/test/Test/Common.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE NumericUnderscores #-}
  2 | {-# LANGUAGE LambdaCase #-}
  3 | {-# LANGUAGE ScopedTypeVariables #-}
  4 | {-# LANGUAGE OverloadedStrings #-}
  5 | 
  6 | module Test.Common where
  7 | import Cardano.Kuber.Api
  8 | import Cardano.Api
  9 | import Cardano.Api.Shelley
 10 | import qualified Cardano.Ledger.Shelley.Core as L
 11 | import Control.Lens ((^.))
 12 | import qualified Cardano.Ledger.Alonzo.TxWits as L
 13 | import qualified Cardano.Ledger.Alonzo.Scripts as L
 14 | import qualified Cardano.Api.Ledger as L
 15 | import Cardano.Marketplace.Common.TransactionUtils
 16 | import qualified Data.ByteString.Char8 as BS8
 17 | import Test.Hspec (shouldSatisfy, expectationFailure)
 18 | import qualified Data.Map as Map
 19 | import qualified Control.Concurrent as Control
 20 | import qualified Data.Set as Set
 21 | import qualified PlutusLedgerApi.V1.Scripts as P
 22 | import Cardano.Api.Ledger (hashToBytes)
 23 | import qualified PlutusTx.Builtins as BI
 24 | import Cardano.Ledger.Shelley.API (Globals(networkId))
 25 | import System.Environment (getEnv)
 26 | import qualified System.Environment.Blank as Blank
 27 | import Cardano.Kuber.Data.Parsers (parseAddress)
 28 | import qualified Data.Text as T
 29 | import Cardano.Kuber.Console.ConsoleWritable (toConsoleText)
 30 | import Cardano.Kuber.Util
 31 | import GHC.Conc
 32 |     ( writeTVar, readTVarIO, TVar, newTVarIO, readTVar )
 33 | import GHC.Conc.Sync (atomically)
 34 | import Control.Exception (throwIO)
 35 | import qualified Data.ByteString as BS
 36 | import Data.List (nub)
 37 | import Test.TestContext
 38 | 
 39 | testContextFromEnv :: IO (TestContext ChainConnectInfo)
 40 | testContextFromEnv = do
 41 |   chainInfo <- chainInfoFromEnv
 42 |   networkId <- evaluateKontract chainInfo  kGetNetworkId >>= throwFrameworkError
 43 |   sKey <-  getEnv "SIGNKEY_FILE" >>= getSignKey
 44 |   walletAddr <- Blank.getEnv "WALLET_ADDRESS" >>= (\case
 45 |         Just addrStr -> parseAddress $ T.pack addrStr
 46 |         Nothing -> pure ( skeyToAddrInEra sKey networkId)
 47 |       )
 48 | 
 49 |   walletUtxo :: UTxO ConwayEra <- evaluateKontract chainInfo (kQueryUtxoByAddress $ Set.singleton (addressInEraToAddressAny walletAddr)) >>= throwFrameworkError
 50 |   putStrLn $ "WalletAddress  : " ++ T.unpack (serialiseAddress walletAddr)
 51 |   putStrLn $ "Wallet Balance :" ++ (toConsoleText "  "  $ utxoSum walletUtxo)
 52 |   report <- newTVarIO mempty
 53 |   tempreport <- newTVarIO mempty
 54 |   tagMetrics <- newTVarIO mempty
 55 | 
 56 |   pure$ TestContext {
 57 |       tcChainInfo = chainInfo
 58 |     , tcNetworkId = networkId
 59 |     , tcSignKey = sKey
 60 |     , tcWalletAddr = walletAddr
 61 |     , tcReports = report
 62 |     , tcTempReport = tempreport
 63 |     , tcTagMetrics = tagMetrics
 64 |   }
 65 | 
 66 | readSaleAndRefScriptVar ::  (TVar (Maybe TxId),TVar (Maybe TxId)) -> IO  ( TxId,TxId)
 67 | readSaleAndRefScriptVar (a,b) = do
 68 |      a'<-readSaleTxVar' a
 69 |      b' <- readRefUtxoTxVar' b
 70 |      pure (a',b')
 71 | 
 72 | readSaleTxVar'  saleVar =  readTxId saleVar "Sale"
 73 | readRefUtxoTxVar'  utxoVAr =   readTxId utxoVAr "Reference Script"
 74 | 
 75 | readSaleTxVar v = liftIO $ readSaleTxVar' v
 76 | readRefUtxoTxVar v = liftIO $ readRefUtxoTxVar' v
 77 | readConfigTxVar  utxoVAr =  liftIO $ readTxId utxoVAr "Market Config"
 78 | 
 79 | readTxId :: TVar (Maybe TxId) -> String ->  IO TxId
 80 | readTxId mTvar tag= do
 81 |   val <- readTVarIO mTvar
 82 |   case val of
 83 |       Nothing ->do
 84 |         let message=tag ++ " transaction was not successful"
 85 |         expectationFailure message
 86 |         error message
 87 |       Just txId -> pure txId
 88 | 
 89 | runTestContext_   c tVar n k = runTestContext   c tVar n k >> return ()
 90 | 
 91 | runTestContext :: (HasKuberAPI a, HasSubmitApi a, HasChainQueryAPI a) =>   TestContext a -> Maybe (TVar (Maybe TxId)) ->String ->  Kontract a w FrameworkError TxBuilder -> IO TxId
 92 | runTestContext  context txVar testName kontract = do
 93 |   result<-evaluateKontract (tcChainInfo context)  $
 94 |         performTransactionAndReport
 95 |         testName
 96 |         (
 97 |             txWalletSignKey (tcSignKey context)
 98 |           <> txWalletAddress (tcWalletAddr context))
 99 |         kontract
100 |   let setTvar v =
101 |         case txVar of
102 |           Nothing -> pure ()
103 |           Just tvar -> do
104 |               atomically $ writeTVar  tvar v
105 |       appendTvar v a =
106 |         atomically $ do
107 |             val <- readTVar v
108 |             writeTVar v (val ++ [a])
109 |   case result of
110 |     Left e -> do
111 |       setTvar Nothing
112 |       expectationFailure $ testName ++ ": Marked as Failed"
113 |       throwIO e
114 |     Right tx -> do
115 |       let txId = getTxId $ getTxBody tx
116 |       setTvar (Just txId)
117 |       appendTvar (tcTempReport context) (TxDetail testName tx)
118 |       pure txId
119 | 
120 | 
121 | performTransactionAndReport :: (HasKuberAPI api,HasSubmitApi api,HasChainQueryAPI api) =>
122 |   String ->
123 |   TxBuilder ->
124 |   Kontract api w FrameworkError TxBuilder ->
125 |   Kontract api w FrameworkError (Tx ConwayEra)
126 | performTransactionAndReport action wallet = performTransactionAndReport' action (pure wallet)
127 | 
128 | performTransactionAndReport' :: (HasKuberAPI api,HasSubmitApi api,HasChainQueryAPI api) =>
129 |   String ->
130 |   Kontract api w FrameworkError TxBuilder ->
131 |   Kontract api w FrameworkError TxBuilder ->
132 |   Kontract api w FrameworkError (Tx ConwayEra)
133 | performTransactionAndReport' action walletKontract builderKontract = do
134 |   wallet <- walletKontract
135 |   builder <- builderKontract
136 |   let txBuilder= builder <> wallet
137 |   let errorHandler e= do
138 | 
139 |         liftIO $
140 |           putStrLn   (action ++ " Tx Failed: " ++ show e  ++ "\n" ++ (BS8.unpack $ prettyPrintJSON (txBuilder)))
141 |         KError e
142 | 
143 |   tx <- catchError  (do
144 |       tx<- kBuildTx txBuilder
145 |       kSubmitTx (InAnyCardanoEra ConwayEra tx)
146 |       liftIO $ putStrLn $ "Tx Submitted :" ++  (getTxIdFromTx tx)
147 |       pure tx
148 |     )
149 |     errorHandler
150 | 
151 |   let txEnvelope =  serialiseTxLedgerCddl ShelleyBasedEraConway tx
152 |   liftIO $ do
153 |     putStrLn $ action ++ " Tx submitted : " ++ (BS8.unpack $  prettyPrintJSON txEnvelope)
154 |     reportExUnitsandFee tx
155 | 
156 |   waitTxConfirmation tx 180
157 |   liftIO $ do putStrLn $ action ++ " Tx Confirmed: " ++ (show $ getTxId (getTxBody tx))
158 |   pure (tx)
159 | 
160 | runBuildAndSubmit :: (HasKuberAPI api, HasSubmitApi api) => TxBuilder -> Kontract api w FrameworkError (Tx ConwayEra)
161 | runBuildAndSubmit txBuilder =  do
162 |         tx<- kBuildTx txBuilder
163 |         kSubmitTx (InAnyCardanoEra ConwayEra tx)
164 |         liftIO $ putStrLn $ "Tx Submitted :" ++  (getTxIdFromTx tx)
165 |         pure tx
166 | 
167 | reportExUnitsandFee:: Tx ConwayEra -> IO ()
168 | reportExUnitsandFee tx = case tx of
169 |   ShelleyTx era ledgerTx -> let
170 |     txWitnesses = ledgerTx ^. L.witsTxL
171 |     sizeLedger = ledgerTx ^. L.sizeTxF
172 |     sizeCapi = fromIntegral $  BS.length  $ serialiseToCBOR tx
173 |     -- this should be exUnits of single script involved in the transaction
174 |     exUnits = map snd $ map snd $  Map.toList $ L.unRedeemers $  txWitnesses ^. L.rdmrsTxWitsL
175 |     txFee=L.unCoin $ ledgerTx ^. L.bodyTxL ^. L.feeTxBodyL
176 |     in do
177 |       (euMem,euCpu) <-case exUnits of
178 |             [eunit]-> let eu = L.unWrapExUnits eunit
179 |                           (mem,cpu) =   (L.exUnitsMem' eu,L.exUnitsSteps' eu)
180 |                       in do
181 |                         putStrLn $  "ExUnits     :  memory = " ++ show mem ++ " cpu = " ++ show cpu
182 |                         pure (toInteger mem, toInteger cpu)
183 |             _       -> pure  (0,0)
184 |       putStrLn $  "Fee      :   " ++ show txFee
185 |       if sizeLedger /= sizeCapi
186 |         then do
187 |           putStrLn $  "Tx Bytes (ledger):   " ++ show sizeLedger
188 |           putStrLn $  "Tx Bytes (api)   :   " ++ show sizeCapi
189 |         else
190 |           putStrLn $  "Tx Bytes  :   " ++ show sizeCapi
191 | 
192 | 
193 | 
194 | waitTxConfirmation :: HasChainQueryAPI a => Tx ConwayEra -> Integer
195 |       -> Kontract a w FrameworkError ()
196 | waitTxConfirmation tx totalWaitSecs =
197 |     let txId = getTxId$ getTxBody tx
198 |     in waitTxId txId  totalWaitSecs
199 |   where
200 |     waitTxId txId remainingSecs =
201 |       if remainingSecs < 0
202 |         then kError TxSubmissionError $ "Transaction not confirmed after  " ++ show totalWaitSecs ++ " secs"
203 |         else do
204 |           (UTxO uMap):: UTxO ConwayEra <- kQueryUtxoByTxin $  Set.singleton (TxIn txId (TxIx 0))
205 |           liftIO $ Control.threadDelay 0
206 |           case Map.toList uMap of
207 |             [] -> waitTxId txId (remainingSecs - 2)
208 |             _ -> pure ()


--------------------------------------------------------------------------------
/frontend/src/components/Listing.vue:
--------------------------------------------------------------------------------
  1 | <script setup lang="ts">
  2 | 
  3 | import type {CIP30Instace, CIP30Provider} from "@/types";
  4 | import {Buffer} from "buffer";
  5 | import {listMarket, getAssetDetail, getDatum} from "@/scripts/blockfrost";
  6 | import {decodeAssetName, listProviders, callKuberAndSubmit, transformNftImageUrl, renderLovelace} from "@/scripts/wallet";
  7 | import * as database from "@/scripts/database"
  8 | import {market} from "@/config";
  9 | import {Address, BaseAddress, Ed25519KeyHash, StakeCredential} from "@emurgo/cardano-serialization-lib-asmjs";
 10 | import {walletAction} from "@/scripts/sotre"
 11 | </script>
 12 | 
 13 | <template>
 14 |   <div>
 15 |     <div class=" ml-2"> 
 16 |       <div v-if="utxos.length==0" class="text-gray-400 font-semibold text-center my-5"> {{message}}</div>
 17 |       <div v-for="utxo in utxos" :key="utxo.id" class="p-2 flex">
 18 |         <img :alt="utxo.assetName +'_img'" class="inline-block h-32 w-32  mr-4 border-red-300 border-2" :src="utxo.detail._imageUrl"/>
 19 |         <div class="flex flex-col justify-between pb-2">
 20 |           <div>
 21 | 
 22 |             <div v-if="utxo.detail._name">
 23 |               <a :href="'https://testnet.cardanoscan.io/token/'+utxo.nft"> &#x29c9; </a>
 24 | 
 25 |               <span class="text-blue-900 text-xl font-extrabol"> {{ utxo.detail._name }}  </span>
 26 |               <span v-if="utxo.detail?.onchain_metadata?.artist"> <span
 27 |                   class="text-gray-400 text-xs"> &nbsp; by {{ utxo.detail.onchain_metadata.artist }}</span>  </span>
 28 |             </div>
 29 | 
 30 |             <div v-else class="text-blue-700 font-extrabold"> {{ utxo.policy.substring(0, 8) }}...{{
 31 |                 utxo.assetName
 32 |               }}
 33 |             </div>
 34 | 
 35 |             <div v-if="utxo.detail?.onchain_metadata">
 36 |               <div v-if="utxo.detail.onchain_metadata.description" class="text-gray-500">
 37 |                 {{ mapDescription(utxo.detail.onchain_metadata.description) }}
 38 |               </div>
 39 | 
 40 |               <div v-if="utxo.detail.onchain_metadata.copyright" class="text-gray-500"> Copyright:
 41 |                 {{ utxo.detail.onchain_metadata.copyright }}
 42 |               </div>
 43 |             </div>
 44 |           </div>
 45 |           <div>
 46 |             <button  @click="buy(utxo)"
 47 |                 class="bg-transparent hover:bg-blue-300 text-blue-700 font-semibold hover:text-white py-2 px-4 border border-blue-500 hover:border-blue-200 rounded">
 48 |               {{
 49 |                 renderLovelace(utxo.detail?.datum?.fields[1]?.int)
 50 |               }} Ada (Buy)
 51 |             </button>
 52 |           </div>
 53 |         </div>
 54 |       </div>
 55 |     </div>
 56 |   </div>
 57 | </template>
 58 | <script lang="ts">
 59 | export default {
 60 |   created() {
 61 |     const _this = this
 62 |     let db;
 63 |     return database.openDB().then(dbInstance => {
 64 |       _this.hasIndexDb = db
 65 |       db = dbInstance
 66 |     }).finally(() => {
 67 |       return listMarket().then(response => {
 68 |         console.log("All  Marketet utxos", response)
 69 |         let utxos: Array<any> = response.filter(utxo => {
 70 |           const amount_ = utxo.amount.filter(x => x.unit !== 'lovelace')
 71 |           if (amount_.length == 1 && amount_[0].quantity == 1) {
 72 |             const nft: string = amount_[0].unit
 73 |             const policy = nft.substring(0, 56)
 74 |             const asset = nft.substring(56)
 75 |             const assetUtf8 = decodeAssetName(asset)
 76 |             utxo.policy = policy
 77 |             utxo.assetName = assetUtf8
 78 |             utxo.detail = {}
 79 |             utxo.nft = nft
 80 |             utxo.id = utxo.tx_hash + '#' + utxo.tx_index
 81 |             return true
 82 |           } else {
 83 |             return false
 84 |           }
 85 |         })
 86 |         const readHandle = db && database.getReadHandle(db)
 87 |         return Promise.allSettled(utxos.map((utxo, i) => {
 88 |           return database.getUtxo(readHandle, utxo.id).then(v => {
 89 |             return v
 90 |           }).catch(e => {
 91 |             console.log("Error returned from db", e)
 92 |             return getDatum(utxo.data_hash)
 93 |                 .then(dataResponse => {
 94 |                       utxo.datum = dataResponse.json_value
 95 |                       return getAssetDetail(utxo.nft)
 96 |                     }
 97 |                 ).then((nftDetail: any) => {
 98 |                   if (nftDetail.onchain_metadata) {
 99 |                     if (nftDetail.onchain_metadata) {
100 |                       if (nftDetail.onchain_metadata.name) {
101 |                         nftDetail._name = nftDetail.onchain_metadata.name
102 |                       }
103 |                       if (nftDetail.onchain_metadata.image) {
104 |                         nftDetail._imageUrl =transformNftImageUrl(nftDetail.onchain_metadata.image)
105 |                       }
106 |                     }
107 |                   }
108 |                   nftDetail.utxo = utxo.id
109 |                   nftDetail.datum = utxo.datum
110 |                   setTimeout(() => {
111 |                     database.saveUtxos(db, [nftDetail])
112 |                   })
113 |                   return nftDetail
114 |                 }).catch(e => {
115 |                   if (e.status_code && e.status_code == 404) {
116 |                     const data = {
117 |                       utxo: utxo.id,
118 |                       status_code: e.status_code
119 |                     }
120 |                     database.saveUtxos(db, [data])
121 |                     return data
122 |                   } else {
123 |                     console.error(e)
124 |                     throw e
125 |                   }
126 |                 })
127 |           })
128 |         })).then((x: Array<any>) => {
129 |               const lookup = {}
130 |               x.filter(v => v.value && v.value.datum).forEach(
131 |                   x => {
132 |                     lookup[x.value.utxo] = x.value
133 |                   })
134 |               utxos.forEach(v => v.detail = lookup[v.id])
135 |               const validUtxos = utxos.filter(v => v.detail)
136 |               console.log("Valid market utxos", validUtxos)
137 |               this.utxos = validUtxos
138 |               if(validUtxos.length == 0){
139 |                 this.message="Marketplace is empty"
140 |               }
141 |             }
142 |         )
143 |       }).catch((e)=>{
144 |         if(e.status_code == 404){
145 |             this.message="Marketplace is empty"
146 |         }else{
147 |           alert(e.message)
148 |         }
149 |       })
150 |     })
151 |   },
152 |   computed: {},
153 |   data() {
154 |     const providers: Array<CIP30Provider> = [];
155 | 
156 |     return {
157 |       message: "Loading ...",
158 |       hasIndexDb: false,
159 |       utxos: [],
160 |       providers: providers,
161 |       addSelections: true,
162 |       interval: 0,
163 |       timeout: 0,
164 |     };
165 |   },
166 |   methods: {
167 |     mapDescription(desc: Array<string> | string) {
168 |       return Array.isArray(desc) ? desc.join('') : desc
169 |     },
170 |     async buy( utxo) {
171 |       console.log(utxo)
172 |       const datum = utxo.detail.datum
173 |       const cost = datum.fields[1].int;
174 |       const sellerPubKeyHashHex =datum.fields[0].fields[0].fields[0].bytes
175 |       const sellerStakeKeyHashHex = datum.fields[0].fields[1].fields[0].fields[0].fields[0].bytes
176 |       const vkey = StakeCredential.from_keyhash(Ed25519KeyHash.from_bytes(Buffer.from(sellerPubKeyHashHex, "hex")))
177 |       const stakeKey = StakeCredential.from_keyhash(Ed25519KeyHash.from_bytes(Buffer.from(sellerStakeKeyHashHex, "hex")))
178 |       const sellerAddr= BaseAddress.new(0,vkey,stakeKey)
179 |       console.log("SellerAddr",sellerAddr.to_address().to_bech32())
180 | 
181 |       // Create constraints for buying
182 |       walletAction.callback=async (provider : CIP30Instace)=>{
183 |           const request = {
184 |         selections: await provider.getUtxos(),
185 |         inputs: [
186 |           {
187 |             address: market.address,
188 |             utxo: {
189 |               "hash":utxo.tx_hash,
190 |               "index": utxo.tx_index
191 |             },
192 |             script: market.script,
193 |             redeemer: { fields: [], constructor: 0 },
194 |           },
195 |         ],
196 |         outputs: [
197 |           {
198 |             address: sellerAddr.to_address().to_bech32(market.address.startsWith('addr_test')?"addr_test":"addr"),
199 |             value: cost,
200 |             insuffientUtxoAda: "increase"
201 |           }
202 |         ],
203 |       };
204 |       return callKuberAndSubmit(provider,JSON.stringify(request))
205 |       }
206 |       walletAction.enable=true
207 |     },
208 |     save(v: string) {
209 |       localStorage.setItem("editor.content", v);
210 |     },
211 |   }
212 | };
213 | </script>
214 | <style>
215 | @import "../assets/base.css";
216 | </style>
217 | 


--------------------------------------------------------------------------------
/test/Test/TestStoryConfigurableMarket.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE NumericUnderscores #-}
  2 | {-# LANGUAGE LambdaCase #-}
  3 | {-# LANGUAGE ScopedTypeVariables #-}
  4 | 
  5 | module Test.TestStoryConfigurableMarket where
  6 | 
  7 | import Test.Hspec
  8 | import Test.Hspec.JUnit
  9 | import Cardano.Kuber.Api
 10 | import System.Environment.Blank (getEnvDefault)
 11 | import Cardano.Kuber.Data.Parsers
 12 | import qualified Data.Text as T
 13 | import System.Environment (getEnv)
 14 | import Cardano.Marketplace.Common.TransactionUtils
 15 | import Cardano.Api
 16 | import qualified Data.ByteString.Char8 as BS8
 17 | import qualified Data.Set as Set
 18 | import GHC.Conc
 19 | import Cardano.Kuber.Util
 20 | import Cardano.Kuber.Console.ConsoleWritable
 21 | import Plutus.Contracts.V2.ConfigurableMarketplace
 22 | import qualified PlutusLedgerApi.V1.Scripts as P
 23 | import qualified Debug.Trace as Debug
 24 | import Test.Common
 25 | import Plutus.Contracts.V2.MarketplaceConfig
 26 | import Cardano.Api.Shelley (toShelleyAddr, toShelleyScriptHash, PlutusScript (..))
 27 | import qualified PlutusTx.Builtins as BI
 28 | import Data.Maybe (fromJust)
 29 | import Cardano.Api (prettyPrintJSON)
 30 | import Cardano.Marketplace.ConfigurableMarketplace
 31 | import Cardano.Marketplace.V2.Core (makeConfigurableMarketV2Helper, makeConfigurableMarketV2HelperSuperLazy)
 32 | import Cardano.Marketplace.V3.Core (makeConfigurableMarketV3Helper, makeConfigurableMarketV3HelperLazy, makeConfigurableMarketV3HelperSuperLazy)
 33 | import Test.TestContext
 34 | import Test.Reporting (collectReports, addTagMetric)
 35 | import qualified Data.Map as Map
 36 | 
 37 | 
 38 | 
 39 | makeConfigurableMarketSpecs :: Integer -> TestContext ChainConnectInfo -> IO [SpecWith ()]
 40 | makeConfigurableMarketSpecs testIdx tContext = do
 41 |   let makeVars = do
 42 |         saleVar <- newTVarIO Nothing
 43 |         refVar <- newTVarIO Nothing
 44 |         configVar <- newTVarIO Nothing
 45 |         pure (configVar,saleVar,refVar)
 46 |       v2Helper = makeConfigurableMarketV2Helper (tcWalletAddr tContext) 3_000_000
 47 |       v2HelperSuperLazy = makeConfigurableMarketV2HelperSuperLazy (tcWalletAddr tContext) 3_000_000
 48 |       v3Helper = makeConfigurableMarketV3Helper (tcWalletAddr tContext) 3_000_000
 49 |       v3HelperLazy = makeConfigurableMarketV3HelperLazy (tcWalletAddr tContext) 3_000_000
 50 |       v3HelperSuperLazy = makeConfigurableMarketV3HelperSuperLazy (tcWalletAddr tContext) 3_000_000
 51 |   v2Vars <- makeVars
 52 |   v2SuperLazyVars <- makeVars
 53 |   v3Vars <- makeVars
 54 |   v3VarsLazy <- makeVars
 55 |   v3VarsSuperLazy <- makeVars
 56 |   addTagMetric tContext (TagMetric "Configurable Market" "V2" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ cmMarketScript v2Helper ))
 57 |   addTagMetric tContext (TagMetric "Configurable Market" "V2 Super Lazy" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ cmMarketScript v2HelperSuperLazy ))
 58 |   addTagMetric tContext (TagMetric "Configurable Market" "V3" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ cmMarketScript v3Helper ))
 59 |   addTagMetric tContext (TagMetric "Configurable Market" "V3 Lazy" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ cmMarketScript v3HelperLazy ))
 60 |   addTagMetric tContext (TagMetric "Configurable Market" "V3 Super Lazy" "ScriptBytes" (show $ txScriptByteSize $ TxScriptPlutus $ cmMarketScript v3HelperSuperLazy ))
 61 | 
 62 |   pure [
 63 |       afterAll
 64 |           (\x -> collectReports  "Configurable Market" "V2" tContext )
 65 |           $ simpleMarketSpecs testIdx "ConfigurableMarketV2 Flow" v2Helper tContext (pure v2Vars)
 66 |     , afterAll
 67 |           (\x -> collectReports  "Configurable Market" "V2 Super Lazy" tContext )
 68 |           $ simpleMarketSpecs (testIdx+1) "ConfigurableMarketV2SuperLazy Flow" v2HelperSuperLazy tContext (pure v2SuperLazyVars)
 69 |     , afterAll
 70 |         (\x -> collectReports  "Configurable Market" "V3" tContext)
 71 |         $ simpleMarketSpecs  (testIdx+2) "ConfigurableMarketV3 Flow" v3Helper tContext (pure  v3Vars)
 72 |     , afterAll 
 73 |         (\x -> collectReports  "Configurable Market" "V3 Lazy" tContext) 
 74 |         $ simpleMarketSpecs  (testIdx+3) "ConfigurableMarketV3Lazy Flow" v3HelperLazy tContext (pure  v3VarsLazy)
 75 |     , afterAll 
 76 |         (\x -> collectReports  "Configurable Market" "V3 Super Lazy" tContext) 
 77 |         $ simpleMarketSpecs  (testIdx+4) "ConfigurableMarketV3SuperLazy Flow" v3HelperSuperLazy tContext (pure  v3VarsSuperLazy)
 78 |     ]
 79 | 
 80 | simpleMarketSpecs::  Integer ->  String -> ConfigurableMarketHelper -> TestContext ChainConnectInfo -> IO (TVar (Maybe TxId), TVar (Maybe TxId),TVar (Maybe TxId)) -> SpecWith ()
 81 | simpleMarketSpecs testIndex scriptName marketHelper context@(TestContext chainInfo networkId sKey walletAddr _ _ _ )  ioAction =
 82 |   let
 83 |       operatorAddr = walletAddr
 84 |       treasuryAddr= walletAddr
 85 | 
 86 |       marketFee = 3_000_000
 87 |       (mintedAsset,mintBuilder) = mintNativeAsset (getVerificationKey sKey) (AssetName $ BS8.pack "TestToken") 4
 88 |       runTest_ index mRef str tb = do
 89 |         putStrLn $ (show testIndex ++ "." ++ show index ++" "++scriptName ++ " : " ++ show str)
 90 |         runTestContext_  context mRef str tb
 91 |       marketAddressInEra = plutusScriptAddr  (cmMarketScript marketHelper)  networkId
 92 |       configAddressInEra = plutusScriptAddr (cmConfigScript marketHelper) networkId
 93 |     in do
 94 |     let
 95 |     describe scriptName $ do
 96 |       before ioAction $ do
 97 |         it "Should mint  4 Native Assets" $ \(configTx,saleTx, refUtxo) -> do
 98 |           runTest_ 1 Nothing "Mint Native Asset"  (do
 99 |               (UTxO utxos) ::UTxO ConwayEra <- kQueryUtxoByAddress (Set.singleton $ addressInEraToAddressAny walletAddr)
100 |               pure $     mintBuilder
101 |                       <> txConsumeUtxos (UTxO $ Map.fromList $ take 100  $ Map.toList utxos)
102 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,5_000_000)])
103 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,10_000_000)])
104 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,20_000_000)])
105 |                       <> txPayTo walletAddr (valueFromList [(AdaAssetId,30_000_000)])
106 |                       -- create extra utxos that might be required
107 |               )
108 | 
109 |         it "Should create reference script UTxO" $ \(configTx,saleTx, refUtxo) -> do
110 |           runTest_ 2
111 |                 (Just refUtxo)
112 |                 "Create reference script UTxO"
113 |                 (pure $ createReferenceScript (cmMarketScript marketHelper) marketAddressInEra )
114 | 
115 |         it "Should place 4 tokens on sale" $ \(configTx,saleTx, refUtxo) -> do
116 |           let sellTxBuilder = sellBuilder marketHelper marketAddressInEra (valueFromList [(mintedAsset,1)] ) 10_000_000 walletAddr
117 |           runTest_ 3
118 |             (Just saleTx)
119 |             "Place on Sell"
120 |             (pure $ mconcat $ take 4 $ repeat  sellTxBuilder )
121 | 
122 |         it "Should create market configuration" $ \(configTx,saleTx, refUtxo) -> do
123 |           runTest_ 4
124 |             (Just configTx)
125 |                 "Create market configuration"
126 |                 (pure $ txPayToScriptWithData
127 |                         configAddressInEra  mempty (cmConfigDatum marketHelper))
128 |         
129 |         it "Should withdraw 1 token from sale" $ \(configTx,saleTx, refUtxo) -> do
130 |           saleTxId <- readSaleTxVar saleTx
131 |           let txBuilder = withdrawTokenBuilder marketHelper Nothing (TxIn saleTxId (TxIx 0))
132 |           runTest_ 5 Nothing "Withdraw" txBuilder
133 | 
134 |         it "Should withdraw 1 token from sale with reference script" $ \(configTx,saleTx, refUtxo) -> do
135 |           saleTxId <- readSaleTxVar saleTx
136 |           refTxId <- readConfigTxVar refUtxo
137 |           let txBuilder = withdrawTokenBuilder marketHelper (Just $ TxIn refTxId (TxIx 0)) (TxIn saleTxId (TxIx 1) )
138 |           runTest_ 6 Nothing "Withdraw with RefScript" txBuilder
139 | 
140 | 
141 | 
142 |         it "Should buy 1 token from sale" $ \(configTx,saleTx, refUtxo) -> do
143 |           saleTxId <- readSaleTxVar saleTx
144 |           configTxId <- readConfigTxVar configTx
145 |           let
146 |             feeInfo = (operatorAddr, marketFee , TxIn configTxId (TxIx 0))
147 |             txBuilder = buyTokenBuilder marketHelper Nothing (TxIn saleTxId (TxIx 2))  (Just feeInfo)
148 |           runTest_ 7 Nothing "Buy" txBuilder
149 | 
150 |         it "Should buy 1 token from sale with reference script" $ \tvars -> do
151 |           (configTxId,saleTxId,refTxId)<- readConfigSaleAndRefScriptVar  tvars
152 |           let
153 |             operatorAddress =operatorAddr
154 |             feeInfo = (operatorAddress, marketFee, TxIn configTxId (TxIx 0))
155 |             txBuilder = buyTokenBuilder marketHelper (Just $ TxIn refTxId (TxIx 0)) (TxIn saleTxId (TxIx 3))  (Just feeInfo)
156 |           runTest_ 8 Nothing "Buy with RefScript" txBuilder
157 | 
158 | 
159 | readConfigSaleAndRefScriptVar (z,a,b) = do
160 |      z' <- liftIO $ readTxId z "MarketC onfig"
161 |      a'<-liftIO $ readTxId a "Sale"
162 |      b' <- liftIO $ readTxId b "Reference Script"
163 |      pure (z',a',b')
164 | 


--------------------------------------------------------------------------------
/benchmark/Reporting.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE ScopedTypeVariables #-}
  2 | 
  3 | module Reporting where
  4 | 
  5 | import Data.Time.Clock (UTCTime, diffUTCTime, NominalDiffTime)
  6 | import Data.List (nub)
  7 | import Data.Time.Format (defaultTimeLocale, formatTime)
  8 | import Numeric (showFFloat)
  9 | import qualified Data.ByteString as BS
 10 | import Statistics.Sample (mean, stdDev)
 11 | import qualified Data.Vector as V
 12 | import Cardano.Api
 13 | import ParallelUtils
 14 | import Cardano.Api.Shelley (Tx(ShelleyTx))
 15 | import qualified Cardano.Ledger.Core as L
 16 | import Control.Lens ( (^.) )
 17 | import qualified Cardano.Ledger.Plutus as L
 18 | import qualified Data.Map as Map
 19 | import qualified Cardano.Ledger.Coin as L
 20 | import qualified Cardano.Ledger.Alonzo.TxWits as L
 21 | import qualified Data.Text as T
 22 | import Cardano.Kuber.Api (FrameworkError)
 23 | import Data.Either (isRight, rights)
 24 | import Data.Bifunctor (second)
 25 | 
 26 | -- Existing functions
 27 | 
 28 | writeBenchmarkReport :: [Either FrameworkError BenchRun] -> FilePath -> IO ()
 29 | writeBenchmarkReport benchRuns filePath = do
 30 |     let reportLines = renderBenchmarkReports benchRuns
 31 |     writeFile filePath (unlines $  reportLines ++ renderDetailedBenchmarkReports (rights benchRuns))
 32 | 
 33 | renderBenchmarkReports :: [Either FrameworkError BenchRun] -> [String]
 34 | renderBenchmarkReports benchRuns =
 35 |     let
 36 |         successfulRuns = rights  benchRuns
 37 |         testNames = nub . concatMap (map ttTxName . brTimings) $ successfulRuns
 38 |         (averages, stdDevs) = calculateStats successfulRuns testNames
 39 |     in
 40 |         ["# Benchmark Report"]
 41 |         ++
 42 |         [ "<style>"
 43 |         , "  .highlight {"
 44 |         , "    background-color: #f8d7da;"
 45 |         , "  }"
 46 |         , "</style>"
 47 |         ]
 48 |         ++ ["### Transaction times\n"]
 49 |         ++ renderStats averages stdDevs (testNames++ ["Total Time"])
 50 |         ++ ["\n### Time Details\n"]
 51 |         ++ ["<table border=\"1\">"]
 52 |         ++ tableHeaderBenchmark (testNames)
 53 |         ++ concatMap (renderReportRowBenchmark testNames averages) benchRuns
 54 |         ++ ["</table>"]
 55 | 
 56 | calculateStats :: [BenchRun] -> [String] -> ([(String, Double)], [(String, Double)])
 57 | calculateStats benchRuns testNames =
 58 |     let
 59 |         allTimings = concatMap brTimings benchRuns
 60 |         timingByName name = filter ((== name) . ttTxName) allTimings
 61 |         totalTestTimes = map (\x -> do  
 62 |             (brEndTime x) `diffUTCTime` (brStartTime x) ) benchRuns
 63 |         totalTime = [("Total Time", V.fromList $ map realToFrac totalTestTimes)]
 64 |         timingsMap = map (\name -> (name, V.fromList $ map (realToFrac . diffUTCTime' ) $ timingByName name)) testNames
 65 |         means = map (second mean) (timingsMap ++ totalTime)
 66 |         stdDevs = map (second stdDev) (timingsMap ++ totalTime)
 67 |     in
 68 |         (means, stdDevs)
 69 |   where
 70 |     diffUTCTime' tt = diffUTCTime (ttEndTime tt) (ttStartTime tt)
 71 |     getTime :: String -> [TransactionTime] -> TransactionTime
 72 |     getTime name tts = head $ filter ((== name) . ttTxName) tts
 73 | 
 74 | renderStats :: [(String, Double)] -> [(String, Double)] -> [String] -> [String]
 75 | renderStats averages stdDevs testNames =
 76 |     let
 77 |         theader = ["<tr><th> </th>"]
 78 |                 ++  map (\name -> "<th>" ++ name ++ "</th>")   testNames
 79 |                 ++ ["</tr>"]
 80 |         avgHeader = "<tr><th>Average</th>" ++ concatMap (renderStat averages) testNames ++ "</tr>"
 81 |         stdDevHeader = "<tr><th>Std Deviation</th>" ++ concatMap (renderStat stdDevs) testNames ++ "</tr>"
 82 |     in
 83 |         ["<table border=\"1\">"] ++ theader ++ [ avgHeader, stdDevHeader, "</table>"]
 84 | 
 85 | renderStat :: [(String, Double)] -> String -> String
 86 | renderStat stats name =
 87 |     case lookup name stats of
 88 |         Just value -> "<td>" ++ showFFloat (Just 3) value "" ++ "</td>"
 89 |         Nothing -> "<td>-</td>"
 90 | 
 91 | renderReportRowBenchmark :: [String] -> [(String, Double)] -> Either FrameworkError BenchRun -> [String]
 92 | renderReportRowBenchmark testNames averages benchRun =
 93 |     let
 94 |         formatDuration :: NominalDiffTime -> String
 95 |         formatDuration duration = showFFloat (Just 3) (realToFrac duration :: Double) ""
 96 |         getReport tMap testName = case lookup testName tMap of
 97 |             Just duration -> let
 98 |                 avg = lookup testName averages
 99 |                 classAttr = case avg of
100 |                     Just a -> if realToFrac duration > a then " class=\"highlight\"" else ""
101 |                     Nothing -> ""
102 |                 in "<td" ++ classAttr ++ ">" ++ formatDuration duration ++ "</td>"
103 |             Nothing -> "<td>-</td>"
104 |     in
105 |         ["<tr>"]++
106 |         (case benchRun of
107 |             Left error -> [
108 |                  "<td colspan=" ++ show (length testNames + 1) ++ ">" ++ show error ++ "</td>"
109 |                 ]
110 |             Right successRun ->
111 |               let  timingsMap = map (\tt -> (ttTxName tt, diffUTCTime (ttEndTime tt) (ttStartTime tt))) (brTimings successRun)
112 |                 in
113 |                 ("<td>" ++ show (brId successRun) ++ "</td>")
114 | 
115 |                     : map (getReport timingsMap) testNames)
116 |         ++ ["</tr>"]
117 | 
118 | tableHeaderBenchmark :: [String] -> [String]
119 | tableHeaderBenchmark testNames =
120 |     let
121 |         headers = concatMap (\name -> ["<th>" ++ name ++ "</th>"]) testNames
122 |     in
123 |         [ "<thead>"
124 |         , "<tr>"
125 |         , "<th>Run ID</th>"
126 |         ]
127 |         ++ headers
128 |         ++ ["</tr>"
129 |         , "</thead>"]
130 | 
131 | -- New function to write a detailed report
132 | 
133 | writeDetailedBenchmarkReport :: [BenchRun] -> FilePath -> IO ()
134 | writeDetailedBenchmarkReport benchRuns filePath = do
135 |     let reportLines = renderDetailedBenchmarkReports benchRuns
136 |     writeFile filePath (unlines reportLines)
137 | 
138 | renderDetailedBenchmarkReports :: [BenchRun] -> [String]
139 | renderDetailedBenchmarkReports benchRuns =
140 |     let
141 |         allTransactions = concatMap (\(a,b) -> map (\t -> (a,t)) $ brTimings b) (zip [0..] benchRuns)
142 |     in
143 |         ["\n## Transaction Details\n"]
144 |         ++
145 |         [ "<style>"
146 |         , "  .highlight {"
147 |         , "    background-color: #f8d7da;"
148 |         , "  }"
149 |         , "</style>"
150 |         ]
151 |         ++ ["<table border=\"1\">"]
152 |         ++ detailedTableHeader
153 |         ++ concatMap renderDetailedReportRow allTransactions
154 |         ++ ["</table>"]
155 | 
156 | detailedTableHeader :: [String]
157 | detailedTableHeader =
158 |     [ "<thead>"
159 |     , "<tr>"
160 |     , "<th rowspan=2 >Run ID</th>"
161 |     , "<th rowspan=2>Tx Name</th>"
162 |     , "<th rowspan=2>Tx Hash</th>"
163 |     , "<th rowspan=2>Fee</th>"
164 |     , "<th colspan=2>Execution Units</th>"
165 |     , "</tr>"
166 |     , "<tr>"
167 |     , "<th> Mem </th>"
168 |     , "<th> Cpu </th>"
169 |     , "</tr>"
170 |     , "</thead>"
171 |     ]
172 | 
173 | renderDetailedReportRow :: (Integer,TransactionTime) -> [String]
174 | renderDetailedReportRow (index,txTime) =
175 |     [ "<tr>"
176 |                 , "<td>" ++ show index ++ "</td>"
177 |                 , "<td>" ++ ttTxName txTime ++ "</td>"
178 |     ] ++
179 |     case ttTx txTime of
180 |         Right tx -> let
181 |             metrics = getTxMetrics  tx
182 |             fee = show  txTime
183 |             (mem, steps) = case tmExUnit metrics of
184 |                 Just (ExecutionUnits cpu mem) -> (show $ cpu, show $ mem)
185 |                 Nothing -> ("-", "-")
186 |             in
187 |                 [
188 |                   "<td>" ++ T.unpack  (serialiseToRawBytesHexText  (getTxId (getTxBody tx))) ++ "</td>"
189 |                 , "<td>" ++ show (tmFee metrics) ++ "</td>"
190 |                 , "<td>" ++ mem ++ "</td>"
191 |                 , "<td>" ++ steps ++ "</td>"
192 |                 , "</tr>"
193 |                 ]
194 |         Left fe ->[
195 |                  "<td colspan=4>" ++ show fe ++ "</td>"
196 |                 , "</tr>"
197 |                 ]
198 | 
199 | 
200 | getTxMetrics :: Tx ConwayEra -> TxMetrics
201 | getTxMetrics tx = case tx of
202 |   ShelleyTx era ledgerTx -> let
203 |     txWitnesses = ledgerTx ^. L.witsTxL
204 |     lExUnits = map (snd . snd) (Map.toList $ L.unRedeemers $  txWitnesses ^. L.rdmrsTxWitsL)
205 |     eUnits = case lExUnits of
206 |           [eunit]-> let eu = L.unWrapExUnits eunit
207 |                         (mem,cpu) =   (L.exUnitsMem' eu,L.exUnitsSteps' eu)
208 |                     in do
209 |                       Just $ ExecutionUnits mem  cpu
210 |           _       ->  Nothing
211 |     in TxMetrics {
212 |           tmFee = L.unCoin $ ledgerTx ^. L.bodyTxL ^. L.feeTxBodyL
213 |         , tmSize = fromIntegral $  BS.length  $ serialiseToCBOR tx
214 |         , tmSizeL =  ledgerTx ^. L.sizeTxF
215 |         , tmExUnit = eUnits
216 |     }
217 | 
218 | 
219 | data TxMetrics = TxMetrics {
220 |     tmFee:: Integer
221 |   , tmSize :: Integer
222 |   , tmSizeL :: Integer
223 |   , tmExUnit :: Maybe ExecutionUnits
224 | }
225 | 


--------------------------------------------------------------------------------
/test/Test/Reporting.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE ScopedTypeVariables #-}
  2 | module Test.Reporting
  3 | where
  4 | import Cardano.Api
  5 | import Cardano.Api.Shelley
  6 | import Data.List (nub, groupBy)
  7 | import GHC.Conc (readTVar, atomically, writeTVar, readTVarIO)
  8 | import qualified Cardano.Ledger.Shelley.Core as L
  9 | import Control.Lens ((^.))
 10 | import qualified Cardano.Ledger.Alonzo.Scripts as L
 11 | import qualified Data.Map as Map
 12 | import qualified Cardano.Api.Ledger as L
 13 | import qualified Data.ByteString as BS
 14 | import qualified Cardano.Ledger.Alonzo.TxWits as L
 15 | import Test.TestContext
 16 | import qualified Debug.Trace as Debug
 17 | import Data.Map (Map)
 18 | import Data.Foldable (find)
 19 | 
 20 | collectReports:: String -> String -> TestContext a -> IO ()
 21 | collectReports testGroup  partition  context =
 22 |   let tempReportTvar = tcTempReport  context
 23 |       reportsTvar = tcReports context
 24 |   in
 25 |     atomically $ do
 26 |       newReports <- readTVar tempReportTvar
 27 |       writeTVar tempReportTvar []
 28 |       allReports <-  readTVar reportsTvar
 29 |       writeTVar reportsTvar (allReports ++ [TestReport testGroup partition newReports])
 30 | 
 31 | addTagMetric :: TestContext a ->  TagMetric -> IO ()
 32 | addTagMetric tc metric = do
 33 |   let metricVar = tcTagMetrics tc
 34 |   atomically $ do
 35 |     metrics <- readTVar metricVar
 36 |     writeTVar metricVar (metrics ++ [metric])
 37 | 
 38 | 
 39 | getTxMetrics :: Tx ConwayEra -> TxMetrics
 40 | getTxMetrics tx = case tx of
 41 |   ShelleyTx era ledgerTx -> let
 42 |     txWitnesses = ledgerTx ^. L.witsTxL
 43 |     -- this should be exUnits of single script involved in the transaction
 44 |     lExUnits = map snd $ map snd $  Map.toList $ L.unRedeemers $  txWitnesses ^. L.rdmrsTxWitsL
 45 |     eUnits = case lExUnits of
 46 |           [eunit]-> let eu = L.unWrapExUnits eunit
 47 |                         (mem,cpu) =   (L.exUnitsMem' eu,L.exUnitsSteps' eu)
 48 |                     in do
 49 |                       Just $ ExecutionUnits mem  cpu
 50 |           _       ->  Nothing
 51 |     in TxMetrics {
 52 |           tmFee = L.unCoin $ ledgerTx ^. L.bodyTxL ^. L.feeTxBodyL
 53 |         , tmSize = fromIntegral $  BS.length  $ serialiseToCBOR tx
 54 |         , tmSizeL =  ledgerTx ^. L.sizeTxF
 55 |         , tmExUnit = eUnits
 56 |     }
 57 | 
 58 | 
 59 | data TxMetrics = TxMetrics {
 60 |     tmFee:: Integer
 61 |   , tmSize :: Integer
 62 |   , tmSizeL :: Integer
 63 |   , tmExUnit :: Maybe ExecutionUnits
 64 | }
 65 | 
 66 | 
 67 | writeReports :: TestContext a -> FilePath -> IO ()
 68 | writeReports context filePath = do
 69 |   reports <- readTVarIO (tcReports context)
 70 |   tagMetrics <- readTVarIO (tcTagMetrics context)
 71 |   let reportLines = renderReports reports tagMetrics
 72 |   writeFile filePath (unlines reportLines)
 73 | 
 74 | renderReports :: [TestReport] -> [TagMetric] -> [String]
 75 | renderReports testReports tagMetrics=
 76 |   let
 77 |     groups = nub (map trTestGroup testReports)
 78 |     testsByGroup :: Map String [TestReport] =
 79 |                 Map.fromList $ map
 80 |                 (\grpName -> (grpName,filter (\testReport  -> grpName == trTestGroup testReport) testReports ))
 81 |                 groups
 82 |     tagsByGroup :: Map String [TagMetric] =
 83 |           Map.fromList $ map
 84 |               (\grpName -> ( grpName,filter (\tagMetric  -> grpName == tmTestGroup  tagMetric) tagMetrics))
 85 |               groups
 86 |     tagMetric group = case Map.lookup group tagsByGroup of
 87 |             Nothing -> []
 88 |             Just v -> renderTagMetrics group v
 89 |     in
 90 |       ["# Test Transaction Report"]
 91 |       ++
 92 |       [ "<style>"
 93 |         , "  .improved {"
 94 |         , "    background-color: #d4edda;"
 95 |         , "  }"
 96 |         , "  .declined {"
 97 |         , "    background-color: #f8d7da;"
 98 |         , "  }"
 99 |         , "</style>"
100 |         ]
101 |       ++
102 |       concatMap  (\group ->tagMetric group ++  case Map.lookup group testsByGroup of
103 |             Nothing -> []
104 |             Just v -> renderGroupedReports group v
105 |         ) groups
106 | 
107 | renderGroupedReports :: String ->  [TestReport] -> [String]
108 | renderGroupedReports groupName testReports =
109 |   let
110 |       tags =  nub (map trTag testReports)
111 |       flatTests = concat $ map (\tr -> ( map (\txDetails -> ( trTag tr, tdTestName txDetails, txDetails))) (trTxDetail tr) ) testReports
112 |       testsByName = aggregateTests flatTests
113 | 
114 |       aggregateTests :: (Ord b) => [(a, b, c)] -> Map.Map b [(a, c)]
115 |       aggregateTests = foldr (\(a, b, c) -> Map.insertWith (++) b [(a, c)]) Map.empty
116 | 
117 |       allTestsTxs = concat $  map trTxDetail testReports
118 | 
119 |       testNames = nub (map  tdTestName allTestsTxs )
120 |       testDetailMetric  (tag, (TxDetail tName tx )) = (tag,getTxMetrics tx)
121 |       lookupStrict a b = case Map.lookup a b of
122 |           Just v -> v
123 |           Nothing -> error "Unexpected"
124 |   in
125 | 
126 |    
127 |       ["\n<table border=\"1\">"]
128 |       <> tableHeader (Debug.trace ("Tags:"<> show tags) tags)
129 |       <>(
130 |           concat $ map (\testName ->
131 |             renderReportRow tags testName  (map testDetailMetric (lookupStrict  testName testsByName))
132 |           ) testNames )
133 |       <>
134 |       ["</table>"]
135 | 
136 | 
137 | renderTagMetrics :: String -> [TagMetric] -> [String]
138 | renderTagMetrics groupName metrics = let
139 |   metricNames = nub $  map tmMetricName metrics
140 |   metricCount = length metricNames
141 |   -- Step 2: Group metrics by tmTag
142 |   groupedMetrics :: [[TagMetric]]
143 |   groupedMetrics = groupBy (\x y -> tmTag x == tmTag y) metrics
144 | 
145 |   -- Step 3: Generate Markdown table rows
146 |   markdownRows = map (\group -> renderTagMetricRow group) groupedMetrics
147 | 
148 |   in [
149 |         "\n### " ++ groupName,
150 |         "\n| - |" ++ concatMap (\mn ->  " "++ mn ++ " |") metricNames,
151 |         "| --- |" ++ concat (replicate metricCount "  --- |")] ++  markdownRows
152 | 
153 | -- Helper function to render a single Markdown table row for a group of metrics
154 | renderTagMetricRow :: [TagMetric] -> String
155 | renderTagMetricRow metrics =
156 |   let
157 |     -- Extract tag name and metrics
158 |     tagName = tmTag (head metrics)
159 |     metricNames = nub $ map tmMetricName metrics
160 |     metricValues = map (\name -> findMetricValue name metrics) metricNames
161 | 
162 |     -- Render the row in Markdown format
163 |     tagCell = "| " ++ tagName ++ " "
164 |     metricCells = concatMap (\value -> "| " ++ value ++ " ") metricValues
165 |     markdownRow = tagCell ++ metricCells ++ "|"
166 |   in markdownRow
167 | 
168 | -- Helper function to find metric value by metric name
169 | findMetricValue :: String -> [TagMetric] -> String
170 | findMetricValue metricName metrics =
171 |   case find (\metric -> tmMetricName metric == metricName) metrics of
172 |     Just metric -> tmMetric metric
173 |     Nothing -> "-"
174 | 
175 | renderReportRow :: [String] -> String -> [(String,TxMetrics)] -> [String]
176 | renderReportRow orderedTagList testName results =
177 |   let
178 |       resultMap = Map.fromList results
179 |       -- getReport f =  map (\(_tag,metric) ->  "<td>" ++  show (f metric)  ++ "</td>") results
180 | 
181 |       -- this is recursive function to loop over the results in each tag 
182 |       -- and render them with improved/no-imporved color 
183 |       getReport' ::(Integral a,Show a )=>  (TxMetrics ->  a) -> Maybe a -> [String]  -> [String]
184 |       getReport' f  _  [] = []
185 |       getReport' f Nothing  (tag:remainingTag) =
186 |           case Map.lookup tag resultMap of
187 |               Nothing ->  Debug.trace ("Lookup " ++  tag ++" "++ show (Map.keys resultMap) ) ("<td>" ++  "-"  ++ "</td>") : getReport' f Nothing   remainingTag
188 |               Just metric->  let
189 |                   value = f metric
190 |                 in ("<td>" ++  showNum value  ++ "</td>") : getReport' f (Just value)  remainingTag
191 | 
192 |       getReport' f (Just earlier)  (tag:remainingTag) =
193 |         case Map.lookup tag resultMap of
194 |               Nothing ->  ("<td>" ++  "-"  ++ "</td>") : getReport' f Nothing   remainingTag
195 |               Just metric->  let
196 |                   currentVal = f metric
197 |                 in
198 |                   (if earlier == currentVal
199 |                     then  "<td>" ++  showNum (f metric)  ++ "</td>"
200 |                     else (
201 |                       if earlier < currentVal
202 |                         then "<td class=\"declined\">" ++  showNum (f metric)  ++ "</td>"
203 |                         else "<td class=\"improved\">" ++  showNum (f metric)  ++ "</td>"
204 |                     )
205 |                   ) : getReport' f (Just currentVal) remainingTag
206 |       showNum 0 = "-"
207 |       showNum v = show (v)
208 |       getReport f = getReport' f Nothing orderedTagList
209 |       exUnitf f metric = case tmExUnit metric of
210 |           Nothing -> 0
211 |           Just exunits ->  f exunits
212 |       exMemf = exUnitf executionMemory
213 |       exCpuf =  exUnitf executionSteps
214 | 
215 |     in  [ "<tr>"
216 |         , "  <td>" ++ testName ++ "</td>"
217 |         ]
218 |         ++ getReport exMemf
219 |         ++ getReport exCpuf
220 |         ++ getReport tmFee
221 |         ++ getReport tmSize
222 |         ++[
223 |           "</tr>"
224 |         ]
225 | 
226 | 
227 | tableHeader :: [String] ->  [String]
228 | tableHeader tagList =
229 |   let
230 |       tagLen = length tagList
231 |       tagHtml = map (\tag -> "    <th>" ++ tag ++ "</th>") tagList
232 |       tagHeaders = concat $ take 4 $   repeat tagHtml
233 |     in
234 |       [ "<thead>"
235 |       , "  <tr>"
236 |       , "    <th rowspan=\"" <> show tagLen <> "\">Test Name</th>"
237 |       , "    <th colspan=\"" <> show tagLen <> "\">Ex-Units (Mem)</th>"
238 |       , "    <th colspan=\"" <> show tagLen <> "\">Ex-Units (CPU)</th>"
239 |       , "    <th colspan=\"" <> show tagLen <> "\">Fee</th>"
240 |       , "    <th colspan=\"" <> show tagLen <> "\">Tx Bytes</th>"
241 |       , "  </tr>"
242 |       , "  <tr>"
243 |       ]
244 |       ++ tagHeaders
245 |       ++
246 |       [
247 |         "  </tr>"
248 |       , "</thead>"
249 |       ]


--------------------------------------------------------------------------------
/frontend/src/config.ts:
--------------------------------------------------------------------------------
 1 | 
 2 | export const kuberApiUrl = "http://localhost:8081"
 3 | export const explorerUrl = "https://preview.cexplorer.io"
 4 | export const blockfrost = {
 5 |     apiUrl: "https://cardano-preview.blockfrost.io/api/v0",
 6 |     apiKey: "previewxxxxxxxxxxxxxxxxxxxxxxxxx",  // replace the api key
 7 | }
 8 | 
 9 | 
10 | export const market= {
11 |     // this adress is obtained by using `market-cli ls` command
12 |     address:  "addr_test1wpuxaj2hl67ete0nchuenhc4utmuevep2umnn7ajm0xdfnsmquxcs",
13 |     script: {
14 |         type: 'PlutusScriptV2',
15 |         description: 'SimpleMarketplaceV2',
16 |         // this cbor hex is obtained by using  `market-cli cat`   command
17 |         cborHex:
18 |             '59133d59133a010000323232323322332232323232323322323232323232323232323232323232323232323232323232323322323222232533500110261350244901035054350032323235003225335350022233500223502a00125029215335005153355335333573466e1cd401088cccd54c04448004c8cd405488ccd405800c004008d404c004cd4050888c00cc008004800488cdc00009a801111a80091111a8021119a801124000490011a8011111111111110062400090010178170817899ab9c491164d756c7469706c652073637269707420696e707574730002e15335333573466e20c8c0b4004ccd54c02c4800488cd54c040480048d400488cd540dc008cd54c04c480048d400488cd540e8008ccd40048cc0f52000001223303e00200123303d00148000004cd54c040480048d400488cd540dc008ccd40048cd54c050480048d400488cd540ec008d5405800400488ccd5540440680080048cd54c050480048d400488cd540ec008d54054004004ccd55403005400800540c4c8d4004888888888888ccd54c0604800488d40088888d401088cd400894cd4ccd5cd19b8f017001045044133504600600810082008503e00a350042200200202e02f102f133573892010f53656c6c6572206e6f7420706169640002e102e153353235001222222222222533533355301c1200133501f225335002210031001503425335333573466e3c03c0040f40f04d40d8004540d4010840f440ecd40108800840bc4cd5ce24811853656c6c6572205369676e6174757265204d697373696e670002e13263202a335738920118536372697074204164647265737320696e2073656c6c65720002a333502223232323333333574800846666ae68cdc39aab9d5004480008cccd55cfa8021281511999aab9f50042502b233335573e6ae89401494cd4c8c8c8c8c8c8c8c8c8c8c8c8c8c8ccccccd5d200711999ab9a3370e6aae7540392000233335573ea01c4a07a46666aae7d4038940f88cccd55cfa8071281f91999aab9f500e25040233335573ea01c4a08246666aae7d4038941088cccd55cfa8071282191999aab9f500e25044233335573ea01c4a08a46666aae7d4038941188cccd55cfa8071282391999aab9f500e25048233335573e6ae89403c94cd4cd40d80dcd5d0a80d90a99a99a81b81c1aba1501b21533533503803a35742a03642a66a666aa07a090a0786ae85406c854cd4ccd540f812540f4d5d0a80d90a99a99a81d8231aba1501b2153353335504004804935742a03642a66a646464646666666ae900108cccd5cd19b8735573aa008900011999aab9f500425057233335573ea0084a0b046666aae7cd5d128029299a991919191999999aba400423333573466e1cd55cea8022400046666aae7d4010941808cccd55cfa8021283091999aab9f35744a00a4a66a66a0be0b86ae85401c854cd4c184d5d0a803909a83289198008018010a8318a831128310328320319282f8309282f1282f1282f1282f03089aba25001135573ca00226ea8004d5d0a80390a99a991919191999999aba400423333573466e1cd55cea8022400046666aae7d4010941848cccd55cfa8021283111999aab9f35744a00a4a66a66a0c00ba6ae85401c854cd4c188d5d0a803909a83309198008018010a8320a83192831833032832128300311282f9282f9282f9282f83109aba25001135573ca00226ea8004d5d0a803909a82e09198008018010a82d0a82c9282c82e02d82d1282b02c1282a9282a9282a9282a82c09aba25001135573ca00226ea8004d5d0a80d90a99a99a81f0269aba1501b21533533355043047505335742a03642a66a666aa08809ea0a86ae85406c854cd4c12cd5d0a80d909a82b091999999999998008068060058050048040038030028020018010a82a0a8298a8290a8288a8280a8278a8270a8268a8260a8258a8250a824928248260258250248240238230228220218210208201281e01f1281d9281d9281d9281d81f09aba25001135744a00226ae8940044d5d1280089aba25001135744a00226ae8940044d5d1280089aba25001135744a00226ae8940044d55cf280089baa00135742a00e42a66a60446ae85401c84d40bc48cc00400c008540b4540b0940b00bc0b80b4940a40ac940a0940a0940a0940a00ac4d5d1280089aab9e50011375400200692010f496e76616c696420636f6e7465787400333502123232323333333574800846666ae68cdc3a8012400446666aae7d40108d40a8488004940a40b08cccd5cd19b875003480008cccd55cfa80291a81589100112815016928148158151281392813928139281381509aab9d5002135573ca00226ea800400d240110496e76616c69642072656465656d657200333502023232323333333574800846666ae68cdc39aab9d5004480008cccd55cfa8021281411999aab9f500425029233335573e6ae89401494cd54cd4c074d5d0a803909a816109198008018010a81510a99a98129aba15007213502d30020011502b1502a2502a02d02c02b2502702925026250262502625026029135744a00226aae7940044dd5000801a4810c496e76616c6964206461746100111222333553004120015029335530071200123500122335502e00235500900133355300412001223500222533533355300c12001323350102233350032200200200135001220011233001225335002102f100102c235001223300a0020050061003133502d004003502a00133553007120012350012232335502f003300100532001355031225335001135500a003221350022253353300c002008112223300200a004130060030023200135502a22112225335001100222133005002333553007120010050040011121222300300411212223001004320013550272211225335001150272213350283004002335530061200100400132001355026221122253350011350060032213335009005300400233355300712001005004001123500122001123500122002122123300100300222333573466e3c00800407807448c88ccccccd5d20009280b9280b918019bac002250172501701a320013550222233335573e00246a030a0424a66a60086ae84008854cd4c010d5d1001909a80d19a8110010008a80c0a80b80d11919191999999aba400423333573466e1cd55cea8022400046666aae7d4010940648cccd55cfa8021280d11999aab9f35744a00a4a66a60226ae85401c854cd4c02cd5d0a803909a80f09198008018010a80e0a80d9280d80f00e80e1280c00d1280b9280b9280b9280b80d09aba25001135573ca00226ea80048c8c8c8c8c8ccccccd5d200311999ab9a3370e6aae7540192000233335573ea00c4a03446666aae7d40189406c8cccd55cfa8031280e11999aab9f50062501d233335573e6ae89401c94cd4c044d5d0a80590a99a999aa80800da8079aba1500b215335323232323333333574800846666ae68cdc3a8012400846666aae7d40109409c8cccd55cf9aba25005235029321222300200435742a00c4a05005605446666ae68cdc3a801a400446666aae7d4014940a08cccd55cf9aba2500625335302535742a00e426a056244460020082a0524a05205805646666ae68cdc3a8022400046666aae7d40188d40a8488800c940a40b0940a00a80a40a0940949409494094940940a04d55cea80109aab9e5001137540026ae85402c854cd4cd4054074d5d0a805909a8118919998008028020018010a8108a8100a80f8a80f1280f01081000f80f00e9280c80d9280c1280c1280c1280c00d89aba25001135744a00226ae8940044d55cf280089baa0011335500100c00a112232233333335748002aa00a4a66a60066eac00884d40580045405154015540155401405cc8004d5407c88c8cccd55cf80111a80b280f9299a98031aab9d5002215335300635573ca00642a66a600c6ae8801484d4064cd4084cd5408c00c0080045405c54058540540604d5d0800889280791919191999999aba400423333573466e1cd55cea8022400046666aae7d4010940508cccd55cfa8021280a91999aab9f35744a00a4a66a60226ae85401c854cd4cd402c040d5d0a803909a80c89198008018010a80b8a80b1280b00c80c00b9280980a9280912809128091280900a89aba25001135573ca00226ea8004488c8c8c8ccccccd5d200211999ab9a3370ea004900011999aab9f500425014233335573e6ae89401494cd4c024d5d0a803109a80b9a80b8008a80a9280a80c00b91999ab9a3370ea006900111999aab9f50052350165015250150182501401601525012250122501225012015135573aa00426aae7940044dd500091919191999999aba400423333573466e1d40092006233335573ea0084a02446666aae7cd5d128029299a98059aba150062135015122223004005150132501301601523333573466e1d400d2004233335573ea00a4a02646666aae7cd5d128031299a98069aba150072135016122223002005150142501401701623333573466e1d40112002233335573ea00c4a02846666aae7cd5d128039299a98059aba150082135017122223001005150152501501801723333573466e1d40152000233335573ea00e4a02a46666aae7cd5d128041299a98091aba15009213501812222300300515016250160190182501401601501401325010250102501025010013135573aa00426aae7940044dd500091919191999999aba400423333573466e1cd55cea8022400046666aae7d4010940448cccd55cfa8021280911999aab9f35744a00a4a66a60146ae85401c854cd4c038d5d0a803909a80b09198008018010a80a0a8099280980b00a80a128080091280792807928079280780909aba25001135573ca00226ea80048c8c8ccccccd5d200191999ab9a3370e6aae75400d2000233335573ea0064a01e46666aae7cd5d128021299a98061aba15005213501200115010250100130122500e0102500d2500d2500d2500d010135573ca00226ea80048c8c8c8c8c8c8ccccccd5d200391999ab9a3370ea004900611999aab9f5007235013122222220032501201523333573466e1d400d200a233335573ea01046a028244444440084a02602c46666ae68cdc3a8022401046666aae7d4024940508cccd55cfa8039280a91999aab9f35744a0104a66a60246ae854030854cd4c044d5d0a805109a80c89111111198008048040a80b8a80b1280b00c80c00b91999ab9a3370ea00a900311999aab9f500a25015233335573ea0124a02c46666aae7cd5d128051299a98099aba1500d215335301435742a018426a03424444444660040120102a0302a02e4a02e03403203046666ae68cdc3a8032400846666aae7d402c940588cccd55cfa8059280b91999aab9f35744a0184a66a60226ae854038854cd4c054d5d0a807109a80d89111111198030048040a80c8a80c1280c00d80d00c91999ab9a3370ea00e900111999aab9f500c25017233335573e6ae89403494cd4c044d5d0a807109a80d0911111118038040a80c1280c00d80d11999ab9a3370ea010900011999aab9f500d25018233335573e6ae89403894cd4c048d5d0a807909a80d8911111118028040a80c9280c80e00d9280b80c80c00b80b00a80a0099280812808128081280800989aab9d5005135744a00626ae8940084d5d1280089aab9e500113754002464646464646666666ae900188cccd5cd19b875002480088cccd55cfa8031280811999aab9f500625011233335573ea00c4a02446666aae7cd5d128039299a98069aba1500a215335300e35742a01442a66a601e6ae85402884d405c488ccc00401401000c54054540505404c9404c05805405004c8cccd5cd19b875003480008cccd55cfa8039280891999aab9f35744a0104a66a601a6ae85402484d4050488c00800c540489404805405094040048044940389403894038940380444d55cea80209aba25001135744a00226aae7940044dd500091999999aba4001250082500825008235009375a0044a01001646464646666666ae900108cccd5cd19b875002480088cccd55cfa8021280611999aab9f35744a00a4a66a60126ae85401884d403c488c00400c540349403404003c8cccd5cd19b875003480008cccd55cfa8029280691999aab9f35744a00c4a66a60146ae85401c84d4040488c00800c540389403804404094030038034940289402894028940280344d55cea80109aab9e50011375400246666666ae90004940189401894018940188d401cdd70010048911919191999999aba400423333573466e1d40092004233335573ea00846a01824440024a01601c46666ae68cdc3a801a400446666aae7d4014940308cccd55cf9aba2500625335300a35742a00e426a01e244460060082a01a4a01a02001e46666ae68cdc3a8022400046666aae7d40188d403848880089403404094030038034030940249402494024940240304d55cea80109aab9e50011375400246464646666666ae900108cccd5cd19b875002480088cccd55cfa80211a8050089280480611999ab9a3370ea006900011999aab9f500523500b0112500a00d2500900b00a2500725007250072500700a135573aa00426aae7940044dd50008911299a98018011080089a8030008909118010018891000891931900199ab9c00100349848004c8004d5402488cd400520002235002225335333573466e3c0080340240204c01c0044c01800cc8004d5402088cd400520002235002225335333573466e3c00803002001c40044c01800c4880084880044488008488488cc00401000c448848cc00400c009220100223370000400222464600200244660066004004003',
19 |     },
20 | }
21 | 
22 | 


--------------------------------------------------------------------------------
/reports/benchmark-conway-cardano-node-9.1.0/10-wallets/2024-08-13_06-49-22-transaction-bench.log:
--------------------------------------------------------------------------------
  1 | WalletAddress  : addr_test1qp444s0a5p2t225f3urwwfpyx7v7u9zg0aevtkt05rptkv5l636vkjjyt545wg3dagvzrv23ckltwlr4pzmsrw88jqpssa7hl0
  2 | Wallet Balance :  5.99999637261286e8 Ada
  3 | 0 : Create Ref Script: setup = Finalied
  4 | 0 : Create Ref Script: buildAndSubmit = Finalied
  5 | 0 : Create Ref Script-confirmation : Confirmed "2096a89d81166abad1fee87a6815ab2635f559055d8a5cd48d20d675686b5b1a"
  6 | 0 Generated wallets for batch  buyers : 0-1 sellers : 2-3
  7 | 0 : Fund Wallets: setup = Finalied
  8 | 0 : Fund Wallets: buildAndSubmit = Finalied
  9 | 0 : Fund Wallets-confirmation : Confirmed "f72bc13ffc1f47250e991f1223e78e96c197df3c087b1cc3fb8730bdada84f0a"
 10 | 1 Generated wallets for batch  buyers : 4-5 sellers : 6-7
 11 | 1 : Fund Wallets: setup = Finalied
 12 | 1 : Fund Wallets: buildAndSubmit = Finalied
 13 | 1 : Fund Wallets-confirmation : Confirmed "050107156ea950baeffd5674d408134480f1f497f61637a0b14b196b39ed0039"
 14 | 2 Generated wallets for batch  buyers : 8-9 sellers : 10-11
 15 | 2 : Fund Wallets: setup = Finalied
 16 | 2 : Fund Wallets: buildAndSubmit = Finalied
 17 | 2 : Fund Wallets-confirmation : Confirmed "84bf685ee7aea17f82dafba863dd916718c6ed730ecc348c509ca6331de109bf"
 18 | 3 Generated wallets for batch  buyers : 12-13 sellers : 14-15
 19 | 3 : Fund Wallets: setup = Finalied
 20 | 3 : Fund Wallets: buildAndSubmit = Finalied
 21 | 3 : Fund Wallets-confirmation : Confirmed "09f55064537fd96316ab571117c3320ba2ee7c13968907ad090e24dc9a049b6c"
 22 | 4 Generated wallets for batch  buyers : 16-17 sellers : 18-19
 23 | 4 : Fund Wallets: setup = Finalied
 24 | 4 : Fund Wallets: buildAndSubmit = Finalied
 25 | 4 : Fund Wallets-confirmation : Confirmed "0b6dc7d4e2cde01e6fe6be250f09f2ad43d8ec761e16936481e30f36543328a3"
 26 | 3 : Primary Sale: setup = Finalied
 27 | 4 : Primary Sale: setup = Finalied
 28 | 5 : Primary Sale: setup = Finalied
 29 | 6 : Primary Sale: setup = Finalied
 30 | 7 : Primary Sale: setup = Finalied
 31 | 8 : Primary Sale: setup = Finalied
 32 | 9 : Primary Sale: setup = Finalied
 33 | 0 : Primary Sale: setup = Finalied
 34 | 1 : Primary Sale: setup = Finalied
 35 | 2 : Primary Sale: setup = Finalied
 36 | 7 : Primary Sale: buildAndSubmit = Finalied
 37 | 3 : Primary Sale: buildAndSubmit = Finalied
 38 | 8 : Primary Sale: buildAndSubmit = Finalied
 39 | 6 : Primary Sale: buildAndSubmit = Finalied
 40 | 0 : Primary Sale: buildAndSubmit = Finalied
 41 | 2 : Primary Sale: buildAndSubmit = Finalied
 42 | 9 : Primary Sale: buildAndSubmit = Finalied
 43 | 4 : Primary Sale: buildAndSubmit = Finalied
 44 | 1 : Primary Sale: buildAndSubmit = Finalied
 45 | 5 : Primary Sale: buildAndSubmit = Finalied
 46 | 5 : Primary Sale-confirmation : Confirmed "9fbef672a52b2558fdefd064367631bf6b36add66fa1fc70ae4ee8454d3c03c3"
 47 | 3 : Primary Sale-confirmation : Confirmed "0f718dbbeebbf34f5534fda5a4bcef4fb6b1f3e1de59015b539b4a58b171af51"
 48 | 2 : Primary Sale-confirmation : Confirmed "68c227e6e7a719bec5e61563601fe45665a292d57b8374742de676fc74ec6594"
 49 | 8 : Primary Sale-confirmation : Confirmed "ba20c6841ae6d42a490575f532a277c17fc8fd7e90cc83dd4c09009bf4ca03e2"
 50 | 0 : Primary Sale-confirmation : Confirmed "0f48c24b9f7c67bee30533cb5da63cb132eb0d3dd2c2cf14812573cf351955c2"
 51 | 9 : Primary Sale-confirmation : Confirmed "3074d788bcc67c87fcaa3b22dc13cc479ac794902c0c2e6d9bfcbb748b9e8acb"
 52 | 7 : Primary Sale-confirmation : Confirmed "216a75dfabd05e326c18cf3d10fe73a3855e8448aaf310753c3e99b2cfc62bb6"
 53 | 4 : Primary Sale-confirmation : Confirmed "57c0b0b4f2de2bfee4b9d588245690ff1745829466ba2f6be13328a86dfe1297"
 54 | 1 : Primary Sale-confirmation : Confirmed "70c967a572592f0232d05d1e3ecb1bd7593c0d557954e5e8ea213389caecb376"
 55 | 6 : Primary Sale-confirmation : Confirmed "51354d03b614a8d6792a9f4d7312a5811d2eaa606a21048bb9fcd494a5b95dd6"
 56 | 2 : Primary Buy: setup = Finalied
 57 | 5 : Primary Buy: setup = Finalied
 58 | 3 : Primary Buy: setup = Finalied
 59 | 0 : Primary Buy: setup = Finalied
 60 | 7 : Primary Buy: setup = Finalied
 61 | 4 : Primary Buy: setup = Finalied
 62 | 9 : Primary Buy: setup = Finalied
 63 | 6 : Primary Buy: setup = Finalied
 64 | 8 : Primary Buy: setup = Finalied
 65 | 1 : Primary Buy: setup = Finalied
 66 | 9 : Primary Buy: buildAndSubmit = Finalied
 67 | 2 : Primary Buy: buildAndSubmit = Finalied
 68 | 3 : Primary Buy: buildAndSubmit = Finalied
 69 | 5 : Primary Buy: buildAndSubmit = Finalied
 70 | 4 : Primary Buy: buildAndSubmit = Finalied
 71 | 0 : Primary Buy: buildAndSubmit = Finalied
 72 | 7 : Primary Buy: buildAndSubmit = Finalied
 73 | 1 : Primary Buy: buildAndSubmit = Finalied
 74 | 6 : Primary Buy: buildAndSubmit = Finalied
 75 | 8 : Primary Buy: buildAndSubmit = Finalied
 76 | 6 : Primary Buy-confirmation : Confirmed "b576116d074c6ac32025fb6f15db2f19a1fb7645a2dc8c9245218a0064b8279f"
 77 | 6 : Secondary Sale: setup = Finalied
 78 | 1 : Primary Buy-confirmation : Confirmed "eb584394899aa06a7dea5e1f917ce22e50d1c67d9164718995a8c20188f67627"
 79 | 1 : Secondary Sale: setup = Finalied
 80 | 3 : Primary Buy-confirmation : Confirmed "5825aaec1280e5c649a2318793c9b1b103c620651e1f43e3a1ec7f82d128da81"
 81 | 3 : Secondary Sale: setup = Finalied
 82 | 2 : Primary Buy-confirmation : Confirmed "f5db1c5a37bee0131f1c6f85c9b8bb09b71d5f5535b4759d8d485f1f2e19cd97"
 83 | 2 : Secondary Sale: setup = Finalied
 84 | 9 : Primary Buy-confirmation : Confirmed "172289b7f80c6ccb0ea53d08cf11245daafe43e1f14a7a074bbde9b0b7fd8a16"
 85 | 9 : Secondary Sale: setup = Finalied
 86 | 0 : Primary Buy-confirmation : Confirmed "3775800d1ac2f1a3d8a4737efaba734218d5d2713449588749868b6c0458391f"
 87 | 0 : Secondary Sale: setup = Finalied
 88 | 7 : Primary Buy-confirmation : Confirmed "2212ea135861f2aaba382a3037bdcca3dffc98c047d75253c1e549e2f5a6a18b"
 89 | 7 : Secondary Sale: setup = Finalied
 90 | 5 : Primary Buy-confirmation : Confirmed "c830e495f528a967571dc10fb9ef5d67f39c0cfced5018d11d9b172d748e1f69"
 91 | 5 : Secondary Sale: setup = Finalied
 92 | 4 : Primary Buy-confirmation : Confirmed "a8ab5d8df3affca5370c5d3f3e2e059c84fe5860b19b8ec29e92e8e72287781b"
 93 | 4 : Secondary Sale: setup = Finalied
 94 | 8 : Primary Buy-confirmation : Confirmed "7575342b5910b3421ae311b87635eaf0122d1262a48101c1c23bf95a986d420c"
 95 | 8 : Secondary Sale: setup = Finalied
 96 | 1 : Secondary Sale: buildAndSubmit = Finalied
 97 | 0 : Secondary Sale: buildAndSubmit = Finalied
 98 | 3 : Secondary Sale: buildAndSubmit = Finalied
 99 | 6 : Secondary Sale: buildAndSubmit = Finalied
100 | 9 : Secondary Sale: buildAndSubmit = Finalied
101 | 2 : Secondary Sale: buildAndSubmit = Finalied
102 | 7 : Secondary Sale: buildAndSubmit = Finalied
103 | 5 : Secondary Sale: buildAndSubmit = Finalied
104 | 8 : Secondary Sale: buildAndSubmit = Finalied
105 | 4 : Secondary Sale: buildAndSubmit = Finalied
106 | 2 : Secondary Sale-confirmation : Confirmed "474621169e0e34425ebc2b8cfb233b307e76a1abe41a27750ba9201e405b3799"
107 | 7 : Secondary Sale-confirmation : Confirmed "b667935d0e8006ca8477b1d5633deb0980795f9d76a291774306b7fc1f4284fc"
108 | 5 : Secondary Sale-confirmation : Confirmed "b8850ed2caef8427f4164180248d94f73c6f4d9c6e971e5434b5a65af4a1c16e"
109 | 9 : Secondary Sale-confirmation : Confirmed "5612ed64973e64652c81be0011cf95ae57dda3d281ff51dd799bcb191bdc0988"
110 | 8 : Secondary Sale-confirmation : Confirmed "9938932dc61326c7640d49123da5ac4b7cc19029264df498325ce7e64b6ee1e3"
111 | 1 : Secondary Sale-confirmation : Confirmed "1d64fc13bc2aea28e4eb94344e672c27a2688af9535bc1494d70eecdf0a7be21"
112 | 6 : Secondary Sale-confirmation : Confirmed "b76a2286e42f4554068c296c348f76ee1edb08121e9bcd667b1f18e1c3eab7ce"
113 | 0 : Secondary Sale-confirmation : Confirmed "44f210390b09f0fc7f38efca46322695e624f5aa5c67ab58691c82aa8396059a"
114 | 4 : Secondary Sale-confirmation : Confirmed "b903920e3b54619d729b82170b66669eb622ddfa4d1f0cea12542fa6d3d63800"
115 | 3 : Secondary Sale-confirmation : Confirmed "ca4ef81495304442ac25fb0c9b2f83314804496e9049fca035ad275c87d7e0d4"
116 | 7 : Withdraw: setup = Finalied
117 | 0 : Withdraw: setup = Finalied
118 | 8 : Withdraw: setup = Finalied
119 | 1 : Withdraw: setup = Finalied
120 | 3 : Withdraw: setup = Finalied
121 | 9 : Withdraw: setup = Finalied
122 | 5 : Withdraw: setup = Finalied
123 | 6 : Withdraw: setup = Finalied
124 | 4 : Withdraw: setup = Finalied
125 | 2 : Withdraw: setup = Finalied
126 | 4 : Withdraw: buildAndSubmit = Finalied
127 | 8 : Withdraw: buildAndSubmit = Finalied
128 | 6 : Withdraw: buildAndSubmit = Finalied
129 | 0 : Withdraw: buildAndSubmit = Finalied
130 | 7 : Withdraw: buildAndSubmit = Finalied
131 | 1 : Withdraw: buildAndSubmit = Finalied
132 | 9 : Withdraw: buildAndSubmit = Finalied
133 | 3 : Withdraw: buildAndSubmit = Finalied
134 | 5 : Withdraw: buildAndSubmit = Finalied
135 | 2 : Withdraw: buildAndSubmit = Finalied
136 | 0 : Withdraw-confirmation : Confirmed "89f177fef2b8669111dd3978f6cd2437e11d975a3a9bc71d3bd52cb3ddf52177"
137 | 7 : Withdraw-confirmation : Confirmed "449d78dcd802bc0fbc21330e81ac2c604f2cdfca1ba93e8bc02439fdddc32b6a"
138 | 4 : Withdraw-confirmation : Confirmed "115afe4e44bdf959744e4bea9622e585df3c4fb432b01322d9b09a7d8a758a89"
139 | 2 : Withdraw-confirmation : Confirmed "a623e8f24f5858038b8d8bcc8f552e12ab9fe8b7daf1eeb97880507dbd79d7ec"
140 | 8 : Withdraw-confirmation : Confirmed "585b6459101c9053040e0d2bde0e4a58e5f06e7ddf0fd1ecf0b7fe89e791917f"
141 | 3 : Withdraw-confirmation : Confirmed "bccfceeaa0eca23512353cc1383bc9af4ccf2155b0533ba38b6ebfa83208f52f"
142 | 6 : Withdraw-confirmation : Confirmed "61e26a231f3a6e7007194c3912cbcc551d6c410529f6a3fd43553188178c91aa"
143 | 9 : Withdraw-confirmation : Confirmed "568d8187523a47e8e5d1e98d2fbbea3861f0836795409f58205513cc5bbacbc6"
144 | 5 : Withdraw-confirmation : Confirmed "376f1a0722bde768dae8892f476adaf8c1a7b69770f7c23eeef0d7d3179f3c2b"
145 | 1 : Withdraw-confirmation : Confirmed "4989277f7de4be0c5672ffea9ac93817e7276bc6e1ea78aa2118a5f3fcfbc5ea"
146 | 3 : Refund Wallet: setup = Finalied
147 | 1 : Refund Wallet: setup = Finalied
148 | 4 : Refund Wallet: setup = Finalied
149 | 2 : Refund Wallet: setup = Finalied
150 | 0 : Refund Wallet: setup = Finalied
151 | 3 : Refund Wallet: buildAndSubmit = Finalied
152 | 1 : Refund Wallet: buildAndSubmit = Finalied
153 | 2 : Refund Wallet: buildAndSubmit = Finalied
154 | 4 : Refund Wallet: buildAndSubmit = Finalied
155 | 0 : Refund Wallet: buildAndSubmit = Finalied
156 | 0 : Refund Wallet-confirmation : Confirmed "5207b1ed6ff6b2f0d7597a6681fe983cff89666704cbbed5d16ebe1e2cf395aa"
157 | 2 : Refund Wallet-confirmation : Confirmed "42a988b3915818b44fa34417e3f47153a88d7c527bad346048fe281752cc95c8"
158 | 4 : Refund Wallet-confirmation : Confirmed "bfbef6d4a034d40c543a7150cf549f625aac0d58d88b138435611505f7b50db5"
159 | 1 : Refund Wallet-confirmation : Confirmed "48245dcaffddafb8a9c56d4f942838c256bf8a895f7945407aaa29ecfcd2d3d9"
160 | 3 : Refund Wallet-confirmation : Confirmed "3278083acfb3c6cd9606add11453501f7b955e2ca75ec14cb96713d188eae0c4"
161 | 


--------------------------------------------------------------------------------