├── .pact-history ├── kda-env ├── bootstrap-modules │ ├── basic-guards.pact │ └── repl-coin-tools.pact ├── init-test-accounts.repl ├── init-pact-util-lib.repl ├── init-namespaces.repl ├── init.repl ├── init-marmalade.repl ├── init-kadena.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 ├── marmalade │ ├── manifest.pact │ ├── token-policy-v1.pact │ ├── policy.pact │ ├── fixed-quote-policy.pact │ ├── fixed-quote-royalty-policy.pact │ ├── poly-fungible-v2.pact │ └── ledger.pact └── pact-util-lib │ ├── util-random.pact │ ├── util-lists.pact │ ├── util-math.pact │ └── util-strings.pact ├── README.MD ├── coinflip.repl └── coinflip.pact /.pact-history: -------------------------------------------------------------------------------- 1 | (load "coinflip.repl") 2 | (load "coinflip.repl") 3 | (load "coinflip.repl") 4 | (load "coinflip.repl") 5 | (load "coinflip.repl") 6 | (load "coinflip.repl") 7 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /kda-env/init-test-accounts.repl: -------------------------------------------------------------------------------- 1 | (env-enable-repl-natives true) 2 | 3 | (begin-tx) 4 | (load "./bootstrap-modules/repl-coin-tools.pact") 5 | (commit-tx) 6 | 7 | 8 | (begin-tx) 9 | (use repl-coin-tools) 10 | (fund-accounts ["alice", "bob", "carol", "dave"] 1000.0) 11 | (commit-tx) 12 | 13 | (env-enable-repl-natives false) 14 | -------------------------------------------------------------------------------- /kda-env/init-pact-util-lib.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (namespace 'free) 3 | (load "pact-util-lib/util-lists.pact") 4 | (load "pact-util-lib/util-strings.pact") 5 | (load "pact-util-lib/util-math.pact") 6 | (load "pact-util-lib/util-random.pact") 7 | 8 | (create-table state-table) 9 | 10 | (env-hash (hash "GOOD SEED!")) 11 | (util-random.reset-state) 12 | 13 | (commit-tx) 14 | 15 | (print "Utils library contracts initialized") 16 | -------------------------------------------------------------------------------- /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.repl: -------------------------------------------------------------------------------- 1 | (enforce-pact-version "4.4") 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 | (load "init-pact-util-lib.repl") 16 | 17 | ;Marmelade 18 | (load "init-marmalade.repl") 19 | 20 | ;Init test accounts 21 | (load "init-test-accounts.repl") 22 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /README.MD: -------------------------------------------------------------------------------- 1 | # Coinflip 2 | 3 | This is the coinflip contract, recreated and fully tested. 4 | 5 | In order to place a bet, you must call the `place-bet` function with the `OPS` capability. 6 | 7 | Which means that the steps you have to go through to place a bet for a user are the following: 8 | 9 | 1. Send the user info to your backend 10 | 2. Construct the command with both the `TRANSFER` and `OPS` capabilities for the user, include your own random number from your backend 11 | 3. Sign the same command using your `OPS` key 12 | 4. Send the command back to the user and have them sign it 13 | 5. Send the transaction to the blockchain 14 | -------------------------------------------------------------------------------- /kda-env/init-kadena.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (env-keys []) 3 | (env-data {}) 4 | (env-sigs []) 5 | 6 | ; Root namespace 7 | (load "./kadena/fungible-v2.pact") 8 | (load "./kadena/fungible-xchain-v1.pact")+ 9 | (load "./kadena/gas-payer-v1.pact") 10 | (load "./kadena/coin-v5.pact") 11 | (create-table coin-table) 12 | 13 | ; On the Kadena blockchain the guards modules are loaded 14 | ;in both root and util namespaces 15 | (load "./kadena/guards.pact") 16 | (load "./kadena/guards1.pact") 17 | 18 | (namespace 'kip) 19 | (load "./kadena/account-protocols-v1.pact") 20 | 21 | (namespace 'util) 22 | (load "./kadena/fungible-util.pact") 23 | (load "./kadena/guards.pact") 24 | (load "./kadena/guards1.pact") 25 | 26 | (print "Kadena contracts initialized") 27 | (commit-tx) 28 | -------------------------------------------------------------------------------- /kda-env/bootstrap-modules/repl-coin-tools.pact: -------------------------------------------------------------------------------- 1 | (module repl-coin-tools GOV 2 | (defcap GOV () true) 3 | (use coin) 4 | 5 | (defun fund-account (account-name:string key:string amount:decimal) 6 | "Fund a coin account from nothing" 7 | (env-data { "k": [key]}) 8 | (with-applied-env 9 | (let ((ks:guard (read-keyset 'k))) 10 | (create-account account-name ks) 11 | (test-capability (CREDIT account-name)) 12 | (credit account-name ks amount))) 13 | ) 14 | 15 | (defun fund-accounts (account-names:[string] amount:decimal) 16 | "Fund a list of coin accounts with a constant amount. the key is dervied from the account name" 17 | (map (lambda (x) (fund-account x (+ x "-key") amount)) account-names) 18 | ) 19 | 20 | ) 21 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | (module guards1 AUTONOMOUS 2 | 3 | (defcap AUTONOMOUS () 4 | (enforce false "Non-upgradeable")) 5 | 6 | (defun guard-all:guard (guards:[guard]) 7 | "Create a guard that only succeeds if every guard in GUARDS is successfully enforced." 8 | (enforce (< 0 (length guards)) "Guard list cannot be empty") 9 | (create-user-guard (enforce-guard-all guards))) 10 | 11 | (defun enforce-guard-all:bool (guards:[guard]) 12 | "Enforces all guards in GUARDS" 13 | (map (enforce-guard) guards) 14 | ) 15 | 16 | (defun guard-any:guard (guards:[guard]) 17 | "Create a guard that succeeds if at least one guard in GUARDS is successfully enforced." 18 | (enforce (< 0 (length guards)) "Guard list cannot be empty") 19 | (create-user-guard (enforce-guard-any guards))) 20 | 21 | (defun enforce-guard-any:bool (guards:[guard]) 22 | "Will succeed if at least one guard in GUARDS is successfully enforced." 23 | (enforce (< 0 24 | (length 25 | (filter 26 | (= true) 27 | (map (try-enforce-guard) guards)))) 28 | "None of the guards passed") 29 | ) 30 | 31 | (defun try-enforce-guard (g:guard) 32 | (try false (enforce-guard g)) 33 | ) 34 | 35 | (defun max-gas-notional:guard (gasNotional:decimal) 36 | "Guard to enforce gas price * gas limit is smaller than or equal to GAS" 37 | (create-user-guard 38 | (enforce-below-or-at-gas-notional gasNotional))) 39 | 40 | (defun enforce-below-gas-notional (gasNotional:decimal) 41 | (enforce (< (chain-gas-notional) gasNotional) 42 | (format "Gas Limit * Gas Price must be smaller than {}" [gasNotional]))) 43 | 44 | (defun enforce-below-or-at-gas-notional (gasNotional:decimal) 45 | (enforce (<= (chain-gas-notional) gasNotional) 46 | (format "Gas Limit * Gas Price must be smaller than or equal to {}" [gasNotional]))) 47 | 48 | (defun max-gas-price:guard (gasPrice:decimal) 49 | "Guard to enforce gas price is smaller than or equal to GAS PRICE" 50 | (create-user-guard 51 | (enforce-below-or-at-gas-price gasPrice))) 52 | 53 | (defun enforce-below-gas-price:bool (gasPrice:decimal) 54 | (enforce (< (chain-gas-price) gasPrice) 55 | (format "Gas Price must be smaller than {}" [gasPrice]))) 56 | 57 | (defun enforce-below-or-at-gas-price:bool (gasPrice:decimal) 58 | (enforce (<= (chain-gas-price) gasPrice) 59 | (format "Gas Price must be smaller than or equal to {}" [gasPrice]))) 60 | 61 | (defun max-gas-limit:guard (gasLimit:integer) 62 | "Guard to enforce gas limit is smaller than or equal to GAS LIMIT" 63 | (create-user-guard 64 | (enforce-below-or-at-gas-limit gasLimit))) 65 | 66 | (defun enforce-below-gas-limit:bool (gasLimit:integer) 67 | (enforce (< (chain-gas-limit) gasLimit) 68 | (format "Gas Limit must be smaller than {}" [gasLimit]))) 69 | 70 | (defun enforce-below-or-at-gas-limit:bool (gasLimit:integer) 71 | (enforce (<= (chain-gas-limit) gasLimit) 72 | (format "Gas Limit must be smaller than or equal to {}" [gasLimit]))) 73 | 74 | (defun chain-gas-price () 75 | "Return gas price from chain-data" 76 | (at 'gas-price (chain-data))) 77 | 78 | (defun chain-gas-limit () 79 | "Return gas limit from chain-data" 80 | (at 'gas-limit (chain-data))) 81 | 82 | (defun chain-gas-notional () 83 | "Return gas limit * gas price from chain-data" 84 | (* (chain-gas-price) (chain-gas-limit))) 85 | ) 86 | -------------------------------------------------------------------------------- /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 hard (maybe impossible) to predict before mining since block-time includes microseconds. 13 | ; 14 | ; Several numbers can be generated in the same block or transaction. They will be all different, unpredictable and uncorrelated 15 | ; 16 | ; Be careful, the miner can control the generated numbers => Don't use for high stakes lottery or cryptography 17 | ; 18 | ; Feel free to reuse, comment, review, fork, propose PRs, submit bugs: 19 | ; https://github.com/CryptoPascal31/pact-util-lib 20 | 21 | (module util-random GOV 22 | "This module provides pseudo-random numbers/string generation \ 23 | \ Documentation: https://pact-util-lib.readthedocs.io \ 24 | \ Github: https://github.com/CryptoPascal31/pact-util-lib " 25 | (defconst VERSION:string "0.2") 26 | 27 | (bless "RBfxKPExaz5q6i64FLA_k7UVM9MaOO0UDJulfPFZBRA") 28 | 29 | (defcap GOV() 30 | (enforce-keyset "free.util-lib")) 31 | 32 | (use util-strings [join]) 33 | (use util-math [pow10]) 34 | 35 | (defschema state-schema 36 | state:string) 37 | 38 | (deftable state-table:{state-schema}) 39 | 40 | (defun reset-state:string() 41 | "Reset the state of the generator. Should only be called when the contract is generated" 42 | (with-default-read state-table "" {'state:""} {"state":=s} 43 | (enforce (= s "") "Random generator already initialized" )) 44 | 45 | (write state-table ""{'state:(tx-hash)}) 46 | (+ "Random Generator state resetted to " (tx-hash)) 47 | ) 48 | 49 | (defun --random-hash:string () 50 | "Core private function which returns the 256 bits random number in base 64" 51 | (with-read state-table "" {"state":= old-state} 52 | (let* ((seed1 (tx-hash)) 53 | (seed2 (hash (at 'block-time (chain-data)))) 54 | (new-state (hash (concat [old-state seed1 seed2])))) 55 | (update state-table "" {'state:new-state}) 56 | new-state)) 57 | ) 58 | 59 | (defun random-int:integer () 60 | "Returns a 256 bit random integer" 61 | (str-to-int 64 (--random-hash))) 62 | 63 | (defun random-int-range:integer (min_:integer max_:integer) 64 | "Returns a random integer in range [min - max]" 65 | (enforce (and (>= min_ 0) (>= max_ 0)) "Min and Max must be positive") 66 | (enforce (> max_ min_) "Max must be > to min") 67 | (let ((remainder (+ (- max_ min_) 1))) 68 | (+ (mod (random-int) remainder) min_)) 69 | ) 70 | 71 | (defun random-decimal-range:decimal (min_:decimal max_:decimal) 72 | "Returns a random decimal in range [min - max] with a precision of 12" 73 | (enforce (> max_ min_) "Max must be > to min") 74 | (let* ((to-int (lambda (x) (floor (* x (pow10 12))))) 75 | (to-decimal (lambda (x) (floor (* x (pow10 -12)) 12)))) 76 | (+ min_ (to-decimal (random-int-range 0 (to-int (- max_ min_)))))) 77 | ) 78 | 79 | (defun random-string:string (len:integer) 80 | "Returns a random string whose length is given by the argument" 81 | (let* ((cnt (+ (/ len 43) 1)) 82 | (rnd (random-int)) 83 | (substrings (map (lambda (x) (hash (+ rnd x))) (enumerate 1 cnt)))) 84 | (take len (concat substrings))) 85 | ) 86 | 87 | (defun gen-uuid-rfc-4122-v4:string () 88 | "Generate an UUID (Universal Unique ID) according to RFC 4122 v4" 89 | (let* ((set-bits (lambda (x bits mask) (int-to-str 16 (| bits (& mask (str-to-int 16 x)))))) 90 | (uid-hex (int-to-str 16 (random-int))) 91 | (field-4 (take -12 uid-hex)) 92 | (field-3 (take -4 (drop -12 uid-hex))) 93 | (field-3 (set-bits field-3 32768 16383)) 94 | (field-2 (take -4 (drop -16 uid-hex))) 95 | (field-2 (set-bits field-2 16384 4095)) 96 | (field-1 (take -4 (drop -20 uid-hex))) 97 | (field-0 (take -8 (drop -24 uid-hex)))) 98 | (join "-" [field-0, field-1, field-2, field-3, field-4])) 99 | ) 100 | ) 101 | -------------------------------------------------------------------------------- /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-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.2") 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 (> (length x) 0) "List cannot be empty")) 26 | 27 | (defun enforce-list-bounds:bool (x:list idx:integer) 28 | "Verify and ENFORCES that idx is in list bounds" 29 | (enforce (and? (<= 0) (> (length x)) idx) "Index out of bounds")) 30 | 31 | (defun chain:list (in:list) 32 | "Chain list of lists" 33 | (fold (+) [] in)) 34 | 35 | (defun enumerate-list:[object] (in:list) 36 | "Returns a list of objects {'i:idx, 'v:value} where i is the index, and v the value" 37 | ; The enumerate should go from 0 to N-1, but since zip takes the shortest, and for clarity we go from 0 to N 38 | (let ((indexes (enumerate 0 (length in)))) 39 | (zip (lambda (idx x) {'i:idx, 'v:x}) indexes in)) 40 | ) 41 | 42 | ;; Getter Funtcions 43 | (defun first (in:list) 44 | "Returns the first item of a list" 45 | (enforce-not-empty in) 46 | (at 0 in)) 47 | 48 | (defun last (in:list) 49 | "Returns the last item of the list" 50 | (enforce-not-empty in) 51 | (at (- (length in) 1) in)) 52 | 53 | (defun search:[integer] (in:list item) 54 | "Search an item into the list and returns a list of index" 55 | ; Save gas if item is not in list => use the native contains to return empty 56 | (if (contains item in) 57 | (let ((match-func (lambda (out-list x) 58 | (if (= (at 'v x) item) 59 | (append-last out-list (at 'i x)) 60 | out-list)))) 61 | (fold match-func [] (enumerate-list in))) 62 | []) 63 | ) 64 | 65 | (defun count:integer (in:list item) 66 | "Returns the number of occurences of an item" 67 | (length (filter (= item) in)) 68 | ) 69 | 70 | ;; Insertion functions 71 | (defun insert-first:list (in:list item) 72 | "Insert an item at the left of the list" 73 | (+ [item] in)) 74 | 75 | (defun append-last:list (in:list item) 76 | "Append an item at the end of the list" 77 | (+ in [item])) 78 | 79 | (defun insert-at:list (in:list idx:integer item) 80 | "Insert an item at position idx" 81 | (enforce (and? (<= 0) (>= (length in)) idx) "Index out of bounds") 82 | (chain [(take idx in), 83 | [item], 84 | (drop idx in)]) 85 | ) 86 | 87 | ;; Replacement functions 88 | (defun replace-first:list (in:list item) 89 | "Replace the first item of the list" 90 | (enforce-not-empty in) 91 | (insert-first (drop 1 in) item)) 92 | 93 | (defun replace-last:list (in:list item) 94 | "Replace the last item of the list" 95 | (enforce-not-empty in) 96 | (append-last (drop -1 in) item)) 97 | 98 | (defun replace-at:list (in:list idx:integer item) 99 | "Replace the item at position idx" 100 | (enforce (and? (<= 0) (> (length in)) idx) "Index out of bounds") 101 | (chain [(take idx in), 102 | [item], 103 | (drop (+ 1 idx) in)]) 104 | ) 105 | 106 | (defun replace-item:list (in:list old-item new-item) 107 | "Replace each occurrence of old-item by new-item" 108 | (map (lambda (x) (if (= x old-item) new-item x)) in) 109 | ) 110 | 111 | (defun replace-item*:list (in:list old-item new-item) 112 | "Replace each occurrence of old-item by new-item but raises an error if old-item does not exist" 113 | (enforce (contains old-item in) "The item is not present in the list") 114 | (replace-item in old-item new-item) 115 | ) 116 | 117 | ;; Removal functions 118 | (defun remove-first:list (in:list) 119 | "Remove first element from the list" 120 | (enforce-not-empty in) 121 | (drop 1 in) 122 | ) 123 | 124 | (defun remove-last:list (in:list) 125 | "Remove last element from the list" 126 | (enforce-not-empty in) 127 | (drop -1 in) 128 | ) 129 | 130 | (defun remove-at:list (in:list idx:integer) 131 | "Remove element at position idx" 132 | (enforce-list-bounds in idx) 133 | (+ (take idx in) (drop (+ 1 idx) in)) 134 | ) 135 | 136 | (defun remove-item:list (in:list item) 137 | "Remove an item from a list" 138 | (filter (!= item) in) 139 | ) 140 | 141 | (defun remove-item*:list (in:list item) 142 | "Remove and item from the list but raises an error if it does not exist" 143 | (enforce (contains item in) "The item is not present in the list") 144 | (remove-item in item) 145 | ) 146 | ) 147 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /coinflip.repl: -------------------------------------------------------------------------------- 1 | (load "kda-env/init.repl") 2 | 3 | (begin-tx) 4 | 5 | (env-keys ["gov", "ops"]) 6 | (env-data 7 | { 8 | "gov": { "keys": ["gov"], "pred": "keys-all"}, 9 | "ops": { "keys": ["ops"], "pred": "keys-all"}, 10 | "init": true 11 | }) 12 | 13 | (load "coinflip.pact") 14 | 15 | (commit-tx) 16 | 17 | 18 | 19 | (begin-tx "Values are correct") 20 | (use free.coinflip) 21 | 22 | (expect-that "Chance to win" 23 | (= 2) 24 | (get-int-value WIN_CHANCE_KEY) 25 | ) 26 | (expect-that "Chance to win" 27 | (= 1) 28 | (mod 1 (get-int-value WIN_CHANCE_KEY)) 29 | ) 30 | (expect-that "Chance to win" 31 | (= true) 32 | (= (mod 1 (get-int-value WIN_CHANCE_KEY)) 1) 33 | ) 34 | (commit-tx) 35 | 36 | 37 | 38 | (begin-tx "Bets and Claim") 39 | (use free.coinflip) 40 | 41 | (env-keys ["alice-key"]) 42 | (env-sigs [ 43 | { 44 | "key": "alice-key", 45 | "caps": [ 46 | (coin.TRANSFER "alice" TREASURY_BANK 200.0) 47 | ] 48 | } 49 | ]) 50 | (expect-failure "Can't place bet without ops" 51 | "Keyset failure (keys-all): [ops]" 52 | (place-bet "alice" 1 1 100.0) 53 | ) 54 | 55 | (env-keys ["alice-key", "ops"]) 56 | (env-sigs [ 57 | { 58 | "key": "alice-key", 59 | "caps": [ 60 | (coin.TRANSFER "alice" TREASURY_BANK 200.0) 61 | ] 62 | }, 63 | { 64 | "key": "ops", 65 | "caps": [ 66 | (OPS) 67 | ] 68 | } 69 | ]) 70 | (expect-that "Can place bet with OPS" 71 | (= "Write succeeded") 72 | (place-bet "alice" 1 1 100.0) 73 | ) 74 | (expect-that "Can claim" 75 | (= (* (- 100.0 (* 100.0 (get-decimal-value SITE_FEE_KEY))) 2)) 76 | (get-claim-amount "alice") 77 | ) 78 | (expect-that "Can place bet with OPS" 79 | (= "Lost bet") 80 | (place-bet "alice" 1 2 100.0) 81 | ) 82 | (expect-that "Can claim" 83 | (= (* (- 100.0 (* 100.0 (get-decimal-value SITE_FEE_KEY))) 2)) 84 | (get-claim-amount "alice") 85 | ) 86 | 87 | (commit-tx) 88 | 89 | 90 | 91 | (begin-tx "Claim") 92 | (use free.coinflip) 93 | 94 | (env-keys ["bob-key"]) 95 | (env-sigs [ 96 | { 97 | "key": "bob-key", 98 | "caps": [ 99 | (WINNER "alice" 50.0) 100 | ] 101 | } 102 | ]) 103 | (expect-failure "Can't withdraw from someone else" 104 | "Keyset failure (keys-all): [alice" 105 | (withdraw-winnings "alice" 50.0) 106 | ) 107 | (env-sigs [ 108 | { 109 | "key": "bob-key", 110 | "caps": [ 111 | (WINNER "bob" 100.0) 112 | ] 113 | } 114 | ]) 115 | (expect-failure "Can't withdraw if you haven't won" 116 | "You haven't won yet" 117 | (withdraw-winnings "bob" 100.0) 118 | ) 119 | 120 | (env-keys ["alice-key"]) 121 | (env-sigs [ 122 | { 123 | "key": "alice-key", 124 | "caps": [ 125 | (WINNER "alice" (get-claim-amount "alice")) 126 | ] 127 | } 128 | ]) 129 | (get-claim-amount "alice") 130 | (expect-that "Can withdraw up to won amount" 131 | (= "Write succeeded") 132 | (withdraw-winnings "alice" (get-claim-amount "alice")) 133 | ) 134 | 135 | (commit-tx) 136 | 137 | 138 | 139 | (begin-tx "Claim Fail") 140 | (use free.coinflip) 141 | 142 | (env-keys ["alice-key"]) 143 | (env-sigs [ 144 | { 145 | "key": "alice-key", 146 | "caps": [ 147 | (WINNER "alice" 100.0) 148 | ] 149 | } 150 | ]) 151 | (expect-failure "Can't withdraw more than winnings" 152 | "Your winning balance is not enough for claim 100.0" 153 | (withdraw-winnings "alice" 100.0) 154 | ) 155 | 156 | (commit-tx) 157 | 158 | 159 | 160 | (begin-tx "Bank and Withdraw") 161 | (use free.coinflip) 162 | 163 | (env-keys ["ops"]) 164 | (env-sigs [ 165 | { 166 | "key": "ops", 167 | "caps": [ 168 | (OPS) 169 | ] 170 | } 171 | ]) 172 | (expect-that "Can withdraw" 173 | (= "Write succeeded") 174 | (withdraw-from-bank "alice" 7.0) 175 | ) 176 | 177 | (commit-tx) 178 | 179 | 180 | 181 | (begin-tx "Permissions") 182 | (use free.coinflip) 183 | 184 | (env-keys ["bob"]) 185 | (env-sigs [ 186 | { 187 | "key": "bob", 188 | "caps": [ 189 | (OPS) 190 | ] 191 | } 192 | ]) 193 | (expect-failure "Can't withdraw" 194 | "Keyset failure (keys-all): [ops]" 195 | (withdraw-from-bank "bob" 7.0) 196 | ) 197 | 198 | (commit-tx) 199 | 200 | 201 | 202 | (begin-tx "Gov and Ops guard rotation") 203 | (use free.coinflip) 204 | 205 | (env-keys ["gov"]) 206 | (env-sigs [{ "key": "gov", "caps": [(GOV)]}]) 207 | (env-data 208 | { 209 | "gov2": { "keys": ["gov2"], "pred": "="} 210 | }) 211 | (expect-that "Rotating gov works" 212 | (= "Rotated GOV to a new guard") 213 | (rotate-gov (read-keyset "gov2")) 214 | ) 215 | (expect-failure "Setting value with old keyset doesn't work" 216 | "Tx Failed: Keyset failure (=): [gov2]" 217 | (rotate-gov (read-keyset "gov2")) 218 | ) 219 | 220 | (env-keys ["gov2"]) 221 | (env-sigs [{ "key": "gov2", "caps": [(GOV)]}]) 222 | (env-data 223 | { 224 | "gov": { "keys": ["gov"], "pred": "="} 225 | }) 226 | (expect-that "Rotating gov works" 227 | (= "Rotated GOV to a new guard") 228 | (rotate-gov (read-keyset "gov")) 229 | ) 230 | 231 | (env-keys ["ops"]) 232 | (env-sigs [{ "key": "ops", "caps": [(OPS)]}]) 233 | (env-data 234 | { 235 | "ops2": { "keys": ["ops2"], "pred": "="} 236 | }) 237 | (expect-that "Rotating ops works" 238 | (= "Rotated OPS to a new guard") 239 | (rotate-ops (read-keyset "ops2")) 240 | ) 241 | (expect-failure "Setting value with old keyset doesn't work" 242 | "Tx Failed: Keyset failure (=): [ops2]" 243 | (rotate-ops (read-keyset "ops2")) 244 | ) 245 | 246 | (env-keys ["ops2"]) 247 | (env-sigs [{ "key": "ops2", "caps": [(OPS)]}]) 248 | (env-data 249 | { 250 | "ops": { "keys": ["ops"], "pred": "="} 251 | }) 252 | (expect-that "Rotating ops works" 253 | (= "Rotated OPS to a new guard") 254 | (rotate-ops (read-keyset "ops")) 255 | ) 256 | 257 | (commit-tx) -------------------------------------------------------------------------------- /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.2") 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 sum3:decimal (x:decimal y:decimal z:decimal) 83 | "Returns the sum of 3 values" 84 | (+ x (+ y z))) 85 | 86 | (defun sum4:decimal (x:decimal y:decimal z:decimal zz:decimal) 87 | "Returns the sum of 4 values" 88 | (+ (+ x y) (+ z zz))) 89 | 90 | (defun sum:decimal (x:[decimal]) 91 | "Returns the sum of a list" 92 | (fold (+) 0.0 x)) 93 | 94 | (defun prod3:decimal (x:decimal y:decimal z:decimal) 95 | "Returns the product of 3 values" 96 | (* x (* y z))) 97 | 98 | (defun prod4:decimal (x:decimal y:decimal z:decimal zz:decimal) 99 | "Returns the product of 4 values" 100 | (* (* x y) (* z zz))) 101 | 102 | (defun prod:decimal (x:[decimal]) 103 | "Returns the product of a list" 104 | (fold (*) 1.0 x)) 105 | 106 | (defun square:decimal (x:decimal) 107 | "Returns the square of x" 108 | (* x x)) 109 | 110 | (defun safe-/ (x:decimal y:decimal default:decimal) 111 | "Divide x/y but returns default if y is 0.0" 112 | (if (= y 0.0) default (/ x y))) 113 | 114 | (defun avg:decimal (x:[decimal]) 115 | "Returns the average of a list" 116 | (enforce-not-empty x) 117 | (/ (sum x) (length x))) 118 | 119 | (defun is-even:bool (x:integer) 120 | "Returns true if x is even" 121 | (= 0 (mod x 2))) 122 | 123 | (defun is-odd:bool (x:integer) 124 | "Returns true if x is odd" 125 | (= 1 (mod x 2))) 126 | 127 | (defun med:decimal (x:[decimal]) 128 | "Returns the median of a list: if the length of the list is even return the (n/2 -1)th element" 129 | (enforce-not-empty x) 130 | (let* ((cnt (length x)) 131 | (mid (/ cnt 2)) 132 | (index (if (is-even cnt) (- mid 1) mid))) 133 | (at index (sort x))) 134 | ) 135 | 136 | (defun med*:decimal (x:[decimal]) 137 | "Returns the median of a list: if the length of the list is even return the average of the\ 138 | \(n/2 -1)th and (n/2)th elements" 139 | (enforce-not-empty x) 140 | (let* ((cnt (length x)) 141 | (mid (/ cnt 2)) 142 | (mid-1 (- mid 1)) 143 | (sorted-x (sort x))) 144 | (if (is-even cnt) 145 | (/ (+ (at mid sorted-x) (at mid-1 sorted-x)) 2) 146 | (at mid sorted-x))) 147 | ) 148 | 149 | (defun between:bool (a:decimal b:decimal x:decimal) 150 | "Returns true is a <= x <= b" 151 | (and? (<= a) (>= b) x)) 152 | 153 | (defun sign:decimal (x:decimal) 154 | "Returns 1.0 if x is positive, 0.0 if x is null, and -1.0 if x is negative" 155 | (if (= x 0.0) 156 | 0.0 157 | (if (> x 0.0) 158 | 1.0 159 | -1.0))) 160 | 161 | (defun pow10:decimal (x:integer) 162 | "Returns 10^x, rounded to 12 decimals (rounding is important when x is negative)" 163 | (round (^ 10.0 x) 12)) 164 | 165 | (defun xEy (x:decimal y:integer) 166 | "Returns x.10^y, rounded to 12 decimals" 167 | (round (* x (pow10 y)) 12)) 168 | 169 | ;;; Log functions 170 | (defun log10:decimal (x) 171 | "Returns the log of x base 10, rounded to 12 decimals" 172 | ; x can be decimal or an integer but the returned result is always a decimal 173 | (round (log 10 (* 1.0 x)) 12)) 174 | 175 | (defun safe-log (x y default) 176 | "Log of Y base X, but returns default when y <= 0" 177 | (if (> (* 1.0 y) 0.0 ) (log x y) default)) 178 | 179 | (defun safe-ln (x:decimal default:decimal) 180 | "Natural log of x, but returns default when x <= 0" 181 | (if (> x 0.0 ) (ln x) default)) 182 | 183 | (defun safe-log10:decimal (x default:decimal) 184 | "Returns the log of x base 10, rounded to 12 decimals but returns default when x <= 0" 185 | ; x can be decimal or an integer but the returned result is always a decimal 186 | ; btw default has to be a decimal 187 | (if (> (* 1.0 x) 0.0 ) (log10 x) default)) 188 | 189 | ) 190 | -------------------------------------------------------------------------------- /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 | (enforce-pact-version "3.7") 2 | 3 | (namespace 'kip) 4 | 5 | (interface poly-fungible-v2 6 | 7 | (defschema account-details 8 | @doc 9 | " Account details: token ID, account name, balance, and guard." 10 | @model 11 | [ (invariant (!= id "")) 12 | (invariant (!= account "")) 13 | (invariant (>= balance 0.0)) 14 | ] 15 | id:string 16 | account:string 17 | balance:decimal 18 | guard:guard) 19 | 20 | (defschema sender-balance-change 21 | @doc "For use in RECONCILE events" 22 | account:string 23 | previous:decimal 24 | current:decimal 25 | ) 26 | 27 | (defschema receiver-balance-change 28 | @doc "For use in RECONCILE events" 29 | account:string 30 | previous:decimal 31 | current:decimal 32 | ) 33 | 34 | (defcap TRANSFER:bool 35 | ( id:string 36 | sender:string 37 | receiver:string 38 | amount:decimal 39 | ) 40 | @doc 41 | " Manage transferring AMOUNT of ID from SENDER to RECEIVER. \ 42 | \ As event, also used to notify burn (with \"\" RECEIVER) \ 43 | \ and create (with \"\" SENDER)." 44 | @managed amount TRANSFER-mgr 45 | ) 46 | 47 | (defcap XTRANSFER:bool 48 | ( id:string 49 | sender:string 50 | receiver:string 51 | target-chain:string 52 | amount:decimal 53 | ) 54 | " Manage cross-chain transferring AMOUNT of ID from SENDER to RECEIVER \ 55 | \ on TARGET-CHAIN." 56 | @managed amount TRANSFER-mgr 57 | ) 58 | 59 | (defun TRANSFER-mgr:decimal 60 | ( managed:decimal 61 | requested:decimal 62 | ) 63 | @doc " Manages TRANSFER cap AMOUNT where MANAGED is the installed quantity \ 64 | \ and REQUESTED is the quantity attempting to be granted." 65 | ) 66 | 67 | (defcap SUPPLY:bool (id:string supply:decimal) 68 | @doc " Emitted when SUPPLY is updated, if supported." 69 | @event 70 | ) 71 | 72 | (defcap TOKEN:bool (id:string precision:integer supply:decimal policy:module{kip.token-policy-v1}) 73 | @doc " Emitted when token ID is created." 74 | @event 75 | ) 76 | 77 | (defcap ACCOUNT_GUARD:bool (id:string account:string guard:guard) 78 | @doc " Emitted when ACCOUNT guard is updated." 79 | @event 80 | ) 81 | 82 | (defcap RECONCILE:bool 83 | ( token-id:string 84 | amount:decimal 85 | sender:object{sender-balance-change} 86 | receiver:object{receiver-balance-change} 87 | ) 88 | @doc " For accounting via events. \ 89 | \ sender = {account: '', previous: 0.0, current: 0.0} for mint \ 90 | \ receiver = {account: '', previous: 0.0, current: 0.0} for burn" 91 | @event 92 | ) 93 | 94 | (defun precision:integer (id:string) 95 | @doc 96 | " Return maximum decimal precision for ID." 97 | ) 98 | 99 | (defun enforce-unit:bool 100 | ( id:string 101 | amount:decimal 102 | ) 103 | @doc 104 | " Enforce that AMOUNT meets minimum precision allowed for ID." 105 | ) 106 | 107 | (defun create-account:bool 108 | ( id:string 109 | account:string 110 | guard:guard 111 | ) 112 | @doc 113 | " Create ACCOUNT for ID with 0.0 balance, with GUARD controlling access." 114 | @model 115 | [ (property (!= id "")) 116 | (property (!= account "")) 117 | ] 118 | ) 119 | 120 | (defun get-balance:decimal 121 | ( id:string 122 | account:string 123 | ) 124 | @doc 125 | " Get balance of ID for ACCOUNT. Fails if account does not exist." 126 | ) 127 | 128 | (defun details:object{account-details} 129 | ( id:string 130 | account:string 131 | ) 132 | @doc 133 | " Get details of ACCOUNT under ID. Fails if account does not exist." 134 | ) 135 | 136 | (defun rotate:bool 137 | ( id:string 138 | account:string 139 | new-guard:guard ) 140 | @doc 141 | " Rotate guard for ACCOUNT for ID to NEW-GUARD, validating against existing guard." 142 | @model 143 | [ (property (!= id "")) 144 | (property (!= account "")) 145 | ] 146 | 147 | ) 148 | 149 | (defun transfer:bool 150 | ( id:string 151 | sender:string 152 | receiver:string 153 | amount:decimal 154 | ) 155 | @doc 156 | " Transfer AMOUNT of ID between accounts SENDER and RECEIVER. \ 157 | \ Fails if SENDER does not exist. Managed by TRANSFER." 158 | @model 159 | [ (property (> amount 0.0)) 160 | (property (!= id "")) 161 | (property (!= sender "")) 162 | (property (!= receiver "")) 163 | (property (!= sender receiver)) 164 | ] 165 | ) 166 | 167 | (defun transfer-create:bool 168 | ( id:string 169 | sender:string 170 | receiver:string 171 | receiver-guard:guard 172 | amount:decimal 173 | ) 174 | @doc 175 | " Transfer AMOUNT of ID between accounts SENDER and RECEIVER. \ 176 | \ If RECEIVER exists, RECEIVER-GUARD must match existing guard; \ 177 | \ if RECEIVER does not exist, account is created. \ 178 | \ Managed by TRANSFER." 179 | @model 180 | [ (property (> amount 0.0)) 181 | (property (!= id "")) 182 | (property (!= sender "")) 183 | (property (!= receiver "")) 184 | (property (!= sender receiver)) 185 | ] 186 | ) 187 | 188 | (defpact transfer-crosschain:bool 189 | ( id:string 190 | sender:string 191 | receiver:string 192 | receiver-guard:guard 193 | target-chain:string 194 | amount:decimal 195 | ) 196 | @doc 197 | " Transfer AMOUNT of ID between accounts SENDER on source chain \ 198 | \ and RECEIVER on TARGET-CHAIN. If RECEIVER exists, RECEIVER-GUARD \ 199 | \ must match existing guard. If RECEIVER does not exist, account is created." 200 | @model 201 | [ (property (> amount 0.0)) 202 | (property (!= id "")) 203 | (property (!= sender "")) 204 | (property (!= receiver "")) 205 | (property (!= target-chain "")) 206 | ] 207 | ) 208 | 209 | (defun total-supply:decimal (id:string) 210 | @doc 211 | " Give total available quantity of ID. If not supported, return 0." 212 | ) 213 | 214 | (defun get-manifest:object{kip.token-manifest.manifest} (id:string) 215 | @doc 216 | " Give manifest for ID." 217 | ) 218 | 219 | ;; 220 | ;; Sale API 221 | ;; 222 | 223 | (defcap SALE:bool 224 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 225 | @doc "Wrapper cap/event of SALE of token ID by SELLER of AMOUNT until TIMEOUT block height." 226 | @event 227 | ) 228 | 229 | (defcap OFFER:bool 230 | (id:string seller:string amount:decimal timeout:integer) 231 | @doc "Managed cap for SELLER offering AMOUNT of token ID until TIMEOUT." 232 | @managed 233 | ) 234 | 235 | (defcap WITHDRAW:bool 236 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 237 | @doc "Withdraws offer SALE from SELLER of AMOUNT of token ID after TIMEOUT." 238 | @event 239 | ) 240 | 241 | (defcap BUY:bool 242 | (id:string seller:string buyer:string amount:decimal timeout:integer sale-id:string) 243 | @doc "Completes sale OFFER to BUYER." 244 | @managed 245 | ) 246 | 247 | (defpact sale:bool 248 | ( id:string 249 | seller:string 250 | amount:decimal 251 | timeout:integer 252 | ) 253 | @doc " Offer->buy escrow pact of AMOUNT of token ID by SELLER with TIMEOUT in blocks. \ 254 | \ Step 1 is offer with withdraw rollback after timeout. \ 255 | \ Step 2 is buy, which completes using 'buyer' and 'buyer-guard' payload values." 256 | ) 257 | 258 | ) 259 | -------------------------------------------------------------------------------- /coinflip.pact: -------------------------------------------------------------------------------- 1 | (namespace "free") 2 | 3 | (module coinflip GOV 4 | "Coinflip module" 5 | 6 | ;; Import `coin` module while only making the `details` function available 7 | ;; in the `coinflip` module body 8 | (use coin) 9 | 10 | ;; ------------------------------- 11 | ;; Governance and Permissions 12 | 13 | (defconst GOV_GUARD:string "gov") 14 | (defconst OPS_GUARD:string "ops") 15 | 16 | (defcap GOV () 17 | (enforce-guard (at "guard" (read m-guards GOV_GUARD ["guard"]))) 18 | ) 19 | 20 | (defcap OPS () 21 | (enforce-guard (at "guard" (read m-guards OPS_GUARD ["guard"]))) 22 | (compose-capability (WITHDRAW)) 23 | ) 24 | 25 | (defcap PLACE_BET() 26 | @doc "Verifies single tx" 27 | (enforce (= 1 (length (at "exec-code" (read-msg)))) "Tx of only one pact function") 28 | ) 29 | 30 | (defschema m-guard ;; ID is a const: OPS_GUARD, GOV_GUARD etc. 31 | @doc "Stores guards for the module" 32 | guard:guard 33 | ) 34 | (deftable m-guards:{m-guard}) 35 | 36 | (defun rotate-ops:string (guard:guard) 37 | @doc "Requires GOV. Changes the ops guard to the provided one." 38 | 39 | (with-capability (OPS) 40 | (update m-guards OPS_GUARD 41 | { "guard": guard } 42 | ) 43 | 44 | "Rotated OPS to a new guard" 45 | ) 46 | ) 47 | 48 | (defun rotate-gov:string (guard:guard) 49 | @doc "Requires GOV. Changes the gov guard to the provided one." 50 | 51 | (with-capability (GOV) 52 | (update m-guards GOV_GUARD 53 | { "guard": guard } 54 | ) 55 | 56 | "Rotated GOV to a new guard" 57 | ) 58 | ) 59 | 60 | (defun init-perms:string (gov:guard ops:guard) 61 | @doc "Initializes the guards and creates the tables for the module" 62 | 63 | ;; This is only vulnerable if GOV_GUARD doesn't exist 64 | ;; Which means it's only vulnerable if you don't call 65 | ;; init when you deploy the contract. 66 | ;; So let us be sure that init is called. =) 67 | (insert m-guards GOV_GUARD 68 | { "guard": gov } 69 | ) 70 | (insert m-guards OPS_GUARD 71 | { "guard": ops } 72 | ) 73 | ) 74 | 75 | ;; ------------------------------- 76 | ;; Decimal Values 77 | 78 | (defschema decimal-value 79 | @doc "Stores decimal values" 80 | value:decimal 81 | ) 82 | (deftable decimal-values:{decimal-value}) 83 | 84 | (defun update-decimal-value (val-id:string value:decimal) 85 | @doc "Updates the account for the bank" 86 | 87 | (with-capability (OPS) 88 | (write decimal-values val-id 89 | { "value": value } 90 | ) 91 | ) 92 | ) 93 | 94 | (defun get-decimal-value:decimal (val-id:string) 95 | @doc "Gets the value with the provided id" 96 | 97 | (at "value" (read decimal-values val-id ["value"])) 98 | ) 99 | 100 | ;; ------------------------------- 101 | ;; Int Values 102 | 103 | (defschema int-value 104 | @doc "Stores decimal values" 105 | value:integer 106 | ) 107 | (deftable int-values:{int-value}) 108 | 109 | (defun update-int-value:string (val-id:string value:integer) 110 | @doc "Updates the account for the bank" 111 | 112 | (with-capability (OPS) 113 | (write int-values val-id 114 | { "value": value } 115 | ) 116 | ) 117 | ) 118 | 119 | (defun get-int-value:integer (val-id:string) 120 | @doc "Gets the value with the provided id" 121 | 122 | (at "value" (read int-values val-id ["value"])) 123 | ) 124 | 125 | ;; ------------------------------- 126 | ;; Constants 127 | 128 | (defconst SITE_FEE_KEY:string "SITE_FEE") 129 | (defconst WIN_CHANCE_KEY:string "WIN_CHANCE") 130 | 131 | (defschema winner 132 | account:string 133 | amountKDA:decimal 134 | wonCount:integer 135 | ) 136 | 137 | (deftable winners:{winner}) 138 | 139 | (defun generateRandom:integer () 140 | (mod (abs (str-to-int 64 (base64-encode (take -1 (drop -1(hash (at "block-time" (chain-data)))))))) 2) 141 | ) 142 | 143 | (defun place-bet:string (account:string prediction:integer amount:decimal) 144 | @doc "Start the betting." 145 | (with-capability (PLACE_BET) 146 | (coin.transfer account TREASURY_BANK amount) 147 | (let ((randomiss (generateRandom))) 148 | (if (= randomiss prediction) 149 | (let 150 | ( 151 | (exists (winner-exists account)) 152 | (winAmount (* (- amount (* amount (get-decimal-value SITE_FEE_KEY))) 2)) 153 | ) 154 | (if exists 155 | (with-read winners account { 156 | "wonCount":= wonCount, 157 | "amountKDA":= amountKDA 158 | } 159 | (update winners account { 160 | "wonCount":(+ wonCount 1), 161 | "amountKDA":(+ amountKDA winAmount) 162 | }) 163 | ) 164 | (insert winners account { 165 | "account":account, 166 | "amountKDA":winAmount, 167 | "wonCount":1 168 | } 169 | ) 170 | ) 171 | ) 172 | "Lost bet" 173 | ) 174 | ) 175 | ) 176 | ) 177 | 178 | (defun get-claim-amount:decimal (account:string) 179 | @doc "Get the claim amount by winner account" 180 | ;; Read the row using the account as key and select only amountKDA column 181 | (with-default-read winners account 182 | {"amountKDA":0} 183 | {"amountKDA":= amountKDA} 184 | amountKDA 185 | ) 186 | ) 187 | 188 | (defun winner-exists:bool (account:string) 189 | @doc "Check if the winner exists" 190 | ;; Read from winners table using `account` param value as key. 191 | ;; with-default-read allows us to set default values for the table columns 192 | ;; That are returned if the row does not exist. 193 | (with-default-read winners account 194 | {"wonCount":0} 195 | {"wonCount":= wonCount} 196 | (> wonCount 0) 197 | ) 198 | ) 199 | 200 | (defun balance-exists:bool (account:string amount:decimal) 201 | @doc "Check if the winners balance exists" 202 | ;; Read from winners table using `account` param value as key. 203 | (with-default-read winners account 204 | {"amountKDA":0} 205 | {"amountKDA":= amountKDA} 206 | (>= amountKDA amount) 207 | ) 208 | ) 209 | 210 | (defcap WINNER (account:string amount:decimal) 211 | @doc "Make sure the requester owns the KDA account" 212 | ;; Get the guard of the given KDA account using coin.details function 213 | ;; and execute it using `enforce-guard` 214 | (enforce-guard (at 'guard (coin.details account))) 215 | (with-default-read winners account 216 | {"amountKDA":0, "wonCount":0} 217 | {"wonCount":= wonCount, "amountKDA":= amountKDA} 218 | (enforce (> wonCount 0) "You haven't won yet") 219 | (enforce (>= amountKDA amount) (format "Your winning balance is not enough for claim {}" [amount])) 220 | ) 221 | (compose-capability (WITHDRAW)) 222 | ) 223 | 224 | (defun withdraw-winnings (account:string amount:decimal) 225 | @doc "Withdraw the winning balance" 226 | (with-capability (WINNER account amount) 227 | 228 | (install-capability (coin.TRANSFER TREASURY_BANK account amount)) 229 | (coin.transfer TREASURY_BANK account amount) 230 | 231 | 232 | (with-read winners account { 233 | "amountKDA":= amountKDA 234 | } 235 | ( update winners account { 236 | "amountKDA": (- amountKDA amount) 237 | }) 238 | ) 239 | ) 240 | ) 241 | 242 | ;; ------------------------------- 243 | ;; Bank Creation and Guard 244 | 245 | (defconst TREASURY_BANK:string (bank-account-name)) 246 | 247 | (defcap WITHDRAW () 248 | @doc "Used to give permission to withdraw money from the bank" 249 | true 250 | ) 251 | 252 | (defun require-WITHDRAW:bool () 253 | (require-capability (WITHDRAW)) 254 | true 255 | ) 256 | 257 | (defun bank-guard:guard () 258 | @doc "Creates a guard that is used for the bank of the pool" 259 | (create-user-guard (require-WITHDRAW)) 260 | ) 261 | 262 | (defun bank-account-name:string () 263 | (create-principal (bank-guard)) 264 | ) 265 | 266 | (defun withdraw-from-bank:string (receiver:string amount:decimal) 267 | @doc "Ops function that enables coinflip managers to withdraw from a treasury's bank. \ 268 | \ Expects that the receiver exists." 269 | (with-capability (OPS) 270 | (install-capability (coin.TRANSFER TREASURY_BANK receiver amount)) 271 | (coin.transfer TREASURY_BANK receiver amount) 272 | ) 273 | ) 274 | 275 | (defun deposit-to-bank:string (account:string amount:decimal) 276 | @doc "Ops function that enables coinflip managers to deposit to treasury's bank." 277 | (with-capability (OPS) 278 | (install-capability (coin.TRANSFER account TREASURY_BANK amount)) 279 | (coin.transfer account TREASURY_BANK amount) 280 | ) 281 | ) 282 | 283 | (defun intilialize() 284 | (with-capability (OPS) 285 | (coin.create-account TREASURY_BANK (bank-guard)) 286 | "Bank accounts have been created" 287 | ) 288 | ) 289 | ) 290 | 291 | 292 | 293 | (if (read-msg "init") 294 | [ 295 | (create-table m-guards) 296 | (create-table decimal-values) 297 | (create-table int-values) 298 | (create-table winners) 299 | (init-perms (read-keyset "gov") (read-keyset "ops")) 300 | (update-decimal-value SITE_FEE_KEY 0.035) 301 | (update-int-value WIN_CHANCE_KEY 2) 302 | (intilialize) 303 | ] 304 | "Contract upgraded" 305 | ) -------------------------------------------------------------------------------- /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.2") 22 | (defcap GOV() 23 | (enforce-keyset "free.util-lib")) 24 | 25 | (use util-lists [replace-item first last append-last replace-last]) 26 | 27 | (defconst ASCII-TABLE {" ":32, "!":33, "\"":34, "#":35, "$":36, "%":37, "&":38, "\'":39, 28 | "(":40, ")":41, "*":42, "+":43, ",":44, "-":45, ".":46, "/":47, 29 | "0":48, "1":49, "2":50, "3":51, "4":52, "5":53, "6":54, "7":55, 30 | "8":56, "9":57, ":":58, ";":59, "<":60, "=":61, ">":62, "?":63, 31 | "@":64, "A":65, "B":66, "C":67, "D":68, "E":69, "F":70, "G":71, 32 | "H":72, "I":73, "J":74, "K":75, "L":76, "M":77, "N":78, "O":79, 33 | "P":80, "Q":81, "R":82, "S":83, "T":84, "U":85, "V":86, "W":87, 34 | "X":88, "Y":89, "Z":90, "[":91, "\\":92, "]":93, "^":94, "_":95, 35 | "`":96, "a":97, "b":98, "c":99, "d":100, "e":101, "f":102, "g":103, 36 | "h":104, "i":105, "j":106, "k":107, "l":108, "m":109, "n":110, "o":111, 37 | "p":112, "q":113, "r":114, "s":115, "t":116, "u":117, "v":118, "w":119, 38 | "x":120, "y":121, "z":122, "{":123, "|":124, "}":125, "~":126}) 39 | 40 | (defconst ASCII-TABLE-REVERSE (+ (make-list 32 "") 41 | (+ (str-to-list " !\"#$%&\'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~") 42 | (make-list 128 "")))) 43 | 44 | (defun to-string:string (x) 45 | "Convert any pact type (object, list, decimal, ...) to its string representation" 46 | (format "{}" [x]) 47 | ) 48 | 49 | (defun decode-ascii:[integer] (in:string) 50 | "Convert a string to an A SCII codes list: All characters must be printable" 51 | (map (lambda (x) (at x ASCII-TABLE)) 52 | (str-to-list in)) 53 | ) 54 | 55 | (defun str-to-ascii-int:integer (in:string) 56 | "Convert a string to its integer ASCII representation" 57 | (let ((shift-add (lambda (x y) (+ (shift x 8) y)))) 58 | (fold (shift-add) 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 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 join:string (separator:string in:[string]) 134 | "Join a list of string with a separator" 135 | (if (= 0 (length in)) 136 | "" 137 | (if (= 1 (length in)) 138 | (at 0 in) 139 | (+ (first in) (concat (map (+ separator) (drop 1 in)))))) 140 | ) 141 | 142 | (defun split:[string] (separator:string in:string) 143 | "Split a string using a separator. Returns a list of substrings. Separator can only be a single char" 144 | (if (= 0 (length in)) 145 | [] ;If the string is empty return a zero length list 146 | (let ((process-char (lambda (current-list char) 147 | (if (= char separator) 148 | (append-last current-list "") 149 | (replace-last current-list (+ (last current-list) char)))))) 150 | (fold (process-char) [""] (str-to-list in)))) 151 | ) 152 | 153 | (defun starts-with:bool (in:string to-match:string) 154 | "Returns true if the string starts with the string to-match" 155 | (let ((len (length to-match))) 156 | (if (>= (length in) len) 157 | (= (take len in) to-match) 158 | false)) 159 | ) 160 | 161 | (defun ends-with:bool (in:string to-match:string) 162 | "Returns true if the string ends with the string to-match" 163 | (let ((len (length to-match))) 164 | (if (>= (length in) len) 165 | (= (take (- len) in) to-match) 166 | false)) 167 | ) 168 | 169 | ;; Stripping functions 170 | (defun --count-to-strip:integer (to-remove:string in:[string]) 171 | (let* ((do-count (lambda (state x) 172 | (bind state {"s":=s, "cnt":=cnt} 173 | (if (not s) 174 | state 175 | (if (= x to-remove) 176 | (+ {'cnt: (+ cnt 1)} state) 177 | (+ {'s:false} state))))))) 178 | 179 | (at 'cnt (fold (do-count) {'s:true, 'cnt:0} in))) 180 | ) 181 | 182 | (defun left-strip:string (to-remove:string in:string) 183 | "Remove any leading characters" 184 | (let ((cnt (--count-to-strip to-remove (str-to-list in)))) 185 | (drop cnt in)) 186 | ) 187 | 188 | (defun right-strip:string (to-remove:string in:string) 189 | "Remove any trailing characters" 190 | (let ((cnt (--count-to-strip to-remove (reverse (str-to-list in))))) 191 | (drop (- cnt) in)) 192 | ) 193 | 194 | (defun strip:string (to-remove:string in:string) 195 | "Remove both leading and trailing characters" 196 | (right-strip to-remove (left-strip to-remove in)) 197 | ) 198 | 199 | (defun decimal-to-str (x:decimal precision:integer) 200 | "Convert a decimal to string with a fixed precision" 201 | (to-string (round x precision)) 202 | ) 203 | 204 | (defun str-to-decimal:decimal (in:string) 205 | "Convert a string to a decimal" 206 | (let* ((is-negative (= "-" (take 1 in))) 207 | (in (if is-negative (drop 1 in) in)) 208 | (parts (split "." in))) 209 | (enforce (or? (= 1) (= 2) (length parts)) "Invalid format") 210 | (let* ((int-part (at 0 parts)) 211 | (has-decimal (= 2 (length parts))) 212 | (dec-part (if has-decimal (at 1 parts) "0")) 213 | (precision (if has-decimal (length dec-part) 0)) 214 | (int-val (* 1.0 (str-to-int 10 int-part))) 215 | (dec-val (* (^ 0.1 precision) (str-to-int 10 dec-part))) 216 | (val (+ int-val dec-val))) 217 | (round (if is-negative (- val) val) precision))) 218 | ) 219 | ) 220 | -------------------------------------------------------------------------------- /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:bool 194 | ( id:string 195 | precision:integer 196 | manifest:object{manifest} 197 | policy:module{kip.token-policy-v1} 198 | ) 199 | (enforce-verify-manifest manifest) 200 | (policy::enforce-init 201 | { 'id: id, 'supply: 0.0, 'precision: precision, 'manifest: manifest }) 202 | (insert tokens id { 203 | "id": id, 204 | "precision": precision, 205 | "manifest": manifest, 206 | "supply": 0.0, 207 | "policy": policy 208 | }) 209 | (emit-event (TOKEN id precision 0.0 policy)) 210 | ) 211 | 212 | (defun truncate:decimal (id:string amount:decimal) 213 | (floor amount (precision id)) 214 | ) 215 | 216 | (defun get-balance:decimal (id:string account:string) 217 | (at 'balance (read ledger (key id account))) 218 | ) 219 | 220 | (defun details:object{account-details} 221 | ( id:string account:string ) 222 | (read ledger (key id account)) 223 | ) 224 | 225 | (defun rotate:bool (id:string account:string new-guard:guard) 226 | (with-capability (ROTATE id account) 227 | (enforce-transfer-policy id account account 0.0) 228 | (with-read ledger (key id account) 229 | { "guard" := old-guard } 230 | 231 | (enforce-guard old-guard) 232 | (update ledger (key id account) 233 | { "guard" : new-guard }) 234 | (emit-event (ACCOUNT_GUARD id account new-guard))))) 235 | 236 | (defun transfer:bool 237 | ( id:string 238 | sender:string 239 | receiver:string 240 | amount:decimal 241 | ) 242 | (enforce (!= sender receiver) 243 | "sender cannot be the receiver of a transfer") 244 | (enforce-valid-transfer sender receiver (precision id) amount) 245 | (with-capability (TRANSFER id sender receiver amount) 246 | (enforce-transfer-policy id sender receiver amount) 247 | (with-read ledger (key id receiver) 248 | { "guard" := g } 249 | (let 250 | ( (sender (debit id sender amount)) 251 | (receiver (credit id receiver g amount)) 252 | ) 253 | (emit-event (RECONCILE id amount sender receiver)) 254 | ) 255 | ) 256 | ) 257 | ) 258 | 259 | (defun enforce-transfer-policy 260 | ( id:string 261 | sender:string 262 | receiver:string 263 | amount:decimal 264 | ) 265 | (bind (get-policy-info id) 266 | { 'policy := policy:module{kip.token-policy-v1} 267 | , 'token := token } 268 | (policy::enforce-transfer token sender (account-guard id sender) receiver amount)) 269 | ) 270 | 271 | (defun transfer-create:bool 272 | ( id:string 273 | sender:string 274 | receiver:string 275 | receiver-guard:guard 276 | amount:decimal 277 | ) 278 | (enforce (!= sender receiver) 279 | "sender cannot be the receiver of a transfer") 280 | (enforce-valid-transfer sender receiver (precision id) amount) 281 | 282 | (with-capability (TRANSFER id sender receiver amount) 283 | (enforce-transfer-policy id sender receiver amount) 284 | (let 285 | ( 286 | (sender (debit id sender amount)) 287 | (receiver (credit id receiver receiver-guard amount)) 288 | ) 289 | (emit-event (RECONCILE id amount sender receiver)) 290 | )) 291 | ) 292 | 293 | (defun mint:bool 294 | ( id:string 295 | account:string 296 | guard:guard 297 | amount:decimal 298 | ) 299 | (with-capability (MINT id account amount) 300 | (bind (get-policy-info id) 301 | { 'policy := policy:module{kip.token-policy-v1} 302 | , 'token := token } 303 | (policy::enforce-mint token account guard amount)) 304 | (let 305 | ( 306 | (receiver (credit id account guard amount)) 307 | (sender:object{sender-balance-change} 308 | {'account: "", 'previous: 0.0, 'current: 0.0}) 309 | ) 310 | (emit-event (RECONCILE id amount sender receiver)) 311 | (update-supply id amount) 312 | )) 313 | ) 314 | 315 | (defun burn:bool 316 | ( id:string 317 | account:string 318 | amount:decimal 319 | ) 320 | (with-capability (BURN id account amount) 321 | (bind (get-policy-info id) 322 | { 'policy := policy:module{kip.token-policy-v1} 323 | , 'token := token } 324 | (policy::enforce-burn token account amount)) 325 | (let 326 | ( 327 | (sender (debit id account amount)) 328 | (receiver:object{receiver-balance-change} 329 | {'account: "", 'previous: 0.0, 'current: 0.0}) 330 | ) 331 | (emit-event (RECONCILE id amount sender receiver)) 332 | (update-supply id (- amount)) 333 | )) 334 | ) 335 | 336 | (defun debit:object{sender-balance-change} 337 | ( id:string 338 | account:string 339 | amount:decimal 340 | ) 341 | 342 | (require-capability (DEBIT id account)) 343 | 344 | (enforce-unit id amount) 345 | 346 | (with-read ledger (key id account) 347 | { "balance" := old-bal } 348 | 349 | (enforce (<= amount old-bal) "Insufficient funds") 350 | 351 | (let ((new-bal (- old-bal amount))) 352 | (update ledger (key id account) 353 | { "balance" : new-bal } 354 | ) 355 | {'account: account, 'previous: old-bal, 'current: new-bal} 356 | )) 357 | ) 358 | 359 | (defun credit:object{receiver-balance-change} 360 | ( id:string 361 | account:string 362 | guard:guard 363 | amount:decimal 364 | ) 365 | @doc "Credit AMOUNT to ACCOUNT balance" 366 | 367 | @model [ (property (> amount 0.0)) 368 | (property (valid-account account)) 369 | ] 370 | (enforce-valid-account account) 371 | (enforce-unit id amount) 372 | 373 | (require-capability (CREDIT id account)) 374 | 375 | (with-default-read ledger (key id account) 376 | { "balance" : -1.0, "guard" : guard } 377 | { "balance" := old-bal, "guard" := retg } 378 | (enforce (= retg guard) 379 | "account guards do not match") 380 | 381 | (let* ((is-new 382 | (if (= old-bal -1.0) 383 | (enforce-reserved account guard) 384 | false)) 385 | (new-bal (if is-new amount (+ old-bal amount))) 386 | ) 387 | 388 | (write ledger (key id account) 389 | { "balance" : new-bal 390 | , "guard" : retg 391 | , "id" : id 392 | , "account" : account 393 | }) 394 | (if is-new (emit-event (ACCOUNT_GUARD id account retg)) true) 395 | {'account: account, 'previous: (if is-new 0.0 old-bal), 'current: new-bal} 396 | )) 397 | ) 398 | 399 | (defun credit-account:object{receiver-balance-change} 400 | ( id:string 401 | account:string 402 | amount:decimal 403 | ) 404 | @doc "Credit AMOUNT to ACCOUNT" 405 | (credit id account (account-guard id account) amount) 406 | ) 407 | 408 | (defun update-supply:bool (id:string amount:decimal) 409 | (require-capability (UPDATE_SUPPLY)) 410 | (with-default-read tokens id 411 | { 'supply: 0.0 } 412 | { 'supply := s } 413 | (let ((new-supply (+ s amount))) 414 | (update tokens id {'supply: new-supply }) 415 | (emit-event (SUPPLY id new-supply)))) 416 | ) 417 | 418 | (defun enforce-unit:bool (id:string amount:decimal) 419 | (let ((p (precision id))) 420 | (enforce 421 | (= (floor amount p) 422 | amount) 423 | "precision violation")) 424 | ) 425 | 426 | (defun precision:integer (id:string) 427 | (at 'precision (read tokens id)) 428 | ) 429 | 430 | (defpact transfer-crosschain:bool 431 | ( id:string 432 | sender:string 433 | receiver:string 434 | receiver-guard:guard 435 | target-chain:string 436 | amount:decimal ) 437 | (step (format "{}" [(enforce false "cross chain not supported")]) false)) 438 | 439 | ;; 440 | ;; ACCESSORS 441 | ;; 442 | 443 | (defun key:string ( id:string account:string ) 444 | @doc "DB key for ledger account" 445 | (format "{}:{}" [id account]) 446 | ) 447 | 448 | (defun get-manifest:object{manifest} (id:string) 449 | (at 'manifest (read tokens id))) 450 | 451 | ;; 452 | ;; sale 453 | ;; 454 | 455 | (defcap SALE:bool 456 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 457 | @doc "Wrapper cap/event of SALE of token ID by SELLER of AMOUNT until TIMEOUT block height." 458 | @event 459 | (enforce (> amount 0.0) "Amount must be positive") 460 | (compose-capability (OFFER id seller amount timeout)) 461 | (compose-capability (SALE_PRIVATE sale-id)) 462 | ) 463 | 464 | (defcap OFFER:bool 465 | (id:string seller:string amount:decimal timeout:integer) 466 | @doc "Managed cap for SELLER offering AMOUNT of token ID until TIMEOUT." 467 | @managed 468 | (enforce (sale-active timeout) "SALE: invalid timeout") 469 | (compose-capability (DEBIT id seller)) 470 | (compose-capability (CREDIT id (sale-account))) 471 | ) 472 | 473 | (defcap WITHDRAW:bool 474 | (id:string seller:string amount:decimal timeout:integer sale-id:string) 475 | @doc "Withdraws offer SALE from SELLER of AMOUNT of token ID after timeout." 476 | @event 477 | (enforce (not (sale-active timeout)) "WITHDRAW: still active") 478 | (compose-capability (DEBIT id (sale-account))) 479 | (compose-capability (CREDIT id seller)) 480 | (compose-capability (SALE_PRIVATE sale-id)) 481 | ) 482 | 483 | (defcap BUY:bool 484 | (id:string seller:string buyer:string amount:decimal timeout:integer sale-id:string) 485 | @doc "Completes sale OFFER to BUYER." 486 | @managed 487 | (enforce (sale-active timeout) "BUY: expired") 488 | (compose-capability (DEBIT id (sale-account))) 489 | (compose-capability (CREDIT id buyer)) 490 | (compose-capability (SALE_PRIVATE sale-id)) 491 | ) 492 | 493 | (defcap SALE_PRIVATE:bool (sale-id:string) true) 494 | 495 | (defpact sale:bool 496 | ( id:string 497 | seller:string 498 | amount:decimal 499 | timeout:integer 500 | ) 501 | (step-with-rollback 502 | (with-capability (SALE id seller amount timeout (pact-id)) 503 | (offer id seller amount)) 504 | (with-capability (WITHDRAW id seller amount timeout (pact-id)) 505 | (withdraw id seller amount)) 506 | ) 507 | (step 508 | (let ( (buyer:string (read-msg "buyer")) 509 | (buyer-guard:guard (read-msg "buyer-guard")) ) 510 | (with-capability (BUY id seller buyer amount timeout (pact-id)) 511 | (buy id seller buyer buyer-guard amount (pact-id))))) 512 | ) 513 | 514 | (defun offer:bool 515 | ( id:string 516 | seller:string 517 | amount:decimal 518 | ) 519 | @doc "Initiate sale with by SELLER by escrowing AMOUNT of TOKEN until TIMEOUT." 520 | (require-capability (SALE_PRIVATE (pact-id))) 521 | (bind (get-policy-info id) 522 | { 'policy := policy:module{kip.token-policy-v1} 523 | , 'token := token } 524 | (policy::enforce-offer token seller amount (pact-id))) 525 | (let 526 | ( 527 | (sender (debit id seller amount)) 528 | (receiver (credit id (sale-account) (create-pact-guard "SALE") amount)) 529 | ) 530 | (emit-event (TRANSFER id seller (sale-account) amount)) 531 | (emit-event (RECONCILE id amount sender receiver))) 532 | ) 533 | 534 | (defun withdraw:bool 535 | ( id:string 536 | seller:string 537 | amount:decimal 538 | ) 539 | @doc "Withdraw offer by SELLER of AMOUNT of TOKEN before TIMEOUT" 540 | (require-capability (SALE_PRIVATE (pact-id))) 541 | (let 542 | ( 543 | (sender (debit id (sale-account) amount)) 544 | (receiver (credit-account id seller amount)) 545 | ) 546 | (emit-event (TRANSFER id (sale-account) seller amount)) 547 | (emit-event (RECONCILE id amount sender receiver))) 548 | ) 549 | 550 | 551 | (defun buy:bool 552 | ( id:string 553 | seller:string 554 | buyer:string 555 | buyer-guard:guard 556 | amount:decimal 557 | sale-id:string 558 | ) 559 | @doc "Complete sale with transfer." 560 | (require-capability (SALE_PRIVATE (pact-id))) 561 | (bind (get-policy-info id) 562 | { 'policy := policy:module{kip.token-policy-v1} 563 | , 'token := token } 564 | (policy::enforce-buy token seller buyer buyer-guard amount sale-id)) 565 | (let 566 | ( 567 | (sender (debit id (sale-account) amount)) 568 | (receiver (credit id buyer buyer-guard amount)) 569 | ) 570 | (emit-event (TRANSFER id (sale-account) buyer amount)) 571 | (emit-event (RECONCILE id amount sender receiver))) 572 | ) 573 | 574 | (defun sale-active:bool (timeout:integer) 575 | @doc "Sale is active until TIMEOUT block height." 576 | (< (at 'block-height (chain-data)) timeout) 577 | ) 578 | 579 | (defun sale-account:string () 580 | (create-principal (create-pact-guard "SALE")) 581 | ) 582 | ) 583 | 584 | (if (read-msg 'upgrade) 585 | ["upgrade complete"] 586 | [ (create-table ledger) 587 | (create-table tokens) ]) 588 | -------------------------------------------------------------------------------- /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 | ; -------------------------------------------------------------------------- 161 | ; Utilities 162 | 163 | (defun enforce-unit:bool (amount:decimal) 164 | @doc "Enforce minimum precision allowed for coin transactions" 165 | 166 | (enforce 167 | (= (floor amount MINIMUM_PRECISION) 168 | amount) 169 | (format "Amount violates minimum precision: {}" [amount])) 170 | ) 171 | 172 | (defun validate-account (account:string) 173 | @doc "Enforce that an account name conforms to the coin contract \ 174 | \minimum and maximum length requirements, as well as the \ 175 | \latin-1 character set." 176 | 177 | (enforce 178 | (is-charset COIN_CHARSET account) 179 | (format 180 | "Account does not conform to the coin contract charset: {}" 181 | [account])) 182 | 183 | (let ((account-length (length account))) 184 | 185 | (enforce 186 | (>= account-length MINIMUM_ACCOUNT_LENGTH) 187 | (format 188 | "Account name does not conform to the min length requirement: {}" 189 | [account])) 190 | 191 | (enforce 192 | (<= account-length MAXIMUM_ACCOUNT_LENGTH) 193 | (format 194 | "Account name does not conform to the max length requirement: {}" 195 | [account])) 196 | ) 197 | ) 198 | 199 | ; -------------------------------------------------------------------------- 200 | ; Coin Contract 201 | 202 | (defun gas-only () 203 | "Predicate for gas-only user guards." 204 | (require-capability (GAS))) 205 | 206 | (defun gas-guard (guard:guard) 207 | "Predicate for gas + single key user guards" 208 | (enforce-one 209 | "Enforce either the presence of a GAS cap or keyset" 210 | [ (gas-only) 211 | (enforce-guard guard) 212 | ])) 213 | 214 | (defun buy-gas:string (sender:string total:decimal) 215 | @doc "This function describes the main 'gas buy' operation. At this point \ 216 | \MINER has been chosen from the pool, and will be validated. The SENDER \ 217 | \of this transaction has specified a gas limit LIMIT (maximum gas) for \ 218 | \the transaction, and the price is the spot price of gas at that time. \ 219 | \The gas buy will be executed prior to executing SENDER's code." 220 | 221 | @model [ (property (> total 0.0)) 222 | (property (valid-account sender)) 223 | ] 224 | 225 | (validate-account sender) 226 | 227 | (enforce-unit total) 228 | (enforce (> total 0.0) "gas supply must be a positive quantity") 229 | 230 | (require-capability (GAS)) 231 | (with-capability (DEBIT sender) 232 | (debit sender total)) 233 | ) 234 | 235 | (defun redeem-gas:string (miner:string miner-guard:guard sender:string total:decimal) 236 | @doc "This function describes the main 'redeem gas' operation. At this \ 237 | \point, the SENDER's transaction has been executed, and the gas that \ 238 | \was charged has been calculated. MINER will be credited the gas cost, \ 239 | \and SENDER will receive the remainder up to the limit" 240 | 241 | @model [ (property (> total 0.0)) 242 | (property (valid-account sender)) 243 | (property (valid-account miner)) 244 | ] 245 | 246 | (validate-account sender) 247 | (validate-account miner) 248 | (enforce-unit total) 249 | 250 | (require-capability (GAS)) 251 | (let* 252 | ((fee (read-decimal "fee")) 253 | (refund (- total fee))) 254 | 255 | (enforce-unit fee) 256 | (enforce (>= fee 0.0) 257 | "fee must be a non-negative quantity") 258 | 259 | (enforce (>= refund 0.0) 260 | "refund must be a non-negative quantity") 261 | 262 | (emit-event (TRANSFER sender miner fee)) ;v3 263 | 264 | ; directly update instead of credit 265 | (with-capability (CREDIT sender) 266 | (if (> refund 0.0) 267 | (with-read coin-table sender 268 | { "balance" := balance } 269 | (update coin-table sender 270 | { "balance": (+ balance refund) })) 271 | 272 | "noop")) 273 | 274 | (with-capability (CREDIT miner) 275 | (if (> fee 0.0) 276 | (credit miner miner-guard fee) 277 | "noop")) 278 | ) 279 | 280 | ) 281 | 282 | (defun create-account:string (account:string guard:guard) 283 | @model [ (property (valid-account account)) ] 284 | 285 | (validate-account account) 286 | (enforce-reserved account guard) 287 | 288 | (insert coin-table account 289 | { "balance" : 0.0 290 | , "guard" : guard 291 | }) 292 | ) 293 | 294 | (defun get-balance:decimal (account:string) 295 | (with-read coin-table account 296 | { "balance" := balance } 297 | balance 298 | ) 299 | ) 300 | 301 | (defun details:object{fungible-v2.account-details} 302 | ( account:string ) 303 | (with-read coin-table account 304 | { "balance" := bal 305 | , "guard" := g } 306 | { "account" : account 307 | , "balance" : bal 308 | , "guard": g }) 309 | ) 310 | 311 | (defun rotate:string (account:string new-guard:guard) 312 | (with-capability (ROTATE account) 313 | (with-read coin-table account 314 | { "guard" := old-guard } 315 | 316 | (enforce-guard old-guard) 317 | 318 | (update coin-table account 319 | { "guard" : new-guard } 320 | ))) 321 | ) 322 | 323 | 324 | (defun precision:integer 325 | () 326 | MINIMUM_PRECISION) 327 | 328 | (defun transfer:string (sender:string receiver:string amount:decimal) 329 | @model [ (property conserves-mass) 330 | (property (> amount 0.0)) 331 | (property (valid-account sender)) 332 | (property (valid-account receiver)) 333 | (property (!= sender receiver)) ] 334 | 335 | (enforce (!= sender receiver) 336 | "sender cannot be the receiver of a transfer") 337 | 338 | (validate-account sender) 339 | (validate-account receiver) 340 | 341 | (enforce (> amount 0.0) 342 | "transfer amount must be positive") 343 | 344 | (enforce-unit amount) 345 | 346 | (with-capability (TRANSFER sender receiver amount) 347 | (debit sender amount) 348 | (with-read coin-table receiver 349 | { "guard" := g } 350 | 351 | (credit receiver g amount)) 352 | ) 353 | ) 354 | 355 | (defun transfer-create:string 356 | ( sender:string 357 | receiver:string 358 | receiver-guard:guard 359 | amount:decimal ) 360 | 361 | @model [ (property conserves-mass) ] 362 | 363 | (enforce (!= sender receiver) 364 | "sender cannot be the receiver of a transfer") 365 | 366 | (validate-account sender) 367 | (validate-account receiver) 368 | 369 | (enforce (> amount 0.0) 370 | "transfer amount must be positive") 371 | 372 | (enforce-unit amount) 373 | 374 | (with-capability (TRANSFER sender receiver amount) 375 | (debit sender amount) 376 | (credit receiver receiver-guard amount)) 377 | ) 378 | 379 | (defun coinbase:string (account:string account-guard:guard amount:decimal) 380 | @doc "Internal function for the initial creation of coins. This function \ 381 | \cannot be used outside of the coin contract." 382 | 383 | @model [ (property (valid-account account)) 384 | (property (> amount 0.0)) 385 | ] 386 | 387 | (validate-account account) 388 | (enforce-unit amount) 389 | 390 | (require-capability (COINBASE)) 391 | (emit-event (TRANSFER "" account amount)) ;v3 392 | (with-capability (CREDIT account) 393 | (credit account account-guard amount)) 394 | ) 395 | 396 | (defun remediate:string (account:string amount:decimal) 397 | @doc "Allows for remediation transactions. This function \ 398 | \is protected by the REMEDIATE capability" 399 | @model [ (property (valid-account account)) 400 | (property (> amount 0.0)) 401 | ] 402 | 403 | (validate-account account) 404 | 405 | (enforce (> amount 0.0) 406 | "Remediation amount must be positive") 407 | 408 | (enforce-unit amount) 409 | 410 | (require-capability (REMEDIATE)) 411 | (emit-event (TRANSFER "" account amount)) ;v3 412 | (with-read coin-table account 413 | { "balance" := balance } 414 | 415 | (enforce (<= amount balance) "Insufficient funds") 416 | 417 | (update coin-table account 418 | { "balance" : (- balance amount) } 419 | )) 420 | ) 421 | 422 | (defpact fund-tx (sender:string miner:string miner-guard:guard total:decimal) 423 | @doc "'fund-tx' is a special pact to fund a transaction in two steps, \ 424 | \with the actual transaction transpiring in the middle: \ 425 | \ \ 426 | \ 1) A buying phase, debiting the sender for total gas and fee, yielding \ 427 | \ TX_MAX_CHARGE. \ 428 | \ 2) A settlement phase, resuming TX_MAX_CHARGE, and allocating to the \ 429 | \ coinbase account for used gas and fee, and sender account for bal- \ 430 | \ ance (unused gas, if any)." 431 | 432 | @model [ (property (> total 0.0)) 433 | (property (valid-account sender)) 434 | (property (valid-account miner)) 435 | ;(property conserves-mass) not supported yet 436 | ] 437 | 438 | (step (buy-gas sender total)) 439 | (step (redeem-gas miner miner-guard sender total)) 440 | ) 441 | 442 | (defun debit:string (account:string amount:decimal) 443 | @doc "Debit AMOUNT from ACCOUNT balance" 444 | 445 | @model [ (property (> amount 0.0)) 446 | (property (valid-account account)) 447 | ] 448 | 449 | (validate-account account) 450 | 451 | (enforce (> amount 0.0) 452 | "debit amount must be positive") 453 | 454 | (enforce-unit amount) 455 | 456 | (require-capability (DEBIT account)) 457 | (with-read coin-table account 458 | { "balance" := balance } 459 | 460 | (enforce (<= amount balance) "Insufficient funds") 461 | 462 | (update coin-table account 463 | { "balance" : (- balance amount) } 464 | )) 465 | ) 466 | 467 | 468 | (defun credit:string (account:string guard:guard amount:decimal) 469 | @doc "Credit AMOUNT to ACCOUNT balance" 470 | 471 | @model [ (property (> amount 0.0)) 472 | (property (valid-account account)) 473 | ] 474 | 475 | (validate-account account) 476 | 477 | (enforce (> amount 0.0) "credit amount must be positive") 478 | (enforce-unit amount) 479 | 480 | (require-capability (CREDIT account)) 481 | (with-default-read coin-table account 482 | { "balance" : -1.0, "guard" : guard } 483 | { "balance" := balance, "guard" := retg } 484 | ; we don't want to overwrite an existing guard with the user-supplied one 485 | (enforce (= retg guard) 486 | "account guards do not match") 487 | 488 | (let ((is-new 489 | (if (= balance -1.0) 490 | (enforce-reserved account guard) 491 | false))) 492 | 493 | (write coin-table account 494 | { "balance" : (if is-new amount (+ balance amount)) 495 | , "guard" : retg 496 | })) 497 | )) 498 | 499 | (defun check-reserved:string (account:string) 500 | " Checks ACCOUNT for reserved name and returns type if \ 501 | \ found or empty string. Reserved names start with a \ 502 | \ single char and colon, e.g. 'c:foo', which would return 'c' as type." 503 | (let ((pfx (take 2 account))) 504 | (if (= ":" (take -1 pfx)) (take 1 pfx) ""))) 505 | 506 | (defun enforce-reserved:bool (account:string guard:guard) 507 | @doc "Enforce reserved account name protocols." 508 | (if (validate-principal guard account) 509 | true 510 | (let ((r (check-reserved account))) 511 | (if (= r "") 512 | true 513 | (if (= r "k") 514 | (enforce false "Single-key account protocol violation") 515 | (enforce false 516 | (format "Reserved protocol guard violation: {}" [r])) 517 | ))))) 518 | 519 | 520 | (defschema crosschain-schema 521 | @doc "Schema for yielded value in cross-chain transfers" 522 | receiver:string 523 | receiver-guard:guard 524 | amount:decimal 525 | source-chain:string) 526 | 527 | (defpact transfer-crosschain:string 528 | ( sender:string 529 | receiver:string 530 | receiver-guard:guard 531 | target-chain:string 532 | amount:decimal ) 533 | 534 | @model [ (property (> amount 0.0)) 535 | (property (valid-account sender)) 536 | (property (valid-account receiver)) 537 | ] 538 | 539 | (step 540 | (with-capability 541 | (TRANSFER_XCHAIN sender receiver amount target-chain) 542 | 543 | (validate-account sender) 544 | (validate-account receiver) 545 | 546 | (enforce (!= "" target-chain) "empty target-chain") 547 | (enforce (!= (at 'chain-id (chain-data)) target-chain) 548 | "cannot run cross-chain transfers to the same chain") 549 | 550 | (enforce (> amount 0.0) 551 | "transfer quantity must be positive") 552 | 553 | (enforce-unit amount) 554 | 555 | ;; step 1 - debit delete-account on current chain 556 | (debit sender amount) 557 | (emit-event (TRANSFER sender "" amount)) 558 | 559 | (let 560 | ((crosschain-details:object{crosschain-schema} 561 | { "receiver" : receiver 562 | , "receiver-guard" : receiver-guard 563 | , "amount" : amount 564 | , "source-chain" : (at 'chain-id (chain-data)) 565 | })) 566 | (yield crosschain-details target-chain) 567 | ))) 568 | 569 | (step 570 | (resume 571 | { "receiver" := receiver 572 | , "receiver-guard" := receiver-guard 573 | , "amount" := amount 574 | , "source-chain" := source-chain 575 | } 576 | 577 | (enforce (= target-chain (at 'chain-id (chain-data))) 578 | "Current chain id does not match the specified target chain for cross-chain transfer") 579 | 580 | (emit-event (TRANSFER "" receiver amount)) 581 | (emit-event (TRANSFER_XCHAIN_RECD "" receiver amount source-chain)) 582 | 583 | ;; step 2 - credit create account on target chain 584 | (with-capability (CREDIT receiver) 585 | (credit receiver receiver-guard amount)) 586 | )) 587 | ) 588 | 589 | 590 | ; -------------------------------------------------------------------------- 591 | ; Coin allocations 592 | 593 | (defschema allocation-schema 594 | @doc "Genesis allocation registry" 595 | ;@model [ (invariant (>= balance 0.0)) ] 596 | 597 | balance:decimal 598 | date:time 599 | guard:guard 600 | redeemed:bool) 601 | 602 | (deftable allocation-table:{allocation-schema}) 603 | 604 | (defun create-allocation-account 605 | ( account:string 606 | date:time 607 | keyset-ref:string 608 | amount:decimal 609 | ) 610 | 611 | @doc "Add an entry to the coin allocation table. This function \ 612 | \also creates a corresponding empty coin contract account \ 613 | \of the same name and guard. Requires GENESIS capability. " 614 | 615 | @model [ (property (valid-account account)) ] 616 | 617 | (require-capability (GENESIS)) 618 | 619 | (validate-account account) 620 | (enforce (>= amount 0.0) 621 | "allocation amount must be non-negative") 622 | 623 | (enforce-unit amount) 624 | 625 | (let 626 | ((guard:guard (keyset-ref-guard keyset-ref))) 627 | 628 | (create-account account guard) 629 | 630 | (insert allocation-table account 631 | { "balance" : amount 632 | , "date" : date 633 | , "guard" : guard 634 | , "redeemed" : false 635 | }))) 636 | 637 | (defun release-allocation 638 | ( account:string ) 639 | 640 | @doc "Release funds associated with allocation ACCOUNT into main ledger. \ 641 | \ACCOUNT must already exist in main ledger. Allocation is deactivated \ 642 | \after release." 643 | @model [ (property (valid-account account)) ] 644 | 645 | (validate-account account) 646 | 647 | (with-read allocation-table account 648 | { "balance" := balance 649 | , "date" := release-time 650 | , "redeemed" := redeemed 651 | , "guard" := guard 652 | } 653 | 654 | (let ((curr-time:time (at 'block-time (chain-data)))) 655 | 656 | (enforce (not redeemed) 657 | "allocation funds have already been redeemed") 658 | 659 | (enforce 660 | (>= curr-time release-time) 661 | (format "funds locked until {}. current time: {}" [release-time curr-time])) 662 | 663 | (with-capability (RELEASE_ALLOCATION account balance) 664 | 665 | (enforce-guard guard) 666 | 667 | (with-capability (CREDIT account) 668 | (emit-event (TRANSFER "" account balance)) 669 | (credit account guard balance) 670 | 671 | (update allocation-table account 672 | { "redeemed" : true 673 | , "balance" : 0.0 674 | }) 675 | 676 | "Allocation successfully released to main ledger")) 677 | ))) 678 | 679 | ) 680 | --------------------------------------------------------------------------------