├── .gitignore ├── tests ├── run_off_chain.sh ├── run_on_chain.sh ├── README.md ├── on_chain.tkpl └── off_chain.repl ├── kda-env ├── init-test-accounts.repl ├── bootstrap-modules │ ├── basic-guards.pact │ └── repl-coin-tools.repl ├── init-namespaces.repl ├── init-marmalade.repl ├── init-pact-util-lib.repl ├── init-kadena.repl ├── init.repl ├── kadena │ ├── account-protocols-v1.pact │ ├── fungible-xchain-v1.pact │ ├── gas-payer-v1.pact │ ├── fungible-util.pact │ ├── guards.pact │ ├── guards1.pact │ ├── fungible-v2.pact │ ├── coin-v5.pact │ └── coin-v6.pact ├── pact-util-lib │ ├── util-chain-data.pact │ ├── util-zk.pact │ ├── util-fungible.pact │ ├── util-random.pact │ ├── util-time.pact │ ├── util-lists.pact │ ├── util-math.pact │ └── util-strings.pact └── marmalade │ ├── manifest.pact │ ├── token-policy-v1.pact │ ├── policy.pact │ ├── fixed-quote-policy.pact │ ├── fixed-quote-royalty-policy.pact │ ├── poly-fungible-v2.pact │ └── ledger.pact ├── example.pact ├── example.repl └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .pact-history 2 | .pc-history 3 | -------------------------------------------------------------------------------- /tests/run_off_chain.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | pact off_chain.repl |tail -1| jq 4 | -------------------------------------------------------------------------------- /kda-env/init-test-accounts.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (load "./bootstrap-modules/repl-coin-tools.repl") 3 | (commit-tx) 4 | 5 | 6 | (begin-tx) 7 | (use repl-coin-tools) 8 | (fund-accounts ["alice", "bob", "carol", "dave"] 1000.0) 9 | (commit-tx) 10 | -------------------------------------------------------------------------------- /example.pact: -------------------------------------------------------------------------------- 1 | (module hello GOV 2 | 3 | (defcap GOV() 4 | true) 5 | 6 | (defun say-hello(name:string) 7 | (let ((bal (coin.get-balance name))) 8 | (format "Hello {}: You have currently {} KDA" 9 | [name bal]))) 10 | ) 11 | -------------------------------------------------------------------------------- /kda-env/bootstrap-modules/basic-guards.pact: -------------------------------------------------------------------------------- 1 | (module basic-guards GOV 2 | (defcap GOV () true) 3 | 4 | (defconst GUARD_SUCCESS (create-user-guard (success))) 5 | (defconst GUARD_FAILURE (create-user-guard (failure))) 6 | 7 | (defun success () true) 8 | (defun failure () (enforce false "Disabled")) 9 | ) 10 | -------------------------------------------------------------------------------- /tests/run_on_chain.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | rm -f tx.json tx.yaml 3 | 4 | kda gen -t on_chain.tkpl 5 | kda combine-sigs tx.yaml 6 | STATUS=`kda local tx.json|jq -r ".[]|.[].body.result.status"` 7 | if [ $STATUS == "success" ] 8 | then kda local tx.json|jq ".[]|.[].body.result.data" 9 | else kda local tx.json|jq ".[]|.[].body.result" 10 | fi 11 | -------------------------------------------------------------------------------- /kda-env/init-namespaces.repl: -------------------------------------------------------------------------------- 1 | 2 | (begin-tx) 3 | 4 | (use basic-guards) 5 | (define-namespace 'util GUARD_SUCCESS GUARD_SUCCESS) 6 | (define-namespace 'free GUARD_SUCCESS GUARD_SUCCESS) 7 | (define-namespace 'kip GUARD_SUCCESS GUARD_SUCCESS) 8 | (define-namespace 'user GUARD_SUCCESS GUARD_SUCCESS) 9 | (define-namespace 'marmalade GUARD_SUCCESS GUARD_SUCCESS) 10 | 11 | (print "Standard namespaces initialized") 12 | (commit-tx) 13 | -------------------------------------------------------------------------------- /kda-env/init-marmalade.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (namespace 'kip) 3 | 4 | ;Manifest HFT Module 5 | (load "./marmalade/manifest.pact") 6 | 7 | ; Load interfaces 8 | (load "./marmalade/token-policy-v1.pact") 9 | (load "./marmalade/poly-fungible-v2.pact") 10 | 11 | (env-data {'ns:'marmalade, 'upgrade:false}) 12 | (load "./marmalade/ledger.pact") 13 | (load "./marmalade/policy.pact") 14 | (load "./marmalade/fixed-quote-policy.pact") 15 | (load "./marmalade/fixed-quote-royalty-policy.pact") 16 | 17 | (commit-tx) 18 | 19 | (print "Marmalade contracts initialized") 20 | -------------------------------------------------------------------------------- /kda-env/init-pact-util-lib.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (namespace 'free) 3 | (load "pact-util-lib/util-chain-data.pact") 4 | (load "pact-util-lib/util-fungible.pact") 5 | (load "pact-util-lib/util-lists.pact") 6 | (load "pact-util-lib/util-strings.pact") 7 | (load "pact-util-lib/util-math.pact") 8 | (load "pact-util-lib/util-time.pact") 9 | (load "pact-util-lib/util-zk.pact") 10 | (load "pact-util-lib/util-random.pact") 11 | 12 | (create-table state-table) 13 | 14 | (env-hash (hash "GOOD SEED!")) 15 | (util-random.reset-state) 16 | 17 | (commit-tx) 18 | 19 | (print "Utils library contracts initialized") 20 | -------------------------------------------------------------------------------- /tests/README.md: -------------------------------------------------------------------------------- 1 | # Tests Scripts 2 | 3 | Simple test script to verify that the local modules are the same than the on-chain deployed modules. 4 | 5 | ## On-chain 6 | 7 | ``` 8 | ./run_on_chain.sh 9 | ``` 10 | 11 | Use `kda tool`, and `jq` to retrieve the hashes of deployed-module 12 | 13 | ## Off-chain 14 | ``` 15 | ./run_off_chain.sh" 16 | ``` 17 | 18 | Use the `pact` executable to retrieve the hashes of the modules of this package. 19 | 20 | 21 | ## Comparison 22 | 23 | Both lists can be compared to verify that everything is up-to-date respect to the blockchain. 24 | 25 | **Note:**: For some reasons, `util.guards1` is expected to be different. 26 | -------------------------------------------------------------------------------- /example.repl: -------------------------------------------------------------------------------- 1 | ;; Load the environment 2 | 3 | ;; Optionnal: Here we disable Marmalade because it's not usefull in our test script. 4 | (env-data {"disable-marmalade":true, 5 | "disable-util-lib":false, 6 | "disable-test-accounts":false}) 7 | 8 | (load "kda-env/init.repl") 9 | 10 | ; Load my module 11 | (begin-tx) 12 | (namespace 'free) 13 | (load "example.pact") 14 | (commit-tx) 15 | 16 | ; Test the module 17 | (use free.util-strings) 18 | (print (free.hello.say-hello "bob")) 19 | (expect "Result should start with Hello" true (starts-with (free.hello.say-hello "bob") "Hello")) 20 | (expect "Result should end with KDA" true (ends-with (free.hello.say-hello "bob") "KDA")) 21 | -------------------------------------------------------------------------------- /kda-env/init-kadena.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (env-keys []) 3 | (env-sigs []) 4 | 5 | ; Root namespace 6 | (load "./kadena/fungible-v2.pact") 7 | (load "./kadena/fungible-xchain-v1.pact") 8 | (load "./kadena/gas-payer-v1.pact") 9 | (load "./kadena/coin-v6.pact") 10 | (create-table coin-table) 11 | 12 | ; On the Kadena blockchain the guards modules are loaded 13 | ;in both root and util namespaces 14 | (load "./kadena/guards.pact") 15 | (load "./kadena/guards1.pact") 16 | 17 | (namespace 'kip) 18 | (load "./kadena/account-protocols-v1.pact") 19 | 20 | (namespace 'util) 21 | (load "./kadena/fungible-util.pact") 22 | (load "./kadena/guards.pact") 23 | (load "./kadena/guards1.pact") 24 | 25 | (print "Kadena contracts initialized") 26 | (commit-tx) 27 | -------------------------------------------------------------------------------- /kda-env/init.repl: -------------------------------------------------------------------------------- 1 | (enforce-pact-version "5.0") 2 | 3 | ;Init basic guard contract (needed to init namespaces) 4 | (begin-tx) 5 | (load "bootstrap-modules/basic-guards.pact") 6 | (commit-tx) 7 | 8 | ; Init Namespaces 9 | (load "init-namespaces.repl") 10 | 11 | ; Init standards Kadena contracts (coin, etc...) 12 | (load "init-kadena.repl") 13 | 14 | ; Util lib 15 | (if (not (try false (read-msg "disable-util-lib"))) 16 | (load "init-pact-util-lib.repl") 17 | "") 18 | 19 | ; Marmalade 20 | (if (not (try false (read-msg "disable-marmalade"))) 21 | (load "init-marmalade.repl") 22 | "") 23 | 24 | ; Init test accounts 25 | (if (not (try false (read-msg "disable-test-accounts"))) 26 | (load "init-test-accounts.repl") 27 | "") 28 | -------------------------------------------------------------------------------- /kda-env/kadena/account-protocols-v1.pact: -------------------------------------------------------------------------------- 1 | (interface account-protocols-v1 2 | 3 | " Define a standard for support of Kadena Account Protocols, \ 4 | \ which reserve account names starting with 'X:'' where X is a \ 5 | \ single latin-1 character. It also indicates which protocols are \ 6 | \ supported." 7 | 8 | (defconst SINGLE_KEY "k:" 9 | " Protocol in which the data portion of the name must match the \ 10 | \ key in a single-key, 'keys-all' guard." 11 | ) 12 | 13 | (defun enforce-reserved:bool 14 | ( account:string 15 | guard:guard 16 | ) 17 | @doc " Enforce reserved account name protocols. Implementations \ 18 | \ must call this function in all account creation modes \ 19 | \ (transfer-create, create-account, etc)." 20 | ) 21 | 22 | ) 23 | -------------------------------------------------------------------------------- /kda-env/kadena/fungible-xchain-v1.pact: -------------------------------------------------------------------------------- 1 | (interface fungible-xchain-v1 2 | 3 | " This interface offers a standard capability for cross-chain \ 4 | \ transfers and associated events. " 5 | 6 | (defcap TRANSFER_XCHAIN:bool 7 | ( sender:string 8 | receiver:string 9 | amount:decimal 10 | target-chain:string 11 | ) 12 | @doc " Managed capability sealing AMOUNT for transfer \ 13 | \ from SENDER to RECEIVER on TARGET-CHAIN. Permits \ 14 | \ any number of cross-chain transfers up to AMOUNT." 15 | 16 | @managed amount TRANSFER_XCHAIN-mgr 17 | ) 18 | 19 | (defun TRANSFER_XCHAIN-mgr:decimal 20 | ( managed:decimal 21 | requested:decimal 22 | ) 23 | @doc " Allows TRANSFER-XCHAIN AMOUNT to be less than or \ 24 | \ equal managed quantity as a one-shot, returning 0.0." 25 | ) 26 | 27 | (defcap TRANSFER_XCHAIN_RECD:bool 28 | ( sender:string 29 | receiver:string 30 | amount:decimal 31 | source-chain:string 32 | ) 33 | @doc "Event emitted on receipt of cross-chain transfer." 34 | @event 35 | ) 36 | ) 37 | -------------------------------------------------------------------------------- /tests/on_chain.tkpl: -------------------------------------------------------------------------------- 1 | code: |- 2 | (let ((mod-list:[string] ["coin", 3 | "util.fungible-util", 4 | "util.guards", 5 | "util.guards1", 6 | "free.util-lists", 7 | "free.util-math", 8 | "free.util-random", 9 | "free.util-strings", 10 | "free.util-time", 11 | "free.util-zk", 12 | "kip.token-manifest", 13 | "marmalade.ledger", 14 | "marmalade.fixed-quote-policy", 15 | "marmalade.fixed-quote-royalty-policy", 16 | "marmalade.guard-token-policy" 17 | ])) 18 | 19 | (zip (lambda (x y) {'mod:x, 'hash:y}) 20 | mod-list 21 | (map (compose (describe-module) (at 'hash)) mod-list))) 22 | 23 | meta: 24 | chainId: "8" 25 | sender: "" 26 | gasLimit: 50000 27 | gasPrice: 0.00000001 28 | ttl: 600 29 | networkId: mainnet01 30 | 31 | type: exec 32 | -------------------------------------------------------------------------------- /kda-env/bootstrap-modules/repl-coin-tools.repl: -------------------------------------------------------------------------------- 1 | ; Note: 2 | ; 3 | ; This module should be adaptable for other fungible contracts based on coin. 4 | ; - Change coin to the relevant module name in several place 5 | ; - Change the table: (line 27) (here coin-table) to the table name used by the targetted module 6 | 7 | (env-enable-repl-natives true) 8 | 9 | (module repl-coin-tools GOV 10 | (defcap GOV () true) 11 | 12 | (defun fund-account (account-name:string key:string amount:decimal) 13 | @doc "Fund a coin account from nothing" 14 | (env-data { "k": [key]}) 15 | (coin.create-account account-name (read-keyset 'k)) 16 | (set-balance account-name amount) 17 | ) 18 | 19 | (defun fund-accounts (account-names:[string] amount:decimal) 20 | @doc "Fund a list of fungible accounts with a constant amount. the key is derived from the account name" 21 | (map (lambda (x) (fund-account x (+ x "-key") amount)) account-names) 22 | ) 23 | 24 | (defun set-balance (account-name:string amount:decimal) 25 | @doc "Set the balance of a fungible account" 26 | (env-module-admin coin) 27 | (update coin.coin-table account-name {'balance:amount}) 28 | ) 29 | 30 | ) 31 | 32 | (env-enable-repl-natives false) 33 | -------------------------------------------------------------------------------- /kda-env/kadena/gas-payer-v1.pact: -------------------------------------------------------------------------------- 1 | (interface gas-payer-v1 2 | 3 | (defcap GAS_PAYER:bool 4 | ( user:string 5 | limit:integer 6 | price:decimal 7 | ) 8 | @doc 9 | " Provide a capability indicating that declaring module supports \ 10 | \ gas payment for USER for gas LIMIT and PRICE. Functionality \ 11 | \ should require capability (coin.FUND_TX), and should validate \ 12 | \ the spend of (limit * price), possibly updating some database \ 13 | \ entry. \ 14 | \ Should compose capability required for 'create-gas-payer-guard'." 15 | @model 16 | [ (property (user != "")) 17 | (property (limit > 0)) 18 | (property (price > 0.0)) 19 | ] 20 | ) 21 | 22 | (defun create-gas-payer-guard:guard () 23 | @doc 24 | " Provide a guard suitable for controlling a coin account that can \ 25 | \ pay gas via GAS_PAYER mechanics. Generally this is accomplished \ 26 | \ by having GAS_PAYER compose an unparameterized, unmanaged capability \ 27 | \ that is required in this guard. Thus, if coin contract is able to \ 28 | \ successfully acquire GAS_PAYER, the composed 'anonymous' cap required \ 29 | \ here will be in scope, and gas buy will succeed." 30 | ) 31 | 32 | ) 33 | -------------------------------------------------------------------------------- /tests/off_chain.repl: -------------------------------------------------------------------------------- 1 | (env-data {}) 2 | (load "../kda-env/init.repl") 3 | 4 | (module format-result G 5 | (defcap G() true) 6 | 7 | (defun format-json:string (data-in) 8 | (+ "[" 9 | (+ (drop -1 (fold (+) "" (map (lambda (x) (format "{}," [x])) data-in))) 10 | "]"))) 11 | ) 12 | 13 | (let ((mod-list:[string] ["coin", 14 | "util.fungible-util", 15 | "util.guards", 16 | "util.guards1", 17 | "free.util-lists", 18 | "free.util-math", 19 | "free.util-random", 20 | "free.util-strings", 21 | "free.util-time", 22 | "free.util-zk", 23 | "kip.token-manifest", 24 | "marmalade.ledger", 25 | "marmalade.fixed-quote-policy", 26 | "marmalade.fixed-quote-royalty-policy", 27 | "marmalade.guard-token-policy" 28 | ])) 29 | (print (format-json (zip (lambda (x y) {'mod:x, 'hash:y}) 30 | mod-list 31 | (map (compose (describe-module) (at 'hash)) mod-list))))) 32 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-chain-data.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | ; 3 | ; This module maps env data to normal Pact functions. 4 | ; 5 | ; It helps to improve code readability 6 | ; 7 | ; Be aware that this module is only in Beta and hasn't been audited: 8 | ; --> BE CAREFUL if a security enforcement depends on one of theses functions 9 | ; 10 | ; 11 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 12 | ; https://github.com/CryptoPascal31/pact-util-lib 13 | ; 14 | ; 15 | (module util-chain-data GOV 16 | "This module provides some helpers to retrieve env data \ 17 | \ Documentation: https://pact-util-lib.readthedocs.io \ 18 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 19 | 20 | (defconst VERSION:string "0.11") 21 | 22 | (defcap GOV() 23 | (enforce-keyset "free.util-lib")) 24 | 25 | (defun chain-id:string () 26 | (at 'chain-id (chain-data))) 27 | 28 | (defun block-height:integer () 29 | (at 'block-height (chain-data))) 30 | 31 | (defun block-time:time () 32 | (at 'block-time (chain-data))) 33 | 34 | (defun prev-block-hash:string () 35 | (at 'prev-block-hash (chain-data))) 36 | 37 | (defun sender:string () 38 | (at 'sender (chain-data))) 39 | 40 | (defun gas-limit:integer () 41 | (at 'gas-limit (chain-data))) 42 | 43 | (defun gas-price:decimal () 44 | (at 'gas-price (chain-data))) 45 | 46 | (defun total-gas-limit:decimal () 47 | (* (dec (gas-limit)) (gas-price))) 48 | ) 49 | -------------------------------------------------------------------------------- /kda-env/marmalade/manifest.pact: -------------------------------------------------------------------------------- 1 | (namespace 'kip) 2 | 3 | (module token-manifest GOVERNANCE 4 | 5 | (defcap GOVERNANCE () 6 | (enforce-guard (keyset-ref-guard 'marmalade-admin ))) 7 | 8 | (defschema mf-uri 9 | scheme:string 10 | data:string 11 | ) 12 | 13 | (defschema mf-datum 14 | uri:object{mf-uri} 15 | hash:string 16 | datum:object 17 | ) 18 | 19 | (defschema manifest 20 | uri:object{mf-uri} 21 | hash:string 22 | data:[object{mf-datum}] 23 | ) 24 | 25 | (defun hash-contents:string 26 | ( uri:object{mf-uri} 27 | hashes:[string] 28 | ) 29 | (hash {'uri: uri, 'data: hashes}) 30 | ) 31 | 32 | (defun create-manifest:object{manifest} 33 | ( uri:object{mf-uri} 34 | data:[object{mf-datum}] 35 | ) 36 | { 'uri: uri 37 | , 'hash: (hash-contents uri (map (at 'hash ) data)) 38 | , 'data: data 39 | } 40 | ) 41 | 42 | (defun create-datum:object{mf-datum} 43 | ( uri:object{mf-uri} 44 | datum:object 45 | ) 46 | { 'uri: uri 47 | , 'hash: (hash-contents uri [(hash datum)]) 48 | , 'datum: datum 49 | } 50 | ) 51 | 52 | (defun verify-manifest:bool 53 | ( manifest:object{manifest} 54 | ) 55 | (bind manifest 56 | { "uri":= uri 57 | , "data":= data 58 | } 59 | (= (create-manifest uri data) manifest) 60 | ) 61 | ) 62 | 63 | (defun enforce-verify-manifest:bool 64 | ( manifest:object{manifest} 65 | ) 66 | (enforce 67 | (verify-manifest manifest) 68 | "Manifest is not valid") 69 | ) 70 | 71 | (defun uri (scheme:string data:string) 72 | {'scheme: scheme, 'data: data } 73 | ) 74 | 75 | ) 76 | -------------------------------------------------------------------------------- /kda-env/kadena/fungible-util.pact: -------------------------------------------------------------------------------- 1 | (module fungible-util GOVERNANCE 2 | (implements kip.account-protocols-v1) 3 | 4 | (defcap GOVERNANCE () 5 | (enforce-guard (keyset-ref-guard 'util-ns-admin))) 6 | 7 | (defun enforce-valid-amount 8 | ( precision:integer 9 | amount:decimal 10 | ) 11 | (enforce (> amount 0.0) "Positive non-zero amount") 12 | (enforce-precision precision amount) 13 | ) 14 | 15 | (defun enforce-valid-account (account:string) 16 | (enforce (> (length account) 2) "minimum account length") 17 | ) 18 | 19 | (defun enforce-precision 20 | ( precision:integer 21 | amount:decimal 22 | ) 23 | (enforce 24 | (= (floor amount precision) amount) 25 | "precision violation") 26 | ) 27 | 28 | (defun enforce-valid-transfer 29 | ( sender:string 30 | receiver:string 31 | precision:integer 32 | amount:decimal) 33 | (enforce (!= sender receiver) 34 | "sender cannot be the receiver of a transfer") 35 | (enforce-valid-amount precision amount) 36 | (enforce-valid-account sender) 37 | (enforce-valid-account receiver) 38 | ) 39 | 40 | 41 | (defun check-reserved:string (account:string) 42 | " Checks ACCOUNT for reserved name and returns type if \ 43 | \ found or empty string. Reserved names start with a \ 44 | \ single char and colon, e.g. 'c:foo', which would return 'c' as type." 45 | (let ((pfx (take 2 account))) 46 | (if (= ":" (take -1 pfx)) (take 1 pfx) ""))) 47 | 48 | (defun enforce-reserved:bool (account:string guard:guard) 49 | @doc "Enforce reserved account name protocols." 50 | (if (validate-principal guard account) 51 | true 52 | (let ((r (check-reserved account))) 53 | (if (= r "") 54 | true 55 | (if (= r "k") 56 | (enforce false "Single-key account protocol violation") 57 | (enforce false 58 | (format "Reserved protocol guard violation: {}" [r])) 59 | ))))) 60 | 61 | ) 62 | -------------------------------------------------------------------------------- /kda-env/marmalade/token-policy-v1.pact: -------------------------------------------------------------------------------- 1 | (namespace 'kip) 2 | 3 | (interface token-policy-v1 4 | 5 | (defschema token-info 6 | id:string 7 | supply:decimal 8 | precision:integer 9 | manifest:object{kip.token-manifest.manifest}) 10 | 11 | (defun enforce-mint:bool 12 | ( token:object{token-info} 13 | account:string 14 | guard:guard 15 | amount:decimal 16 | ) 17 | @doc "Minting policy for TOKEN to ACCOUNT for AMOUNT." 18 | @model [ 19 | (property (!= account "")) 20 | (property (> amount 0.0)) 21 | ] 22 | ) 23 | 24 | (defun enforce-burn:bool 25 | ( token:object{token-info} 26 | account:string 27 | amount:decimal 28 | ) 29 | @doc "Burning policy for TOKEN to ACCOUNT for AMOUNT." 30 | @model [ 31 | (property (!= account "")) 32 | (property (> amount 0.0)) 33 | ] 34 | ) 35 | 36 | (defun enforce-init:bool 37 | (token:object{token-info}) 38 | @doc "Enforce policy on TOKEN initiation." 39 | ) 40 | 41 | (defun enforce-offer:bool 42 | ( token:object{token-info} 43 | seller:string 44 | amount:decimal 45 | sale-id:string ) 46 | @doc "Offer policy of sale SALE-ID by SELLER of AMOUNT of TOKEN." 47 | ) 48 | 49 | 50 | (defun enforce-buy:bool 51 | ( token:object{token-info} 52 | seller:string 53 | buyer:string 54 | buyer-guard:guard 55 | amount:decimal 56 | sale-id:string ) 57 | @doc "Buy policy on SALE-ID by SELLER to BUYER AMOUNT of TOKEN." 58 | ) 59 | 60 | (defun enforce-transfer:bool 61 | ( token:object{token-info} 62 | sender:string 63 | guard:guard 64 | receiver:string 65 | amount:decimal ) 66 | @doc " Enforce rules on transfer of TOKEN AMOUNT from SENDER to RECEIVER. \ 67 | \ Also governs rotate of SENDER (with same RECEIVER and 0.0 AMOUNT). " 68 | ) 69 | 70 | (defun enforce-crosschain:bool 71 | ( token:object{token-info} 72 | sender:string 73 | guard:guard 74 | receiver:string 75 | target-chain:string 76 | amount:decimal ) 77 | @doc " Enforce rules on crosschain transfer of TOKEN AMOUNT \ 78 | \ from SENDER to RECEIVER on TARGET-CHAIN." 79 | ) 80 | ) 81 | -------------------------------------------------------------------------------- /kda-env/kadena/guards.pact: -------------------------------------------------------------------------------- 1 | ;; guards.pact 2 | 3 | (namespace 'util) 4 | 5 | (module guards AUTONOMOUS 6 | 7 | "Functions for implementing various user guards." 8 | 9 | (defcap AUTONOMOUS () 10 | (enforce false "Non-upgradeable")) 11 | 12 | (defun after-date:guard (date:time) 13 | "Guard to enforce chain time is after DATE." 14 | (create-user-guard (enforce-after-date date))) 15 | 16 | (defun enforce-after-date:bool (date:time) 17 | (enforce-time date "after" 18 | (> (chain-time) date))) 19 | 20 | 21 | (defun at-after-date:guard (date:time) 22 | "Guard to enforce chain time is at or after DATE." 23 | (create-user-guard (enforce-at-after-date date))) 24 | 25 | (defun enforce-at-after-date:bool (date:time) 26 | (enforce-time date "at or after" 27 | (>= (chain-time) date))) 28 | 29 | 30 | (defun before-date:guard (date:time) 31 | "Guard to enforce chain time is before DATE." 32 | (create-user-guard (enforce-before-date date))) 33 | 34 | (defun enforce-before-date:bool (date:time) 35 | (enforce-time date "before" 36 | (< (chain-time) date))) 37 | 38 | 39 | (defun at-before-date:guard (date:time) 40 | "Guard to enforce chain time is at or before DATE." 41 | (create-user-guard (enforce-at-before-date date))) 42 | 43 | (defun enforce-at-before-date:bool (date:time) 44 | (enforce-time date "at or before" 45 | (<= (chain-time) date))) 46 | 47 | 48 | (defun enforce-time:bool (date:time msg:string test:bool) 49 | (enforce test 50 | (format "Chain time must be {} {}" [msg date]))) 51 | 52 | (defun chain-time:time () 53 | (at 'block-time (chain-data))) 54 | 55 | (defun guard-and:guard (a:guard b:guard) 56 | "Guard to enforce both A and B." 57 | (create-user-guard (enforce-and a b))) 58 | 59 | (defun enforce-and:bool (a:guard b:guard) 60 | (enforce-guard a) 61 | (enforce-guard b)) 62 | 63 | (defun guard-or:guard (a:guard b:guard) 64 | "Guard to enforce A or B." 65 | (create-user-guard (enforce-or a b))) 66 | 67 | (defun enforce-or:bool (a:guard b:guard) 68 | (enforce-one 69 | (format "Enforce {} or {}" [a b]) 70 | [(enforce-guard a) 71 | (enforce-guard b)])) 72 | 73 | ) 74 | -------------------------------------------------------------------------------- /kda-env/marmalade/policy.pact: -------------------------------------------------------------------------------- 1 | 2 | (namespace (read-msg 'ns)) 3 | 4 | (module guard-token-policy GOVERNANCE 5 | 6 | (defcap GOVERNANCE () 7 | (enforce-guard (keyset-ref-guard 'marmalade-admin ))) 8 | 9 | (implements kip.token-policy-v1) 10 | (use kip.token-policy-v1 [token-info]) 11 | 12 | (defschema guards 13 | mint-guard:guard 14 | burn-guard:guard 15 | sale-guard:guard 16 | transfer-guard:guard 17 | ) 18 | 19 | (deftable policy-guards:{guards}) 20 | 21 | (defun get-guards:object{guards} (token:object{token-info}) 22 | (read policy-guards (at 'id token)) 23 | ) 24 | 25 | (defun enforce-ledger:bool () 26 | (enforce-guard (marmalade.ledger.ledger-guard)) 27 | ) 28 | 29 | (defun enforce-mint:bool 30 | ( token:object{token-info} 31 | account:string 32 | guard:guard 33 | amount:decimal 34 | ) 35 | (enforce-ledger) 36 | (enforce-guard (at 'mint-guard (get-guards token))) 37 | ) 38 | 39 | (defun enforce-burn:bool 40 | ( token:object{token-info} 41 | account:string 42 | amount:decimal 43 | ) 44 | (enforce-ledger) 45 | (enforce-guard (at 'burn-guard (get-guards token))) 46 | ) 47 | 48 | (defun enforce-init:bool 49 | ( token:object{token-info} 50 | ) 51 | (enforce-ledger) 52 | (insert policy-guards (at 'id token) 53 | { 'mint-guard: (read-keyset 'mint-guard) 54 | , 'burn-guard: (read-keyset 'burn-guard) 55 | , 'sale-guard: (read-keyset 'sale-guard) 56 | , 'transfer-guard: (read-keyset 'transfer-guard) }) 57 | true 58 | ) 59 | 60 | 61 | (defun enforce-offer:bool 62 | ( token:object{token-info} 63 | seller:string 64 | amount:decimal 65 | sale-id:string ) 66 | (enforce-ledger) 67 | (enforce-sale-pact sale-id) 68 | (enforce-guard (at 'sale-guard (get-guards token))) 69 | ) 70 | 71 | (defun enforce-buy:bool 72 | ( token:object{token-info} 73 | seller:string 74 | buyer:string 75 | buyer-guard:guard 76 | amount:decimal 77 | sale-id:string ) 78 | (enforce-ledger) 79 | (enforce-sale-pact sale-id) 80 | (enforce-guard (at 'sale-guard (get-guards token))) 81 | ) 82 | 83 | (defun enforce-sale-pact:bool (sale:string) 84 | "Enforces that SALE is id for currently executing pact" 85 | (enforce (= sale (pact-id)) "Invalid pact/sale id") 86 | ) 87 | 88 | (defun enforce-transfer:bool 89 | ( token:object{token-info} 90 | sender:string 91 | guard:guard 92 | receiver:string 93 | amount:decimal ) 94 | (enforce-ledger) 95 | (enforce-guard (at 'transfer-guard (get-guards token))) 96 | ) 97 | 98 | (defun enforce-crosschain:bool 99 | ( token:object{token-info} 100 | sender:string 101 | guard:guard 102 | receiver:string 103 | target-chain:string 104 | amount:decimal ) 105 | (enforce-ledger) 106 | (enforce-guard (at 'transfer-guard (get-guards token))) 107 | ) 108 | ) 109 | 110 | (if (read-msg 'upgrade) 111 | ["upgrade complete"] 112 | [ (create-table policy-guards) ]) 113 | -------------------------------------------------------------------------------- /kda-env/kadena/guards1.pact: -------------------------------------------------------------------------------- 1 | ; Note: On-chain is module is guarded by old fashion keyset. 2 | ; It's not possible anymore to deploy exactly the same module. 3 | ; ===> That's the governance has been shifted here to an AUTONOMOUS governance 4 | ; 5 | (module guards1 AUTONOMOUS 6 | 7 | (defcap AUTONOMOUS () 8 | (enforce false "Non-upgradeable")) 9 | 10 | (defun guard-all:guard (guards:[guard]) 11 | "Create a guard that only succeeds if every guard in GUARDS is successfully enforced." 12 | (enforce (< 0 (length guards)) "Guard list cannot be empty") 13 | (create-user-guard (enforce-guard-all guards))) 14 | 15 | (defun enforce-guard-all:bool (guards:[guard]) 16 | "Enforces all guards in GUARDS" 17 | (map (enforce-guard) guards) 18 | ) 19 | 20 | (defun guard-any:guard (guards:[guard]) 21 | "Create a guard that succeeds if at least one guard in GUARDS is successfully enforced." 22 | (enforce (< 0 (length guards)) "Guard list cannot be empty") 23 | (create-user-guard (enforce-guard-any guards))) 24 | 25 | (defun enforce-guard-any:bool (guards:[guard]) 26 | "Will succeed if at least one guard in GUARDS is successfully enforced." 27 | (enforce (< 0 28 | (length 29 | (filter 30 | (= true) 31 | (map (try-enforce-guard) guards)))) 32 | "None of the guards passed") 33 | ) 34 | 35 | (defun try-enforce-guard (g:guard) 36 | (try false (enforce-guard g)) 37 | ) 38 | 39 | (defun max-gas-notional:guard (gasNotional:decimal) 40 | "Guard to enforce gas price * gas limit is smaller than or equal to GAS" 41 | (create-user-guard 42 | (enforce-below-or-at-gas-notional gasNotional))) 43 | 44 | (defun enforce-below-gas-notional (gasNotional:decimal) 45 | (enforce (< (chain-gas-notional) gasNotional) 46 | (format "Gas Limit * Gas Price must be smaller than {}" [gasNotional]))) 47 | 48 | (defun enforce-below-or-at-gas-notional (gasNotional:decimal) 49 | (enforce (<= (chain-gas-notional) gasNotional) 50 | (format "Gas Limit * Gas Price must be smaller than or equal to {}" [gasNotional]))) 51 | 52 | (defun max-gas-price:guard (gasPrice:decimal) 53 | "Guard to enforce gas price is smaller than or equal to GAS PRICE" 54 | (create-user-guard 55 | (enforce-below-or-at-gas-price gasPrice))) 56 | 57 | (defun enforce-below-gas-price:bool (gasPrice:decimal) 58 | (enforce (< (chain-gas-price) gasPrice) 59 | (format "Gas Price must be smaller than {}" [gasPrice]))) 60 | 61 | (defun enforce-below-or-at-gas-price:bool (gasPrice:decimal) 62 | (enforce (<= (chain-gas-price) gasPrice) 63 | (format "Gas Price must be smaller than or equal to {}" [gasPrice]))) 64 | 65 | (defun max-gas-limit:guard (gasLimit:integer) 66 | "Guard to enforce gas limit is smaller than or equal to GAS LIMIT" 67 | (create-user-guard 68 | (enforce-below-or-at-gas-limit gasLimit))) 69 | 70 | (defun enforce-below-gas-limit:bool (gasLimit:integer) 71 | (enforce (< (chain-gas-limit) gasLimit) 72 | (format "Gas Limit must be smaller than {}" [gasLimit]))) 73 | 74 | (defun enforce-below-or-at-gas-limit:bool (gasLimit:integer) 75 | (enforce (<= (chain-gas-limit) gasLimit) 76 | (format "Gas Limit must be smaller than or equal to {}" [gasLimit]))) 77 | 78 | (defun chain-gas-price () 79 | "Return gas price from chain-data" 80 | (at 'gas-price (chain-data))) 81 | 82 | (defun chain-gas-limit () 83 | "Return gas limit from chain-data" 84 | (at 'gas-limit (chain-data))) 85 | 86 | (defun chain-gas-notional () 87 | "Return gas limit * gas price from chain-data" 88 | (* (chain-gas-price) (chain-gas-limit))) 89 | ) 90 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Sandbox for Kadena REPL 2 | 3 | ## Introduction 4 | 5 | This package helps to create a "Plug & Play" sandbox for easy development of Pact Smart Contracts off-chain, with all standards contracts preloaded and ready. 6 | 7 | The goal is to simulate the Kadena environment as it can be found on-chain: 8 | 9 | * Namespaces 10 | * Coin-contract and fungible-v2 interfaces 11 | * Official Kadena utilities 12 | * Third party utilities 13 | * Marmalade interfaces and contracts 14 | 15 | ## How-to 16 | 17 | 1. Make sure that the Pact interpreter in installed. 18 | - https://github.com/kadena-io/pact/releases 19 | 2. Create your REPL file which: 20 | - load the main sandbox script `kda-env/init.repl`: `(env-data {})(load "kda-env/init.repl")` 21 | - declare or load and test your contracts 22 | 3. Optionally, you can disable some features by setting user data before loading `init.repl` 23 | 4. Launch your REPL file with the pact executable. 24 | 25 | An example can be found: `example.repl` and `example.pact` and can be launched: 26 | ``` 27 | $ pact example.repl 28 | Standard namespaces initialized 29 | Kadena contracts initialized 30 | Utils library contracts initialized 31 | Marmalade contracts initialized 32 | Hello bob: You have currently 1000.0 KDA 33 | Load successful 34 | ``` 35 | 36 | ## Description 37 | 38 | ### Pact 39 | Based on Pact 5.3, and currently on-chains contracts (18/10/2025) 40 | 41 | ### Bootstrap modules 42 | 43 | **basic-guards**: Implements two simple guards (used to initialize the namespaces): 44 | GUARD_SUCCESS and GUARD_FAILURE 45 | 46 | **repl-coin-tools**: Implements some utility functions to "cheat" the coin module and create test accounts. 47 | - ```(fund-account account-name:string key:string amount:decimal)``` : Create and fund a coin account 48 | - ```(set-balance account-name:string amount:decimal)``` : Set the balance of a coin account 49 | - ``` (fund-accounts account-names:[string] amount:decimal)``` : Create and fund a list of accounts by auto-creating key-names 50 | 51 | ### Namespaces 52 | The following namespaces are created: 53 | - util 54 | - free 55 | - kip 56 | - user 57 | - marmalade 58 | 59 | There is no enabled policy, and the module `ns` is not loaded. 60 | There is no guard on the namespaces. 61 | 62 | ### Fungible-v2 and coin 63 | The coin contract v5 is installed. 64 | 65 | The followings accounts are pre-funded for test purpose: 66 | 67 | | Account | Key | Balance | 68 | |---------|-----------|----------| 69 | | alice | alice-key | 1000.0 | 70 | | bob | bob-key | 1000.0 | 71 | | carol | carol-key | 1000.0 | 72 | | dave | dave-key | 1000.0 | 73 | 74 | If you need more accounts, you can create new ones with `(repl-coin-tools.fund-account name key-name balance)` 75 | 76 | 77 | ### Marmalade 78 | The version RC1 of marmalade is installed: 79 | - https://github.com/kadena-io/marmalade/releases/tag/marmalade-rc1 80 | 81 | Contracts: 82 | - poly-fungible-v2 and token-policy-v1 interfaces in NS `kip` 83 | - manifest contract in NS `kip` 84 | - ledger in NS `marmalade` 85 | - 3 default policy contracts in NS `marmalade` 86 | 87 | Note: Marmalade V1 appears to being compatible with Pact 5.0. The provided version has been slightly updated to ensure compatibility. 88 | 89 | 90 | ### Pact Util library 91 | The version 0.11 of unofficial Pact Util library: 92 | - https://github.com/CryptoPascal31/pact-util-lib 93 | - https://pact-util-lib.readthedocs.io/en/beta_0.11/ 94 | 95 | ### Disabling features (optional) 96 | If you don't need to load some features, you can disable them. 97 | Before loading `init.repl` just use an `(env-data {...})` command with the following parameters: 98 | 99 | - `disable-util-lib` => Do not load the Pact Util Library modules 100 | - `disable-marmalade` => Do not load Marmalade modules 101 | - `disable-test-accounts` => Do not fund test accounts (Alice, Bob, ...) 102 | 103 | Examples: 104 | ```lisp 105 | ; Do not fund test account 106 | (env-data {"disable-test-accounts":true}) 107 | (load "kda-env/init.repl") 108 | ``` 109 | 110 | ```lisp 111 | ; Do not fund test account and do not load Marmalade 112 | (env-data {"disable-test-accounts":true, 113 | "disable-marmalade":true}) 114 | (load "kda-env/init.repl") 115 | ``` 116 | -------------------------------------------------------------------------------- /kda-env/kadena/fungible-v2.pact: -------------------------------------------------------------------------------- 1 | (interface fungible-v2 2 | 3 | " Standard for fungible coins and tokens as specified in KIP-0002. " 4 | 5 | ; ---------------------------------------------------------------------- 6 | ; Schema 7 | 8 | (defschema account-details 9 | @doc "Schema for results of 'account' operation." 10 | @model [ (invariant (!= "" sender)) ] 11 | 12 | account:string 13 | balance:decimal 14 | guard:guard) 15 | 16 | 17 | ; ---------------------------------------------------------------------- 18 | ; Caps 19 | 20 | (defcap TRANSFER:bool 21 | ( sender:string 22 | receiver:string 23 | amount:decimal 24 | ) 25 | @doc " Managed capability sealing AMOUNT for transfer from SENDER to \ 26 | \ RECEIVER. Permits any number of transfers up to AMOUNT." 27 | @managed amount TRANSFER-mgr 28 | ) 29 | 30 | (defun TRANSFER-mgr:decimal 31 | ( managed:decimal 32 | requested:decimal 33 | ) 34 | @doc " Manages TRANSFER AMOUNT linearly, \ 35 | \ such that a request for 1.0 amount on a 3.0 \ 36 | \ managed quantity emits updated amount 2.0." 37 | ) 38 | 39 | ; ---------------------------------------------------------------------- 40 | ; Functionality 41 | 42 | 43 | (defun transfer:string 44 | ( sender:string 45 | receiver:string 46 | amount:decimal 47 | ) 48 | @doc " Transfer AMOUNT between accounts SENDER and RECEIVER. \ 49 | \ Fails if either SENDER or RECEIVER does not exist." 50 | @model [ (property (> amount 0.0)) 51 | (property (!= sender "")) 52 | (property (!= receiver "")) 53 | (property (!= sender receiver)) 54 | ] 55 | ) 56 | 57 | (defun transfer-create:string 58 | ( sender:string 59 | receiver:string 60 | receiver-guard:guard 61 | amount:decimal 62 | ) 63 | @doc " Transfer AMOUNT between accounts SENDER and RECEIVER. \ 64 | \ Fails if SENDER does not exist. If RECEIVER exists, guard \ 65 | \ must match existing value. If RECEIVER does not exist, \ 66 | \ RECEIVER account is created using RECEIVER-GUARD. \ 67 | \ Subject to management by TRANSFER capability." 68 | @model [ (property (> amount 0.0)) 69 | (property (!= sender "")) 70 | (property (!= receiver "")) 71 | (property (!= sender receiver)) 72 | ] 73 | ) 74 | 75 | (defpact transfer-crosschain:string 76 | ( sender:string 77 | receiver:string 78 | receiver-guard:guard 79 | target-chain:string 80 | amount:decimal 81 | ) 82 | @doc " 2-step pact to transfer AMOUNT from SENDER on current chain \ 83 | \ to RECEIVER on TARGET-CHAIN via SPV proof. \ 84 | \ TARGET-CHAIN must be different than current chain id. \ 85 | \ First step debits AMOUNT coins in SENDER account and yields \ 86 | \ RECEIVER, RECEIVER_GUARD and AMOUNT to TARGET-CHAIN. \ 87 | \ Second step continuation is sent into TARGET-CHAIN with proof \ 88 | \ obtained from the spv 'output' endpoint of Chainweb. \ 89 | \ Proof is validated and RECEIVER is credited with AMOUNT \ 90 | \ creating account with RECEIVER_GUARD as necessary." 91 | @model [ (property (> amount 0.0)) 92 | (property (!= sender "")) 93 | (property (!= receiver "")) 94 | (property (!= sender receiver)) 95 | (property (!= target-chain "")) 96 | ] 97 | ) 98 | 99 | (defun get-balance:decimal 100 | ( account:string ) 101 | " Get balance for ACCOUNT. Fails if account does not exist." 102 | ) 103 | 104 | (defun details:object{account-details} 105 | ( account: string ) 106 | " Get an object with details of ACCOUNT. \ 107 | \ Fails if account does not exist." 108 | ) 109 | 110 | (defun precision:integer 111 | () 112 | "Return the maximum allowed decimal precision." 113 | ) 114 | 115 | (defun enforce-unit:bool 116 | ( amount:decimal ) 117 | " Enforce minimum precision allowed for transactions." 118 | ) 119 | 120 | (defun create-account:string 121 | ( account:string 122 | guard:guard 123 | ) 124 | " Create ACCOUNT with 0.0 balance, with GUARD controlling access." 125 | ) 126 | 127 | (defun rotate:string 128 | ( account:string 129 | new-guard:guard 130 | ) 131 | " Rotate guard for ACCOUNT. Transaction is validated against \ 132 | \ existing guard before installing new guard. " 133 | ) 134 | 135 | ) 136 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-zk.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | 3 | ; This modules provides some convenient Zero Knowledge function for Pact. 4 | ; 5 | ; Be aware that this module is only in Beta and hasn't been audited: 6 | ; --> BE CAREFUL if a security enforcement depends on one of theses functions 7 | ; 8 | ; 9 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 10 | ; https://github.com/CryptoPascal31/pact-util-lib 11 | 12 | (module util-zk GOV 13 | "Module containing time utilities \ 14 | \ Documentation: https://pact-util-lib.readthedocs.io \ 15 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 16 | 17 | ; References: 18 | ; - https://www.zeroknowledgeblog.com/index.php/groth16 19 | ; - https://github.com/kadena-io/pact/blob/master/tests/pact/pairing.repl 20 | ; - https://github.com/iden3/snarkjs/blob/master/templates/verifier_groth16.sol.ejs 21 | 22 | (defconst VERSION:string "0.11") 23 | 24 | (use util-strings [split-chunks]) 25 | (use util-lists [remove-first first]) 26 | (use util-math [++]) 27 | 28 | (defcap GOV() 29 | (enforce-keyset "free.util-lib")) 30 | 31 | (defconst BN128-GROUP-MODULUS:integer 21888242871839275222246405745257275088548364400416034343698204186575808495617) 32 | 33 | (defconst GEN-POINT-G1:object{point-G1} {'x:1, 'y:2}) 34 | 35 | (defconst NULL-POINT-G1:object{point-G1} {'x:0, 'y:0}) 36 | 37 | (defconst GEN-POINT-G2:object{point-G2} {'x:[11559732032986387107991004021392285783925812861821192530917403151452391805634, 38 | 10857046999023057135944570762232829481370756359578518086990519993285655852781], 39 | 'y:[4082367875863433681332203403145435568316851327593401208105741076214120093531, 40 | 8495653923123431417604973247489272438418190587263600148770280649306958101930]}) 41 | ; Point in G1 42 | (defschema point-G1 43 | x:integer 44 | y:integer 45 | ) 46 | 47 | ; Point in G2 (extended field) 48 | (defschema point-G2 49 | x:[integer] 50 | y:[integer] 51 | ) 52 | 53 | ; Groph16 Proof (2 point in G1, and 1 point in G2) 54 | (defschema groth16-proof 55 | A:object{point-G1} 56 | B:object{point-G2} 57 | C:object{point-G1} 58 | ) 59 | 60 | (defschema groth16-verify-key 61 | alpha:object{point-G1} 62 | beta:object{point-G2} 63 | gamma:object{point-G2} 64 | delta:object{point-G2} 65 | ic:[object{point-G1}] 66 | ) 67 | 68 | (defun int256-to-b64 (x:integer) 69 | "Convert a 256 bits integer to base 64" 70 | (drop 4 (int-to-str 64 (| x (shift 1 272)))) 71 | ) 72 | 73 | (defun serialize-proof:string (proof:object{groth16-proof}) 74 | "Serialiaze an object proof to its base64 representation (344 octets)" 75 | (bind proof {'A:=A, 'B:=B, 'C:=C} 76 | (concat (map int256-to-b64 [ (at 'x A), (at 'y A), 77 | (at 0 (at 'x B)), (at 1 (at 'x B)), 78 | (at 0 (at 'y B)), (at 1 (at 'y B)), 79 | (at 'x C), (at 'y C) 80 | ]))) 81 | ) 82 | 83 | (defun deserialize-proof:object{groth16-proof} (proof-str:string) 84 | "Deserialize a base64 proof string to its object representation" 85 | (enforce (= 344 (length proof-str)) "The base64 proof must have 344 characters") 86 | (let ((proof-lst (map (str-to-int 64) (split-chunks 43 proof-str)))) 87 | {'A: {'x: (at 0 proof-lst), 88 | 'y: (at 1 proof-lst)}, 89 | 'B: {'x: [(at 2 proof-lst) (at 3 proof-lst)], 90 | 'y: [(at 4 proof-lst) (at 5 proof-lst)]}, 91 | 'C: {'x: (at 6 proof-lst), 92 | 'y: (at 7 proof-lst)} 93 | }) 94 | ) 95 | 96 | 97 | (defun neg-G1:object{point-G1} (in:object{point-G1}) 98 | "Returns the negative of a point in G1" 99 | (bind in {'x := x, 'y := y} 100 | {'x:x, 'y: (- y)}) 101 | ) 102 | 103 | 104 | (defun verify-groth16-proof:bool (key:object{groth16-verify-key} 105 | pub-inputs:[integer] 106 | proof:object{groth16-proof}) 107 | "Verify a groth16 proof against a list of public inputs and proof object" 108 | 109 | ; Check that all public inputs are in the group 110 | (enforce (fold (and) true 111 | (map (> BN128-GROUP-MODULUS) pub-inputs)) 112 | "Invalid public inputs") 113 | 114 | (bind key {'alpha:= alpha, 'beta:=beta, 'gamma:=gamma, 'delta:=delta, 'ic:=ic} 115 | (enforce (= (++ (length pub-inputs )) (length ic)) "Bad number of inputs") 116 | (bind proof {'A:=A, 'B:=B, 'C:=C} 117 | ; Compute The linear combinations of inputs and IC 118 | (let ((vk_0 (point-add 'g1 NULL-POINT-G1 (first ic))) 119 | (vk_n (fold (point-add 'g1) vk_0 (zip (scalar-mult 'g1) (remove-first ic) pub-inputs)))) 120 | (pairing-check [(neg-G1 A) alpha vk_n C] 121 | [B beta gamma delta])))) 122 | ) 123 | 124 | ) 125 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-fungible.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | 3 | ; This module provides some utilities to work with fungible tokens. 4 | ; 5 | ; The library deployed by the Kadena team was outdated and a little bit shitty. 6 | ; That's why I created this. 7 | ; 8 | ; Be aware that this module is only in Beta and hasn't been audited: 9 | ; --> BE CAREFUL if a security enforcement depends on one of these functions 10 | ; 11 | ; Remember that in Pact, all variables are immutable and no function can 12 | ; work in place. New lists are always returned. 13 | ; 14 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 15 | ; https://github.com/CryptoPascal31/pact-util-lib 16 | (module util-fungible GOV 17 | "This module provides some helpers to create fungible tokens \ 18 | \ Documentation: https://pact-util-lib.readthedocs.io \ 19 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 20 | 21 | (defconst VERSION:string "0.11") 22 | 23 | (defcap GOV() 24 | (enforce-keyset "free.util-lib")) 25 | 26 | (use util-chain-data [chain-id]) 27 | 28 | (defconst STD_CHARSET:integer CHARSET_LATIN1) 29 | 30 | (defconst STD_MINIMUM_ACCOUNT_LENGTH:integer 3) 31 | 32 | (defconst STD_MAXIMUM_ACCOUNT_LENGTH:integer 256) 33 | 34 | (defconst VALID_CHAIN_IDS:[string] (map (int-to-str 10) (enumerate 0 19))) 35 | 36 | (defun enforce-precision:bool (precision:integer amount:decimal) 37 | "Validate the precision (number of decimals) of an amount" 38 | (enforce (= (floor amount precision) amount) 39 | (format "Amount {} violates the required precision {}" 40 | [amount precision])) 41 | ) 42 | 43 | (defun enforce-valid-amount:bool (precision:integer amount:decimal) 44 | "Validate that an amount is positive and does not viloate the precision \ 45 | \ Must be used to handle every amount in a fungible module" 46 | (enforce (> amount 0.0) "Amount must be positive") 47 | (enforce-precision precision amount) 48 | ) 49 | 50 | (defun enforce-valid-account:bool (account:string) 51 | "Enforce that an account name conforms to minimum and maximum length \ 52 | \ requirements, as well as the latin-1 character set." 53 | 54 | (enforce (is-charset STD_CHARSET account) 55 | "Account does not conform to the charset LATIN1") 56 | 57 | (enforce (and? (<= STD_MINIMUM_ACCOUNT_LENGTH) (>= STD_MAXIMUM_ACCOUNT_LENGTH) 58 | (length account)) 59 | (format "Account name does not conform to the length rquirements [{}-{}]" 60 | [STD_MINIMUM_ACCOUNT_LENGTH, STD_MAXIMUM_ACCOUNT_LENGTH])) 61 | ) 62 | 63 | (defun enforce-valid-transfer:bool (sender:string receiver:string precision:integer 64 | amount:decimal) 65 | "Validate that the sender, the receiver and the amount are valid for a transfer" 66 | (enforce (!= sender receiver) 67 | (format "Sender and Receiver must be different: {}" [sender])) 68 | (enforce-valid-amount precision amount) 69 | (enforce-valid-account sender) 70 | (enforce-valid-account receiver) 71 | ) 72 | 73 | (defun enforce-valid-transfer-xchain:bool (sender:string receiver:string precision:integer 74 | amount:decimal) 75 | "Validate that the sender, the receiver and the amount are valid for an X-chain transfer" 76 | (enforce-valid-amount precision amount) 77 | (enforce-valid-account sender) 78 | (enforce-valid-account receiver) 79 | ) 80 | 81 | (defun enforce-reserved:bool (account:string guard:guard) 82 | "Enforce that a principal account matches to it's guard" 83 | (if (is-principal account) 84 | (enforce (validate-principal guard account) 85 | (format "Reserved protocol guard violation: {}" [(typeof-principal account)])) 86 | true) 87 | ) 88 | 89 | (defun enforce-reserved*:bool (account:string guard:guard) 90 | "Starred version for enforce-reserved. Enforce that a principal account \ 91 | \ matches to it's guard and refuse non principal accounts" 92 | (enforce (is-principal account) "Only principal accounts can be used") 93 | (enforce (validate-principal guard account) 94 | (format "Reserved protocol guard violation: {}" [(typeof-principal account)])) 95 | ) 96 | 97 | (defun enforce-valid-chain-id:bool (target-chain-id:string) 98 | "Enforce that chain-id is a valid chain identifier" 99 | (enforce (contains target-chain-id VALID_CHAIN_IDS) "Target chain is not a valid Chainweb chainID")) 100 | 101 | (defun enforce-not-same-chain:bool (target-chain-id:string) 102 | "Enforce that chain-id is not same as the current chain" 103 | (enforce (!= (chain-id) target-chain-id) 104 | (format "Target chain {} cannot be the current chain {}" [target-chain-id, (chain-id)])) 105 | ) 106 | 107 | (defschema fungible-xchain-sch 108 | "Schema for yielded value in cross-chain transfers" 109 | receiver:string 110 | receiver-guard:guard 111 | amount:decimal 112 | source-chain:string 113 | ) 114 | 115 | ) 116 | -------------------------------------------------------------------------------- /kda-env/marmalade/fixed-quote-policy.pact: -------------------------------------------------------------------------------- 1 | (namespace (read-msg 'ns)) 2 | 3 | (module fixed-quote-policy GOVERNANCE 4 | 5 | @doc "Policy for fixed issuance with simple quoted sale." 6 | 7 | (defcap GOVERNANCE () 8 | (enforce-guard (keyset-ref-guard 'marmalade-admin ))) 9 | 10 | (implements kip.token-policy-v1) 11 | (use kip.token-policy-v1 [token-info]) 12 | 13 | (defschema policy-schema 14 | mint-guard:guard 15 | max-supply:decimal 16 | min-amount:decimal 17 | ) 18 | 19 | (deftable policies:{policy-schema}) 20 | 21 | (defcap QUOTE:bool 22 | ( sale-id:string 23 | token-id:string 24 | amount:decimal 25 | price:decimal 26 | sale-price:decimal 27 | spec:object{quote-spec} 28 | ) 29 | @doc "For event emission purposes" 30 | @event 31 | true 32 | ) 33 | 34 | (defconst QUOTE-MSG-KEY "quote" 35 | @doc "Payload field for quote spec") 36 | 37 | (defschema quote-spec 38 | @doc "Quote data to include in payload" 39 | fungible:module{fungible-v2} 40 | price:decimal 41 | recipient:string 42 | recipient-guard:guard 43 | ) 44 | 45 | (defschema quote-schema 46 | id:string 47 | spec:object{quote-spec}) 48 | 49 | (deftable quotes:{quote-schema}) 50 | 51 | (defun get-policy:object{policy-schema} (token:object{token-info}) 52 | (read policies (at 'id token)) 53 | ) 54 | 55 | (defun enforce-ledger:bool () 56 | (enforce-guard (marmalade.ledger.ledger-guard)) 57 | ) 58 | 59 | (defun enforce-mint:bool 60 | ( token:object{token-info} 61 | account:string 62 | guard:guard 63 | amount:decimal 64 | ) 65 | (enforce-ledger) 66 | (bind (get-policy token) 67 | { 'mint-guard:=mint-guard:guard 68 | , 'min-amount:=min-amount:decimal 69 | , 'max-supply:=max-supply:decimal 70 | } 71 | (enforce-guard mint-guard) 72 | (enforce (>= amount min-amount) "mint amount < min-amount") 73 | (enforce (<= (+ amount (at 'supply token)) max-supply) "Exceeds max supply") 74 | )) 75 | 76 | (defun enforce-burn:bool 77 | ( token:object{token-info} 78 | account:string 79 | amount:decimal 80 | ) 81 | (enforce-ledger) 82 | (enforce false "Burn prohibited") 83 | ) 84 | 85 | (defun enforce-init:bool 86 | ( token:object{token-info} 87 | ) 88 | (enforce-ledger) 89 | (let* ( (mint-guard:guard (read-keyset 'mint-guard )) 90 | (max-supply:decimal (read-decimal 'max-supply )) 91 | (min-amount:decimal (read-decimal 'min-amount )) 92 | ) 93 | (enforce (>= min-amount 0.0) "Invalid min-amount") 94 | (enforce (>= max-supply 0.0) "Invalid max-supply") 95 | (insert policies (at 'id token) 96 | { 'mint-guard: mint-guard 97 | , 'max-supply: max-supply 98 | , 'min-amount: min-amount }) 99 | true) 100 | ) 101 | 102 | (defun enforce-offer:bool 103 | ( token:object{token-info} 104 | seller:string 105 | amount:decimal 106 | sale-id:string 107 | ) 108 | @doc "Capture quote spec for SALE of TOKEN from message" 109 | (enforce-ledger) 110 | (enforce-sale-pact sale-id) 111 | (let* ( (spec:object{quote-spec} (read-msg QUOTE-MSG-KEY)) 112 | (fungible:module{fungible-v2} (at 'fungible spec) ) 113 | (price:decimal (at 'price spec)) 114 | (recipient:string (at 'recipient spec)) 115 | (recipient-guard:guard (at 'recipient-guard spec)) 116 | (recipient-details:object (fungible::details recipient)) 117 | (sale-price:decimal (* amount price)) ) 118 | (fungible::enforce-unit sale-price) 119 | (enforce (< 0.0 price) "Offer price must be positive") 120 | (enforce (= 121 | (at 'guard recipient-details) recipient-guard) 122 | "Recipient guard does not match") 123 | (insert quotes sale-id { 'id: (at 'id token), 'spec: spec }) 124 | (emit-event (QUOTE sale-id (at 'id token) amount price sale-price spec))) 125 | true 126 | ) 127 | 128 | (defun enforce-buy:bool 129 | ( token:object{token-info} 130 | seller:string 131 | buyer:string 132 | buyer-guard:guard 133 | amount:decimal 134 | sale-id:string ) 135 | (enforce-ledger) 136 | (enforce-sale-pact sale-id) 137 | (with-read quotes sale-id { 'id:= qtoken, 'spec:= spec:object{quote-spec} } 138 | (enforce (= qtoken (at 'id token)) "incorrect sale token") 139 | (bind spec 140 | { 'fungible := fungible:module{fungible-v2} 141 | , 'price := price:decimal 142 | , 'recipient := recipient:string 143 | } 144 | (fungible::transfer buyer recipient (* amount price)) 145 | ) 146 | ) 147 | true 148 | ) 149 | 150 | (defun enforce-sale-pact:bool (sale:string) 151 | "Enforces that SALE is id for currently executing pact" 152 | (enforce (= sale (pact-id)) "Invalid pact/sale id") 153 | ) 154 | 155 | (defun enforce-transfer:bool 156 | ( token:object{token-info} 157 | sender:string 158 | guard:guard 159 | receiver:string 160 | amount:decimal ) 161 | (enforce-ledger) 162 | (enforce false "Transfer prohibited") 163 | ) 164 | 165 | (defun enforce-crosschain:bool 166 | ( token:object{token-info} 167 | sender:string 168 | guard:guard 169 | receiver:string 170 | target-chain:string 171 | amount:decimal ) 172 | (enforce-ledger) 173 | (enforce false "Transfer prohibited") 174 | ) 175 | ) 176 | 177 | 178 | (if (read-msg 'upgrade) 179 | ["upgrade complete"] 180 | [ (create-table quotes) 181 | (create-table policies) ]) 182 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-random.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | 3 | ; This module provides random generation functions. 4 | ; 5 | ; The random integers Xn are generated according to the following formula: 6 | ; Xn = HASH(Xn-1 + TxHash + HASH(block-time)) 7 | ; Xn is stored in database for the next iteration 8 | ; 9 | ; The random string is derived from Xn with the following formula 10 | ; S = HASH( [Xn + 1] ) + HASH ( [Xn + 2] ) + HASH ( [Xn + 3] ) + .......... 11 | ; 12 | ; The result is easy to predict. Even if block-time includes microseconds, block-time 13 | ; is an exact copy of the creation-time of the previous block. 14 | ; That's why a contract whose security would rely on that module would be highly exploitable. 15 | ; An attacker just need to watch the current block, to predict what will be the generated numbers 16 | ; in the next block. 17 | ; 18 | ; => DO NOT NOT NOT USE this PRBS generator for cryptographic or lottery purposes. 19 | ; 20 | ; Several numbers can be generated in the same block or transaction. They will be all different, and uncorrelated 21 | ; 22 | ; 23 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 24 | ; https://github.com/CryptoPascal31/pact-util-lib 25 | 26 | (module util-random GOV 27 | "This module provides pseudo-random numbers/string generation \ 28 | \ Documentation: https://pact-util-lib.readthedocs.io \ 29 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 30 | 31 | (defconst VERSION:string "0.11") 32 | 33 | (bless "RBfxKPExaz5q6i64FLA_k7UVM9MaOO0UDJulfPFZBRA") 34 | (bless "I-yq-JDWu9Lpag6SJgkWbDtsaZ21k4YqOyA09uzSnuY") 35 | (bless "qSwrZYiS0ZR7fVcbIVrtC-f_ZB6n-Q-6JsTkn6zg2IQ") 36 | (bless "gq7DxC0_CPW3_zU4FbHXS6TFDd_cz45VYDjLCEzWsOs") 37 | (bless "NEG7aa1Edx6oU97d5wRh2Tl6Sw9Hiv4GOGBcZK2UWtU") 38 | (bless "od06XLD2aQzeFoasShObwYCWVTqgx-09IEL0fbksoFM") 39 | (bless "SVQVrKpSIj-1qBY3SxceeG_3GkODAIYdzszYa44yPe4") 40 | (bless "0C6T81mWS7QBA7nPBvaJLeO0ExPMwbVg20eKTNQ2DhU") 41 | (bless "wKB0nWJ-ti1LLUGR07zlZIs7_0g6PkCalRwK3pmaRmc") 42 | (bless "ZDYrboWZoGy1yX4rCNOW8H5ZyzK69zIiyD1qoOgvF5M") 43 | 44 | (defcap GOV() 45 | (enforce-keyset "free.util-lib")) 46 | 47 | (use util-lists [enforce-not-empty]) 48 | (use util-strings [join]) 49 | (use util-math [pow10 -- ++ is-even]) 50 | (use util-chain-data [block-time]) 51 | 52 | (defschema state-schema 53 | state:string) 54 | 55 | (deftable state-table:{state-schema}) 56 | 57 | (defun reset-state:string() 58 | "Reset the state of the generator. Should only be called when the contract is generated" 59 | (with-default-read state-table "" {'state:""} {"state":=s} 60 | (enforce (= s "") "Random generator already initialized" )) 61 | 62 | (write state-table ""{'state:(tx-hash)}) 63 | (+ "Random Generator state resetted to " (tx-hash)) 64 | ) 65 | 66 | (defun --random-hash:string () 67 | "Core private function which returns the 256 bits random number in base 64" 68 | (with-read state-table "" {"state":= old-state} 69 | (let ((seed1 (tx-hash)) 70 | (seed2 (hash (block-time))) 71 | (new-state (hash (concat [old-state seed1 seed2])))) 72 | (update state-table "" {'state:new-state}) 73 | new-state)) 74 | ) 75 | 76 | (defun random-int:integer () 77 | "Returns a 256 bit random integer" 78 | (str-to-int 64 (--random-hash))) 79 | 80 | (defun random-int-range:integer (min_:integer max_:integer) 81 | "Returns a random integer in range [min - max]" 82 | (enforce (and (>= min_ 0) (>= max_ 0)) "Min and Max must be positive") 83 | (enforce (> max_ min_) "Max must be > to min") 84 | (let ((modulus (++ (- max_ min_)))) 85 | (+ (mod (random-int) modulus) min_)) 86 | ) 87 | 88 | (defun random-decimal-range:decimal (min_:decimal max_:decimal) 89 | "Returns a random decimal in range [min - max] with a precision of 12" 90 | (enforce (> max_ min_) "Max must be > to min") 91 | (let ((to-int (lambda (x) (floor (* x (pow10 12))))) 92 | (to-decimal (lambda (x) (floor (* (dec x) (pow10 -12)) 12)))) 93 | (+ min_ (to-decimal (random-int-range 0 (to-int (- max_ min_)))))) 94 | ) 95 | 96 | (defun random-string:string (len:integer) 97 | "Returns a random string whose length is given by the argument" 98 | (let ((cnt (++ (/ len 43))) 99 | (rnd (random-int)) 100 | (substrings (map (lambda (x) (hash (+ rnd x))) (enumerate 1 cnt)))) 101 | (take len (concat substrings))) 102 | ) 103 | 104 | (defun random-bool:bool () 105 | "Returns a random boolean: a coin flip" 106 | (is-even (random-int))) 107 | 108 | (defun random-choice (choices-list:list) 109 | "Returns a random element from the non-empty list" 110 | (enforce-not-empty choices-list) 111 | (let ((max-idx (-- (length choices-list))) 112 | (idx (random-int-range 0 max-idx))) 113 | (at idx choices-list)) 114 | ) 115 | 116 | (defun shuffle:list (in:list) 117 | "Shuffle a list" 118 | (let ((seed (random-int)) 119 | (indexes (enumerate seed (+ (length in) seed))) 120 | (assign-order (lambda (x i) {'order:i, 'val:x }))) 121 | (map (at 'val) 122 | (sort ['order] 123 | (zip assign-order in (map (hash) indexes))))) 124 | ) 125 | 126 | (defun gen-uuid-rfc-4122-v4:string () 127 | "Generate an UUID (Universal Unique ID) according to RFC 4122 v4" 128 | (let ((set-bits (lambda (x bits mask) (int-to-str 16 (| bits (& mask (str-to-int 16 x)))))) 129 | (uid-hex (int-to-str 16 (random-int))) 130 | (field-4 (take -12 uid-hex)) 131 | (field-3 (take -4 (drop -12 uid-hex))) 132 | (field-3 (set-bits field-3 32768 16383)) 133 | (field-2 (take -4 (drop -16 uid-hex))) 134 | (field-2 (set-bits field-2 16384 4095)) 135 | (field-1 (take -4 (drop -20 uid-hex))) 136 | (field-0 (take -8 (drop -24 uid-hex)))) 137 | (join "-" [field-0, field-1, field-2, field-3, field-4])) 138 | ) 139 | ) 140 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-time.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | 3 | ; This modules provides some convenient time management function for Pact. 4 | ; 5 | ; Be aware that this module is only in Beta and hasn't been audited: 6 | ; --> BE CAREFUL if a security enforcement depends on one of theses functions 7 | ; 8 | ; 9 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 10 | ; https://github.com/CryptoPascal31/pact-util-lib 11 | 12 | (module util-time GOV 13 | "Module containing time utilities \ 14 | \ Documentation: https://pact-util-lib.readthedocs.io \ 15 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 16 | 17 | (defconst VERSION:string "0.11") 18 | 19 | (defcap GOV() 20 | (enforce-keyset "free.util-lib")) 21 | 22 | (use util-chain-data [block-time block-height]) 23 | (use util-math [between pow10]) 24 | 25 | (defconst EPOCH:time (time "1970-01-01T00:00:00Z")) 26 | 27 | (defconst HASKELL-EPOCH:time (time "1858-11-17T00:00:00Z")) 28 | 29 | (defconst GENESIS:time (time "2019-10-30T00:01:00Z")) 30 | 31 | (defconst BLOCK-TIME 30.0) 32 | 33 | ; General functions 34 | (defun epoch:time () 35 | "Returns Unix EPOCH" 36 | EPOCH) 37 | 38 | (defun genesis:time () 39 | "Returns Kadena Genesis time" 40 | GENESIS) 41 | 42 | (defun now:time () 43 | "Returns the current time" 44 | (block-time)) 45 | 46 | ;; Safe time computation management 47 | ; 48 | ; (add-time) uses Haskell time library and can overflow 49 | ; Haskell computes time from the TAI EPOCH ("1858-11-17T00:00:00Z") is useconds. 50 | ; in signed int64 (min = - 2^63, max = 2 ^63 -1) 51 | ; 52 | ; To be sure, we never overflowwe limits: 53 | ; - Every usable time to (TAI EPOCH +/- 2^62/1e6 -1) 54 | ; - Every usable offset to (+/- 2^62/1e6 -1) 55 | ; 56 | ; By enforcing such limits, we can guarantee that time functions never overflow. 57 | ; 58 | ; When a Smart contract developer uses (add-time), (diff-time), (time) or (parse-time) with 59 | ; user supplied inputs, he should preferably use safe counterparts to avoid non-expected 60 | ; behaviour that could yield to a security issue. 61 | ; 62 | ; For parsing functions: ie (time) and (parse-time), we compare the input string with 63 | ; the stringified parsed date. If there is a difference, it means that an overflow probably occured 64 | (defconst SAFE-DELTA:decimal (- (/ (^ 2.0 62.0) (pow10 6)) 1.0)) 65 | 66 | (defconst MIN-SAFE-TIME:time (add-time HASKELL-EPOCH (- SAFE-DELTA))) 67 | 68 | (defconst MAX-SAFE-TIME:time (add-time HASKELL-EPOCH SAFE-DELTA)) 69 | 70 | (defun --enforce-safe-time:bool (in:time) 71 | (enforce (time-between MIN-SAFE-TIME MAX-SAFE-TIME in) "Time out of safe bounds")) 72 | 73 | (defun --enforce-safe-delta:bool (in:decimal) 74 | (enforce (between (- SAFE-DELTA) SAFE-DELTA in) "Delta out of safe bounds")) 75 | 76 | (defun time-safe:time (in:string) 77 | "Do a (time) without any risk of overflow" 78 | (let ((t (time in))) 79 | (enforce (= in (format-time "%Y-%m-%dT%H:%M:%SZ" t)) "Unsafe time conversion") 80 | (--enforce-safe-time t) 81 | t) 82 | ) 83 | 84 | (defun parse-time-safe:time (fmt:string in:string) 85 | "Do a (parse-time) without any risk of overflow" 86 | (let ((t (parse-time fmt in))) 87 | (enforce (= in (format-time fmt t)) "Unsafe time conversion") 88 | (--enforce-safe-time t) 89 | t) 90 | ) 91 | 92 | (defun add-time-safe:time (in:time delta:decimal) 93 | "Do a (add-time) without any risk of overflow" 94 | (--enforce-safe-time in) 95 | (--enforce-safe-delta delta) 96 | (add-time in delta) 97 | ) 98 | 99 | (defun diff-time-safe:decimal (x:time y:time) 100 | "Do a (diff-time) without any risk of overflow" 101 | (--enforce-safe-time x) 102 | (--enforce-safe-time y) 103 | (diff-time x y) 104 | ) 105 | 106 | (defun tomorrow:time () 107 | "Returns current time + 24 hours" 108 | (from-now (days 1)) 109 | ) 110 | 111 | (defun yesterday:time () 112 | "Returns current time - 24 hours" 113 | (from-now (days -1)) 114 | ) 115 | 116 | (defun from-now:time (delta:decimal) 117 | "Returns the delta time taking now as a reference" 118 | (--enforce-safe-delta delta) 119 | (add-time (now) delta) 120 | ) 121 | 122 | (defun today:string () 123 | "Returns the current day" 124 | (format-time "%F" (now)) 125 | ) 126 | 127 | (defun to-timestamp:decimal (in:time) 128 | "Computes an Unix timestamp of the input date" 129 | (--enforce-safe-time in) 130 | (diff-time in (epoch)) 131 | ) 132 | 133 | (defun from-timestamp:time (timestamp:decimal) 134 | "Computes a time from an Unix timestamp" 135 | (--enforce-safe-delta timestamp) 136 | (add-time (epoch) timestamp) 137 | ) 138 | 139 | ;; Compare functions 140 | (defun earliest:time (time1:time time2:time) 141 | "Returns the earliest time between time1 and time2" 142 | (if (< time1 time2) time1 time2) 143 | ) 144 | 145 | (defun latest:time (time1:time time2:time) 146 | "Returns the latest time between time1 and time2" 147 | (if (> time1 time2) time1 time2) 148 | ) 149 | 150 | (defun time-between:bool (time1:time time2:time in:time) 151 | "Returns true if in is between time1 and time2" 152 | (let ((a (earliest time1 time2)) 153 | (b (latest time1 time2))) 154 | (and? (<= a) (>= b) in)) 155 | ) 156 | 157 | (defun is-past:bool (in:time) 158 | "Returns true if the date is in the past (before now)" 159 | (< in (now)) 160 | ) 161 | 162 | (defun is-future:bool (in:time) 163 | "Returns true if the date is in the future (after now)" 164 | (> in (now)) 165 | ) 166 | 167 | (defun is-today:bool (in:time) 168 | "Returns true if the time in is in the current day" 169 | (let ((in-day (format-time "%F" in))) 170 | (= (today) in-day)) 171 | ) 172 | 173 | 174 | (defun est-height-at-time:integer (target-time:time) 175 | "Estimates the block height at a target-time" 176 | (--enforce-safe-time target-time) 177 | (let ((delta (diff-time target-time (now))) 178 | (est-block (+ (block-height) (round (/ delta BLOCK-TIME))))) 179 | (if (> est-block 0 ) est-block 0)) 180 | ) 181 | 182 | (defun est-time-at-height:time (target-block:integer) 183 | "Estimates the time of the target-block height" 184 | (let* ((delta-blocks (- target-block (block-height))) 185 | (delta (* BLOCK-TIME (dec delta-blocks)))) 186 | (--enforce-safe-delta delta) 187 | (add-time (now) delta)) 188 | ) 189 | 190 | ;; Diff time functions 191 | (defun diff-time-minutes:decimal (time1:time time2:time) 192 | "Computes difference between TIME1 and TIME2 in minutes" 193 | (/ (diff-time-safe time1 time2) 60.0) 194 | ) 195 | 196 | (defun diff-time-hours:decimal (time1:time time2:time) 197 | "Computes difference between TIME1 and TIME2 in hours" 198 | (/ (diff-time-safe time1 time2) 3600.0) 199 | ) 200 | 201 | (defun diff-time-days:decimal (time1:time time2:time) 202 | "Computes difference between TIME1 and TIME2 in days" 203 | (/ (diff-time-safe time1 time2) 86400.0) 204 | ) 205 | ) 206 | -------------------------------------------------------------------------------- /kda-env/marmalade/fixed-quote-royalty-policy.pact: -------------------------------------------------------------------------------- 1 | (namespace (read-msg 'ns)) 2 | 3 | (module fixed-quote-royalty-policy GOVERNANCE 4 | 5 | @doc "Policy for fixed issuance with royalty and quoted sale in specified fungible." 6 | 7 | (defcap GOVERNANCE () 8 | (enforce-guard (keyset-ref-guard 'marmalade-admin ))) 9 | 10 | (implements kip.token-policy-v1) 11 | (use kip.token-policy-v1 [token-info]) 12 | 13 | (defschema policy-schema 14 | fungible:module{fungible-v2} 15 | creator:string 16 | creator-guard:guard 17 | mint-guard:guard 18 | max-supply:decimal 19 | min-amount:decimal 20 | royalty-rate:decimal 21 | ) 22 | 23 | (deftable policies:{policy-schema}) 24 | 25 | (defconst TOKEN_SPEC "token_spec" 26 | @doc "Payload field for token spec") 27 | 28 | (defconst QUOTE-MSG-KEY "quote" 29 | @doc "Payload field for quote spec") 30 | 31 | (defschema quote-spec 32 | @doc "Quote data to include in payload" 33 | price:decimal 34 | recipient:string 35 | recipient-guard:guard 36 | ) 37 | 38 | (defschema quote-schema 39 | id:string 40 | spec:object{quote-spec}) 41 | 42 | (deftable quotes:{quote-schema}) 43 | 44 | (defun get-policy:object{policy-schema} (token:object{token-info}) 45 | (read policies (at 'id token)) 46 | ) 47 | 48 | (defcap QUOTE:bool 49 | ( sale-id:string 50 | token-id:string 51 | amount:decimal 52 | price:decimal 53 | sale-price:decimal 54 | royalty-payout:decimal 55 | creator:string 56 | spec:object{quote-spec} 57 | ) 58 | @doc "For event emission purposes" 59 | @event 60 | true 61 | ) 62 | 63 | (defun enforce-ledger:bool () 64 | (enforce-guard (marmalade.ledger.ledger-guard)) 65 | ) 66 | 67 | (defun enforce-mint:bool 68 | ( token:object{token-info} 69 | account:string 70 | guard:guard 71 | amount:decimal 72 | ) 73 | (enforce-ledger) 74 | (bind (get-policy token) 75 | { 'mint-guard:=mint-guard:guard 76 | , 'min-amount:=min-amount:decimal 77 | , 'max-supply:=max-supply:decimal 78 | } 79 | (enforce-guard mint-guard) 80 | (enforce (>= amount min-amount) "mint amount < min-amount") 81 | (enforce (<= (+ amount (at 'supply token)) max-supply) "Exceeds max supply") 82 | )) 83 | 84 | (defun enforce-burn:bool 85 | ( token:object{token-info} 86 | account:string 87 | amount:decimal 88 | ) 89 | (enforce-ledger) 90 | (enforce false "Burn prohibited") 91 | ) 92 | 93 | (defun enforce-init:bool 94 | ( token:object{token-info} 95 | ) 96 | (enforce-ledger) 97 | (let* ( (spec:object{policy-schema} (read-msg TOKEN_SPEC)) 98 | (fungible:module{fungible-v2} (at 'fungible spec)) 99 | (creator:string (at 'creator spec)) 100 | (creator-guard:guard (at 'creator-guard spec)) 101 | (mint-guard:guard (at 'mint-guard spec)) 102 | (max-supply:decimal (at 'max-supply spec)) 103 | (min-amount:decimal (at 'min-amount spec)) 104 | (royalty-rate:decimal (at 'royalty-rate spec)) 105 | (creator-details:object (fungible::details creator )) 106 | ) 107 | (enforce (>= min-amount 0.0) "Invalid min-amount") 108 | (enforce (>= max-supply 0.0) "Invalid max-supply") 109 | (enforce (= 110 | (at 'guard creator-details) creator-guard) 111 | "Creator guard does not match") 112 | (enforce (and 113 | (>= royalty-rate 0.0) (<= royalty-rate 1.0)) 114 | "Invalid royalty rate") 115 | (insert policies (at 'id token) 116 | { 'fungible: fungible 117 | , 'creator: creator 118 | , 'creator-guard: creator-guard 119 | , 'mint-guard: mint-guard 120 | , 'max-supply: max-supply 121 | , 'min-amount: min-amount 122 | , 'royalty-rate: royalty-rate })) 123 | true 124 | ) 125 | 126 | (defun enforce-offer:bool 127 | ( token:object{token-info} 128 | seller:string 129 | amount:decimal 130 | sale-id:string 131 | ) 132 | @doc "Capture quote spec for SALE of TOKEN from message" 133 | (enforce-ledger) 134 | (enforce-sale-pact sale-id) 135 | (bind (get-policy token) 136 | { 'fungible := fungible:module{fungible-v2} 137 | ,'royalty-rate:= royalty-rate:decimal 138 | ,'creator:= creator:string 139 | } 140 | (let* ( (spec:object{quote-spec} (read-msg QUOTE-MSG-KEY)) 141 | (price:decimal (at 'price spec)) 142 | (recipient:string (at 'recipient spec)) 143 | (recipient-guard:guard (at 'recipient-guard spec)) 144 | (recipient-details:object (fungible::details recipient)) 145 | (sale-price:decimal (* amount price)) 146 | (royalty-payout:decimal 147 | (floor (* sale-price royalty-rate) (fungible::precision))) ) 148 | (fungible::enforce-unit sale-price) 149 | (enforce (< 0.0 price) "Offer price must be positive") 150 | (enforce (= 151 | (at 'guard recipient-details) recipient-guard) 152 | "Recipient guard does not match") 153 | (insert quotes sale-id { 'id: (at 'id token), 'spec: spec }) 154 | (emit-event (QUOTE sale-id (at 'id token) amount price sale-price royalty-payout creator spec))) 155 | true 156 | ) 157 | ) 158 | 159 | (defun enforce-buy:bool 160 | ( token:object{token-info} 161 | seller:string 162 | buyer:string 163 | buyer-guard:guard 164 | amount:decimal 165 | sale-id:string ) 166 | (enforce-ledger) 167 | (enforce-sale-pact sale-id) 168 | (bind (get-policy token) 169 | { 'fungible := fungible:module{fungible-v2} 170 | , 'creator:= creator:string 171 | , 'royalty-rate:= royalty-rate:decimal 172 | } 173 | (with-read quotes sale-id { 'id:= qtoken, 'spec:= spec:object{quote-spec} } 174 | (enforce (= qtoken (at 'id token)) "incorrect sale token") 175 | (bind spec 176 | { 'price := price:decimal 177 | , 'recipient := recipient:string 178 | } 179 | (let* ((sale-price:decimal (* amount price)) 180 | (royalty-payout:decimal 181 | (floor (* sale-price royalty-rate) (fungible::precision))) 182 | (payout:decimal (- sale-price royalty-payout)) ) 183 | (if 184 | (> royalty-payout 0.0) 185 | (fungible::transfer buyer creator royalty-payout) 186 | "No royalty") 187 | (fungible::transfer buyer recipient payout))) 188 | true 189 | )) 190 | ) 191 | 192 | (defun enforce-sale-pact:bool (sale:string) 193 | "Enforces that SALE is id for currently executing pact" 194 | (enforce (= sale (pact-id)) "Invalid pact/sale id") 195 | ) 196 | 197 | (defun enforce-transfer:bool 198 | ( token:object{token-info} 199 | sender:string 200 | guard:guard 201 | receiver:string 202 | amount:decimal ) 203 | (enforce-ledger) 204 | (enforce false "Transfer prohibited") 205 | ) 206 | 207 | (defun enforce-crosschain:bool 208 | ( token:object{token-info} 209 | sender:string 210 | guard:guard 211 | receiver:string 212 | target-chain:string 213 | amount:decimal ) 214 | (enforce-ledger) 215 | (enforce false "Transfer prohibited") 216 | ) 217 | ) 218 | 219 | 220 | (if (read-msg 'upgrade) 221 | ["upgrade complete"] 222 | [ (create-table quotes) 223 | (create-table policies) ]) 224 | -------------------------------------------------------------------------------- /kda-env/marmalade/poly-fungible-v2.pact: -------------------------------------------------------------------------------- 1 | (namespace 'kip) 2 | 3 | (interface poly-fungible-v2 4 | 5 | (defschema account-details 6 | @doc 7 | " Account details: token ID, account name, balance, and guard." 8 | @model 9 | [ (invariant (!= id "")) 10 | (invariant (!= account "")) 11 | (invariant (>= balance 0.0)) 12 | ] 13 | id:string 14 | account:string 15 | balance:decimal 16 | guard:guard) 17 | 18 | (defschema sender-balance-change 19 | @doc "For use in RECONCILE events" 20 | account:string 21 | previous:decimal 22 | current:decimal 23 | ) 24 | 25 | (defschema receiver-balance-change 26 | @doc "For use in RECONCILE events" 27 | account:string 28 | previous:decimal 29 | current:decimal 30 | ) 31 | 32 | (defcap TRANSFER:bool 33 | ( id:string 34 | sender:string 35 | receiver:string 36 | amount:decimal 37 | ) 38 | @doc 39 | " Manage transferring AMOUNT of ID from SENDER to RECEIVER. \ 40 | \ As event, also used to notify burn (with \"\" RECEIVER) \ 41 | \ and create (with \"\" SENDER)." 42 | @managed amount TRANSFER-mgr 43 | ) 44 | 45 | (defcap XTRANSFER:bool 46 | ( id:string 47 | sender:string 48 | receiver:string 49 | target-chain:string 50 | amount:decimal 51 | ) 52 | " Manage cross-chain transferring AMOUNT of ID from SENDER to RECEIVER \ 53 | \ on TARGET-CHAIN." 54 | @managed amount TRANSFER-mgr 55 | ) 56 | 57 | (defun TRANSFER-mgr:decimal 58 | ( managed:decimal 59 | requested:decimal 60 | ) 61 | @doc " Manages TRANSFER cap AMOUNT where MANAGED is the installed quantity \ 62 | \ and REQUESTED is the quantity attempting to be granted." 63 | ) 64 | 65 | (defcap SUPPLY:bool (id:string supply:decimal) 66 | @doc " Emitted when SUPPLY is updated, if supported." 67 | @event 68 | ) 69 | 70 | (defcap TOKEN:bool (id:string precision:integer supply:decimal policy:module{kip.token-policy-v1}) 71 | @doc " Emitted when token ID is created." 72 | @event 73 | ) 74 | 75 | (defcap ACCOUNT_GUARD:bool (id:string account:string guard:guard) 76 | @doc " Emitted when ACCOUNT guard is updated." 77 | @event 78 | ) 79 | 80 | (defcap RECONCILE:bool 81 | ( token-id:string 82 | amount:decimal 83 | sender:object{sender-balance-change} 84 | receiver:object{receiver-balance-change} 85 | ) 86 | @doc " For accounting via events. \ 87 | \ sender = {account: '', previous: 0.0, current: 0.0} for mint \ 88 | \ receiver = {account: '', previous: 0.0, current: 0.0} for burn" 89 | @event 90 | ) 91 | 92 | (defun precision:integer (id:string) 93 | @doc 94 | " Return maximum decimal precision for ID." 95 | ) 96 | 97 | (defun enforce-unit:bool 98 | ( id:string 99 | amount:decimal 100 | ) 101 | @doc 102 | " Enforce that AMOUNT meets minimum precision allowed for ID." 103 | ) 104 | 105 | (defun create-account:bool 106 | ( id:string 107 | account:string 108 | guard:guard 109 | ) 110 | @doc 111 | " Create ACCOUNT for ID with 0.0 balance, with GUARD controlling access." 112 | @model 113 | [ (property (!= id "")) 114 | (property (!= account "")) 115 | ] 116 | ) 117 | 118 | (defun get-balance:decimal 119 | ( id:string 120 | account:string 121 | ) 122 | @doc 123 | " Get balance of ID for ACCOUNT. Fails if account does not exist." 124 | ) 125 | 126 | (defun details:object{account-details} 127 | ( id:string 128 | account:string 129 | ) 130 | @doc 131 | " Get details of ACCOUNT under ID. Fails if account does not exist." 132 | ) 133 | 134 | (defun rotate:bool 135 | ( id:string 136 | account:string 137 | new-guard:guard ) 138 | @doc 139 | " Rotate guard for ACCOUNT for ID to NEW-GUARD, validating against existing guard." 140 | @model 141 | [ (property (!= id "")) 142 | (property (!= account "")) 143 | ] 144 | 145 | ) 146 | 147 | (defun transfer:bool 148 | ( id:string 149 | sender:string 150 | receiver:string 151 | amount:decimal 152 | ) 153 | @doc 154 | " Transfer AMOUNT of ID between accounts SENDER and RECEIVER. \ 155 | \ Fails if SENDER does not exist. Managed by TRANSFER." 156 | @model 157 | [ (property (> amount 0.0)) 158 | (property (!= id "")) 159 | (property (!= sender "")) 160 | (property (!= receiver "")) 161 | (property (!= sender receiver)) 162 | ] 163 | ) 164 | 165 | (defun transfer-create:bool 166 | ( id:string 167 | sender:string 168 | receiver:string 169 | receiver-guard:guard 170 | amount:decimal 171 | ) 172 | @doc 173 | " Transfer AMOUNT of ID between accounts SENDER and RECEIVER. \ 174 | \ If RECEIVER exists, RECEIVER-GUARD must match existing guard; \ 175 | \ if RECEIVER does not exist, account is created. \ 176 | \ Managed by TRANSFER." 177 | @model 178 | [ (property (> amount 0.0)) 179 | (property (!= id "")) 180 | (property (!= sender "")) 181 | (property (!= receiver "")) 182 | (property (!= sender receiver)) 183 | ] 184 | ) 185 | 186 | (defpact transfer-crosschain:bool 187 | ( id:string 188 | sender:string 189 | receiver:string 190 | receiver-guard:guard 191 | target-chain:string 192 | amount:decimal 193 | ) 194 | @doc 195 | " Transfer AMOUNT of ID between accounts SENDER on source chain \ 196 | \ and RECEIVER on TARGET-CHAIN. If RECEIVER exists, RECEIVER-GUARD \ 197 | \ must match existing guard. If RECEIVER does not exist, account is created." 198 | @model 199 | [ (property (> amount 0.0)) 200 | (property (!= id "")) 201 | (property (!= sender "")) 202 | (property (!= receiver "")) 203 | (property (!= target-chain "")) 204 | ] 205 | ) 206 | 207 | (defun total-supply:decimal (id:string) 208 | @doc 209 | " Give total available quantity of ID. If not supported, return 0." 210 | ) 211 | 212 | (defun get-manifest:object{kip.token-manifest.manifest} (id:string) 213 | @doc 214 | " Give manifest for ID." 215 | ) 216 | 217 | ;; 218 | ;; Sale API 219 | ;; 220 | 221 | (defcap SALE:bool 222 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 223 | @doc "Wrapper cap/event of SALE of token ID by SELLER of AMOUNT until TIMEOUT block height." 224 | @event 225 | ) 226 | 227 | (defcap OFFER:bool 228 | (id:string seller:string amount:decimal timeout:integer) 229 | @doc "Managed cap for SELLER offering AMOUNT of token ID until TIMEOUT." 230 | @managed 231 | ) 232 | 233 | (defcap WITHDRAW:bool 234 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 235 | @doc "Withdraws offer SALE from SELLER of AMOUNT of token ID after TIMEOUT." 236 | @event 237 | ) 238 | 239 | (defcap BUY:bool 240 | (id:string seller:string buyer:string amount:decimal timeout:integer sale-id:string) 241 | @doc "Completes sale OFFER to BUYER." 242 | @managed 243 | ) 244 | 245 | (defpact sale:bool 246 | ( id:string 247 | seller:string 248 | amount:decimal 249 | timeout:integer 250 | ) 251 | @doc " Offer->buy escrow pact of AMOUNT of token ID by SELLER with TIMEOUT in blocks. \ 252 | \ Step 1 is offer with withdraw rollback after timeout. \ 253 | \ Step 2 is buy, which completes using 'buyer' and 'buyer-guard' payload values." 254 | ) 255 | 256 | ) 257 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-lists.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | 3 | ; This module provides some utilities to work with lists in Pact 4 | ; Be aware that this module is only in Beta and hasn't been audited: 5 | ; --> BE CAREFUL if a security enforcement depends on one of these functions 6 | ; 7 | ; Remember that in Pact, all variables are immutable and no function can 8 | ; work in place. New lists are always returned. 9 | ; 10 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 11 | ; https://github.com/CryptoPascal31/pact-util-lib 12 | 13 | (module util-lists GOV 14 | "This module provides some lists management utilities \ 15 | \ Documentation: https://pact-util-lib.readthedocs.io \ 16 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 17 | 18 | (defconst VERSION:string "0.11") 19 | 20 | (defcap GOV() 21 | (enforce-keyset "free.util-lib")) 22 | 23 | (defun enforce-not-empty:bool (x:list) 24 | "Verify and ENFORCES that a list is not empty" 25 | (enforce (is-not-empty x) "List cannot be empty")) 26 | 27 | (defun is-empty:bool (x:list) 28 | "Return true if the list is empty" 29 | (= 0 (length x))) 30 | 31 | (defun is-not-empty:bool (x:list) 32 | "Return true if the list is not empty" 33 | (< 0 (length x))) 34 | 35 | (defun is-singleton:bool (x:list) 36 | "Return true if the list is a singleton" 37 | (= 1 (length x))) 38 | 39 | (defun is-pair:bool (x:list) 40 | "Return true if the list is a pair" 41 | (= 2 (length x))) 42 | 43 | (defun is-length:bool (target:integer x:list) 44 | "Returns true if the list has the targetted length" 45 | (= target (length x))) 46 | 47 | (defun enforce-list-bounds:bool (x:list idx:integer) 48 | "Verify and ENFORCES that idx is in list bounds" 49 | (enforce (and? (<= 0) (> (length x)) idx) "Index out of bounds")) 50 | 51 | (defun chain:list (in:list) 52 | "Chain list of lists" 53 | (fold + [] in)) 54 | 55 | (defun same-length:bool (x:list y:list) 56 | "Return true if two lists have the same length" 57 | (= (length x) (length y))) 58 | 59 | (defschema list-enum 60 | "Object returned by enumerate-list" 61 | i:integer 62 | v) 63 | 64 | (defun enumerate-list:[object{list-enum}] (in:list) 65 | "Returns a list of objects {'i:idx, 'v:value} where i is the index, and v the value" 66 | ; The enumeration should go from 0 to N-1, but since zip takes the shortest, and for clarity we go from 0 to N 67 | (let ((indexes (enumerate 0 (length in)))) 68 | (zip (lambda (idx:integer x) {'i:idx, 'v:x}) indexes in)) 69 | ) 70 | 71 | (defun contains*:bool (in:list item) 72 | "Starred version of contains for list => arguments inverted" 73 | (contains item in) 74 | ) 75 | 76 | ;; Getter Functions 77 | (defun first (in:list) 78 | "Returns the first item of a list" 79 | (enforce-not-empty in) 80 | (at 0 in)) 81 | 82 | (defun last (in:list) 83 | "Returns the last item of the list" 84 | (enforce-not-empty in) 85 | (at (- (length in) 1) in)) 86 | 87 | (defun at* (in:list idx:integer default) 88 | "Returns the element at idx, but returns default if the list is too short" 89 | (enforce (>= idx 0) "Index cannot be negative") 90 | (if (>= idx (length in)) 91 | default 92 | (at idx in)) 93 | ) 94 | 95 | (defun search:[integer] (in:list item) 96 | "Search an item into the list and returns a list of index" 97 | ; Save gas if item is not in list => use the native contains to return empty 98 | (if (contains item in) 99 | (let ((indexes (enumerate 0 (length in))) 100 | (match (lambda (v i) (if (= item v) i -1)))) 101 | (remove-item (zip match in indexes) -1)) 102 | []) 103 | ) 104 | 105 | (defun count:integer (in:list item) 106 | "Returns the number of occurences of an item" 107 | (length (filter (= item) in)) 108 | ) 109 | 110 | ;; Creation and extension functions 111 | (defun make-list-like:list (in:list value) 112 | "Creates a new list whose size is the same as in, by repeating value" 113 | (make-list (length in) value) 114 | ) 115 | 116 | (defun extend:list (in:list new-length:integer value) 117 | "Extends a list to new-length by repeating value" 118 | (let ((missing-items (- new-length (length in)))) 119 | (if (<= missing-items 0) 120 | in 121 | (+ in (make-list missing-items value)))) 122 | ) 123 | 124 | (defun extend-like:list (in:list target:list value) 125 | "Extends a list to the same length as target, by repeating value" 126 | (extend in (length target) value) 127 | ) 128 | 129 | ;; Insertion functions 130 | (defun insert-first:list (in:list item) 131 | "Insert an item at the left of the list" 132 | (+ [item] in)) 133 | 134 | (defun append-last:list (in:list item) 135 | "Append an item at the end of the list" 136 | (+ in [item])) 137 | 138 | (defun insert-at:list (in:list idx:integer item) 139 | "Insert an item at position idx" 140 | (enforce (and? (<= 0) (>= (length in)) idx) "Index out of bounds") 141 | (chain [(take idx in), 142 | [item], 143 | (drop idx in)]) 144 | ) 145 | 146 | (defun insert-at*:list (in:list idx:integer item default) 147 | "Insert an item at position idx, extends the list if it is too short using the default value" 148 | (insert-at (extend in idx default) idx item) 149 | ) 150 | 151 | ;; Replacement functions 152 | (defun replace-first:list (in:list item) 153 | "Replace the first item of the list" 154 | (enforce-not-empty in) 155 | (insert-first (drop 1 in) item)) 156 | 157 | (defun replace-last:list (in:list item) 158 | "Replace the last item of the list" 159 | (enforce-not-empty in) 160 | (append-last (drop -1 in) item)) 161 | 162 | (defun replace-at:list (in:list idx:integer item) 163 | "Replace the item at position idx" 164 | (enforce (and? (<= 0) (> (length in)) idx) "Index out of bounds") 165 | (chain [(take idx in), 166 | [item], 167 | (drop (+ 1 idx) in)]) 168 | ) 169 | 170 | (defun replace-at*:list (in:list idx:integer item default) 171 | "Replace an item at position idx, extends the list if it is too short using the default value" 172 | (replace-at (extend in (+ idx 1) default) idx item) 173 | ) 174 | 175 | (defun replace-item:list (in:list old-item new-item) 176 | "Replace each occurrence of old-item by new-item" 177 | (map (lambda (x) (if (= x old-item) new-item x)) in) 178 | ) 179 | 180 | (defun replace-item*:list (in:list old-item new-item) 181 | "Replace each occurrence of old-item by new-item but raises an error if old-item does not exist" 182 | (enforce (contains old-item in) "The item is not present in the list") 183 | (replace-item in old-item new-item) 184 | ) 185 | 186 | ;; Removal functions 187 | (defun remove-first:list (in:list) 188 | "Remove first element from the list" 189 | (enforce-not-empty in) 190 | (drop 1 in) 191 | ) 192 | 193 | (defun remove-last:list (in:list) 194 | "Remove last element from the list" 195 | (enforce-not-empty in) 196 | (drop -1 in) 197 | ) 198 | 199 | (defun remove-at:list (in:list idx:integer) 200 | "Remove element at position idx" 201 | (enforce-list-bounds in idx) 202 | (+ (take idx in) (drop (+ 1 idx) in)) 203 | ) 204 | 205 | (defun remove-item:list (in:list item) 206 | "Remove an item from a list" 207 | (filter (!= item) in) 208 | ) 209 | 210 | (defun remove-item*:list (in:list item) 211 | "Remove and item from the list but raises an error if it does not exist" 212 | (enforce (contains item in) "The item is not present in the list") 213 | (remove-item in item) 214 | ) 215 | 216 | ;; Shift/Roll functions 217 | (defun shift-left:list (in:list item) 218 | "Shift a list to the left" 219 | (remove-first (append-last in item))) 220 | 221 | (defun shift-right:list (in:list item) 222 | "Shift a list to the right" 223 | (remove-last (insert-first in item))) 224 | 225 | (defun roll-left:list (in:list) 226 | "Roll a list to the left" 227 | (shift-left in (first in))) 228 | 229 | (defun roll-right:list (in:list) 230 | "Roll a list to the right" 231 | (shift-right in (last in))) 232 | 233 | (defun fifo-push:list (in:list fifo-size:integer item) 234 | "Append an item at the right, and shift left if the FIFO if full" 235 | (if (>= (length in) fifo-size) 236 | (shift-left in item) 237 | (append-last in item)) 238 | ) 239 | ) 240 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-math.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | 3 | ; This modules provides some convenient math function for Pact. 4 | ; 5 | ; Be aware that this module is only in Beta and hasn't been audited: 6 | ; --> BE CAREFUL if a security enforcement depends on one of theses functions 7 | ; 8 | ; 9 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 10 | ; https://github.com/CryptoPascal31/pact-util-lib 11 | 12 | (module util-math GOV 13 | "Module containing math utilities \ 14 | \ Documentation: https://pact-util-lib.readthedocs.io \ 15 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 16 | 17 | (defconst VERSION:string "0.11") 18 | 19 | (defcap GOV() 20 | (enforce-keyset "free.util-lib")) 21 | 22 | (use util-lists [enforce-not-empty first enumerate-list remove-first]) 23 | 24 | (defconst PI:decimal 3.141592653589793) 25 | 26 | (defconst E:decimal 2.718281828459045) 27 | 28 | (defconst GOLDEN-RATIO:decimal (/ (+ 1.0 (sqrt 5.0)) 2.0)) 29 | 30 | (defun min:decimal (x:decimal y:decimal) 31 | "Returns the min of 2 values" 32 | (if (< x y) x y)) 33 | 34 | (defun min3:decimal (x:decimal y:decimal z:decimal) 35 | "Returns the min of 3 values" 36 | (min x (min y z))) 37 | 38 | (defun min4:decimal (x:decimal y:decimal z:decimal zz:decimal) 39 | "Returns the min of 4 values" 40 | (min (min x y) (min z zz))) 41 | 42 | (defun min-list:decimal (x:[decimal]) 43 | "Returns the min of a list" 44 | (enforce-not-empty x) 45 | (fold min (first x) (remove-first x)) 46 | ) 47 | 48 | (defun amin:integer (in:[decimal]) 49 | "Returns the min index of a list" 50 | (enforce-not-empty in) 51 | (let ((in-enum (enumerate-list in)) 52 | (cmp (lambda (x y) (if (< (at 'v x) (at 'v y)) x y)))) 53 | (at 'i (fold cmp (first in-enum) (remove-first in-enum)))) 54 | ) 55 | 56 | (defun max:decimal (x:decimal y:decimal) 57 | "Returns the max of 2 values" 58 | (if (> x y) x y)) 59 | 60 | (defun max3:decimal (x:decimal y:decimal z:decimal) 61 | "Returns the max of 3 values" 62 | (max x (max y z))) 63 | 64 | (defun max4:decimal (x:decimal y:decimal z:decimal zz:decimal) 65 | "Returns the max of 4 values" 66 | (max (max x y) (max z zz))) 67 | 68 | (defun max-list:decimal (x:[decimal]) 69 | "Returns the max of a list" 70 | (enforce-not-empty x) 71 | (fold max (first x) (remove-first x)) 72 | ) 73 | 74 | (defun amax:integer (in:[decimal]) 75 | "Returns the max index of a list" 76 | (enforce-not-empty in) 77 | (let ((in-enum (enumerate-list in)) 78 | (cmp (lambda (x y) (if (> (at 'v x) (at 'v y)) x y)))) 79 | (at 'i (fold cmp (first in-enum) (remove-first in-enum)))) 80 | ) 81 | 82 | (defun clamp:decimal (low-limit:decimal up-limit:decimal x:decimal) 83 | "Clamp x between low-limit and up-limit" 84 | (cond 85 | ((< x low-limit) low-limit) 86 | ((> x up-limit) up-limit) 87 | x) 88 | ) 89 | 90 | (defun sum3:decimal (x:decimal y:decimal z:decimal) 91 | "Returns the sum of 3 values" 92 | (+ x (+ y z))) 93 | 94 | (defun sum4:decimal (x:decimal y:decimal z:decimal zz:decimal) 95 | "Returns the sum of 4 values" 96 | (+ (+ x y) (+ z zz))) 97 | 98 | (defun sum:decimal (x:[decimal]) 99 | "Returns the sum of a list" 100 | (fold + 0.0 x)) 101 | 102 | (defun prod3:decimal (x:decimal y:decimal z:decimal) 103 | "Returns the product of 3 values" 104 | (* x (* y z))) 105 | 106 | (defun prod4:decimal (x:decimal y:decimal z:decimal zz:decimal) 107 | "Returns the product of 4 values" 108 | (* (* x y) (* z zz))) 109 | 110 | (defun prod:decimal (x:[decimal]) 111 | "Returns the product of a list" 112 | (fold * 1.0 x)) 113 | 114 | (defun square:decimal (x:decimal) 115 | "Returns the square of x" 116 | (* x x)) 117 | 118 | (defun safe-/ (x:decimal y:decimal default:decimal) 119 | "Divide x/y but returns default if y is 0.0" 120 | (if (= y 0.0) default (/ x y))) 121 | 122 | (defun geom-mean(x:[decimal]) 123 | "Return the geometric mean of a list" 124 | (enforce-not-empty x) 125 | (^ (prod x) (/ 1.0 (dec (length x))))) 126 | 127 | (defun avg:decimal (x:[decimal]) 128 | "Returns the average of a list" 129 | (enforce-not-empty x) 130 | (/ (sum x) (dec (length x)))) 131 | 132 | (defun sizeof:integer (x:integer) 133 | "Returns the storage size of a positive integer in bytes" 134 | (enforce (>= x 0) "Sizeof does not allow negative numbers") 135 | (if (= x 0) 1 136 | (ceiling (log 256.0 (dec (++ x))))) 137 | ) 138 | 139 | (defun ++:integer (x:integer) 140 | "Increment integer" 141 | (+ x 1) 142 | ) 143 | 144 | (defun --:integer (x:integer) 145 | "Decrement integer" 146 | (- x 1) 147 | ) 148 | 149 | (defun is-even:bool (x:integer) 150 | "Returns true if x is even" 151 | (= 0 (mod x 2))) 152 | 153 | (defun is-odd:bool (x:integer) 154 | "Returns true if x is odd" 155 | (= 1 (mod x 2))) 156 | 157 | (defun med:decimal (x:[decimal]) 158 | "Returns the median of a list: if the length of the list is even return the (n/2 -1)th element" 159 | (enforce-not-empty x) 160 | (let ((cnt (length x)) 161 | (mid (/ cnt 2)) 162 | (index (if (is-even cnt) (- mid 1) mid))) 163 | (at index (sort x))) 164 | ) 165 | 166 | (defun med*:decimal (x:[decimal]) 167 | "Returns the median of a list: if the length of the list is even return the average of the\ 168 | \(n/2 -1)th and (n/2)th elements" 169 | (enforce-not-empty x) 170 | (let ((cnt (length x)) 171 | (mid (/ cnt 2)) 172 | (mid-1 (- mid 1)) 173 | (sorted-x (sort x))) 174 | (if (is-even cnt) 175 | (/ (+ (at mid sorted-x) (at mid-1 sorted-x)) 2.0) 176 | (at mid sorted-x))) 177 | ) 178 | 179 | (defun between:bool (a:decimal b:decimal x:decimal) 180 | "Returns true is a <= x <= b" 181 | (and? (<= a) (>= b) x)) 182 | 183 | (defun between*:bool (a:decimal b:decimal x:decimal) 184 | "Returns true is a < x < b" 185 | (and? (< a) (> b) x)) 186 | 187 | (defun sign:decimal (x:decimal) 188 | "Returns 1.0 if x is positive, 0.0 if x is null, and -1.0 if x is negative" 189 | (cond 190 | ((> x 0.0) 1.0) 191 | ((< x 0.0) -1.0) 192 | 0.0)) 193 | 194 | (defun ramp:decimal (x:decimal) 195 | "Returns x if is x is positive, 0.0 otherwise" 196 | (if (>= x 0.0) x 0.0)) 197 | 198 | 199 | (defun gcd:integer (a:integer b:integer) 200 | "Returns the greatest common divisor of 2 integers" 201 | ; We use the Euclidean iterative algorithm (optimized by modulo) 202 | ; According to several sources and my own tests, the maximum complexity of the Euclidean algorithm is 203 | ; log/Phy ( min(a,b)). For safety, at the end, we check (enforce) that the algorithm has ended (ie b=0)/ 204 | ; But that enforcement should never fail. 205 | 206 | ; First let remove the sign of a and b and order them 207 | ; a* is the big, *b is the small 208 | (let ((a (abs a)) (b (abs b)) 209 | (a* (if (< a b) b a)) 210 | (b* (if (< a b) a b))) 211 | (if (= b* 0) a* ; If one (or both) of the arguments is 0: return |a| 212 | (let ((max-iterations (ceiling (log GOLDEN-RATIO (dec b*)))) 213 | (gcd-inner (lambda (x i) (if (= (at 'b x) 0) 214 | x 215 | {'a: (at 'b x), 'b: (mod (at 'a x) (at 'b x))}))) 216 | (gcd-result (fold gcd-inner {'a:a*, 'b:b*} (enumerate 1 max-iterations)))) 217 | (enforce (= (at 'b gcd-result) 0) "Euclidean algorithm not finished") 218 | (at 'a gcd-result)))) 219 | ) 220 | 221 | (defun lcm:integer (a:integer b:integer) 222 | "Returns the least common multiple of 2 integers" 223 | (enforce (and (!= a 0) (!= b 0)) "Arguments can't be 0") 224 | (/ (abs (* a b)) (gcd a b)) 225 | ) 226 | 227 | (defun pow10:decimal (x:integer) 228 | "Returns 10^x, rounded to 12 decimals (rounding is important when x is negative)" 229 | (round (^ 10.0 (dec x)) 12)) 230 | 231 | (defun xEy (x:decimal y:integer) 232 | "Returns x.10^y, rounded to 12 decimals" 233 | (round (* x (pow10 y)) 12)) 234 | 235 | (defun dec*:decimal(x) 236 | "Convert an integer or decimal to decimal" 237 | (if (= (typeof x) "decimal") x (dec x))) 238 | 239 | ;;; Rounding helpers 240 | (defun round* (decimals:integer x:decimal) 241 | "Reversed round function" 242 | (round x decimals)) 243 | 244 | (defun floor* (decimals:integer x:decimal) 245 | "Reversed floor function" 246 | (floor x decimals)) 247 | 248 | (defun ceiling* (decimals:integer x:decimal) 249 | "Reversed ceiling function" 250 | (ceiling x decimals)) 251 | 252 | (defun /-r (decimals:integer x:decimal y:decimal) 253 | "Rounded division" 254 | (round (/ x y) decimals)) 255 | 256 | (defun /-f (decimals:integer x:decimal y:decimal) 257 | "Floored division" 258 | (floor (/ x y) decimals)) 259 | 260 | (defun /-c (decimals:integer x:decimal y:decimal) 261 | "Ceiled division" 262 | (ceiling (/ x y) decimals)) 263 | 264 | ;;; Log functions 265 | (defun log10:decimal (x) 266 | "Returns the log of x base 10, rounded to 12 decimals" 267 | ; x can be decimal or an integer but the returned result is always a decimal 268 | (round (log 10.0 (dec* x)) 12)) 269 | 270 | (defun safe-log (x y default) 271 | "Log of Y base X, but returns default when y <= 0" 272 | (if (> (dec* y) 0.0 ) (log x y) default)) 273 | 274 | (defun safe-ln (x:decimal default:decimal) 275 | "Natural log of x, but returns default when x <= 0" 276 | (if (> x 0.0 ) (ln x) default)) 277 | 278 | (defun safe-log10:decimal (x default:decimal) 279 | "Returns the log of x base 10, rounded to 12 decimals but returns default when x <= 0" 280 | ; x can be decimal or an integer but the returned result is always a decimal 281 | ; btw default has to be a decimal 282 | (if (> (dec* x) 0.0 ) (log10 x) default)) 283 | 284 | ) 285 | -------------------------------------------------------------------------------- /kda-env/pact-util-lib/util-strings.pact: -------------------------------------------------------------------------------- 1 | ;SPDX-License-Identifier: MIT 2 | 3 | ; This modules provides some utilities to work with string in Pact 4 | ; Be aware that this module is only in Beta and hasn't been audited: 5 | ; --> BE CAREFUL if a security enforcement depends on one of theses functions 6 | ; 7 | ; Pact is not a word processor. And some functions can be gas expensive. 8 | ; Use sparingly, and eventually benchmark 9 | ; 10 | ; Remember that in Pact, all variables are immutable and no function can 11 | ; work in place. New string are always returned 12 | ; 13 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 14 | ; https://github.com/CryptoPascal31/pact-util-lib 15 | 16 | (module util-strings GOV 17 | "This module provides some strings management utilities \ 18 | \ Documentation: https://pact-util-lib.readthedocs.io \ 19 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 20 | 21 | (defconst VERSION:string "0.11") 22 | 23 | (defcap GOV() 24 | (enforce-keyset "free.util-lib")) 25 | 26 | (use util-lists) 27 | 28 | (defconst ASCII-TABLE {" ":32, "!":33, "\"":34, "#":35, "$":36, "%":37, "&":38, "\'":39, 29 | "(":40, ")":41, "*":42, "+":43, ",":44, "-":45, ".":46, "/":47, 30 | "0":48, "1":49, "2":50, "3":51, "4":52, "5":53, "6":54, "7":55, 31 | "8":56, "9":57, ":":58, ";":59, "<":60, "=":61, ">":62, "?":63, 32 | "@":64, "A":65, "B":66, "C":67, "D":68, "E":69, "F":70, "G":71, 33 | "H":72, "I":73, "J":74, "K":75, "L":76, "M":77, "N":78, "O":79, 34 | "P":80, "Q":81, "R":82, "S":83, "T":84, "U":85, "V":86, "W":87, 35 | "X":88, "Y":89, "Z":90, "[":91, "\\":92, "]":93, "^":94, "_":95, 36 | "`":96, "a":97, "b":98, "c":99, "d":100, "e":101, "f":102, "g":103, 37 | "h":104, "i":105, "j":106, "k":107, "l":108, "m":109, "n":110, "o":111, 38 | "p":112, "q":113, "r":114, "s":115, "t":116, "u":117, "v":118, "w":119, 39 | "x":120, "y":121, "z":122, "{":123, "|":124, "}":125, "~":126}) 40 | 41 | (defconst ASCII-TABLE-REVERSE (+ (make-list 32 "") 42 | (+ (str-to-list " !\"#$%&\'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~") 43 | (make-list 128 "")))) 44 | 45 | (defun to-string:string (x) 46 | "Convert any pact type (object, list, decimal, ...) to its string representation" 47 | (format "{}" [x]) 48 | ) 49 | 50 | (defun decode-ascii:[integer] (in:string) 51 | "Convert a string to an A SCII codes list: All characters must be printable" 52 | (map (lambda (x) (at x ASCII-TABLE)) 53 | (str-to-list in)) 54 | ) 55 | 56 | (defun str-to-ascii-int:integer (in:string) 57 | "Convert a string to its integer ASCII representation" 58 | (fold (lambda (x y) (+ (shift x 8) y)) 0 (decode-ascii in)) 59 | ) 60 | 61 | (defun encode-ascii:string (in-list:[integer]) 62 | "Convert an ASCII code list to a string: All characters must be printable" 63 | (concat 64 | (map (lambda (x) (at x ASCII-TABLE-REVERSE)) 65 | in-list)) 66 | ) 67 | 68 | (defun ascii-int-to-str:string (in:integer) 69 | "Convert an integer ASCII representation to a string" 70 | (enforce (>= in 0) "Negative integers not allowed") 71 | (if (!= in 0) 72 | (let ((len (ceiling (log 256.0 (dec in)))) 73 | (extract-char-value (lambda (idx) (mod (shift in (* -8 idx)) 256)))) 74 | (encode-ascii (map extract-char-value (enumerate (- len 1) 0)))) 75 | "") 76 | ) 77 | 78 | (defun is-digit:bool (in:string) 79 | "Returns true if all characters are digits [0-9]" 80 | (fold (and) true (map (and? (<= 48) (>= 57)) (decode-ascii in))) 81 | ) 82 | 83 | (defun is-alpha:bool (in:string) 84 | "Returns true if all characters are in alphas [A-Z a-z]" 85 | (fold (and) true (map (or? (and? (<= 65) (>= 90)) 86 | (and? (<= 97) (>= 122))) 87 | (decode-ascii in))) 88 | ) 89 | 90 | (defun is-hex-digit:bool (in:string) 91 | "Returns true if all characters are hexa [A-F a-F 0-9]" 92 | (fold (and) true (map (or? (and? (<= 48) (>= 57)) 93 | (or? (and? (<= 65) (>= 70)) 94 | (and? (<= 97) (>= 102)))) 95 | (decode-ascii in))) 96 | ) 97 | 98 | (defun contains-chars:bool (values:string in:string) 99 | "Returns true if in contains one of the characters in values" 100 | (let ((values-lists (str-to-list values)) 101 | (contains-char (lambda (x) (contains x in)))) 102 | (fold (or) false (map contains-char values-lists))) 103 | ) 104 | 105 | (defun replace-char:string (in:string old-char:string new-char:string) 106 | "Replace all occurrences of old-char to new-char" 107 | (concat (replace-item (str-to-list in) old-char new-char)) 108 | ) 109 | 110 | (defun upper:string (in:string) 111 | "Transform a string to upper case" 112 | (let ((do-upper (lambda (x) 113 | (if (and? (<= 97) (>= 122) x) 114 | (- x 32) 115 | x)))) 116 | (encode-ascii (map do-upper (decode-ascii in)))) 117 | ) 118 | 119 | (defun lower:string (in:string) 120 | "Transform a string to lower case" 121 | (let ((do-lower (lambda (x) 122 | (if (and? (<= 65) (>= 90) x) 123 | (+ x 32) 124 | x)))) 125 | (encode-ascii (map do-lower (decode-ascii in)))) 126 | ) 127 | 128 | (defun char-at:string (idx:integer in:string) 129 | "Returns the character at position idx" 130 | (at idx (str-to-list in)) 131 | ) 132 | 133 | (defun slice(low-idx:integer high-idx:integer in:string) 134 | "Returns the substring between the two indexes, high-idx char is non included" 135 | (enforce (< low-idx high-idx) "Low index must be < to High index") 136 | (enforce (>= low-idx 0) "Indexes must be positive") 137 | (enforce (<= high-idx (length in)) "High index must be <= to string length") 138 | (let ((out-len (- high-idx low-idx))) 139 | (take out-len (drop low-idx in))) 140 | ) 141 | 142 | (defun join:string (separator:string in:[string]) 143 | "Join a list of string with a separator" 144 | (if (is-empty in) "" 145 | (+ (first in) (concat (map (+ separator) (remove-first in))))) 146 | ) 147 | 148 | (defun split:[string] (separator:string in:string) 149 | (if (= 0 (length in)) 150 | [] ;If the string is empty return a zero length list 151 | (let ((sep-pos (search (str-to-list in) separator)) 152 | (substart (map (+ 1) (insert-first sep-pos -1))) 153 | (sublen (zip - (append-last sep-pos 10000000) substart)) 154 | (cut (lambda (start len) (take len (drop start in))))) 155 | (zip cut substart sublen))) 156 | ) 157 | 158 | (defun split-chunks:[string] (chunk-size:integer in:string) 159 | "Split a string in chunks of size chunk-size" 160 | (let ((in-len (length in)) 161 | (out-len (+ (/ in-len chunk-size) 162 | (if (!= 0 (mod in-len chunk-size)) 1 0))) 163 | (take-chunk (lambda (x) (take chunk-size (drop (* x chunk-size) in))))) 164 | (if (= 0 out-len) 165 | [] 166 | (map take-chunk (enumerate 0 (- out-len 1))))) 167 | ) 168 | 169 | (defun starts-with:bool (in:string to-match:string) 170 | "Returns true if the string starts with the string to-match" 171 | (let ((len (length to-match))) 172 | (if (>= (length in) len) 173 | (= (take len in) to-match) 174 | false)) 175 | ) 176 | 177 | (defun starts-with* (to-match:string in:string) 178 | "Returns true if the string starts with the string to-match" 179 | (starts-with in to-match)) 180 | 181 | (defun ends-with:bool (in:string to-match:string) 182 | "Returns true if the string ends with the string to-match" 183 | (let ((len (length to-match))) 184 | (if (>= (length in) len) 185 | (= (take (- len) in) to-match) 186 | false)) 187 | ) 188 | 189 | (defun ends-with* (to-match:string in:string) 190 | "Returns true if the string ends with the string to-match" 191 | (ends-with in to-match)) 192 | 193 | ;; Stripping functions 194 | (defun --count-to-strip:integer (to-remove:string in:[string]) 195 | (fold (lambda (cnt x) (if (>= cnt 0) cnt 196 | (if (= x to-remove) (- cnt 1) 197 | (- (+ cnt 1) )))) 198 | -1 in) 199 | ) 200 | 201 | (defun left-strip:string (to-remove:string in:string) 202 | "Remove any leading characters" 203 | (let ((cnt (--count-to-strip to-remove (str-to-list in)))) 204 | (drop cnt in)) 205 | ) 206 | 207 | (defun right-strip:string (to-remove:string in:string) 208 | "Remove any trailing characters" 209 | (let ((cnt (--count-to-strip to-remove (reverse (str-to-list in))))) 210 | (drop (- cnt) in)) 211 | ) 212 | 213 | (defun strip:string (to-remove:string in:string) 214 | "Remove both leading and trailing characters" 215 | (right-strip to-remove (left-strip to-remove in)) 216 | ) 217 | 218 | (defun decimal-to-str (x:decimal precision:integer) 219 | "Convert a decimal to string with a fixed precision" 220 | (to-string (round x precision)) 221 | ) 222 | 223 | (defun str-to-decimal:decimal (in:string) 224 | "Convert a string to a decimal" 225 | (let ((is-negative (= "-" (take 1 in))) 226 | (in (if is-negative (drop 1 in) in)) 227 | (parts (split "." in))) 228 | (enforce (or? (is-singleton) (is-pair) parts) "Invalid format") 229 | (let ((int-part (first parts)) 230 | (dec-part (if (is-pair parts) (last parts) "0")) 231 | (precision (if (is-pair parts) (length dec-part) 0)) 232 | (dec-multiplier (^ 0.1 (dec precision))) 233 | (str-to-dint (lambda (x) (dec (str-to-int 10 x)))) 234 | (val (+ (str-to-dint int-part) (* dec-multiplier (str-to-dint dec-part))))) 235 | (round (if is-negative (- val) val) precision))) 236 | ) 237 | ) 238 | -------------------------------------------------------------------------------- /kda-env/marmalade/ledger.pact: -------------------------------------------------------------------------------- 1 | (namespace (read-msg 'ns)) 2 | 3 | (module ledger GOVERNANCE 4 | 5 | @model 6 | [ 7 | (defproperty valid-account (account:string) 8 | (> (length account) 2)) 9 | ] 10 | 11 | (use util.fungible-util) 12 | (use kip.token-manifest) 13 | 14 | (implements kip.poly-fungible-v2) 15 | (use kip.poly-fungible-v2 [account-details sender-balance-change receiver-balance-change]) 16 | 17 | ;; 18 | ;; Tables/Schemas 19 | ;; 20 | 21 | (deftable ledger:{account-details}) 22 | 23 | (defschema token-schema 24 | id:string 25 | manifest:object{manifest} 26 | precision:integer 27 | supply:decimal 28 | policy:module{kip.token-policy-v1} 29 | ) 30 | 31 | (deftable tokens:{token-schema}) 32 | 33 | ;; 34 | ;; Capabilities 35 | ;; 36 | 37 | (defcap GOVERNANCE () 38 | (enforce-guard (keyset-ref-guard 'marmalade-admin))) 39 | 40 | ;; 41 | ;; poly-fungible-v2 caps 42 | ;; 43 | 44 | (defcap TRANSFER:bool 45 | ( id:string 46 | sender:string 47 | receiver:string 48 | amount:decimal 49 | ) 50 | @managed amount TRANSFER-mgr 51 | (enforce-unit id amount) 52 | (enforce (> amount 0.0) "Amount must be positive") 53 | (compose-capability (DEBIT id sender)) 54 | (compose-capability (CREDIT id receiver)) 55 | ) 56 | 57 | (defcap XTRANSFER:bool 58 | ( id:string 59 | sender:string 60 | receiver:string 61 | target-chain:string 62 | amount:decimal 63 | ) 64 | @managed amount TRANSFER-mgr 65 | (enforce false "cross chain not supported") 66 | ) 67 | 68 | (defun TRANSFER-mgr:decimal 69 | ( managed:decimal 70 | requested:decimal 71 | ) 72 | (let ((newbal (- managed requested))) 73 | (enforce (>= newbal 0.0) 74 | (format "TRANSFER exceeded for balance {}" [managed])) 75 | newbal) 76 | ) 77 | 78 | (defcap SUPPLY:bool (id:string supply:decimal) 79 | @doc " Emitted when supply is updated, if supported." 80 | @event true 81 | ) 82 | 83 | (defcap TOKEN:bool (id:string precision:integer supply:decimal policy:module{kip.token-policy-v1}) 84 | @event 85 | true 86 | ) 87 | 88 | (defcap RECONCILE:bool 89 | ( token-id:string 90 | amount:decimal 91 | sender:object{sender-balance-change} 92 | receiver:object{receiver-balance-change} 93 | ) 94 | @doc " For accounting via events. \ 95 | \ sender = {account: '', previous: 0.0, current: 0.0} for mint \ 96 | \ receiver = {account: '', previous: 0.0, current: 0.0} for burn" 97 | @event 98 | true 99 | ) 100 | 101 | (defcap ACCOUNT_GUARD:bool (id:string account:string guard:guard) 102 | @doc " Emitted when ACCOUNT guard is updated." 103 | @event 104 | true 105 | ) 106 | 107 | ;; 108 | ;; Implementation caps 109 | ;; 110 | 111 | (defcap ROTATE (id:string account:string) 112 | @doc "Autonomously managed capability for guard rotation" 113 | @managed 114 | true) 115 | 116 | (defcap DEBIT (id:string sender:string) 117 | (enforce-guard (account-guard id sender)) 118 | ) 119 | 120 | (defun account-guard:guard (id:string account:string) 121 | (with-read ledger (key id account) { 'guard := g } g) 122 | ) 123 | 124 | (defcap CREDIT (id:string receiver:string) true) 125 | 126 | (defcap UPDATE_SUPPLY () 127 | "private cap for update-supply" 128 | true) 129 | 130 | (defcap MINT (id:string account:string amount:decimal) 131 | @managed ;; one-shot for a given amount 132 | (enforce (< 0.0 amount) "Amount must be positive") 133 | (compose-capability (CREDIT id account)) 134 | (compose-capability (UPDATE_SUPPLY)) 135 | ) 136 | 137 | (defcap BURN (id:string account:string amount:decimal) 138 | @managed ;; one-shot for a given amount 139 | (enforce (< 0.0 amount) "Amount must be positive") 140 | (compose-capability (DEBIT id account)) 141 | (compose-capability (UPDATE_SUPPLY)) 142 | ) 143 | 144 | (defun ledger-guard:guard () 145 | @doc "Ledger module guard for policies to be able to validate access to policy operations." 146 | (create-module-guard "ledger-guard") 147 | ) 148 | 149 | (defschema policy-info 150 | policy:module{kip.token-policy-v1} 151 | token:object{kip.token-policy-v1.token-info} 152 | ) 153 | 154 | (defun get-policy-info:object{policy-info} (id:string) 155 | (with-read tokens id 156 | { 'policy := policy:module{kip.token-policy-v1} 157 | , 'supply := supply 158 | , 'precision := precision 159 | , 'manifest := manifest 160 | } 161 | { 'policy: policy 162 | , 'token: 163 | { 'id: id 164 | , 'supply: supply 165 | , 'precision: precision 166 | , 'manifest: manifest 167 | } } ) 168 | ) 169 | 170 | (defun create-account:bool 171 | ( id:string 172 | account:string 173 | guard:guard 174 | ) 175 | (enforce-valid-account account) 176 | (enforce-reserved account guard) 177 | (insert ledger (key id account) 178 | { "balance" : 0.0 179 | , "guard" : guard 180 | , "id" : id 181 | , "account" : account 182 | }) 183 | (emit-event (ACCOUNT_GUARD id account guard)) 184 | ) 185 | 186 | (defun total-supply:decimal (id:string) 187 | (with-default-read tokens id 188 | { 'supply : 0.0 } 189 | { 'supply := s } 190 | s) 191 | ) 192 | 193 | (defun create-token-id:string (manifest:object{manifest}) 194 | (enforce-verify-manifest manifest) 195 | (format "t:{}" [(at 'hash manifest)]) 196 | ) 197 | 198 | (defun create-token:bool 199 | ( id:string 200 | precision:integer 201 | manifest:object{manifest} 202 | policy:module{kip.token-policy-v1} 203 | ) 204 | (enforce-verify-manifest manifest) 205 | (enforce-token-reserved id manifest) 206 | (policy::enforce-init 207 | { 'id: id, 'supply: 0.0, 'precision: precision, 'manifest: manifest }) 208 | (insert tokens id { 209 | "id": id, 210 | "precision": precision, 211 | "manifest": manifest, 212 | "supply": 0.0, 213 | "policy": policy 214 | }) 215 | (emit-event (TOKEN id precision 0.0 policy)) 216 | ) 217 | 218 | (defun enforce-token-reserved:bool (token-id:string manifest:object{manifest}) 219 | @doc "Enforce reserved token-id name protocols." 220 | (let ((r (check-reserved token-id))) 221 | (if (= "" r) true 222 | (if (= "t" r) 223 | (enforce 224 | (= token-id 225 | (create-token-id manifest)) 226 | "Token manifest protocol violation") 227 | (enforce false 228 | (format "Unrecognized reserved protocol: {}" [r]) ))))) 229 | 230 | (defun truncate:decimal (id:string amount:decimal) 231 | (floor amount (precision id)) 232 | ) 233 | 234 | (defun get-balance:decimal (id:string account:string) 235 | (at 'balance (read ledger (key id account))) 236 | ) 237 | 238 | (defun details:object{account-details} 239 | ( id:string account:string ) 240 | (read ledger (key id account)) 241 | ) 242 | 243 | (defun rotate:bool (id:string account:string new-guard:guard) 244 | (with-capability (ROTATE id account) 245 | (enforce-transfer-policy id account account 0.0) 246 | (with-read ledger (key id account) 247 | { "guard" := old-guard } 248 | 249 | (enforce-guard old-guard) 250 | (update ledger (key id account) 251 | { "guard" : new-guard }) 252 | (emit-event (ACCOUNT_GUARD id account new-guard))))) 253 | 254 | (defun transfer:bool 255 | ( id:string 256 | sender:string 257 | receiver:string 258 | amount:decimal 259 | ) 260 | (enforce (!= sender receiver) 261 | "sender cannot be the receiver of a transfer") 262 | (enforce-valid-transfer sender receiver (precision id) amount) 263 | (with-capability (TRANSFER id sender receiver amount) 264 | (enforce-transfer-policy id sender receiver amount) 265 | (with-read ledger (key id receiver) 266 | { "guard" := g } 267 | (let 268 | ( (sender (debit id sender amount)) 269 | (receiver (credit id receiver g amount)) 270 | ) 271 | (emit-event (RECONCILE id amount sender receiver)) 272 | ) 273 | ) 274 | ) 275 | ) 276 | 277 | (defun enforce-transfer-policy 278 | ( id:string 279 | sender:string 280 | receiver:string 281 | amount:decimal 282 | ) 283 | (bind (get-policy-info id) 284 | { 'policy := policy:module{kip.token-policy-v1} 285 | , 'token := token } 286 | (policy::enforce-transfer token sender (account-guard id sender) receiver amount)) 287 | ) 288 | 289 | (defun transfer-create:bool 290 | ( id:string 291 | sender:string 292 | receiver:string 293 | receiver-guard:guard 294 | amount:decimal 295 | ) 296 | (enforce (!= sender receiver) 297 | "sender cannot be the receiver of a transfer") 298 | (enforce-valid-transfer sender receiver (precision id) amount) 299 | 300 | (with-capability (TRANSFER id sender receiver amount) 301 | (enforce-transfer-policy id sender receiver amount) 302 | (let 303 | ( 304 | (sender (debit id sender amount)) 305 | (receiver (credit id receiver receiver-guard amount)) 306 | ) 307 | (emit-event (RECONCILE id amount sender receiver)) 308 | )) 309 | ) 310 | 311 | (defun mint:bool 312 | ( id:string 313 | account:string 314 | guard:guard 315 | amount:decimal 316 | ) 317 | (with-capability (MINT id account amount) 318 | (bind (get-policy-info id) 319 | { 'policy := policy:module{kip.token-policy-v1} 320 | , 'token := token } 321 | (policy::enforce-mint token account guard amount)) 322 | (let 323 | ( 324 | (receiver (credit id account guard amount)) 325 | (sender:object{sender-balance-change} 326 | {'account: "", 'previous: 0.0, 'current: 0.0}) 327 | ) 328 | (emit-event (RECONCILE id amount sender receiver)) 329 | (update-supply id amount) 330 | )) 331 | ) 332 | 333 | (defun burn:bool 334 | ( id:string 335 | account:string 336 | amount:decimal 337 | ) 338 | (with-capability (BURN id account amount) 339 | (bind (get-policy-info id) 340 | { 'policy := policy:module{kip.token-policy-v1} 341 | , 'token := token } 342 | (policy::enforce-burn token account amount)) 343 | (let 344 | ( 345 | (sender (debit id account amount)) 346 | (receiver:object{receiver-balance-change} 347 | {'account: "", 'previous: 0.0, 'current: 0.0}) 348 | ) 349 | (emit-event (RECONCILE id amount sender receiver)) 350 | (update-supply id (- amount)) 351 | )) 352 | ) 353 | 354 | (defun debit:object{sender-balance-change} 355 | ( id:string 356 | account:string 357 | amount:decimal 358 | ) 359 | 360 | (require-capability (DEBIT id account)) 361 | 362 | (enforce-unit id amount) 363 | 364 | (with-read ledger (key id account) 365 | { "balance" := old-bal } 366 | 367 | (enforce (<= amount old-bal) "Insufficient funds") 368 | 369 | (let ((new-bal (- old-bal amount))) 370 | (update ledger (key id account) 371 | { "balance" : new-bal } 372 | ) 373 | {'account: account, 'previous: old-bal, 'current: new-bal} 374 | )) 375 | ) 376 | 377 | (defun credit:object{receiver-balance-change} 378 | ( id:string 379 | account:string 380 | guard:guard 381 | amount:decimal 382 | ) 383 | @doc "Credit AMOUNT to ACCOUNT balance" 384 | 385 | @model [ (property (> amount 0.0)) 386 | (property (valid-account account)) 387 | ] 388 | (enforce-valid-account account) 389 | (enforce-unit id amount) 390 | 391 | (require-capability (CREDIT id account)) 392 | 393 | (with-default-read ledger (key id account) 394 | { "balance" : -1.0, "guard" : guard } 395 | { "balance" := old-bal, "guard" := retg } 396 | (enforce (= retg guard) 397 | "account guards do not match") 398 | 399 | (let* ((is-new 400 | (if (= old-bal -1.0) 401 | (enforce-reserved account guard) 402 | false)) 403 | (new-bal (if is-new amount (+ old-bal amount))) 404 | ) 405 | 406 | (write ledger (key id account) 407 | { "balance" : new-bal 408 | , "guard" : retg 409 | , "id" : id 410 | , "account" : account 411 | }) 412 | (if is-new (emit-event (ACCOUNT_GUARD id account retg)) true) 413 | {'account: account, 'previous: (if is-new 0.0 old-bal), 'current: new-bal} 414 | )) 415 | ) 416 | 417 | (defun credit-account:object{receiver-balance-change} 418 | ( id:string 419 | account:string 420 | amount:decimal 421 | ) 422 | @doc "Credit AMOUNT to ACCOUNT" 423 | (credit id account (account-guard id account) amount) 424 | ) 425 | 426 | (defun update-supply:bool (id:string amount:decimal) 427 | (require-capability (UPDATE_SUPPLY)) 428 | (with-default-read tokens id 429 | { 'supply: 0.0 } 430 | { 'supply := s } 431 | (let ((new-supply (+ s amount))) 432 | (update tokens id {'supply: new-supply }) 433 | (emit-event (SUPPLY id new-supply)))) 434 | ) 435 | 436 | (defun enforce-unit:bool (id:string amount:decimal) 437 | (let ((p (precision id))) 438 | (enforce 439 | (= (floor amount p) 440 | amount) 441 | "precision violation")) 442 | ) 443 | 444 | (defun precision:integer (id:string) 445 | (at 'precision (read tokens id)) 446 | ) 447 | 448 | (defpact transfer-crosschain:bool 449 | ( id:string 450 | sender:string 451 | receiver:string 452 | receiver-guard:guard 453 | target-chain:string 454 | amount:decimal ) 455 | (step (format "{}" [(enforce false "cross chain not supported")]))) 456 | 457 | ;; 458 | ;; ACCESSORS 459 | ;; 460 | 461 | (defun key:string ( id:string account:string ) 462 | @doc "DB key for ledger account" 463 | (format "{}:{}" [id account]) 464 | ) 465 | 466 | (defun get-manifest:object{manifest} (id:string) 467 | (at 'manifest (read tokens id))) 468 | 469 | ;; 470 | ;; sale 471 | ;; 472 | 473 | (defcap SALE:bool 474 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 475 | @doc "Wrapper cap/event of SALE of token ID by SELLER of AMOUNT until TIMEOUT block height." 476 | @event 477 | (enforce (> amount 0.0) "Amount must be positive") 478 | (compose-capability (OFFER id seller amount timeout)) 479 | (compose-capability (SALE_PRIVATE sale-id)) 480 | ) 481 | 482 | (defcap OFFER:bool 483 | (id:string seller:string amount:decimal timeout:integer) 484 | @doc "Managed cap for SELLER offering AMOUNT of token ID until TIMEOUT." 485 | @managed 486 | (enforce (sale-active timeout) "SALE: invalid timeout") 487 | (compose-capability (DEBIT id seller)) 488 | (compose-capability (CREDIT id (sale-account))) 489 | ) 490 | 491 | (defcap WITHDRAW:bool 492 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 493 | @doc "Withdraws offer SALE from SELLER of AMOUNT of token ID after timeout." 494 | @event 495 | (enforce (not (sale-active timeout)) "WITHDRAW: still active") 496 | (compose-capability (DEBIT id (sale-account))) 497 | (compose-capability (CREDIT id seller)) 498 | (compose-capability (SALE_PRIVATE sale-id)) 499 | ) 500 | 501 | (defcap BUY:bool 502 | (id:string seller:string buyer:string amount:decimal timeout:integer sale-id:string) 503 | @doc "Completes sale OFFER to BUYER." 504 | @managed 505 | (enforce (sale-active timeout) "BUY: expired") 506 | (compose-capability (DEBIT id (sale-account))) 507 | (compose-capability (CREDIT id buyer)) 508 | (compose-capability (SALE_PRIVATE sale-id)) 509 | ) 510 | 511 | (defcap SALE_PRIVATE:bool (sale-id:string) true) 512 | 513 | (defpact sale:bool 514 | ( id:string 515 | seller:string 516 | amount:decimal 517 | timeout:integer 518 | ) 519 | (step-with-rollback 520 | (with-capability (SALE id seller amount timeout (pact-id)) 521 | (offer id seller amount)) 522 | (with-capability (WITHDRAW id seller amount timeout (pact-id)) 523 | (withdraw id seller amount)) 524 | ) 525 | (step 526 | (let ( (buyer:string (read-msg "buyer")) 527 | (buyer-guard:guard (read-msg "buyer-guard")) ) 528 | (with-capability (BUY id seller buyer amount timeout (pact-id)) 529 | (buy id seller buyer buyer-guard amount (pact-id))))) 530 | ) 531 | 532 | (defun offer:bool 533 | ( id:string 534 | seller:string 535 | amount:decimal 536 | ) 537 | @doc "Initiate sale with by SELLER by escrowing AMOUNT of TOKEN until TIMEOUT." 538 | (require-capability (SALE_PRIVATE (pact-id))) 539 | (bind (get-policy-info id) 540 | { 'policy := policy:module{kip.token-policy-v1} 541 | , 'token := token } 542 | (policy::enforce-offer token seller amount (pact-id))) 543 | (let 544 | ( 545 | (sender (debit id seller amount)) 546 | (receiver (credit id (sale-account) (create-pact-guard "SALE") amount)) 547 | ) 548 | (emit-event (TRANSFER id seller (sale-account) amount)) 549 | (emit-event (RECONCILE id amount sender receiver))) 550 | ) 551 | 552 | (defun withdraw:bool 553 | ( id:string 554 | seller:string 555 | amount:decimal 556 | ) 557 | @doc "Withdraw offer by SELLER of AMOUNT of TOKEN before TIMEOUT" 558 | (require-capability (SALE_PRIVATE (pact-id))) 559 | (let 560 | ( 561 | (sender (debit id (sale-account) amount)) 562 | (receiver (credit-account id seller amount)) 563 | ) 564 | (emit-event (TRANSFER id (sale-account) seller amount)) 565 | (emit-event (RECONCILE id amount sender receiver))) 566 | ) 567 | 568 | 569 | (defun buy:bool 570 | ( id:string 571 | seller:string 572 | buyer:string 573 | buyer-guard:guard 574 | amount:decimal 575 | sale-id:string 576 | ) 577 | @doc "Complete sale with transfer." 578 | (require-capability (SALE_PRIVATE (pact-id))) 579 | (bind (get-policy-info id) 580 | { 'policy := policy:module{kip.token-policy-v1} 581 | , 'token := token } 582 | (policy::enforce-buy token seller buyer buyer-guard amount sale-id)) 583 | (let 584 | ( 585 | (sender (debit id (sale-account) amount)) 586 | (receiver (credit id buyer buyer-guard amount)) 587 | ) 588 | (emit-event (TRANSFER id (sale-account) buyer amount)) 589 | (emit-event (RECONCILE id amount sender receiver))) 590 | ) 591 | 592 | (defun sale-active:bool (timeout:integer) 593 | @doc "Sale is active until TIMEOUT block height." 594 | (< (at 'block-height (chain-data)) timeout) 595 | ) 596 | 597 | (defun sale-account:string () 598 | (create-principal (create-pact-guard "SALE")) 599 | ) 600 | ) 601 | 602 | (if (read-msg 'upgrade) 603 | ["upgrade complete"] 604 | [ (create-table ledger) 605 | (create-table tokens) ]) 606 | -------------------------------------------------------------------------------- /kda-env/kadena/coin-v5.pact: -------------------------------------------------------------------------------- 1 | 2 | (module coin GOVERNANCE 3 | 4 | @doc "'coin' represents the Kadena Coin Contract. This contract provides both the \ 5 | \buy/redeem gas support in the form of 'fund-tx', as well as transfer, \ 6 | \credit, debit, coinbase, account creation and query, as well as SPV burn \ 7 | \create. To access the coin contract, you may use its fully-qualified name, \ 8 | \or issue the '(use coin)' command in the body of a module declaration." 9 | 10 | @model 11 | [ (defproperty conserves-mass 12 | (= (column-delta coin-table 'balance) 0.0)) 13 | 14 | (defproperty valid-account (account:string) 15 | (and 16 | (>= (length account) 3) 17 | (<= (length account) 256))) 18 | ] 19 | 20 | (implements fungible-v2) 21 | (implements fungible-xchain-v1) 22 | 23 | ;; coin-v2 24 | (bless "ut_J_ZNkoyaPUEJhiwVeWnkSQn9JT9sQCWKdjjVVrWo") 25 | 26 | ;; coin v3 27 | (bless "1os_sLAUYvBzspn5jjawtRpJWiH1WPfhyNraeVvSIwU") 28 | 29 | ;; coin v4 30 | (bless "BjZW0T2ac6qE_I5X8GE4fal6tTqjhLTC7my0ytQSxLU") 31 | 32 | ; -------------------------------------------------------------------------- 33 | ; Schemas and Tables 34 | 35 | (defschema coin-schema 36 | @doc "The coin contract token schema" 37 | @model [ (invariant (>= balance 0.0)) ] 38 | 39 | balance:decimal 40 | guard:guard) 41 | 42 | (deftable coin-table:{coin-schema}) 43 | 44 | ; -------------------------------------------------------------------------- 45 | ; Capabilities 46 | 47 | (defcap GOVERNANCE () 48 | (enforce false "Enforce non-upgradeability")) 49 | 50 | (defcap GAS () 51 | "Magic capability to protect gas buy and redeem" 52 | true) 53 | 54 | (defcap COINBASE () 55 | "Magic capability to protect miner reward" 56 | true) 57 | 58 | (defcap GENESIS () 59 | "Magic capability constraining genesis transactions" 60 | true) 61 | 62 | (defcap REMEDIATE () 63 | "Magic capability for remediation transactions" 64 | true) 65 | 66 | (defcap DEBIT (sender:string) 67 | "Capability for managing debiting operations" 68 | (enforce-guard (at 'guard (read coin-table sender))) 69 | (enforce (!= sender "") "valid sender")) 70 | 71 | (defcap CREDIT (receiver:string) 72 | "Capability for managing crediting operations" 73 | (enforce (!= receiver "") "valid receiver")) 74 | 75 | (defcap ROTATE (account:string) 76 | @doc "Autonomously managed capability for guard rotation" 77 | @managed 78 | true) 79 | 80 | (defcap TRANSFER:bool 81 | ( sender:string 82 | receiver:string 83 | amount:decimal 84 | ) 85 | @managed amount TRANSFER-mgr 86 | (enforce (!= sender receiver) "same sender and receiver") 87 | (enforce-unit amount) 88 | (enforce (> amount 0.0) "Positive amount") 89 | (compose-capability (DEBIT sender)) 90 | (compose-capability (CREDIT receiver)) 91 | ) 92 | 93 | (defun TRANSFER-mgr:decimal 94 | ( managed:decimal 95 | requested:decimal 96 | ) 97 | 98 | (let ((newbal (- managed requested))) 99 | (enforce (>= newbal 0.0) 100 | (format "TRANSFER exceeded for balance {}" [managed])) 101 | newbal) 102 | ) 103 | 104 | (defcap TRANSFER_XCHAIN:bool 105 | ( sender:string 106 | receiver:string 107 | amount:decimal 108 | target-chain:string 109 | ) 110 | 111 | @managed amount TRANSFER_XCHAIN-mgr 112 | (enforce-unit amount) 113 | (enforce (> amount 0.0) "Cross-chain transfers require a positive amount") 114 | (compose-capability (DEBIT sender)) 115 | ) 116 | 117 | (defun TRANSFER_XCHAIN-mgr:decimal 118 | ( managed:decimal 119 | requested:decimal 120 | ) 121 | 122 | (enforce (>= managed requested) 123 | (format "TRANSFER_XCHAIN exceeded for balance {}" [managed])) 124 | 0.0 125 | ) 126 | 127 | (defcap TRANSFER_XCHAIN_RECD:bool 128 | ( sender:string 129 | receiver:string 130 | amount:decimal 131 | source-chain:string 132 | ) 133 | @event true 134 | ) 135 | 136 | ; v3 capabilities 137 | (defcap RELEASE_ALLOCATION 138 | ( account:string 139 | amount:decimal 140 | ) 141 | @doc "Event for allocation release, can be used for sig scoping." 142 | @event true 143 | ) 144 | 145 | ; -------------------------------------------------------------------------- 146 | ; Constants 147 | 148 | (defconst COIN_CHARSET CHARSET_LATIN1 149 | "The default coin contract character set") 150 | 151 | (defconst MINIMUM_PRECISION 12 152 | "Minimum allowed precision for coin transactions") 153 | 154 | (defconst MINIMUM_ACCOUNT_LENGTH 3 155 | "Minimum account length admissible for coin accounts") 156 | 157 | (defconst MAXIMUM_ACCOUNT_LENGTH 256 158 | "Maximum account name length admissible for coin accounts") 159 | 160 | (defconst VALID_CHAIN_IDS (map (int-to-str 10) (enumerate 0 19)) 161 | "List of all valid Chainweb chain ids") 162 | 163 | ; -------------------------------------------------------------------------- 164 | ; Utilities 165 | 166 | (defun enforce-unit:bool (amount:decimal) 167 | @doc "Enforce minimum precision allowed for coin transactions" 168 | 169 | (enforce 170 | (= (floor amount MINIMUM_PRECISION) 171 | amount) 172 | (format "Amount violates minimum precision: {}" [amount])) 173 | ) 174 | 175 | (defun validate-account (account:string) 176 | @doc "Enforce that an account name conforms to the coin contract \ 177 | \minimum and maximum length requirements, as well as the \ 178 | \latin-1 character set." 179 | 180 | (enforce 181 | (is-charset COIN_CHARSET account) 182 | (format 183 | "Account does not conform to the coin contract charset: {}" 184 | [account])) 185 | 186 | (let ((account-length (length account))) 187 | 188 | (enforce 189 | (>= account-length MINIMUM_ACCOUNT_LENGTH) 190 | (format 191 | "Account name does not conform to the min length requirement: {}" 192 | [account])) 193 | 194 | (enforce 195 | (<= account-length MAXIMUM_ACCOUNT_LENGTH) 196 | (format 197 | "Account name does not conform to the max length requirement: {}" 198 | [account])) 199 | ) 200 | ) 201 | 202 | ; -------------------------------------------------------------------------- 203 | ; Coin Contract 204 | 205 | (defun gas-only () 206 | "Predicate for gas-only user guards." 207 | (require-capability (GAS))) 208 | 209 | (defun gas-guard (guard:guard) 210 | "Predicate for gas + single key user guards" 211 | (enforce-one 212 | "Enforce either the presence of a GAS cap or keyset" 213 | [ (gas-only) 214 | (enforce-guard guard) 215 | ])) 216 | 217 | (defun buy-gas:string (sender:string total:decimal) 218 | @doc "This function describes the main 'gas buy' operation. At this point \ 219 | \MINER has been chosen from the pool, and will be validated. The SENDER \ 220 | \of this transaction has specified a gas limit LIMIT (maximum gas) for \ 221 | \the transaction, and the price is the spot price of gas at that time. \ 222 | \The gas buy will be executed prior to executing SENDER's code." 223 | 224 | @model [ (property (> total 0.0)) 225 | (property (valid-account sender)) 226 | ] 227 | 228 | (validate-account sender) 229 | 230 | (enforce-unit total) 231 | (enforce (> total 0.0) "gas supply must be a positive quantity") 232 | 233 | (require-capability (GAS)) 234 | (with-capability (DEBIT sender) 235 | (debit sender total)) 236 | ) 237 | 238 | (defun redeem-gas:string (miner:string miner-guard:guard sender:string total:decimal) 239 | @doc "This function describes the main 'redeem gas' operation. At this \ 240 | \point, the SENDER's transaction has been executed, and the gas that \ 241 | \was charged has been calculated. MINER will be credited the gas cost, \ 242 | \and SENDER will receive the remainder up to the limit" 243 | 244 | @model [ (property (> total 0.0)) 245 | (property (valid-account sender)) 246 | (property (valid-account miner)) 247 | ] 248 | 249 | (validate-account sender) 250 | (validate-account miner) 251 | (enforce-unit total) 252 | 253 | (require-capability (GAS)) 254 | (let* 255 | ((fee (read-decimal "fee")) 256 | (refund (- total fee))) 257 | 258 | (enforce-unit fee) 259 | (enforce (>= fee 0.0) 260 | "fee must be a non-negative quantity") 261 | 262 | (enforce (>= refund 0.0) 263 | "refund must be a non-negative quantity") 264 | 265 | (emit-event (TRANSFER sender miner fee)) ;v3 266 | 267 | ; directly update instead of credit 268 | (with-capability (CREDIT sender) 269 | (if (> refund 0.0) 270 | (with-read coin-table sender 271 | { "balance" := balance } 272 | (update coin-table sender 273 | { "balance": (+ balance refund) })) 274 | 275 | "noop")) 276 | 277 | (with-capability (CREDIT miner) 278 | (if (> fee 0.0) 279 | (credit miner miner-guard fee) 280 | "noop")) 281 | ) 282 | 283 | ) 284 | 285 | (defun create-account:string (account:string guard:guard) 286 | @model [ (property (valid-account account)) ] 287 | 288 | (validate-account account) 289 | (enforce-reserved account guard) 290 | 291 | (insert coin-table account 292 | { "balance" : 0.0 293 | , "guard" : guard 294 | }) 295 | ) 296 | 297 | (defun get-balance:decimal (account:string) 298 | (with-read coin-table account 299 | { "balance" := balance } 300 | balance 301 | ) 302 | ) 303 | 304 | (defun details:object{fungible-v2.account-details} 305 | ( account:string ) 306 | (with-read coin-table account 307 | { "balance" := bal 308 | , "guard" := g } 309 | { "account" : account 310 | , "balance" : bal 311 | , "guard": g }) 312 | ) 313 | 314 | (defun rotate:string (account:string new-guard:guard) 315 | (with-capability (ROTATE account) 316 | (with-read coin-table account 317 | { "guard" := old-guard } 318 | 319 | (enforce-guard old-guard) 320 | 321 | (update coin-table account 322 | { "guard" : new-guard } 323 | ))) 324 | ) 325 | 326 | 327 | (defun precision:integer 328 | () 329 | MINIMUM_PRECISION) 330 | 331 | (defun transfer:string (sender:string receiver:string amount:decimal) 332 | @model [ (property conserves-mass) 333 | (property (> amount 0.0)) 334 | (property (valid-account sender)) 335 | (property (valid-account receiver)) 336 | (property (!= sender receiver)) ] 337 | 338 | (enforce (!= sender receiver) 339 | "sender cannot be the receiver of a transfer") 340 | 341 | (validate-account sender) 342 | (validate-account receiver) 343 | 344 | (enforce (> amount 0.0) 345 | "transfer amount must be positive") 346 | 347 | (enforce-unit amount) 348 | 349 | (with-capability (TRANSFER sender receiver amount) 350 | (debit sender amount) 351 | (with-read coin-table receiver 352 | { "guard" := g } 353 | 354 | (credit receiver g amount)) 355 | ) 356 | ) 357 | 358 | (defun transfer-create:string 359 | ( sender:string 360 | receiver:string 361 | receiver-guard:guard 362 | amount:decimal ) 363 | 364 | @model [ (property conserves-mass) ] 365 | 366 | (enforce (!= sender receiver) 367 | "sender cannot be the receiver of a transfer") 368 | 369 | (validate-account sender) 370 | (validate-account receiver) 371 | 372 | (enforce (> amount 0.0) 373 | "transfer amount must be positive") 374 | 375 | (enforce-unit amount) 376 | 377 | (with-capability (TRANSFER sender receiver amount) 378 | (debit sender amount) 379 | (credit receiver receiver-guard amount)) 380 | ) 381 | 382 | (defun coinbase:string (account:string account-guard:guard amount:decimal) 383 | @doc "Internal function for the initial creation of coins. This function \ 384 | \cannot be used outside of the coin contract." 385 | 386 | @model [ (property (valid-account account)) 387 | (property (> amount 0.0)) 388 | ] 389 | 390 | (validate-account account) 391 | (enforce-unit amount) 392 | 393 | (require-capability (COINBASE)) 394 | (emit-event (TRANSFER "" account amount)) ;v3 395 | (with-capability (CREDIT account) 396 | (credit account account-guard amount)) 397 | ) 398 | 399 | (defun remediate:string (account:string amount:decimal) 400 | @doc "Allows for remediation transactions. This function \ 401 | \is protected by the REMEDIATE capability" 402 | @model [ (property (valid-account account)) 403 | (property (> amount 0.0)) 404 | ] 405 | 406 | (validate-account account) 407 | 408 | (enforce (> amount 0.0) 409 | "Remediation amount must be positive") 410 | 411 | (enforce-unit amount) 412 | 413 | (require-capability (REMEDIATE)) 414 | (emit-event (TRANSFER "" account amount)) ;v3 415 | (with-read coin-table account 416 | { "balance" := balance } 417 | 418 | (enforce (<= amount balance) "Insufficient funds") 419 | 420 | (update coin-table account 421 | { "balance" : (- balance amount) } 422 | )) 423 | ) 424 | 425 | (defpact fund-tx (sender:string miner:string miner-guard:guard total:decimal) 426 | @doc "'fund-tx' is a special pact to fund a transaction in two steps, \ 427 | \with the actual transaction transpiring in the middle: \ 428 | \ \ 429 | \ 1) A buying phase, debiting the sender for total gas and fee, yielding \ 430 | \ TX_MAX_CHARGE. \ 431 | \ 2) A settlement phase, resuming TX_MAX_CHARGE, and allocating to the \ 432 | \ coinbase account for used gas and fee, and sender account for bal- \ 433 | \ ance (unused gas, if any)." 434 | 435 | @model [ (property (> total 0.0)) 436 | (property (valid-account sender)) 437 | (property (valid-account miner)) 438 | ;(property conserves-mass) not supported yet 439 | ] 440 | 441 | (step (buy-gas sender total)) 442 | (step (redeem-gas miner miner-guard sender total)) 443 | ) 444 | 445 | (defun debit:string (account:string amount:decimal) 446 | @doc "Debit AMOUNT from ACCOUNT balance" 447 | 448 | @model [ (property (> amount 0.0)) 449 | (property (valid-account account)) 450 | ] 451 | 452 | (validate-account account) 453 | 454 | (enforce (> amount 0.0) 455 | "debit amount must be positive") 456 | 457 | (enforce-unit amount) 458 | 459 | (require-capability (DEBIT account)) 460 | (with-read coin-table account 461 | { "balance" := balance } 462 | 463 | (enforce (<= amount balance) "Insufficient funds") 464 | 465 | (update coin-table account 466 | { "balance" : (- balance amount) } 467 | )) 468 | ) 469 | 470 | 471 | (defun credit:string (account:string guard:guard amount:decimal) 472 | @doc "Credit AMOUNT to ACCOUNT balance" 473 | 474 | @model [ (property (> amount 0.0)) 475 | (property (valid-account account)) 476 | ] 477 | 478 | (validate-account account) 479 | 480 | (enforce (> amount 0.0) "credit amount must be positive") 481 | (enforce-unit amount) 482 | 483 | (require-capability (CREDIT account)) 484 | (with-default-read coin-table account 485 | { "balance" : -1.0, "guard" : guard } 486 | { "balance" := balance, "guard" := retg } 487 | ; we don't want to overwrite an existing guard with the user-supplied one 488 | (enforce (= retg guard) 489 | "account guards do not match") 490 | 491 | (let ((is-new 492 | (if (= balance -1.0) 493 | (enforce-reserved account guard) 494 | false))) 495 | 496 | (write coin-table account 497 | { "balance" : (if is-new amount (+ balance amount)) 498 | , "guard" : retg 499 | })) 500 | )) 501 | 502 | (defun check-reserved:string (account:string) 503 | " Checks ACCOUNT for reserved name and returns type if \ 504 | \ found or empty string. Reserved names start with a \ 505 | \ single char and colon, e.g. 'c:foo', which would return 'c' as type." 506 | (let ((pfx (take 2 account))) 507 | (if (= ":" (take -1 pfx)) (take 1 pfx) ""))) 508 | 509 | (defun enforce-reserved:bool (account:string guard:guard) 510 | @doc "Enforce reserved account name protocols." 511 | (if (validate-principal guard account) 512 | true 513 | (let ((r (check-reserved account))) 514 | (if (= r "") 515 | true 516 | (if (= r "k") 517 | (enforce false "Single-key account protocol violation") 518 | (enforce false 519 | (format "Reserved protocol guard violation: {}" [r])) 520 | ))))) 521 | 522 | 523 | (defschema crosschain-schema 524 | @doc "Schema for yielded value in cross-chain transfers" 525 | receiver:string 526 | receiver-guard:guard 527 | amount:decimal 528 | source-chain:string) 529 | 530 | (defpact transfer-crosschain:string 531 | ( sender:string 532 | receiver:string 533 | receiver-guard:guard 534 | target-chain:string 535 | amount:decimal ) 536 | 537 | @model [ (property (> amount 0.0)) 538 | (property (valid-account sender)) 539 | (property (valid-account receiver)) 540 | ] 541 | 542 | (step 543 | (with-capability 544 | (TRANSFER_XCHAIN sender receiver amount target-chain) 545 | 546 | (validate-account sender) 547 | (validate-account receiver) 548 | 549 | (enforce (!= "" target-chain) "empty target-chain") 550 | (enforce (!= (at 'chain-id (chain-data)) target-chain) 551 | "cannot run cross-chain transfers to the same chain") 552 | 553 | (enforce (> amount 0.0) 554 | "transfer quantity must be positive") 555 | 556 | (enforce-unit amount) 557 | 558 | (enforce (contains target-chain VALID_CHAIN_IDS) 559 | "target chain is not a valid chainweb chain id") 560 | 561 | ;; step 1 - debit delete-account on current chain 562 | (debit sender amount) 563 | (emit-event (TRANSFER sender "" amount)) 564 | 565 | (let 566 | ((crosschain-details:object{crosschain-schema} 567 | { "receiver" : receiver 568 | , "receiver-guard" : receiver-guard 569 | , "amount" : amount 570 | , "source-chain" : (at 'chain-id (chain-data)) 571 | })) 572 | (yield crosschain-details target-chain) 573 | ))) 574 | 575 | (step 576 | (resume 577 | { "receiver" := receiver 578 | , "receiver-guard" := receiver-guard 579 | , "amount" := amount 580 | , "source-chain" := source-chain 581 | } 582 | 583 | (emit-event (TRANSFER "" receiver amount)) 584 | (emit-event (TRANSFER_XCHAIN_RECD "" receiver amount source-chain)) 585 | 586 | ;; step 2 - credit create account on target chain 587 | (with-capability (CREDIT receiver) 588 | (credit receiver receiver-guard amount)) 589 | )) 590 | ) 591 | 592 | 593 | ; -------------------------------------------------------------------------- 594 | ; Coin allocations 595 | 596 | (defschema allocation-schema 597 | @doc "Genesis allocation registry" 598 | ;@model [ (invariant (>= balance 0.0)) ] 599 | 600 | balance:decimal 601 | date:time 602 | guard:guard 603 | redeemed:bool) 604 | 605 | (deftable allocation-table:{allocation-schema}) 606 | 607 | (defun create-allocation-account 608 | ( account:string 609 | date:time 610 | keyset-ref:string 611 | amount:decimal 612 | ) 613 | 614 | @doc "Add an entry to the coin allocation table. This function \ 615 | \also creates a corresponding empty coin contract account \ 616 | \of the same name and guard. Requires GENESIS capability. " 617 | 618 | @model [ (property (valid-account account)) ] 619 | 620 | (require-capability (GENESIS)) 621 | 622 | (validate-account account) 623 | (enforce (>= amount 0.0) 624 | "allocation amount must be non-negative") 625 | 626 | (enforce-unit amount) 627 | 628 | (let 629 | ((guard:guard (keyset-ref-guard keyset-ref))) 630 | 631 | (create-account account guard) 632 | 633 | (insert allocation-table account 634 | { "balance" : amount 635 | , "date" : date 636 | , "guard" : guard 637 | , "redeemed" : false 638 | }))) 639 | 640 | (defun release-allocation 641 | ( account:string ) 642 | 643 | @doc "Release funds associated with allocation ACCOUNT into main ledger. \ 644 | \ACCOUNT must already exist in main ledger. Allocation is deactivated \ 645 | \after release." 646 | @model [ (property (valid-account account)) ] 647 | 648 | (validate-account account) 649 | 650 | (with-read allocation-table account 651 | { "balance" := balance 652 | , "date" := release-time 653 | , "redeemed" := redeemed 654 | , "guard" := guard 655 | } 656 | 657 | (let ((curr-time:time (at 'block-time (chain-data)))) 658 | 659 | (enforce (not redeemed) 660 | "allocation funds have already been redeemed") 661 | 662 | (enforce 663 | (>= curr-time release-time) 664 | (format "funds locked until {}. current time: {}" [release-time curr-time])) 665 | 666 | (with-capability (RELEASE_ALLOCATION account balance) 667 | 668 | (enforce-guard guard) 669 | 670 | (with-capability (CREDIT account) 671 | (emit-event (TRANSFER "" account balance)) 672 | (credit account guard balance) 673 | 674 | (update allocation-table account 675 | { "redeemed" : true 676 | , "balance" : 0.0 677 | }) 678 | 679 | "Allocation successfully released to main ledger")) 680 | ))) 681 | 682 | ) 683 | -------------------------------------------------------------------------------- /kda-env/kadena/coin-v6.pact: -------------------------------------------------------------------------------- 1 | 2 | (module coin GOVERNANCE 3 | 4 | @doc "'coin' represents the Kadena Coin Contract. This contract provides both the \ 5 | \buy/redeem gas support in the form of 'fund-tx', as well as transfer, \ 6 | \credit, debit, coinbase, account creation and query, as well as SPV burn \ 7 | \create. To access the coin contract, you may use its fully-qualified name, \ 8 | \or issue the '(use coin)' command in the body of a module declaration." 9 | 10 | @model 11 | [ (defproperty conserves-mass 12 | (= (column-delta coin-table 'balance) 0.0)) 13 | 14 | (defproperty valid-account (account:string) 15 | (and 16 | (>= (length account) 3) 17 | (<= (length account) 256))) 18 | ] 19 | 20 | (implements fungible-v2) 21 | (implements fungible-xchain-v1) 22 | 23 | ;; coin-v2 24 | (bless "ut_J_ZNkoyaPUEJhiwVeWnkSQn9JT9sQCWKdjjVVrWo") 25 | 26 | ;; coin v3 27 | (bless "1os_sLAUYvBzspn5jjawtRpJWiH1WPfhyNraeVvSIwU") 28 | 29 | ;; coin v4 30 | (bless "BjZW0T2ac6qE_I5X8GE4fal6tTqjhLTC7my0ytQSxLU") 31 | 32 | ;; coin v5 33 | (bless "rE7DU8jlQL9x_MPYuniZJf5ICBTAEHAIFQCB4blofP4") 34 | 35 | ; -------------------------------------------------------------------------- 36 | ; Schemas and Tables 37 | 38 | (defschema coin-schema 39 | @doc "The coin contract token schema" 40 | @model [ (invariant (>= balance 0.0)) ] 41 | 42 | balance:decimal 43 | guard:guard) 44 | 45 | (deftable coin-table:{coin-schema}) 46 | 47 | ; -------------------------------------------------------------------------- 48 | ; Capabilities 49 | 50 | (defcap GOVERNANCE () 51 | (enforce false "Enforce non-upgradeability")) 52 | 53 | (defcap GAS () 54 | "Magic capability to protect gas buy and redeem" 55 | true) 56 | 57 | (defcap COINBASE () 58 | "Magic capability to protect miner reward" 59 | true) 60 | 61 | (defcap GENESIS () 62 | "Magic capability constraining genesis transactions" 63 | true) 64 | 65 | (defcap REMEDIATE () 66 | "Magic capability for remediation transactions" 67 | true) 68 | 69 | (defcap DEBIT (sender:string) 70 | "Capability for managing debiting operations" 71 | (enforce-guard (at 'guard (read coin-table sender))) 72 | (enforce (!= sender "") "valid sender")) 73 | 74 | (defcap CREDIT (receiver:string) 75 | "Capability for managing crediting operations" 76 | (enforce (!= receiver "") "valid receiver")) 77 | 78 | (defcap ROTATE (account:string) 79 | @doc "Autonomously managed capability for guard rotation" 80 | @managed 81 | true) 82 | 83 | (defcap TRANSFER:bool 84 | ( sender:string 85 | receiver:string 86 | amount:decimal 87 | ) 88 | @managed amount TRANSFER-mgr 89 | (enforce (!= sender receiver) "same sender and receiver") 90 | (enforce-unit amount) 91 | (enforce (> amount 0.0) "Positive amount") 92 | (compose-capability (DEBIT sender)) 93 | (compose-capability (CREDIT receiver)) 94 | ) 95 | 96 | (defun TRANSFER-mgr:decimal 97 | ( managed:decimal 98 | requested:decimal 99 | ) 100 | 101 | (let ((newbal (- managed requested))) 102 | (enforce (>= newbal 0.0) 103 | (format "TRANSFER exceeded for balance {}" [managed])) 104 | newbal) 105 | ) 106 | 107 | (defcap TRANSFER_XCHAIN:bool 108 | ( sender:string 109 | receiver:string 110 | amount:decimal 111 | target-chain:string 112 | ) 113 | 114 | @managed amount TRANSFER_XCHAIN-mgr 115 | (enforce-unit amount) 116 | (enforce (> amount 0.0) "Cross-chain transfers require a positive amount") 117 | (compose-capability (DEBIT sender)) 118 | ) 119 | 120 | (defun TRANSFER_XCHAIN-mgr:decimal 121 | ( managed:decimal 122 | requested:decimal 123 | ) 124 | 125 | (enforce (>= managed requested) 126 | (format "TRANSFER_XCHAIN exceeded for balance {}" [managed])) 127 | 0.0 128 | ) 129 | 130 | (defcap TRANSFER_XCHAIN_RECD:bool 131 | ( sender:string 132 | receiver:string 133 | amount:decimal 134 | source-chain:string 135 | ) 136 | @event true 137 | ) 138 | 139 | ; v3 capabilities 140 | (defcap RELEASE_ALLOCATION 141 | ( account:string 142 | amount:decimal 143 | ) 144 | @doc "Event for allocation release, can be used for sig scoping." 145 | @event true 146 | ) 147 | 148 | ; -------------------------------------------------------------------------- 149 | ; Constants 150 | 151 | (defconst COIN_CHARSET CHARSET_LATIN1 152 | "The default coin contract character set") 153 | 154 | (defconst MINIMUM_PRECISION 12 155 | "Minimum allowed precision for coin transactions") 156 | 157 | (defconst MINIMUM_ACCOUNT_LENGTH 3 158 | "Minimum account length admissible for coin accounts") 159 | 160 | (defconst MAXIMUM_ACCOUNT_LENGTH 256 161 | "Maximum account name length admissible for coin accounts") 162 | 163 | (defconst VALID_CHAIN_IDS (map (int-to-str 10) (enumerate 0 19)) 164 | "List of all valid Chainweb chain ids") 165 | 166 | ; -------------------------------------------------------------------------- 167 | ; Utilities 168 | 169 | (defun enforce-unit:bool (amount:decimal) 170 | @doc "Enforce minimum precision allowed for coin transactions" 171 | 172 | (enforce 173 | (= (floor amount MINIMUM_PRECISION) 174 | amount) 175 | (format "Amount violates minimum precision: {}" [amount])) 176 | ) 177 | 178 | (defun validate-account (account:string) 179 | @doc "Enforce that an account name conforms to the coin contract \ 180 | \minimum and maximum length requirements, as well as the \ 181 | \latin-1 character set." 182 | 183 | (enforce 184 | (is-charset COIN_CHARSET account) 185 | (format 186 | "Account does not conform to the coin contract charset: {}" 187 | [account])) 188 | 189 | (let ((account-length (length account))) 190 | 191 | (enforce 192 | (>= account-length MINIMUM_ACCOUNT_LENGTH) 193 | (format 194 | "Account name does not conform to the min length requirement: {}" 195 | [account])) 196 | 197 | (enforce 198 | (<= account-length MAXIMUM_ACCOUNT_LENGTH) 199 | (format 200 | "Account name does not conform to the max length requirement: {}" 201 | [account])) 202 | ) 203 | ) 204 | 205 | ; -------------------------------------------------------------------------- 206 | ; Coin Contract 207 | 208 | (defun gas-only () 209 | "Predicate for gas-only user guards." 210 | (require-capability (GAS))) 211 | 212 | (defun gas-guard (guard:guard) 213 | "Predicate for gas + single key user guards" 214 | (enforce-one 215 | "Enforce either the presence of a GAS cap or keyset" 216 | [ (gas-only) 217 | (enforce-guard guard) 218 | ])) 219 | 220 | (defun buy-gas:string (sender:string total:decimal) 221 | @doc "This function describes the main 'gas buy' operation. At this point \ 222 | \MINER has been chosen from the pool, and will be validated. The SENDER \ 223 | \of this transaction has specified a gas limit LIMIT (maximum gas) for \ 224 | \the transaction, and the price is the spot price of gas at that time. \ 225 | \The gas buy will be executed prior to executing SENDER's code." 226 | 227 | @model [ (property (> total 0.0)) 228 | (property (valid-account sender)) 229 | ] 230 | 231 | (validate-account sender) 232 | 233 | (enforce-unit total) 234 | (enforce (> total 0.0) "gas supply must be a positive quantity") 235 | 236 | (require-capability (GAS)) 237 | (with-capability (DEBIT sender) 238 | (debit sender total)) 239 | ) 240 | 241 | (defun redeem-gas:string (miner:string miner-guard:guard sender:string total:decimal) 242 | @doc "This function describes the main 'redeem gas' operation. At this \ 243 | \point, the SENDER's transaction has been executed, and the gas that \ 244 | \was charged has been calculated. MINER will be credited the gas cost, \ 245 | \and SENDER will receive the remainder up to the limit" 246 | 247 | @model [ (property (> total 0.0)) 248 | (property (valid-account sender)) 249 | (property (valid-account miner)) 250 | ] 251 | 252 | (validate-account sender) 253 | (validate-account miner) 254 | (enforce-unit total) 255 | 256 | (require-capability (GAS)) 257 | (let* 258 | ((fee (read-decimal "fee")) 259 | (refund (- total fee))) 260 | 261 | (enforce-unit fee) 262 | (enforce (>= fee 0.0) 263 | "fee must be a non-negative quantity") 264 | 265 | (enforce (>= refund 0.0) 266 | "refund must be a non-negative quantity") 267 | 268 | (emit-event (TRANSFER sender miner fee)) ;v3 269 | 270 | ; directly update instead of credit 271 | (with-capability (CREDIT sender) 272 | (if (> refund 0.0) 273 | (with-read coin-table sender 274 | { "balance" := balance } 275 | (update coin-table sender 276 | { "balance": (+ balance refund) })) 277 | 278 | "noop")) 279 | 280 | (with-capability (CREDIT miner) 281 | (if (> fee 0.0) 282 | (credit miner miner-guard fee) 283 | "noop")) 284 | ) 285 | 286 | ) 287 | 288 | (defun create-account:string (account:string guard:guard) 289 | @model [ (property (valid-account account)) ] 290 | 291 | (validate-account account) 292 | (enforce-reserved account guard) 293 | 294 | (insert coin-table account 295 | { "balance" : 0.0 296 | , "guard" : guard 297 | }) 298 | ) 299 | 300 | (defun get-balance:decimal (account:string) 301 | (with-read coin-table account 302 | { "balance" := balance } 303 | balance 304 | ) 305 | ) 306 | 307 | (defun details:object{fungible-v2.account-details} 308 | ( account:string ) 309 | (with-read coin-table account 310 | { "balance" := bal 311 | , "guard" := g } 312 | { "account" : account 313 | , "balance" : bal 314 | , "guard": g }) 315 | ) 316 | 317 | (defun rotate:string (account:string new-guard:guard) 318 | (with-capability (ROTATE account) 319 | 320 | ; Allow rotation only for vanity accounts, or 321 | ; re-rotating a principal account back to its proper guard 322 | (enforce (or (not (is-principal account)) 323 | (validate-principal new-guard account)) 324 | "It is unsafe for principal accounts to rotate their guard") 325 | 326 | (with-read coin-table account 327 | { "guard" := old-guard } 328 | (enforce-guard old-guard) 329 | (update coin-table account 330 | { "guard" : new-guard } 331 | ))) 332 | ) 333 | 334 | 335 | (defun precision:integer 336 | () 337 | MINIMUM_PRECISION) 338 | 339 | (defun transfer:string (sender:string receiver:string amount:decimal) 340 | @model [ (property conserves-mass) 341 | (property (> amount 0.0)) 342 | (property (valid-account sender)) 343 | (property (valid-account receiver)) 344 | (property (!= sender receiver)) ] 345 | 346 | (enforce (!= sender receiver) 347 | "sender cannot be the receiver of a transfer") 348 | 349 | (validate-account sender) 350 | (validate-account receiver) 351 | 352 | (enforce (> amount 0.0) 353 | "transfer amount must be positive") 354 | 355 | (enforce-unit amount) 356 | 357 | (with-capability (TRANSFER sender receiver amount) 358 | (debit sender amount) 359 | (with-read coin-table receiver 360 | { "guard" := g } 361 | 362 | (credit receiver g amount)) 363 | ) 364 | ) 365 | 366 | (defun transfer-create:string 367 | ( sender:string 368 | receiver:string 369 | receiver-guard:guard 370 | amount:decimal ) 371 | 372 | @model [ (property conserves-mass) ] 373 | 374 | (enforce (!= sender receiver) 375 | "sender cannot be the receiver of a transfer") 376 | 377 | (validate-account sender) 378 | (validate-account receiver) 379 | 380 | (enforce (> amount 0.0) 381 | "transfer amount must be positive") 382 | 383 | (enforce-unit amount) 384 | 385 | (with-capability (TRANSFER sender receiver amount) 386 | (debit sender amount) 387 | (credit receiver receiver-guard amount)) 388 | ) 389 | 390 | (defun coinbase:string (account:string account-guard:guard amount:decimal) 391 | @doc "Internal function for the initial creation of coins. This function \ 392 | \cannot be used outside of the coin contract." 393 | 394 | @model [ (property (valid-account account)) 395 | (property (> amount 0.0)) 396 | ] 397 | 398 | (validate-account account) 399 | (enforce-unit amount) 400 | 401 | (require-capability (COINBASE)) 402 | (emit-event (TRANSFER "" account amount)) ;v3 403 | (with-capability (CREDIT account) 404 | (credit account account-guard amount)) 405 | ) 406 | 407 | (defun remediate:string (account:string amount:decimal) 408 | @doc "Allows for remediation transactions. This function \ 409 | \is protected by the REMEDIATE capability" 410 | @model [ (property (valid-account account)) 411 | (property (> amount 0.0)) 412 | ] 413 | 414 | (validate-account account) 415 | 416 | (enforce (> amount 0.0) 417 | "Remediation amount must be positive") 418 | 419 | (enforce-unit amount) 420 | 421 | (require-capability (REMEDIATE)) 422 | (emit-event (TRANSFER "" account amount)) ;v3 423 | (with-read coin-table account 424 | { "balance" := balance } 425 | 426 | (enforce (<= amount balance) "Insufficient funds") 427 | 428 | (update coin-table account 429 | { "balance" : (- balance amount) } 430 | )) 431 | ) 432 | 433 | (defpact fund-tx (sender:string miner:string miner-guard:guard total:decimal) 434 | @doc "'fund-tx' is a special pact to fund a transaction in two steps, \ 435 | \with the actual transaction transpiring in the middle: \ 436 | \ \ 437 | \ 1) A buying phase, debiting the sender for total gas and fee, yielding \ 438 | \ TX_MAX_CHARGE. \ 439 | \ 2) A settlement phase, resuming TX_MAX_CHARGE, and allocating to the \ 440 | \ coinbase account for used gas and fee, and sender account for bal- \ 441 | \ ance (unused gas, if any)." 442 | 443 | @model [ (property (> total 0.0)) 444 | (property (valid-account sender)) 445 | (property (valid-account miner)) 446 | ;(property conserves-mass) not supported yet 447 | ] 448 | 449 | (step (buy-gas sender total)) 450 | (step (redeem-gas miner miner-guard sender total)) 451 | ) 452 | 453 | (defun debit:string (account:string amount:decimal) 454 | @doc "Debit AMOUNT from ACCOUNT balance" 455 | 456 | @model [ (property (> amount 0.0)) 457 | (property (valid-account account)) 458 | ] 459 | 460 | (validate-account account) 461 | 462 | (enforce (> amount 0.0) 463 | "debit amount must be positive") 464 | 465 | (enforce-unit amount) 466 | 467 | (require-capability (DEBIT account)) 468 | (with-read coin-table account 469 | { "balance" := balance } 470 | 471 | (enforce (<= amount balance) "Insufficient funds") 472 | 473 | (update coin-table account 474 | { "balance" : (- balance amount) } 475 | )) 476 | ) 477 | 478 | 479 | (defun credit:string (account:string guard:guard amount:decimal) 480 | @doc "Credit AMOUNT to ACCOUNT balance" 481 | 482 | @model [ (property (> amount 0.0)) 483 | (property (valid-account account)) 484 | ] 485 | 486 | (validate-account account) 487 | 488 | (enforce (> amount 0.0) "credit amount must be positive") 489 | (enforce-unit amount) 490 | 491 | (require-capability (CREDIT account)) 492 | (with-default-read coin-table account 493 | { "balance" : -1.0, "guard" : guard } 494 | { "balance" := balance, "guard" := retg } 495 | ; we don't want to overwrite an existing guard with the user-supplied one 496 | (enforce (= retg guard) 497 | "account guards do not match") 498 | 499 | (let ((is-new 500 | (if (= balance -1.0) 501 | (enforce-reserved account guard) 502 | false))) 503 | 504 | (write coin-table account 505 | { "balance" : (if is-new amount (+ balance amount)) 506 | , "guard" : retg 507 | })) 508 | )) 509 | 510 | (defun check-reserved:string (account:string) 511 | " Checks ACCOUNT for reserved name and returns type if \ 512 | \ found or empty string. Reserved names start with a \ 513 | \ single char and colon, e.g. 'c:foo', which would return 'c' as type." 514 | (let ((pfx (take 2 account))) 515 | (if (= ":" (take -1 pfx)) (take 1 pfx) ""))) 516 | 517 | (defun enforce-reserved:bool (account:string guard:guard) 518 | @doc "Enforce reserved account name protocols." 519 | (if (validate-principal guard account) 520 | true 521 | (let ((r (check-reserved account))) 522 | (if (= r "") 523 | true 524 | (if (= r "k") 525 | (enforce false "Single-key account protocol violation") 526 | (enforce false 527 | (format "Reserved protocol guard violation: {}" [r])) 528 | ))))) 529 | 530 | 531 | (defschema crosschain-schema 532 | @doc "Schema for yielded value in cross-chain transfers" 533 | receiver:string 534 | receiver-guard:guard 535 | amount:decimal 536 | source-chain:string) 537 | 538 | (defpact transfer-crosschain:string 539 | ( sender:string 540 | receiver:string 541 | receiver-guard:guard 542 | target-chain:string 543 | amount:decimal ) 544 | 545 | @model [ (property (> amount 0.0)) 546 | (property (valid-account sender)) 547 | (property (valid-account receiver)) 548 | ] 549 | 550 | (step 551 | (with-capability 552 | (TRANSFER_XCHAIN sender receiver amount target-chain) 553 | 554 | (validate-account sender) 555 | (validate-account receiver) 556 | 557 | (enforce (!= "" target-chain) "empty target-chain") 558 | (enforce (!= (at 'chain-id (chain-data)) target-chain) 559 | "cannot run cross-chain transfers to the same chain") 560 | 561 | (enforce (> amount 0.0) 562 | "transfer quantity must be positive") 563 | 564 | (enforce-unit amount) 565 | 566 | (enforce (contains target-chain VALID_CHAIN_IDS) 567 | "target chain is not a valid chainweb chain id") 568 | 569 | ;; step 1 - debit delete-account on current chain 570 | (debit sender amount) 571 | (emit-event (TRANSFER sender "" amount)) 572 | 573 | (let 574 | ((crosschain-details:object{crosschain-schema} 575 | { "receiver" : receiver 576 | , "receiver-guard" : receiver-guard 577 | , "amount" : amount 578 | , "source-chain" : (at 'chain-id (chain-data)) 579 | })) 580 | (yield crosschain-details target-chain) 581 | ))) 582 | 583 | (step 584 | (resume 585 | { "receiver" := receiver 586 | , "receiver-guard" := receiver-guard 587 | , "amount" := amount 588 | , "source-chain" := source-chain 589 | } 590 | 591 | (emit-event (TRANSFER "" receiver amount)) 592 | (emit-event (TRANSFER_XCHAIN_RECD "" receiver amount source-chain)) 593 | 594 | ;; step 2 - credit create account on target chain 595 | (with-capability (CREDIT receiver) 596 | (credit receiver receiver-guard amount)) 597 | )) 598 | ) 599 | 600 | 601 | ; -------------------------------------------------------------------------- 602 | ; Coin allocations 603 | 604 | (defschema allocation-schema 605 | @doc "Genesis allocation registry" 606 | ;@model [ (invariant (>= balance 0.0)) ] 607 | 608 | balance:decimal 609 | date:time 610 | guard:guard 611 | redeemed:bool) 612 | 613 | (deftable allocation-table:{allocation-schema}) 614 | 615 | (defun create-allocation-account 616 | ( account:string 617 | date:time 618 | keyset-ref:string 619 | amount:decimal 620 | ) 621 | 622 | @doc "Add an entry to the coin allocation table. This function \ 623 | \also creates a corresponding empty coin contract account \ 624 | \of the same name and guard. Requires GENESIS capability. " 625 | 626 | @model [ (property (valid-account account)) ] 627 | 628 | (require-capability (GENESIS)) 629 | 630 | (validate-account account) 631 | (enforce (>= amount 0.0) 632 | "allocation amount must be non-negative") 633 | 634 | (enforce-unit amount) 635 | 636 | (let 637 | ((guard:guard (keyset-ref-guard keyset-ref))) 638 | 639 | (create-account account guard) 640 | 641 | (insert allocation-table account 642 | { "balance" : amount 643 | , "date" : date 644 | , "guard" : guard 645 | , "redeemed" : false 646 | }))) 647 | 648 | (defun release-allocation 649 | ( account:string ) 650 | 651 | @doc "Release funds associated with allocation ACCOUNT into main ledger. \ 652 | \ACCOUNT must already exist in main ledger. Allocation is deactivated \ 653 | \after release." 654 | @model [ (property (valid-account account)) ] 655 | 656 | (validate-account account) 657 | 658 | (with-read allocation-table account 659 | { "balance" := balance 660 | , "date" := release-time 661 | , "redeemed" := redeemed 662 | , "guard" := guard 663 | } 664 | 665 | (let ((curr-time:time (at 'block-time (chain-data)))) 666 | 667 | (enforce (not redeemed) 668 | "allocation funds have already been redeemed") 669 | 670 | (enforce 671 | (>= curr-time release-time) 672 | (format "funds locked until {}. current time: {}" [release-time curr-time])) 673 | 674 | (with-capability (RELEASE_ALLOCATION account balance) 675 | 676 | (enforce-guard guard) 677 | 678 | (with-capability (CREDIT account) 679 | (emit-event (TRANSFER "" account balance)) 680 | (credit account guard balance) 681 | 682 | (update allocation-table account 683 | { "redeemed" : true 684 | , "balance" : 0.0 685 | }) 686 | 687 | "Allocation successfully released to main ledger")) 688 | ))) 689 | 690 | ) 691 | --------------------------------------------------------------------------------