├── .gitignore ├── AuthenticatedSupply ├── AuthenticatedSupply.fst └── README.md ├── Bet ├── Bet.fst ├── README.md └── Tests │ ├── Bet.fsx │ ├── Buy.fsx │ └── Redeem.fsx ├── CGP ├── CGP.fst └── tests │ └── CGP.fsx ├── Dex ├── Dex.fst ├── README.md ├── README.tex.md ├── Tests │ ├── Dex.fsx │ ├── Dex_Cancel.fsx │ ├── Dex_Make.fsx │ └── Dex_Take.fsx ├── doc │ └── tex │ │ ├── RequestedPayoutIdentity.png │ │ └── RequestedPayoutIdentity.tex └── tex │ ├── 0b20110fba6015084788cd321a32e3b5.svg │ └── dfa94410d7549c4bea04465b580ed7cb.svg ├── Empty ├── Empty.fst └── README.md ├── FixedPayout ├── FixedPayout.fst ├── README.md └── tests │ ├── FPC3.fsx │ ├── ProofData.fsx │ └── TestData.fsx ├── NamedToken └── NamedToken.fst ├── Oracle ├── Oracle.fst ├── README.md └── tests │ └── OracleTests.fsx ├── README.md ├── appveyor.yml └── run-test.sh /.gitignore: -------------------------------------------------------------------------------- 1 | */output 2 | */*.log 3 | */svgs 4 | -------------------------------------------------------------------------------- /AuthenticatedSupply/AuthenticatedSupply.fst: -------------------------------------------------------------------------------- 1 | module AuthenticatedSupply 2 | 3 | open Zen.Cost 4 | open Zen.Data 5 | open Zen.Types 6 | 7 | module CR = Zen.ContractResult 8 | module Dict = Zen.Dictionary 9 | module RT = Zen.ResultT 10 | module TX = Zen.TxSkeleton 11 | module U64 = FStar.UInt64 12 | 13 | // the public key that messages must be signed with 14 | let authenticatedPubKey = "" 15 | 16 | val getReturnAddress: option (Dict.t data) -> result lock `cost` 77 17 | let getReturnAddress dict = // 11 18 | let! returnAddress = dict >!= Dict.tryFind "returnAddress" // 64 19 | >?= tryLock in // 2 20 | match returnAddress with 21 | | Some returnAddress -> 22 | RT.ok returnAddress 23 | | None -> 24 | RT.failw "Message Body must include valid returnAddress" 25 | 26 | val getAmount: option (Dict.t data) -> result U64.t `cost` 82 27 | let getAmount dict = // 16 28 | let! orderTotal = dict >!= Dict.tryFind "Amount" // 64 29 | >?= tryU64 in // 2 30 | match orderTotal with 31 | | Some orderTotal -> 32 | if orderTotal <> 0UL 33 | then RT.ok orderTotal 34 | else RT.failw "Amount cannot be 0" 35 | | None -> 36 | RT.failw "Message Body must include valid Amount" 37 | 38 | // checks that the sender matches the authenticatedPubKey 39 | val authenticate: sender -> result bool `cost` 135 40 | let authenticate sender = // 15 41 | let! authenticatedPubKey = Zen.Crypto.parsePublicKey authenticatedPubKey in // 120 42 | match authenticatedPubKey, sender with 43 | | Some authenticatedPubKey, PK senderPubKey -> 44 | RT.ok (authenticatedPubKey = senderPubKey) 45 | | None, _ -> 46 | RT.failw "Could not parse authenticatedPubKey. Please re-deploy this contract with a valid authenticatedPubKey." 47 | | _ -> 48 | RT.failw "Sender must sign with Public Key" 49 | 50 | val issueTX: txSkeleton -> contractId -> U64.t -> lock -> bool -> CR.t `cost` 211 51 | let issueTX tx contractID amount returnAddress authenticated = // 16 52 | if authenticated then begin 53 | let! asset = Zen.Asset.getDefault contractID in // 64 54 | // mint the required amount of the asset 55 | TX.mint amount asset tx // 64 56 | // lock to the return address 57 | >>= TX.lockToAddress asset amount returnAddress // 64 58 | >>= CR.ofTxSkel end // 3 59 | else 60 | RT.autoFailw "Authentication failed" 61 | 62 | val issue: txSkeleton -> contractId -> sender -> option data -> CR.t `cost` 522 63 | let issue tx contractID sender messageBody = // 13 64 | let! dict = messageBody >!= tryDict in // 4 65 | let amount = getAmount dict in // 82 66 | let returnAddress = getReturnAddress dict in // 77 67 | let authenticated = authenticate sender in // 135 68 | RT.bind3 amount returnAddress authenticated (issueTX tx contractID) // 211 69 | 70 | val destroyTX: txSkeleton -> contractId -> U64.t -> bool -> CR.t `cost` 142 71 | let destroyTX tx contractID amount authenticated = // 11 72 | if authenticated then begin 73 | let! asset = Zen.Asset.getDefault contractID in // 64 74 | // destroy the required amount of the asset 75 | TX.destroy amount asset tx // 64 76 | >>= CR.ofTxSkel end // 3 77 | else 78 | RT.autoFailw "Authentication failed" 79 | 80 | val destroy: txSkeleton -> contractId -> sender -> option data -> CR.t `cost` 374 81 | let destroy tx contractID sender messageBody = // 11 82 | let! dict = messageBody >!= tryDict in // 4 83 | let amount = getAmount dict in // 82 84 | let authenticated = authenticate sender in // 135 85 | RT.bind2 amount authenticated (destroyTX tx contractID) // 142 86 | 87 | val main: 88 | txSkeleton 89 | -> context 90 | -> contractId 91 | -> command: string 92 | -> sender 93 | -> option data 94 | -> wallet 95 | -> option data 96 | -> CR.t `cost` begin match command with 97 | | "Issue" -> 529 98 | | "Destroy" -> 381 99 | | _ -> 7 end 100 | let main tx _ contractID command sender messageBody _ _ = // 7 101 | match command with 102 | | "Issue" -> issue tx contractID sender messageBody // 522 103 | <: CR.t `cost` begin match command with 104 | | "Issue" -> 522 105 | | "Destroy" -> 374 106 | | _ -> 0 end 107 | | "Destroy" -> destroy tx contractID sender messageBody // 374 108 | | _ -> RT.failw "Invalid Command" 109 | 110 | val cf: 111 | txSkeleton 112 | -> context 113 | -> string 114 | -> sender 115 | -> option data 116 | -> wallet 117 | -> option data 118 | -> nat `cost` 4 119 | let cf _ _ command _ _ _ _ = // 4 120 | ret begin match command with 121 | | "Issue" -> 529 122 | | "Destroy" -> 381 123 | | _ -> 7 end 124 | -------------------------------------------------------------------------------- /AuthenticatedSupply/README.md: -------------------------------------------------------------------------------- 1 | To build, run `zebra -e AuthenticatedSupply.fst` 2 | -------------------------------------------------------------------------------- /Bet/Bet.fst: -------------------------------------------------------------------------------- 1 | module Bet 2 | (* 3 | This contract issues two tokens, for positive and negative outcomes. 4 | The tokens are redeemable for 1ZP in the event that their corresponding outcome occurs. 5 | 6 | This contract will require a z3rlimit of at least 3000000 in order to successfully record hints. 7 | *) 8 | 9 | open Zen.Base 10 | open Zen.Cost 11 | open Zen.Data 12 | open Zen.Types 13 | 14 | module Asset = Zen.Asset 15 | module CR = Zen.ContractResult 16 | module Dict = Zen.Dictionary 17 | module Hash = Zen.Hash 18 | module RT = Zen.ResultT 19 | module TX = Zen.TxSkeleton 20 | module U64 = FStar.UInt64 21 | module Wallet = Zen.Wallet 22 | 23 | val oracleContractID: s:string {FStar.String.length s = 72} 24 | let oracleContractID = "00000000ca055cc0af4d25ea1c8bbbf41444aadd68a168558397516b2f64727d87e72f97" 25 | 26 | val ticker: s: string{FStar.String.length s <= 4} 27 | let ticker = "AMD" 28 | 29 | let strike = 65000UL // USD price multiplied by 1000 30 | 31 | let time = 1539264654UL 32 | 33 | type messageParams = { 34 | price: U64.t; 35 | returnAddress: lock 36 | } 37 | 38 | val getReturnAddress: option (Dict.t data) -> option lock `cost` 71 39 | let getReturnAddress dict = // 5 40 | dict >!= Dict.tryFind "returnAddress" // 64 41 | >?= tryLock // 2 42 | 43 | val getPrice: option (Dict.t data) -> option U64.t `cost` 71 44 | let getPrice dict = // 5 45 | dict >!= Dict.tryFind "Price" // 64 46 | >?= tryU64 // 2 47 | 48 | val getParams: option (Dict.t data) -> result messageParams `cost` 161 49 | let getParams dict = // 19 50 | let! msgPrice = getPrice dict in // 71 51 | let! returnAddress = getReturnAddress dict in // 71 52 | match msgPrice, returnAddress with 53 | | Some msgPrice, Some returnAddress -> 54 | RT.ok ({ price=msgPrice; returnAddress=returnAddress }) 55 | | None, _ -> 56 | RT.failw "Could not parse Price from messageBody" 57 | | _, None -> 58 | RT.failw "Could not parse returnAddress from messageBody" 59 | 60 | val hashData: U64.t -> hash `cost` 812 61 | let hashData price = let open Hash in // 36 62 | let! timeHash = updateU64 time empty // 48 63 | >>= finalize in // 20 64 | let! tickerHash = begin updateString ticker empty 65 | |> inc (6 * (4 - FStar.String.length ticker)) //24 66 | >>= finalize //20 67 | end <: hash `cost` 44 in //20 68 | let! priceHash = updateU64 price empty // 48 69 | >>= finalize in // 20 70 | 71 | updateHash timeHash empty // 192 72 | >>= updateHash tickerHash // 192 73 | >>= updateHash priceHash // 192 74 | >>= finalize // 20 75 | 76 | val buyTx: txSkeleton -> contractId -> lock -> U64.t -> CR.t `cost` 483 77 | let buyTx tx contractID returnAddress amount = // 32 78 | let! bullToken = Asset.fromSubtypeString contractID "Bull" in // 64 79 | let! bearToken = Asset.fromSubtypeString contractID "Bear" in // 64 80 | // lock all available ZP to this contract 81 | TX.lockToContract Asset.zenAsset amount contractID tx // 64 82 | // mint an equivalent amount of bull and bear tokens 83 | >>= TX.mint amount bullToken // 64 84 | >>= TX.mint amount bearToken // 64 85 | // lock bull and bear tokens to the returnAddress 86 | >>= TX.lockToAddress bullToken amount returnAddress // 64 87 | >>= TX.lockToAddress bearToken amount returnAddress // 64 88 | >>= CR.ofTxSkel // 3 89 | 90 | val buy: txSkeleton -> contractId -> messageBody: option data -> CR.t `cost` 718 91 | let buy tx contractID messageBody = // 32 92 | let! returnAddress = messageBody >!= tryDict // 4 93 | >>= getReturnAddress in // 71 94 | let! oracleContractID = Zen.ContractId.parse oracleContractID in //64 95 | let! amount = TX.getAvailableTokens Asset.zenAsset tx in // 64 96 | match returnAddress, oracleContractID with 97 | | Some returnAddress, Some oracleContractID -> 98 | if amount <> 0UL then 99 | buyTx tx contractID returnAddress amount // 483 100 | else 101 | RT.incFailw 483 "Cannot buy with 0ZP in txSkeleton" 102 | | None, _ -> 103 | RT.incFailw 483 "Could not parse returnAddress from messageBody" 104 | | _, None -> 105 | RT.incFailw 483 "Could not parse oracleContractID. This contract will be unusable. Please redeploy this contract with a valid oracleContractID." 106 | 107 | val oracleMessage: U64.t -> Dict.t data -> contractId -> message `cost` 892 108 | let oracleMessage price dict oracleContractID = // 16 109 | let! hash = hashData price in // 812 110 | let! dict = Dict.add "Hash" (Hash hash) dict in // 64 111 | ret ({ recipient=oracleContractID; 112 | command="Verify"; 113 | body=Some(Collection (Dict dict)) }) 114 | 115 | // invokes the oracle to validate inclusion of the message 116 | val invokeOracle: 117 | U64.t 118 | -> option (Dict.t data) 119 | -> option txSkeleton 120 | -> CR.t `cost` 987 121 | let invokeOracle price dict tx = // 31 122 | let! oracleContractID = Zen.ContractId.parse oracleContractID in // 64 123 | match dict, oracleContractID, tx with 124 | | Some dict, Some oracleContractID, Some tx -> 125 | let! msg = oracleMessage price dict oracleContractID in // 892 126 | RT.ok ({ tx=tx; message=Some msg; state=NoChange }) 127 | | None, _, _ -> 128 | RT.incFailw 892 "Something went wrong! messageBody should not be empty" 129 | | _, None, _ -> 130 | RT.incFailw 892 "Something went wrong! could not parse oracleContractID" 131 | | _, _, None -> 132 | RT.incFailw 892 "Could not construct tx from wallet" 133 | 134 | val redeemTx: 135 | asset 136 | -> txSkeleton 137 | -> contractId 138 | -> messageParams 139 | -> option (Dict.t data) 140 | -> w: wallet 141 | -> CR.t `cost` (Wallet.size w * 128 + 1395) 142 | let redeemTx contractAsset tx contractID messageParams dict wallet = // 24 143 | // amount of the contract asset received 144 | let! amount = TX.getAvailableTokens contractAsset tx in // 64 145 | // destroy the contract asset received 146 | begin TX.destroy amount contractAsset tx // 64 147 | // send the same amount of ZP to the returnAddress 148 | >>= TX.lockToAddress Asset.zenAsset amount messageParams.returnAddress // 64 149 | >>= TX.fromWallet Asset.zenAsset amount contractID wallet // 128 * size wallet + 192 150 | <: (option txSkeleton `cost` (Wallet.size wallet * 128 + 320)) 151 | end 152 | // check with the oracle 153 | >>= invokeOracle messageParams.price dict // 987 154 | 155 | val redeem: 156 | txSkeleton 157 | -> contractId 158 | -> messageBody: option data 159 | -> wallet: wallet 160 | -> CR.t `cost` (Wallet.size wallet * 128 + 1652) 161 | let redeem tx contractID messageBody wallet = let open U64 in // 28 162 | let! dict = messageBody >!= tryDict in // 4 163 | let! messageParams = getParams dict in // 161 164 | match messageParams with 165 | | OK messageParams -> begin 166 | let! winningAsset = begin //64 167 | if messageParams.price >=^ strike 168 | then Asset.fromSubtypeString contractID "Bull" 169 | else Asset.fromSubtypeString contractID "Bear" 170 | end in 171 | redeemTx winningAsset tx contractID messageParams dict wallet // Wallet.size w * 128 + 1395 172 | end <: CR.t `cost` (Wallet.size wallet * 128 + 1459) 173 | | ERR msg -> 174 | RT.incFailw (Wallet.size wallet * 128 + 1459) msg 175 | | _ -> 176 | RT.incFailw (Wallet.size wallet * 128 + 1459) "Something went wrong! unexpected error" 177 | 178 | let main (tx: txSkeleton) _ (contractID: contractId) (command: string) _ 179 | (messageBody: option data) (wallet: wallet) _ 180 | : CR.t `cost` ( match command with 181 | | "Buy" -> 725 182 | | "Redeem" -> Wallet.size wallet * 128 + 1659 183 | | _ -> 7 ) = // 7 184 | match command with 185 | | "Buy" -> 186 | buy tx contractID messageBody 187 | <: (CR.t `cost` ( match command with 188 | | "Buy" -> 718 189 | | "Redeem" -> Wallet.size wallet * 128 + 1652 190 | | _ -> 0 )) 191 | | "Redeem" -> 192 | redeem tx contractID messageBody wallet 193 | | _ -> 194 | RT.failw "Invalid command" 195 | 196 | let cf _ _ (command: string) _ _ (wallet: wallet) _ : nat `cost` 9 = // 9 197 | match command with 198 | | "Buy" -> ret 725 199 | | "Redeem" -> ret (Wallet.size wallet * 128 + 1659) 200 | | _ -> ret 7 201 | -------------------------------------------------------------------------------- /Bet/README.md: -------------------------------------------------------------------------------- 1 | 2 | To build, run `zebra --z3rlimit 3000000 -c Bet.fst`. 3 | To run tests, run 4 | ``` 5 | zebra -r Tests/Buy.fsx 6 | zebra -r Tests/RedeemBull.fsx 7 | ``` 8 | -------------------------------------------------------------------------------- /Bet/Tests/Bet.fsx: -------------------------------------------------------------------------------- 1 | module Asset = Consensus.Asset 2 | module Contract = Consensus.Contract 3 | module ContractId = Consensus.ContractId 4 | module Hash = Consensus.Hash 5 | module Result = Infrastructure.Result 6 | module Tx = Consensus.TxSkeleton 7 | module Types = Consensus.Types 8 | 9 | (* *) 10 | (* General utility functions *) 11 | (* *) 12 | 13 | type Hash = Hash.Hash 14 | type Input = Tx.Input 15 | type Outpoint = Types.Outpoint 16 | type Output = Types.Output 17 | type Spend = Types.Spend 18 | 19 | let u64Bytes (u64: uint64) = 20 | let bytes = System.BitConverter.GetBytes u64 21 | if System.BitConverter.IsLittleEndian 22 | then Array.rev bytes 23 | else bytes 24 | 25 | // Zero Hash 26 | let zeroHash = Hash.zero 27 | 28 | // Empty transaction 29 | let emptyTx : Tx.T = Tx.empty 30 | 31 | // Empty messageBody 32 | let emptyMessageBody: Option = None 33 | 34 | // Empty wallet 35 | let emptyWallet: Contract.ContractWallet = [] 36 | 37 | // generate a TxSkeleton from pointed inputs and outputs 38 | let mkTx pInputs outputs = {Tx.pInputs=pInputs; Tx.outputs=outputs} 39 | 40 | // generates a spend from the specified asset and amount 41 | let mkSpend asset amount = {Spend.asset=asset; Spend.amount=amount} 42 | 43 | // generate an output from a lock, asset, and amount 44 | let mkOutput lock asset amount : Output = 45 | {lock=lock; spend=mkSpend asset amount} 46 | 47 | // generate an input from an output 48 | let mkInput lock asset amount : Input = 49 | let outpoint = {Outpoint.txHash=Hash.zero; Outpoint.index=0u} 50 | Tx.PointedOutput (outpoint, mkOutput lock asset amount) 51 | 52 | // generate a mint input from the specified asset and amount 53 | let mkMint asset amount : Input = 54 | Tx.Mint (mkSpend asset amount) 55 | 56 | // try an input as a pointed output 57 | let tryPointedOutput: Input -> Option = function 58 | | Tx.PointedOutput (_, output) -> Some output 59 | | Tx.Mint _ -> None 60 | 61 | // try an input as a mint 62 | let tryMint: Input -> Option = function 63 | | Tx.PointedOutput _ -> None 64 | | Tx.Mint m -> Some m 65 | 66 | // gets all pointed outputs in an input list 67 | let getPointedOutputs: list -> list = List.choose tryPointedOutput 68 | 69 | // all mints in the input 70 | let getMints: list -> list = List.choose tryMint 71 | 72 | let getSpend: Input -> Spend = function 73 | | Tx.PointedOutput (_, output) -> output.spend 74 | | Tx.Mint spend -> spend 75 | 76 | // all spends in the input 77 | let getSpends: list -> list = List.map getSpend 78 | 79 | // all spends in the output 80 | let outputSpends: list -> list = List.map (fun output -> output.spend) 81 | 82 | let hasLock (lock: Types.Lock) (output: Output) = output.lock = lock 83 | 84 | 85 | (* *) 86 | (* Specialised to Bet contract below *) 87 | (* *) 88 | 89 | let ticker = "AMD"B 90 | let time = 1539264654UL 91 | let strike = 65000UL // USD price multiplied by 1000 92 | 93 | let oracleContractID = "00000000ca055cc0af4d25ea1c8bbbf41444aadd68a168558397516b2f64727d87e72f97" 94 | |> ContractId.fromString 95 | |> Option.get 96 | 97 | let getRawCode() = System.IO.File.ReadAllText "Bet.fst" 98 | 99 | let contractID = getRawCode() 100 | |> Contract.makeContractId Types.Version0 101 | 102 | let contractHash = match contractID with 103 | | Types.ContractId (_, contractHash) -> contractHash 104 | 105 | let contractLock = Types.Contract contractID 106 | 107 | // hex encoding of ascii value of "Bull" 108 | let bullHex = "42756c6c" 109 | // hex encoding of ascii value of "Bear" 110 | let bearHex = "42656172" 111 | 112 | let subTokenFromHex (hex: string): Types.Asset = 113 | let subTokenID = hex.PadRight(2 * Hash.Length, '0') 114 | |> Hash.fromString 115 | |> Option.get 116 | Types.Asset (contractID, subTokenID) 117 | 118 | let zp = Asset.Zen 119 | let bullToken = subTokenFromHex bullHex 120 | let bearToken = subTokenFromHex bearHex 121 | 122 | let returnAddressPK = Hash.zero 123 | 124 | let returnAddress = Types.PK returnAddressPK 125 | |> Consensus.ZFStar.fsToFstLock 126 | |> Zen.Types.Data.Lock 127 | 128 | let emptyDict = Zen.Dictionary.empty() 129 | let addToDict (key, value) dict = Zen.Dictionary.add key value dict 130 | |> Zen.Cost.Realized.__force 131 | let addU64 (key, value) = addToDict (key, Zen.Types.Data.U64 value) 132 | let addHash (key, value) = addToDict (key, Zen.Types.Data.Hash value) 133 | 134 | let mkData returnAddress price = 135 | addToDict ("returnAddress"B, returnAddress) emptyDict 136 | |> addU64 ("Price"B, price) 137 | |> Zen.Types.Data.Dict 138 | |> Zen.Types.Data.Collection 139 | |> Some 140 | 141 | // a messageBody consisting of only a return address 142 | let onlyReturnAddress = 143 | Zen.Dictionary.add "returnAddress"B returnAddress (Zen.Dictionary.empty()) 144 | |> Zen.Cost.Realized.__force 145 | |> Zen.Types.Data.Dict 146 | |> Zen.Types.Data.Collection 147 | |> Some 148 | 149 | let onlyPrice = 150 | addU64 ("Price"B, strike) (Zen.Dictionary.empty()) 151 | |> Zen.Types.Data.Dict 152 | |> Zen.Types.Data.Collection 153 | |> Some 154 | 155 | let hashData'' price = 156 | (System.Reflection.Assembly.LoadFrom "output/Bet.dll") 157 | .GetModules().[0] // Should get ModuleName.dll 158 | .GetTypes().[0] // Should get ModuleName 159 | .GetMethod("hashData") // ModuleName.name 160 | .Invoke(null, [|price|]) 161 | :?> (Zen.Cost.Realized.cost) 162 | 163 | 164 | let hashData' (price: uint64) = 165 | let h = hashData'' price 166 | |> Zen.Cost.Realized.__force 167 | |> Hash.Hash 168 | printfn "%A" h 169 | h 170 | 171 | let hashParams (price: uint64) = 172 | [ Hash.compute (u64Bytes time) 173 | Hash.compute ticker 174 | Hash.compute (u64Bytes price) ] 175 | |> Hash.joinHashes 176 | 177 | let wallet50ZP = // wallet with one 50ZP input 178 | let (Tx.PointedOutput p) = mkInput contractLock zp 50UL 179 | [p] 180 | 181 | let fsToFstPointedOutput (opoint: Outpoint, oput: Output) = 182 | let outpoint = {Zen.Types.Extracted.txHash=Hash.bytes opoint.txHash; Zen.Types.Extracted.index=opoint.index} 183 | let (Types.Asset (Types.ContractId (version, assetType), subType)) = oput.spend.asset 184 | let output = 185 | { Zen.Types.Extracted.lock=Consensus.ZFStar.fsToFstLock oput.lock; 186 | Zen.Types.Extracted.spend={Zen.Types.Extracted.asset=version, Hash.bytes assetType, Hash.bytes subType; Zen.Types.Extracted.amount = oput.spend.amount}} 187 | outpoint, output 188 | 189 | let fsToFstWallet = List.map fsToFstPointedOutput >> Consensus.ZFStar.fsToFstList 190 | 191 | let wallet150ZP = // wallet with multiple inputs totalling 150ZP 192 | let (Tx.PointedOutput p0) = mkInput contractLock zp 50UL 193 | let (Tx.PointedOutput p1) = mkInput contractLock zp 30UL 194 | let (Tx.PointedOutput p2) = mkInput contractLock zp 10UL 195 | let (Tx.PointedOutput p3) = mkInput contractLock zp 20UL 196 | let (Tx.PointedOutput p4) = mkInput contractLock zp 40UL 197 | [p0; p1; p2; p3; p4] 198 | 199 | let contractFn = System.Reflection.Assembly.LoadFrom "output/Bet.dll" 200 | |> Contract.getFunctions 201 | |> Result.get 202 | |> fst 203 | 204 | // don't care about context, contractID, command, sender, wallet or state 205 | let buy (txSkeleton: Tx.T) messageBody = 206 | contractFn txSkeleton 207 | {blockNumber=1ul;timestamp=0UL} 208 | contractID 209 | "Buy" 210 | Types.Anonymous 211 | messageBody 212 | [] 213 | None 214 | 215 | // don't care about context, contractID, command, sender, or state 216 | let redeem (txSkeleton: Tx.T) messageBody wallet = 217 | contractFn txSkeleton 218 | {blockNumber=1ul;timestamp=0UL} 219 | contractID 220 | "Redeem" 221 | Types.Anonymous 222 | messageBody 223 | wallet 224 | None 225 | -------------------------------------------------------------------------------- /Bet/Tests/Buy.fsx: -------------------------------------------------------------------------------- 1 | #load "Bet.fsx" 2 | open Consensus 3 | open Infrastructure 4 | open Crypto 5 | open Types 6 | open Zen.Types.Data 7 | open Zen.Data 8 | open Zen.Types 9 | open Bet 10 | module Cost = Zen.Cost.Realized 11 | module Tx = TxSkeleton 12 | 13 | // all spends in the input 14 | let rec inputSpends = function 15 | | input::inputs -> 16 | match input with 17 | | Tx.PointedOutput (_, output) -> 18 | output.spend :: inputSpends inputs 19 | | _ -> 20 | inputSpends inputs 21 | | [] -> [] 22 | 23 | // all spends in the output 24 | let outputSpends = List.map (fun output -> output.spend) 25 | 26 | // spends in the input locked to contract 27 | let rec inputSpendsLockedToContract = function 28 | | input::inputs -> 29 | match input with 30 | | Tx.PointedOutput (_, output) 31 | when output.lock = Contract contractID -> 32 | output.spend :: inputSpendsLockedToContract inputs 33 | | _ -> 34 | inputSpendsLockedToContract inputs 35 | | [] -> [] 36 | 37 | // spends in the output locked to contract 38 | let outputSpendsLockedToContract = 39 | List.filter (fun output -> output.lock = Contract contractID) 40 | >> List.map (fun output -> output.spend) 41 | 42 | // spends in the input locked to returnAddressPK 43 | let rec inputSpendsLockedToReturnAddressPK returnAddressPK = function 44 | | input::inputs -> 45 | match input with 46 | | Tx.PointedOutput (_, output) 47 | when output.lock = PK returnAddressPK -> 48 | output.spend :: inputSpendsLockedToReturnAddressPK returnAddressPK inputs 49 | | _ -> 50 | inputSpendsLockedToReturnAddressPK returnAddressPK inputs 51 | | [] -> [] 52 | 53 | // spends in the output locked to returnAddressPK 54 | let outputSpendsLockedToReturnAddressPK returnAddressPK = 55 | List.filter (fun output -> output.lock = PK returnAddressPK) 56 | >> List.map (fun output -> output.spend) 57 | 58 | // gets a list of minting inputs 59 | let rec getMints = function 60 | | input::inputs -> 61 | match input with 62 | | Tx.Mint spend -> 63 | spend::getMints inputs 64 | | _ -> 65 | getMints inputs 66 | | [] -> [] 67 | 68 | // Total amount of ZP in a list of spends 69 | let totalZP spends = 70 | spends |> List.filter (fun spend -> spend.asset = Asset.Zen) 71 | |> List.sumBy (fun spend -> spend.amount) 72 | 73 | // Total amount of bull token in a list of spends 74 | let totalBullToken spends = 75 | spends |> List.filter (fun spend -> spend.asset = bullToken) 76 | |> List.sumBy (fun spend -> spend.amount) 77 | 78 | // Total amount of bear token in a list of spends 79 | let totalBearToken spends = 80 | spends |> List.filter (fun spend -> spend.asset = bearToken) 81 | |> List.sumBy (fun spend -> spend.amount) 82 | 83 | 84 | ////////////////////////////////////////////////////////////////////////// 85 | // Buy without returnAddress fails 86 | ////////////////////////////////////////////////////////////////////////// 87 | 88 | match buy emptyTx emptyMessageBody with 89 | | Error "Could not parse returnAddress from messageBody" -> 90 | printfn "OK: Buy without returnAddress fails" 91 | | Ok _ -> failwith "Should not return ok without returnAddress" 92 | | Error e -> failwithf "Failed with unexpected error: `%A`" e 93 | 94 | ////////////////////////////////////////////////////////////////////////// 95 | // Buy with returnAddress and no ZP inputs fails 96 | ////////////////////////////////////////////////////////////////////////// 97 | 98 | match buy emptyTx onlyReturnAddress with 99 | 100 | | Error "Cannot buy with 0ZP in txSkeleton" -> 101 | printfn "OK: Buy with returnAddress and no ZP inputs fails" 102 | | Ok _ -> failwith "Should not return ok with 0ZP in inputs" 103 | | Error e -> failwithf "Failed with unexpected error: `%A`" e 104 | 105 | ////////////////////////////////////////////////////////////////////////// 106 | // Buy with returnAddress and single 50ZP input 107 | // Should lock 50ZP to contract 108 | // Should mint 50 bull & bear tokens and spend them to returnAddress 109 | ////////////////////////////////////////////////////////////////////////// 110 | 111 | let singleInputTx = mkTx [mkInput (Contract contractID) zp 50UL] [] 112 | 113 | match buy singleInputTx onlyReturnAddress with 114 | | Ok ({pInputs=pInputs; outputs=outputs}, None, Main.NoChange) -> // expect no message or state update 115 | // inputs 116 | let inputMints = getMints pInputs 117 | let inputSpends = inputSpends pInputs 118 | let inputZP = totalZP inputSpends 119 | let inputSpendsLockedToContract = inputSpendsLockedToContract pInputs 120 | let inputSpendsLockedToReturnAddressPK = 121 | inputSpendsLockedToReturnAddressPK returnAddressPK pInputs 122 | let inputZPLockedToContract = totalZP inputSpendsLockedToContract 123 | let inputZPLockedToReturnAddressPK = totalZP inputSpendsLockedToReturnAddressPK 124 | let inputBullTokensLockedToContract = totalBullToken inputSpendsLockedToContract 125 | let inputBearTokensLockedToContract = totalBearToken inputSpendsLockedToContract 126 | let inputBullTokensLockedToReturnAddressPK = totalBullToken inputSpendsLockedToReturnAddressPK 127 | let inputBearTokensLockedToReturnAddressPK = totalBearToken inputSpendsLockedToReturnAddressPK 128 | let minted = getMints pInputs 129 | let bullTokensMinted = totalBullToken minted 130 | let bearTokensMinted = totalBearToken minted 131 | // Should be total of 50ZP in inputs 132 | if inputZP <> 50UL 133 | then failwithf "Expected 50ZP locked in input spends, but got: `%A`" pInputs 134 | // Should be total of 50ZP locked to contract in inputs 135 | if inputZPLockedToContract <> 50UL 136 | then failwithf "Expected 50ZP locked to contract in inputs, but got: `%A`" pInputs 137 | // Should be total of 50 Bull Tokens in input mints 138 | if bullTokensMinted <> 50UL 139 | then failwithf "Expected 50 Bull Tokens in input mints, but got: `%A`" pInputs 140 | // Should be total of 50 Bear Tokens in input mints 141 | if bearTokensMinted <> 50UL 142 | then failwithf "Expected 50 Bear Tokens in input mints, but got: `%A`" pInputs 143 | 144 | // outputs 145 | let outputSpends = outputSpends outputs 146 | let outputZP = totalZP outputSpends 147 | let outputBullTokens = totalBullToken outputSpends 148 | let outputBearTokens = totalBearToken outputSpends 149 | let outputSpendsLockedToContract = outputSpendsLockedToContract outputs 150 | let outputSpendsLockedToReturnAddressPK = 151 | outputSpendsLockedToReturnAddressPK returnAddressPK outputs 152 | let outputZPLockedToContract = totalZP outputSpendsLockedToContract 153 | let outputZPLockedToReturnAddressPK = totalZP outputSpendsLockedToReturnAddressPK 154 | let outputBullTokensLockedToContract = totalBullToken outputSpendsLockedToContract 155 | let outputBearTokensLockedToContract = totalBearToken outputSpendsLockedToContract 156 | let outputBullTokensLockedToReturnAddressPK = totalBullToken outputSpendsLockedToReturnAddressPK 157 | let outputBearTokensLockedToReturnAddressPK = totalBearToken outputSpendsLockedToReturnAddressPK 158 | // Should be total of 50ZP in outputs 159 | if outputZP <> 50UL 160 | then failwithf "Expected 50ZP locked in outputs, but got: `%A`" outputs 161 | // Should be total of 50ZP locked to contract in outputs 162 | if outputZPLockedToContract <> 50UL 163 | then failwithf "Expected 50ZP locked to contract in outputs, but got: `%A`" outputs 164 | // Should be total of 50 Bull Tokens in outputs 165 | if outputBullTokens <> 50UL 166 | then failwithf "Expected 50 Bull Tokens in outputs, but got: `%A`" outputs 167 | // Should be total of 50 Bull Tokens locked to returnAddress in outputs 168 | if outputBullTokensLockedToReturnAddressPK <> 50UL 169 | then failwithf "Expected 50 Bull Tokens locked to returnAddress in outputs, but got: `%A`" outputs 170 | // Should be total of 50 Bear Tokens in outputs 171 | if outputBearTokens <> 50UL 172 | then failwithf "Expected 50 Bear Tokens in outputs, but got: `%A`" outputs 173 | // Should be total of 50 Bear Tokens locked to returnAddress in outputs 174 | if outputBearTokensLockedToReturnAddressPK <> 50UL 175 | then failwithf "Expected 50 Bear Tokens locked to returnAddress in outputs, but got: `%A`" outputs 176 | 177 | // If you reach here, all is ok! 178 | printfn "OK: Buy with returnAddress and single 50ZP input" 179 | 180 | | Ok (_, msg, Main.NoChange) -> 181 | failwithf "Expected no return message, but got: `%A`" msg 182 | | Ok (_, _, stateUpdate) -> 183 | failwithf "Expected no state change, but got: `%A`" stateUpdate 184 | | Error e -> 185 | failwithf "Failed with unexpected error: `%A`" e 186 | 187 | ////////////////////////////////////////////////////////////////////////// 188 | // Buy with returnAddress and multiple ZP inputs totalling 150ZP 189 | // Should lock 150ZP to contract 190 | // Should mint 150 bull & bear tokens and spend them to returnAddress 191 | ////////////////////////////////////////////////////////////////////////// 192 | 193 | let multiInputTx = 194 | let outpoint = {txHash=Hash.zero; index=0u} 195 | let spend x = {asset=Asset.Zen; amount=x} 196 | let output x = {lock=Contract contractID; spend=spend x} 197 | let pInput x = Tx.PointedOutput (outpoint, output x) 198 | let pInputs = [pInput 40UL; pInput 20UL; pInput 50UL; pInput 30UL; pInput 10UL] 199 | { Tx.pInputs=pInputs; Tx.outputs=[] } 200 | 201 | match buy multiInputTx onlyReturnAddress with 202 | | Ok ({pInputs=pInputs; outputs=outputs}, None, Main.NoChange) -> // expect no message or state update 203 | // inputs 204 | let inputMints = getMints pInputs 205 | let inputSpends = inputSpends pInputs 206 | let inputZP = totalZP inputSpends 207 | let inputSpendsLockedToContract = inputSpendsLockedToContract pInputs 208 | let inputSpendsLockedToReturnAddressPK = 209 | inputSpendsLockedToReturnAddressPK returnAddressPK pInputs 210 | let inputZPLockedToContract = totalZP inputSpendsLockedToContract 211 | let inputZPLockedToReturnAddressPK = totalZP inputSpendsLockedToReturnAddressPK 212 | let inputBullTokensLockedToContract = totalBullToken inputSpendsLockedToContract 213 | let inputBearTokensLockedToContract = totalBearToken inputSpendsLockedToContract 214 | let inputBullTokensLockedToReturnAddressPK = totalBullToken inputSpendsLockedToReturnAddressPK 215 | let inputBearTokensLockedToReturnAddressPK = totalBearToken inputSpendsLockedToReturnAddressPK 216 | let minted = getMints pInputs 217 | let bullTokensMinted = totalBullToken minted 218 | let bearTokensMinted = totalBearToken minted 219 | // Should be total of 150ZP in inputs 220 | if inputZP <> 150UL 221 | then failwithf "Expected 150ZP locked in input spends, but got: `%A`" pInputs 222 | // Should be total of 150ZP locked to contract in inputs 223 | if inputZPLockedToContract <> 150UL 224 | then failwithf "Expected 150ZP locked to contract in inputs, but got: `%A`" pInputs 225 | // Should be total of 150 Bull Tokens in input mints 226 | if bullTokensMinted <> 150UL 227 | then failwithf "Expected 150 Bull Tokens in input mints, but got: `%A`" pInputs 228 | // Should be total of 150 Bear Tokens in input mints 229 | if bearTokensMinted <> 150UL 230 | then failwithf "Expected 150 Bear Tokens in input mints, but got: `%A`" pInputs 231 | 232 | // outputs 233 | let outputSpends = outputSpends outputs 234 | let outputZP = totalZP outputSpends 235 | let outputBullTokens = totalBullToken outputSpends 236 | let outputBearTokens = totalBearToken outputSpends 237 | let outputSpendsLockedToContract = outputSpendsLockedToContract outputs 238 | let outputSpendsLockedToReturnAddressPK = 239 | outputSpendsLockedToReturnAddressPK returnAddressPK outputs 240 | let outputZPLockedToContract = totalZP outputSpendsLockedToContract 241 | let outputZPLockedToReturnAddressPK = totalZP outputSpendsLockedToReturnAddressPK 242 | let outputBullTokensLockedToContract = totalBullToken outputSpendsLockedToContract 243 | let outputBearTokensLockedToContract = totalBearToken outputSpendsLockedToContract 244 | let outputBullTokensLockedToReturnAddressPK = totalBullToken outputSpendsLockedToReturnAddressPK 245 | let outputBearTokensLockedToReturnAddressPK = totalBearToken outputSpendsLockedToReturnAddressPK 246 | // Should be total of 150ZP in outputs 247 | if outputZP <> 150UL 248 | then failwithf "Expected 150ZP locked in outputs, but got: `%A`" outputs 249 | // Should be total of 150ZP locked to contract in outputs 250 | if outputZPLockedToContract <> 150UL 251 | then failwithf "Expected 150ZP locked to contract in outputs, but got: `%A`" outputs 252 | // Should be total of 150 Bull Tokens in outputs 253 | if outputBullTokens <> 150UL 254 | then failwithf "Expected 150 Bull Tokens in outputs, but got: `%A`" outputs 255 | // Should be total of 150 Bull Tokens locked to returnAddress in outputs 256 | if outputBullTokensLockedToReturnAddressPK <> 150UL 257 | then failwithf "Expected 150 Bull Tokens locked to returnAddress in outputs, but got: `%A`" outputs 258 | // Should be total of 150 Bear Tokens in outputs 259 | if outputBearTokens <> 150UL 260 | then failwithf "Expected 150 Bear Tokens in outputs, but got: `%A`" outputs 261 | // Should be total of 150 Bear Tokens locked to returnAddress in outputs 262 | if outputBearTokensLockedToReturnAddressPK <> 150UL 263 | then failwithf "Expected 150 Bear Tokens locked to returnAddress in outputs, but got: `%A`" outputs 264 | 265 | // If you reach here, all is ok! 266 | printfn "OK: Buy with returnAddress and multiple ZP inputs totalling 150ZP" 267 | 268 | | Ok (_, msg, Main.NoChange) -> 269 | failwithf "Expected no return message, but got: `%A`" msg 270 | | Ok (_, _, stateUpdate) -> 271 | failwithf "Expected no state change, but got: `%A`" stateUpdate 272 | | Error e -> 273 | failwithf "Failed with unexpected error: `%A`" e 274 | -------------------------------------------------------------------------------- /Bet/Tests/Redeem.fsx: -------------------------------------------------------------------------------- 1 | #load "Bet.fsx" 2 | 3 | open Bet 4 | 5 | module Asset = Consensus.Asset 6 | module Contract = Consensus.Contract 7 | module Hash = Consensus.Hash 8 | module Result = Infrastructure.Result 9 | module Tx = Consensus.TxSkeleton 10 | module Types = Consensus.Types 11 | 12 | ////////////////////////////////////////////////////////////////////////// 13 | // Redeem with only returnAddress fails 14 | ////////////////////////////////////////////////////////////////////////// 15 | 16 | match redeem emptyTx onlyReturnAddress emptyWallet with 17 | | Error "Could not parse Price from messageBody" -> 18 | printfn "OK: Redeem with only returnAddress fails" 19 | | Ok cr -> failwithf "Should not return ok without Price! Got ContractReturn `%A`" cr 20 | | Error e -> failwithf "Failed with unexpected error: `%A`" e 21 | 22 | ////////////////////////////////////////////////////////////////////////// 23 | // Redeem with only Price fails 24 | ////////////////////////////////////////////////////////////////////////// 25 | 26 | match redeem emptyTx onlyPrice emptyWallet with 27 | | Error "Could not parse returnAddress from messageBody" -> 28 | printfn "OK: Redeem with only Price fails" 29 | | Ok cr -> failwithf "Should not return ok without returnAddress! Got ContractReturn `%A`" cr 30 | | Error e -> failwithf "Failed with unexpected error: `%A`" e 31 | 32 | ////////////////////////////////////////////////////////////////////////// 33 | // Redeem succeeds with OK Data 34 | ////////////////////////////////////////////////////////////////////////// 35 | 36 | let okData = mkData returnAddress strike 37 | let tx1Bull = 38 | mkTx [(mkInput contractLock bullToken 1UL)] [] 39 | match redeem tx1Bull okData wallet50ZP with 40 | | Ok tx -> 41 | printfn "OK: Redeem succeeds with OK Data" 42 | | Error e -> failwithf "Failed with unexpected error: `%A`" e 43 | 44 | ///////////////////////////////////////////////////////////////////////////// 45 | // Redeem with bull token fails with low strike, but succeeds with bear token 46 | ///////////////////////////////////////////////////////////////////////////// 47 | 48 | let lowStrike = mkData returnAddress (strike-1UL) 49 | let tx25Bull = mkTx [(mkInput contractLock bullToken 25UL)] [] 50 | let tx25Bear = mkTx [(mkInput contractLock bearToken 25UL)] [] 51 | 52 | match redeem tx25Bull lowStrike wallet50ZP with 53 | | Error "Could not construct tx from wallet" -> 54 | printfn "OK: Redeem with bull tokens fails for low strike" 55 | | Ok cr -> failwithf "Should not return ok! Got ContractReturn `%A`" cr 56 | | Error e -> failwithf "Failed with unexpected error: `%A`" e 57 | 58 | match redeem tx25Bear lowStrike wallet50ZP with 59 | | Ok tx -> 60 | printfn "OK: Redeem with bear tokens succeeds for low strike" 61 | | Error e -> failwithf "Failed with unexpected error: `%A`" e 62 | -------------------------------------------------------------------------------- /CGP/CGP.fst: -------------------------------------------------------------------------------- 1 | module CGP 2 | 3 | open Zen.Base 4 | open Zen.Cost 5 | open Zen.Types 6 | open Zen.Data 7 | 8 | module U32 = FStar.UInt32 9 | module RT = Zen.ResultT 10 | module Dict = Zen.Dictionary 11 | module TX = Zen.TxSkeleton 12 | module CR = Zen.ContractResult 13 | module Asset = Zen.Asset 14 | module OptT = Zen.OptionT 15 | module Wallet = Zen.Wallet 16 | 17 | 18 | 19 | let maxOutputs : nat = 100 20 | 21 | let payoutBlock : nat = 10 22 | 23 | let intervalLength : nat = 100 24 | 25 | 26 | 27 | (* 28 | ------------------------------------------------------------------------------- 29 | ========== UTILITY FUNCTIONS ================================================== 30 | ------------------------------------------------------------------------------- 31 | *) 32 | 33 | // tries to map a function over a list. 34 | // if all of the mappings return Some, then returns Some list. 35 | // otherwise returns None. 36 | val tryMap(#a #b: Type)(#n: nat): 37 | (a -> option b `cost` n) 38 | -> ls:list a 39 | -> option (ls':list b{length ls' == length ls}) `cost` (length ls * (n + 20) + 20) 40 | let rec tryMap #a #b #n f ls = //20 41 | match ls with 42 | | hd::tl -> 43 | let! hd' = f hd in 44 | let! tl' = tryMap f tl in 45 | begin match hd', tl' with 46 | | Some hd', Some tl' -> 47 | let (result: list b{length result == length ls}) = hd'::tl' in 48 | OptT.some result 49 | | _ -> OptT.none end 50 | | [] -> [] |> OptT.incSome (length ls * (n + 20)) 51 | 52 | val tryFold (#a #b : Type) (#n : nat) : 53 | (b -> a -> option b `cost` n) 54 | -> b 55 | -> ls:list a 56 | -> option b `cost` (length ls * (n + 12) + 10) 57 | let rec tryFold #a #b #n f x ls = // 10 58 | let open OptT in 59 | match ls with 60 | | [] -> 61 | incSome (length ls * (n + 12)) x 62 | | hd :: tl -> 63 | tryFold f x tl >>= (fun r -> f r hd) // (length ls * (n + 12)) 64 | 65 | 66 | 67 | (* 68 | ------------------------------------------------------------------------------- 69 | ========== PARSING ============================================================ 70 | ------------------------------------------------------------------------------- 71 | *) 72 | 73 | val parseDict: 74 | option data 75 | -> result (option (Dict.t data)) `cost` 15 76 | let parseDict data = // 11 77 | match data with 78 | | Some data -> 79 | data 80 | |> tryDict // 4 81 | |> RT.ofOptionT "Data parsing failed - the message body isn't a dictionary" 82 | |> RT.map Some 83 | | None -> 84 | RT.incFailw 4 "Data parsing failed - the message body is empty" 85 | 86 | val parseField (#a:Type) (#m:nat) 87 | : (data -> option a `cost` m) 88 | -> fieldName:string 89 | -> errMsg:string 90 | -> option (Dict.t data) 91 | -> result a `cost` (m + 75) 92 | let parseField #_ #_ parser fieldName errMsg dict = // 11 93 | let! value = dict >!= Dict.tryFind fieldName >?= parser in // (m + 64) 94 | match value with 95 | | Some value -> 96 | RT.ok value 97 | | None -> 98 | RT.failw errMsg 99 | 100 | val extractSpend : 101 | list data 102 | -> option spend `cost` 84 103 | let extractSpend ls = // 17 104 | match ls with 105 | | asset' :: amount' :: [] -> 106 | let open OptT in 107 | let sAsset = tryString asset' in // 2 108 | let oAsset = sAsset >>= Asset.parse in // 64 109 | let oAmount = tryU64 amount' in // 2 110 | oAsset >>= (fun asset -> // 2 111 | oAmount >>= (fun amount -> // 3 112 | OptT.ret ({ asset=asset; amount=amount }) 113 | )) 114 | | _ -> 115 | OptT.incNone 73 116 | 117 | val trySpend : 118 | data 119 | -> option spend `cost` 91 120 | let trySpend d = // 3 121 | let open OptT in 122 | tryList d >>= extractSpend 123 | 124 | val extractOutput : 125 | list data 126 | -> option output `cost` 107 127 | let extractOutput ls = // 9 128 | match ls with 129 | | lock' :: spend' :: [] -> 130 | let open OptT in 131 | let oLock = tryLock lock' in // 2 132 | let oSpend = trySpend spend' in // 91 133 | oLock >>= (fun lock -> // 2 134 | oSpend >>= (fun spend -> // 3 135 | OptT.ret ({ lock=lock; spend=spend }) 136 | )) 137 | | _ -> 138 | OptT.incNone 98 139 | 140 | val tryOutput : 141 | data 142 | -> option output `cost` 114 143 | let tryOutput d = // 3 144 | let open OptT in 145 | tryList d >>= extractOutput 146 | 147 | val extractOutputList : 148 | ls:list data 149 | -> option (ls':list output { length ls' == length ls }) `cost` (length ls * 134 + 22) 150 | let extractOutputList ls = // 2 151 | tryMap tryOutput ls 152 | 153 | val toBounded : 154 | size:nat 155 | -> list data 156 | -> option (ls:list data { let len = length ls in 1 <= len && len <= size }) `cost` 11 157 | let toBounded size ls = // 11 158 | if (let len = length ls in 1 <= len && len <= size) 159 | then OptT.ret (ls <: ls : list data { length ls <= size }) 160 | else OptT.none 161 | 162 | val extractOutputListBounded : 163 | size:nat 164 | -> ls:list data { let len = length ls in 1 <= len && len <= size } 165 | -> option (ls':list output { let len' = length ls' in 1 <= len' && len' <= size }) `cost` (size * 134 + 22 + 11) 166 | let extractOutputListBounded size ls = // 11 167 | let open OptT in 168 | (extractOutputList ls $> (fun ls' -> ls' <: ls':list output { let len' = length ls' in 1 <= len' && len' <= size })) 169 | |> inc ((size - length ls) * 134) 170 | 171 | val parseRawOutputs : 172 | option (Dict.t data) 173 | -> result (ls:list data) `cost` 83 174 | let parseRawOutputs dict = // 4 175 | parseField tryList "Outputs" "Couldn't parse Outputs" dict 176 | 177 | val parseOutputs : 178 | size:nat 179 | -> option (Dict.t data) 180 | -> result (ls:list output { let len = length ls in 1 <= len && len <= size }) `cost` (83 + 11 + (size * 134 + 22 + 11) + 15) 181 | let parseOutputs size dict = // 15 182 | let open RT in 183 | ret dict 184 | >>= parseRawOutputs // 83 185 | >>= (toBounded size >> ofOptionT "Outputs list size is out of bounds" ) // 11 186 | >>= (extractOutputListBounded size >> ofOptionT "Invalid outputs structure") // (size * 134 + 22 + 11) 187 | 188 | 189 | 190 | (* 191 | ------------------------------------------------------------------------------- 192 | ========== PAYOUT ============================================================= 193 | ------------------------------------------------------------------------------- 194 | *) 195 | 196 | val lockOutput : 197 | contractId 198 | -> (w:wallet) 199 | -> txSkeleton 200 | -> output 201 | -> option txSkeleton `cost` (Wallet.size w * 128 + 192 + 64 + 19) 202 | let lockOutput contractId w txSkel outp = // 19 203 | let asset = outp.spend.asset in 204 | let amount = outp.spend.amount in 205 | let open OptT in 206 | ret txSkel 207 | >>= TX.fromWallet asset amount contractId w // (Wallet.size w * 128 + 192) 208 | >>= (TX.lockToAddress asset amount outp.lock >> liftCost) // 64 209 | 210 | val lockOutputs: 211 | contractId 212 | -> (w:wallet) 213 | -> txSkeleton 214 | -> (ls:list output) 215 | -> option txSkeleton `cost` (length ls * ((Wallet.size w * 128 + 192 + 64 + 19) + 12) + 10 + 5) 216 | let lockOutputs contractId w txSkel ls = // 5 217 | tryFold (lockOutput contractId w) txSkel ls 218 | 219 | val lockOutputsBounded : 220 | size:nat 221 | -> contractId 222 | -> (w:wallet) 223 | -> txSkeleton 224 | -> (ls:list output { let len = length ls in 1 <= len && len <= size }) 225 | -> option txSkeleton `cost` (size * ((Wallet.size w * 128 + 192 + 64 + 19) + 12) + 10 + 5 + 23) 226 | let lockOutputsBounded size contractId w txSkel ls = // 23 227 | let open OptT in 228 | lockOutputs contractId w txSkel ls 229 | |> inc ((size - length ls) * ((Wallet.size w * 128 + 192 + 64 + 19) + 12)) 230 | 231 | 232 | 233 | (* 234 | ------------------------------------------------------------------------------- 235 | ========== VALIDATION ========================================================= 236 | ------------------------------------------------------------------------------- 237 | *) 238 | 239 | val isPayoutBlock : 240 | context 241 | -> bool `cost` 9 242 | let isPayoutBlock context = // 14 243 | let r = context.blockNumber `U32.rem` (U32.uint_to_t intervalLength) in 244 | r `U32.eq` (U32.uint_to_t payoutBlock) 245 | |> ret 246 | 247 | val validateBlockNumber (#a:Type) : 248 | context 249 | -> a 250 | -> result a `cost` 16 251 | let validateBlockNumber #_ context txSkel = // 7 252 | let! b = isPayoutBlock context in // 9 253 | if b 254 | then RT.ret txSkel 255 | else RT.failw "Not a payout block" 256 | 257 | 258 | 259 | (* 260 | ------------------------------------------------------------------------------- 261 | ========== MAIN =============================================================== 262 | ------------------------------------------------------------------------------- 263 | *) 264 | 265 | let main txSkel context contractId command sender messageBody w state = // 20 266 | let open RT in 267 | ret messageBody 268 | >>= validateBlockNumber context 269 | // 16 270 | >>= parseDict 271 | // 15 272 | >>= parseOutputs maxOutputs 273 | // (83 + 11 + (maxOutputs * 134 + 22 + 11) + 15) 274 | >>= (lockOutputsBounded maxOutputs contractId w txSkel >> ofOptionT "Insufficient funds") 275 | // (maxOutputs * ((Wallet.size w * 128 + 192 + 64 + 19) + 12) + 10 + 5 + 23) 276 | >>= CR.ofTxSkel 277 | // 3 278 | 279 | val cf: 280 | txSkel : txSkeleton 281 | -> context : context 282 | -> command : string 283 | -> sender : sender 284 | -> messageBody: option data 285 | -> w : wallet 286 | -> state : option data 287 | -> nat `cost` 43 288 | let cf _ _ _ _ _ w _ = 289 | ((15 290 | + (83 + 11 + (maxOutputs * 134 + 22 + 11) + 15) 291 | + (maxOutputs * ((Wallet.size w * 128 + 192 + 64 + 19) + 12) + 10 + 5 + 23) 292 | + 16 293 | + 3 294 | + 20) 295 | <: nat) |> ret 296 | -------------------------------------------------------------------------------- /CGP/tests/CGP.fsx: -------------------------------------------------------------------------------- 1 | module FString = FStar.String 2 | module Hash = Consensus.Hash 3 | module ZFStar = Consensus.ZFStar 4 | module Crypto = Consensus.Crypto 5 | module Types = Consensus.Types 6 | module Data = Zen.Types.Data 7 | module Extracted = Zen.Types.Extracted 8 | module Sha3 = Zen.Hash.Sha3 9 | module PKModule = Crypto.PublicKey 10 | 11 | module Input = ContractInput 12 | module AddInput = Input.MessageBody 13 | module Abs = AbstractContract 14 | 15 | open TestResult 16 | 17 | #r "../output/CGP.dll" 18 | 19 | type cgpCommand = 20 | | CMD_Payout 21 | 22 | type cgpCid = 23 | | CID_CGP 24 | 25 | type cgpPK = 26 | | PK_1 27 | | PK_2 28 | | PK_3 29 | 30 | type cgpAsset = 31 | | Asset_Zen 32 | | Asset_1 33 | | Asset_2 34 | | Asset_3 35 | 36 | type cgpData = { 37 | _Outputs : Abs.AbsPointedOutput list; 38 | } 39 | 40 | let context : Consensus.Types.ContractContext = { 41 | blockNumber = 210u; 42 | timestamp = 123UL; 43 | 44 | } 45 | let CONTRACT_ID_CGP = 46 | Load.computeContractId "output/CGP.fst" 47 | 48 | let generatePublicKey() = 49 | Crypto.KeyPair.create() |> snd 50 | 51 | let PK_1' = generatePublicKey() 52 | let PK_2' = generatePublicKey() 53 | let PK_3' = generatePublicKey() 54 | 55 | let cgpMain, cgpCost = 56 | Load.extractMainAndCost "output/CGP.dll" 57 | 58 | 59 | let FIELD_OUTPUTS = "Outputs"B 60 | 61 | 62 | let realizeCommand cmd = 63 | match cmd with 64 | | CMD_Payout -> "Payout" 65 | 66 | let realizePK pk = 67 | match pk with 68 | | PK_1 -> PK_1' 69 | | PK_2 -> PK_2' 70 | | PK_3 -> PK_3' 71 | 72 | let realizeContract c = 73 | match c with 74 | | CID_CGP -> CONTRACT_ID_CGP 75 | 76 | let realizeAsset asset : Option = 77 | match asset with 78 | | Asset_Zen -> 79 | Some Consensus.Asset.Zen 80 | | Asset_1 -> 81 | match Zen.Asset.fromSubtypeString (ZFStar.fsToFstContractId CONTRACT_ID_CGP) "A"B |> Zen.Cost.Realized.__force with 82 | | (v, cid, sub) -> Some (Types.Asset (Types.ContractId (v, Hash.Hash cid), Hash.Hash sub)) 83 | | Asset_2 -> 84 | match Zen.Asset.fromSubtypeString (ZFStar.fsToFstContractId CONTRACT_ID_CGP) "B"B |> Zen.Cost.Realized.__force with 85 | | (v, cid, sub) -> Some (Types.Asset (Types.ContractId (v, Hash.Hash cid), Hash.Hash sub)) 86 | | Asset_3 -> 87 | match Zen.Asset.fromSubtypeString (ZFStar.fsToFstContractId CONTRACT_ID_CGP) "C"B |> Zen.Cost.Realized.__force with 88 | | (v, cid, sub) -> Some (Types.Asset (Types.ContractId (v, Hash.Hash cid), Hash.Hash sub)) 89 | 90 | let rec cgpRealizer : Abs.Realizer = 91 | { 92 | realizePK = realizePK 93 | realizeContract = realizeContract 94 | realizeAsset = realizeAsset 95 | realizeCommand = realizeCommand 96 | realizeData = realizeData 97 | thisContract = CONTRACT_ID_CGP 98 | } 99 | 100 | and realizeData (data : cgpData) = 101 | let rl = cgpRealizer in 102 | Input.MessageBody.emptyDict () 103 | |> AddInput.add_list_with mkOutput FIELD_OUTPUTS data._Outputs 104 | |> Zen.Types.Data.Dict 105 | |> Zen.Types.Data.Collection 106 | |> Some 107 | 108 | and mkOutput (output : Abs.AbsPointedOutput) : Data.data = 109 | match output with 110 | | (lock, asset, amount) -> 111 | match realizeAsset asset with 112 | | Some asset -> 113 | begin 114 | let sAsset = asset.ToString() 115 | |> ZFStar.fsToFstString 116 | |> Data.String 117 | let lock = Tx.realizeLock cgpRealizer lock 118 | |> ZFStar.fsToFstLock 119 | |> Data.Lock 120 | let spend = [ sAsset; Data.U64 amount] 121 | |> ZFStar.fsToFstList 122 | |> Data.List 123 | |> Data.Collection 124 | let output = [ lock; spend ] 125 | |> ZFStar.fsToFstList 126 | |> Data.List 127 | |> Data.Collection 128 | output 129 | end 130 | | None -> 131 | [] |> ZFStar.fsToFstList |> Data.List |> Data.Collection 132 | 133 | 134 | let test_counter = ref 1 135 | let tests = new System.Collections.Generic.Dictionary>() 136 | 137 | let init_testing_environment() = 138 | Execute.run_test tests test_counter 139 | 140 | 141 | 142 | (* 143 | ------------------------------------------------------------------------------------------------------------------------ 144 | ======================================== COMMAND: "Payout" ============================================================= 145 | ------------------------------------------------------------------------------------------------------------------------ 146 | *) 147 | 148 | printfn "\n\n======================================== Payout ===========================================================================" 149 | 150 | let mutable run_test = init_testing_environment() 151 | 152 | run_test "empty data & empty Tx" 153 | begin 154 | Input.feedContract cgpMain CONTRACT_ID_CGP { 155 | txSkel = 156 | Input.TxSkeleton.Abstract.empty 157 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 158 | context = 159 | context 160 | command = 161 | "Payout" 162 | sender = 163 | Abs.AbsPKSender PK_1 164 | |> Input.Sender.realize cgpRealizer 165 | messageBody = 166 | None 167 | wallet = 168 | Input.Wallet.empty 169 | |> Input.Wallet.realize cgpRealizer 170 | state = 171 | None 172 | } |> should_FAIL_with "Data parsing failed - the message body is empty" 173 | end 174 | 175 | run_test "empty data & 100 kalapas" 176 | begin 177 | Input.feedContract cgpMain CONTRACT_ID_CGP { 178 | txSkel = 179 | Input.TxSkeleton.Abstract.empty 180 | |> Input.TxSkeleton.Abstract.addInput (Abs.AbsPK PK_1) Asset_Zen 100UL 181 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 182 | context = 183 | context 184 | command = 185 | "Payout" 186 | sender = 187 | Abs.AbsPKSender PK_1 188 | |> Input.Sender.realize cgpRealizer 189 | messageBody = 190 | None 191 | wallet = 192 | Input.Wallet.empty 193 | |> Input.Wallet.realize cgpRealizer 194 | state = 195 | None 196 | } |> should_FAIL_with "Data parsing failed - the message body is empty" 197 | end 198 | 199 | run_test "single spend of 100 ZP - empty wallet" 200 | begin 201 | Input.feedContract cgpMain CONTRACT_ID_CGP { 202 | txSkel = 203 | Input.TxSkeleton.Abstract.empty 204 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 205 | context = 206 | context 207 | command = 208 | "Payout" 209 | sender = 210 | Abs.AbsPKSender PK_1 211 | |> Input.Sender.realize cgpRealizer 212 | messageBody = 213 | realizeData { 214 | _Outputs = 215 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 216 | ] 217 | } 218 | wallet = 219 | Input.Wallet.empty 220 | |> Input.Wallet.realize cgpRealizer 221 | state = 222 | None 223 | } |> should_FAIL_with "Insufficient funds" 224 | end 225 | 226 | run_test "single spend of 100 ZP - 50 ZP in wallet" 227 | begin 228 | Input.feedContract cgpMain CONTRACT_ID_CGP { 229 | txSkel = 230 | Input.TxSkeleton.Abstract.empty 231 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 232 | context = 233 | context 234 | command = 235 | "Payout" 236 | sender = 237 | Abs.AbsPKSender PK_1 238 | |> Input.Sender.realize cgpRealizer 239 | messageBody = 240 | realizeData { 241 | _Outputs = 242 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 243 | ] 244 | } 245 | wallet = 246 | Input.Wallet.empty 247 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_Zen , 50UL ) 248 | |> Input.Wallet.realize cgpRealizer 249 | state = 250 | None 251 | } |> should_FAIL_with "Insufficient funds" 252 | end 253 | 254 | run_test "single spend of 100 ZP - 50 ZP and 200 Asset_1 in wallet" 255 | begin 256 | Input.feedContract cgpMain CONTRACT_ID_CGP { 257 | txSkel = 258 | Input.TxSkeleton.Abstract.empty 259 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 260 | context = 261 | context 262 | command = 263 | "Payout" 264 | sender = 265 | Abs.AbsPKSender PK_1 266 | |> Input.Sender.realize cgpRealizer 267 | messageBody = 268 | realizeData { 269 | _Outputs = 270 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 271 | ] 272 | } 273 | wallet = 274 | Input.Wallet.empty 275 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_Zen , 50UL ) 276 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_1 , 200UL ) 277 | |> Input.Wallet.realize cgpRealizer 278 | state = 279 | None 280 | } |> should_FAIL_with "Insufficient funds" 281 | end 282 | 283 | run_test "single spend of 100 ZP - exactly 100 ZP in wallet" 284 | begin 285 | Input.feedContract cgpMain CONTRACT_ID_CGP { 286 | txSkel = 287 | Input.TxSkeleton.Abstract.empty 288 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 289 | context = 290 | context 291 | command = 292 | "Payout" 293 | sender = 294 | Abs.AbsPKSender PK_1 295 | |> Input.Sender.realize cgpRealizer 296 | messageBody = 297 | realizeData { 298 | _Outputs = 299 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 300 | ] 301 | } 302 | wallet = 303 | Input.Wallet.empty 304 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 305 | |> Input.Wallet.realize cgpRealizer 306 | state = 307 | None 308 | } |> should_PASS_with_tx 309 | [ hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 100UL) 310 | ; hasOutput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 100UL) 311 | ] 312 | cgpRealizer 313 | end 314 | 315 | run_test "single spend of 100 ZP - 200 ZP in wallet" 316 | begin 317 | Input.feedContract cgpMain CONTRACT_ID_CGP { 318 | txSkel = 319 | Input.TxSkeleton.Abstract.empty 320 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 321 | context = 322 | context 323 | command = 324 | "Payout" 325 | sender = 326 | Abs.AbsPKSender PK_1 327 | |> Input.Sender.realize cgpRealizer 328 | messageBody = 329 | realizeData { 330 | _Outputs = 331 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 332 | ] 333 | } 334 | wallet = 335 | Input.Wallet.empty 336 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_Zen , 200UL ) 337 | |> Input.Wallet.realize cgpRealizer 338 | state = 339 | None 340 | } |> should_PASS_with_tx 341 | [ hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 200UL) 342 | ; hasOutput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 100UL) 343 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_Zen) (Some 100UL) 344 | ] 345 | cgpRealizer 346 | end 347 | 348 | run_test "single spend of 100 ZP - 200 ZP and 50 Asset_1 in wallet" 349 | begin 350 | Input.feedContract cgpMain CONTRACT_ID_CGP { 351 | txSkel = 352 | Input.TxSkeleton.Abstract.empty 353 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 354 | context = 355 | context 356 | command = 357 | "Payout" 358 | sender = 359 | Abs.AbsPKSender PK_1 360 | |> Input.Sender.realize cgpRealizer 361 | messageBody = 362 | realizeData { 363 | _Outputs = 364 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 365 | ] 366 | } 367 | wallet = 368 | Input.Wallet.empty 369 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_Zen , 200UL ) 370 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_1 , 50UL ) 371 | |> Input.Wallet.realize cgpRealizer 372 | state = 373 | None 374 | } |> should_PASS_with_tx 375 | [ hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 200UL) 376 | ; hasOutput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 100UL) 377 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_Zen) (Some 100UL) 378 | ] 379 | cgpRealizer 380 | end 381 | 382 | run_test "spend of 100 ZP and 50 Asset_1 - 200 ZP and 50 Asset_1 in wallet" 383 | begin 384 | Input.feedContract cgpMain CONTRACT_ID_CGP { 385 | txSkel = 386 | Input.TxSkeleton.Abstract.empty 387 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 388 | context = 389 | context 390 | command = 391 | "Payout" 392 | sender = 393 | Abs.AbsPKSender PK_1 394 | |> Input.Sender.realize cgpRealizer 395 | messageBody = 396 | realizeData { 397 | _Outputs = 398 | [ ( Abs.AbsPK PK_2 , Asset_Zen , 100UL ) 399 | ; ( Abs.AbsPK PK_3 , Asset_1 , 50UL ) 400 | ] 401 | } 402 | wallet = 403 | Input.Wallet.empty 404 | |> Input.Wallet.add ( Abs.AbsPK PK_3 , Asset_Zen, 200UL ) 405 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_1 , 50UL ) 406 | |> Input.Wallet.realize cgpRealizer 407 | state = 408 | None 409 | } |> should_PASS_with_tx 410 | [ hasInput (Some <| Abs.AbsPK PK_3) (Some <| Asset_Zen) (Some 200UL) 411 | ; hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_1 ) (Some 50UL ) 412 | ; hasOutput (Some <| Abs.AbsPK PK_2) (Some <| Asset_Zen) (Some 100UL) 413 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_Zen) (Some 100UL) 414 | ; hasOutput (Some <| Abs.AbsPK PK_3) (Some <| Asset_1 ) (Some 50UL ) 415 | ] 416 | cgpRealizer 417 | end 418 | 419 | run_test "spend of 100 ZP and 50 Asset_1 - 200 ZP and 200 Asset_1 in wallet" 420 | begin 421 | Input.feedContract cgpMain CONTRACT_ID_CGP { 422 | txSkel = 423 | Input.TxSkeleton.Abstract.empty 424 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 425 | context = 426 | context 427 | command = 428 | "Payout" 429 | sender = 430 | Abs.AbsPKSender PK_1 431 | |> Input.Sender.realize cgpRealizer 432 | messageBody = 433 | realizeData { 434 | _Outputs = 435 | [ ( Abs.AbsPK PK_2 , Asset_Zen , 100UL ) 436 | ; ( Abs.AbsPK PK_3 , Asset_1 , 50UL ) 437 | ] 438 | } 439 | wallet = 440 | Input.Wallet.empty 441 | |> Input.Wallet.add ( Abs.AbsPK PK_3 , Asset_Zen , 200UL ) 442 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_1 , 200UL ) 443 | |> Input.Wallet.realize cgpRealizer 444 | state = 445 | None 446 | } |> should_PASS_with_tx 447 | [ hasInput (Some <| Abs.AbsPK PK_3) (Some <| Asset_Zen) (Some 200UL) 448 | ; hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_1 ) (Some 200UL) 449 | ; hasOutput (Some <| Abs.AbsPK PK_2) (Some <| Asset_Zen) (Some 100UL) 450 | ; hasOutput (Some <| Abs.AbsPK PK_3) (Some <| Asset_1 ) (Some 50UL ) 451 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_Zen) (Some 100UL) 452 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_1 ) (Some 150UL) 453 | ] 454 | cgpRealizer 455 | end 456 | 457 | run_test "spend of 100 ZP, 50 Asset_1, 75 Asset_2, 30 Asset_3 - in wallet 200 ZP, 50 Asset_1, 100 Asset_2, 200 Asset_3" 458 | begin 459 | Input.feedContract cgpMain CONTRACT_ID_CGP { 460 | txSkel = 461 | Input.TxSkeleton.Abstract.empty 462 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 463 | context = 464 | context 465 | command = 466 | "Payout" 467 | sender = 468 | Abs.AbsPKSender PK_1 469 | |> Input.Sender.realize cgpRealizer 470 | messageBody = 471 | realizeData { 472 | _Outputs = 473 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 474 | ; ( Abs.AbsPK PK_1 , Asset_1 , 50UL ) 475 | ; ( Abs.AbsPK PK_2 , Asset_2 , 75UL ) 476 | ; ( Abs.AbsPK PK_3 , Asset_3 , 30UL ) 477 | ] 478 | } 479 | wallet = 480 | Input.Wallet.empty 481 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_Zen , 200UL ) 482 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_1 , 50UL ) 483 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_2 , 100UL ) 484 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_3 , 200UL ) 485 | |> Input.Wallet.realize cgpRealizer 486 | state = 487 | None 488 | } |> should_PASS_with_tx 489 | [ hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 200UL) 490 | ; hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_1 ) (Some 50UL ) 491 | ; hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_2 ) (Some 100UL) 492 | ; hasInput (Some <| Abs.AbsPK PK_1) (Some <| Asset_3 ) (Some 200UL) 493 | ; hasOutput (Some <| Abs.AbsPK PK_1) (Some <| Asset_Zen) (Some 100UL) 494 | ; hasOutput (Some <| Abs.AbsPK PK_1) (Some <| Asset_1 ) (Some 50UL ) 495 | ; hasOutput (Some <| Abs.AbsPK PK_2) (Some <| Asset_2 ) (Some 75UL ) 496 | ; hasOutput (Some <| Abs.AbsPK PK_3) (Some <| Asset_3 ) (Some 30UL ) 497 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_Zen) (Some 100UL) 498 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_2 ) (Some 25UL ) 499 | ; hasOutput (Some <| Abs.AbsContract Abs.ThisContract) (Some <| Asset_3 ) (Some 170UL) 500 | ] 501 | cgpRealizer 502 | end 503 | 504 | run_test "spend of 100 ZP, 50 Asset_1, 75 Asset_2, 30 Asset_3 - in wallet 200 ZP, 50 Asset_1, 10 Asset_2, 200 Asset_3" 505 | begin 506 | Input.feedContract cgpMain CONTRACT_ID_CGP { 507 | txSkel = 508 | Input.TxSkeleton.Abstract.empty 509 | |> Input.TxSkeleton.Abstract.realize cgpRealizer 510 | context = 511 | context 512 | command = 513 | "Payout" 514 | sender = 515 | Abs.AbsPKSender PK_1 516 | |> Input.Sender.realize cgpRealizer 517 | messageBody = 518 | realizeData { 519 | _Outputs = 520 | [ ( Abs.AbsPK PK_1 , Asset_Zen , 200UL ) 521 | ; ( Abs.AbsPK PK_1 , Asset_1 , 50UL ) 522 | ; ( Abs.AbsPK PK_1 , Asset_2 , 100UL ) 523 | ; ( Abs.AbsPK PK_1 , Asset_3 , 200UL ) 524 | ] 525 | } 526 | wallet = 527 | Input.Wallet.empty 528 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_Zen , 100UL ) 529 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_1 , 50UL ) 530 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_2 , 10UL ) 531 | |> Input.Wallet.add ( Abs.AbsPK PK_1 , Asset_3 , 200UL ) 532 | |> Input.Wallet.realize cgpRealizer 533 | state = 534 | None 535 | } |> should_FAIL_with "Insufficient funds" 536 | end 537 | 538 | 539 | 540 | 541 | 542 | 543 | 544 | for test in tests do 545 | match fst test.Value , Report.report (snd test.Value) with 546 | | name , Ok _ -> 547 | () 548 | | name , Error err -> 549 | failwithf "Test %s failed with: %s" name err 550 | -------------------------------------------------------------------------------- /Dex/Dex.fst: -------------------------------------------------------------------------------- 1 | module Dex 2 | 3 | open Zen.Cost 4 | open Zen.Data 5 | open Zen.Types 6 | 7 | module Arr = Zen.Array 8 | module CR = Zen.ContractResult 9 | module Dict = Zen.Dictionary 10 | module Hash = Zen.Hash 11 | module RT = Zen.ResultT 12 | module TX = Zen.TxSkeleton 13 | module U32 = FStar.UInt32 14 | module U64 = FStar.UInt64 15 | module W = Zen.Wallet 16 | 17 | type order = { 18 | underlyingAsset: asset; 19 | underlyingAmount: U64.t; // amount of collateral for the order 20 | pairAsset: asset; 21 | orderTotal: U64.t; // the amount of the pair required to take the entire order 22 | makerPubKey: publicKey; // the public key of the order maker 23 | } 24 | 25 | // A double uint64, needed for multiplying two arbitrary uint64s without overflow 26 | type d64 = { hi:U64.t; lo:U64.t } 27 | 28 | // compressed public key 29 | type cpk = byte ** hash 30 | 31 | // compress a public key 32 | val compress: publicKey -> cpk `cost` 305 33 | let compress pk = let open FStar.UInt8 in // 13 34 | let parity = (Arr.item 32 pk %^ 2uy) +^ 2uy in 35 | let aux (i:nat{i < 32}): byte `cost` 5 = ret (Arr.item (31-i) pk) in 36 | let! x = Arr.init_pure 32 aux in // 292 37 | ret (parity, x) 38 | 39 | // multiply two uint64s without overflow 40 | // algorithm adapted from 'The Art of Computer Programming' by Donald E. Knuth 41 | val dmul64: U64.t -> U64.t -> d64 `cost` 43 42 | let dmul64 x y = let open U64 in // 39 43 | let m32 = 4294967296UL in // 2^32 44 | let xlo = x %^ m32 in // 32 low bits of x 45 | let xhi = x /^ m32 in // 32 high bits of x 46 | let ylo = y %^ m32 in // 32 low bits of y 47 | let yhi = y /^ m32 in // 32 high bits of y 48 | 49 | let t0 = xlo *%^ ylo in 50 | let t1 = (xhi *%^ ylo) +%^ (t0 /^ m32) in 51 | let t2 = (xlo *%^ yhi) +%^ (t1 %^ m32) in 52 | 53 | let hi = (xhi *%^ yhi) +%^ (t1 /^ m32) +%^ (t2 /^ m32) in 54 | let lo = ((t2 %^ m32) *%^ m32) +%^ (t0 %^ m32) in 55 | ret ({hi=hi; lo=lo}) 56 | 57 | val mkAsset: contractId -> hash -> asset `cost` 4 58 | let mkAsset (version, contractHash) hash = // 4 59 | ret (version, contractHash, hash) 60 | 61 | val hashAsset: asset -> hash `cost` 408 62 | let hashAsset asset = // 4 63 | Hash.updateAsset asset Hash.empty // 384 64 | >>= Hash.finalize // 20 65 | 66 | val hashU32: U32.t -> hash `cost` 48 67 | let hashU32 x = // 4 68 | Hash.updateU32 x Hash.empty // 24 69 | >>= Hash.finalize // 20 70 | 71 | val hashU64: U64.t -> hash `cost` 72 72 | let hashU64 x = // 4 73 | Hash.updateU64 x Hash.empty // 48 74 | >>= Hash.finalize // 20 75 | 76 | val updatePubKey': pk: list byte{length pk == 64} -> Zen.Hash.Sha3.t -> Zen.Hash.Sha3.t `cost` 648 77 | let updatePubKey' pk s = // 4 78 | Zen.List.foldT (Zen.Base.flip Hash.updateByte) s pk // 64 * 10 + 4 79 | <: Zen.Hash.Sha3.t `cost` 644 80 | 81 | val updatePubKey: publicKey -> Zen.Hash.Sha3.t -> Zen.Hash.Sha3.t `cost` 783 82 | let updatePubKey pk s = // 5 83 | Zen.Array.toList pk // 130 84 | >>= Zen.Base.flip updatePubKey' s // 648 85 | 86 | val hashPubKey: publicKey -> hash `cost` 807 87 | let hashPubKey pk = // 4 88 | updatePubKey pk Hash.empty // 783 89 | >>= Hash.finalize // 20 90 | 91 | val hashCPK: cpk -> hash `cost` 225 92 | let hashCPK (parity, x) = // 7 93 | Hash.updateByte parity Hash.empty // 6 94 | >>= Hash.updateHash x // 192 95 | >>= Hash.finalize // 20 96 | 97 | val hashOrder: order -> hash `cost` 2783 98 | let hashOrder order = // 36 99 | let! underlyingAssetHash = hashAsset order.underlyingAsset in // 408 100 | let! underlyingAmountHash = hashU64 order.underlyingAmount in // 72 101 | let! pairAssetHash = hashAsset order.pairAsset in // 408 102 | let! orderTotalHash = hashU64 order.orderTotal in // 72 103 | let! makerPubKeyHash = hashPubKey order.makerPubKey in // 807 104 | Hash.updateHash underlyingAssetHash Hash.empty // 192 105 | >>= Hash.updateHash underlyingAmountHash // 192 106 | >>= Hash.updateHash pairAssetHash // 192 107 | >>= Hash.updateHash orderTotalHash // 192 108 | >>= Hash.updateHash makerPubKeyHash // 192 109 | >>= Hash.finalize // 20 110 | 111 | val getAsset: option (Dict.t data) -> string -> option asset `cost` 137 112 | let getAsset dict fieldName = // 7 113 | dict >!= Dict.tryFind fieldName // 64 114 | >?= tryString // 2 115 | >?= Zen.Asset.parse // 64 116 | 117 | val getU32: option (Dict.t data) -> string -> option U32.t `cost` 80 118 | let getU32 dict fieldName = // 14 119 | let! x = dict >!= Dict.tryFind fieldName // 64 120 | >?= tryU32 in // 2 121 | ret ( if x <> Some 0ul then x else None ) 122 | 123 | val getU64: option (Dict.t data) -> string -> option U64.t `cost` 80 124 | let getU64 dict fieldName = // 14 125 | let! x = dict >!= Dict.tryFind fieldName // 64 126 | >?= tryU64 in // 2 127 | ret ( if x <> Some 0UL then x else None ) 128 | 129 | val getHash: option (Dict.t data) -> string -> option hash `cost` 71 130 | let getHash dict fieldName = // 5 131 | dict >!= Dict.tryFind fieldName // 64 132 | >?= tryHash // 2 133 | 134 | val getMakerPubKey: option (Dict.t data) -> option publicKey `cost` 71 135 | let getMakerPubKey dict = // 5 136 | dict >!= Dict.tryFind "MakerPubKey" // 64 137 | >?= tryPublicKey // 2 138 | 139 | val getReturnAddress: option (Dict.t data) -> option lock `cost` 71 140 | let getReturnAddress dict = // 5 141 | dict >!= Dict.tryFind "returnAddress" // 64 142 | >?= tryLock // 2 143 | 144 | val getOrder: option (Dict.t data) -> result order `cost` 570 145 | let getOrder dict = // 65 146 | let! underlyingAsset = getAsset dict "UnderlyingAsset" in // 137 147 | let! underlyingAmount = getU64 dict "UnderlyingAmount" in // 80 148 | let! pairAsset = getAsset dict "PairAsset"in // 137 149 | let! orderTotal = getU64 dict "OrderTotal" in // 80 150 | let! makerPubKey = getMakerPubKey dict in // 71 151 | match underlyingAsset, underlyingAmount, pairAsset, orderTotal, makerPubKey with 152 | | Some underlyingAsset, Some underlyingAmount, 153 | Some pairAsset, Some orderTotal, Some makerPubKey -> 154 | RT.ok ({ underlyingAsset=underlyingAsset; 155 | underlyingAmount=underlyingAmount; 156 | pairAsset=pairAsset; 157 | orderTotal=orderTotal; 158 | makerPubKey=makerPubKey; }) 159 | | None, _, _, _, _ -> RT.autoFailw "Could not parse UnderlyingAsset" 160 | | _, None, _, _, _ -> RT.autoFailw "Could not parse UnderlyingAmount, or UnderlyingAmount was 0" 161 | | _, _, None, _, _ -> RT.autoFailw "Could not parse PairAsset" 162 | | _, _, _, None, _ -> RT.autoFailw "Could not parse OrderTotal, or OrderTotal was 0" 163 | | _, _, _, _, None -> RT.autoFailw "Could not parse MakerPubKey" 164 | 165 | val getOrderAsset: contractId -> order -> asset `cost` 2792 166 | let getOrderAsset contractID order = // 5 167 | let! orderHash = hashOrder order in // 2783 168 | mkAsset contractID orderHash // 4 169 | 170 | val lockToPubKey: asset -> U64.t -> publicKey -> txSkeleton -> txSkeleton `cost` 604 171 | let lockToPubKey asset amount pk tx = // 10 172 | let! cpk = compress pk in // 305 173 | let! cpkHash = hashCPK cpk in // 225 174 | TX.lockToPubKey asset amount cpkHash tx // 64 175 | 176 | // mints an order asset and locks it to the contract, as well as the underlying 177 | val createOrder: order -> contractId -> txSkeleton -> txSkeleton `cost` 3003 178 | let createOrder order contractID tx = // 19 179 | let! orderAsset = getOrderAsset contractID order in // 2792 180 | TX.mint 1UL orderAsset tx // 64 181 | >>= TX.lockToContract orderAsset 1UL contractID // 64 182 | >>= TX.lockToContract order.underlyingAsset order.underlyingAmount contractID // 64 183 | 184 | // destroys an order if it exists in the wallet, 185 | // and adds the underlying to the inputs. 186 | val destroyOrder: 187 | order 188 | -> contractId 189 | -> w: wallet 190 | -> txSkeleton 191 | -> CR.t `cost` (W.size w * 256 + 3267) 192 | let destroyOrder order contractID w tx = // 24 193 | // the rewrites are not necessary, but vastly improve verification time 194 | begin 195 | let! orderAsset = getOrderAsset contractID order in // 2792 196 | begin 197 | begin 198 | // destroy the order 199 | begin TX.destroy 1UL orderAsset tx // 64 200 | >>= TX.fromWallet orderAsset 1UL contractID w // W.size w * 128 + 192 201 | <: option txSkeleton `cost` (W.size w * 128 + 256) 202 | end 203 | // add the underlying to the inputs 204 | >?= TX.fromWallet order.underlyingAsset order.underlyingAmount contractID w // W.size w * 128 + 192 205 | <: option txSkeleton `cost` (W.size w * 256 + 448) 206 | end 207 | >>= CR.ofOptionTxSkel "Could not find order in wallet. Ensure that both the order and the correct amount of the underlying are present." // 3 208 | <: CR.t `cost` (W.size w * 256 + 451) 209 | end 210 | end <: CR.t `cost` (W.size w * 256 + 3243) 211 | 212 | ////////////////// 213 | // Making an order 214 | ////////////////// 215 | 216 | val makeTx: txSkeleton -> contractId -> publicKey -> order -> CR.t `cost` 3097 217 | let makeTx tx contractID senderPubKey order = // 27 218 | let! underlyingReceived = TX.getAvailableTokens order.underlyingAsset tx in // 64 219 | let! tx = // issue a token with the hash of the order as the subidentifier, 220 | // and lock it to the contract, with the underlying 221 | createOrder order contractID tx // 3003 222 | >>= CR.ofTxSkel in // 3 223 | match underlyingReceived = order.underlyingAmount, senderPubKey = order.makerPubKey with 224 | | true, true -> ret tx 225 | | false, _ -> RT.failw "Incorrect amount of UnderlyingAsset Received" 226 | | _, false -> RT.failw "SenderPubKey must match MakerPubKey" 227 | 228 | val make: txSkeleton -> contractId -> sender -> option data -> CR.t `cost` 3684 229 | let make tx contractID sender messageBody = // 13 230 | match sender with 231 | | PK senderPubKey -> 232 | let! dict = messageBody >!= tryDict in // 4 233 | getOrder dict // 570 234 | `RT.bind` 235 | makeTx tx contractID senderPubKey // 3097 236 | | _ -> RT.autoFailw "Must authenticate with PubKey" 237 | 238 | ////////////////// 239 | // Cancel an order 240 | ////////////////// 241 | 242 | val cancelTx: 243 | txSkeleton 244 | -> contractId 245 | -> w: wallet 246 | -> publicKey 247 | -> order 248 | -> CR.t `cost` (W.size w * 256 + 3889) 249 | let cancelTx tx contractID w senderPubKey order = // 18 250 | if senderPubKey = order.makerPubKey 251 | then // lock the underlying to the maker's pk 252 | lockToPubKey order.underlyingAsset order.underlyingAmount order.makerPubKey tx // 604 253 | // destroy the order 254 | >>= destroyOrder order contractID w // W.size w * 256 + 3267 255 | <: CR.t `cost` (W.size w * 256 + 3871) 256 | else RT.autoFailw "SenderPubKey must match MakerPubKey" 257 | 258 | val cancel: 259 | txSkeleton 260 | -> contractId 261 | -> sender 262 | -> option data 263 | -> w: wallet 264 | -> CR.t `cost` (W.size w * 256 + 4477) 265 | let cancel tx contractID sender messageBody w = // 14 266 | match sender with 267 | | PK senderPubKey -> 268 | let! dict = messageBody >!= tryDict in // 4 269 | begin let order = getOrder dict in // 570 270 | order `RT.bind` cancelTx tx contractID w senderPubKey // W.size w * 256 + 3889 271 | end <: CR.t `cost` (W.size w * 256 + 4459) 272 | | _ -> 273 | RT.autoFailw "Sender must authenticate with public key" 274 | 275 | ////////////////// 276 | // Taking an order 277 | ////////////////// 278 | 279 | // check that the requestedPayout is ok 280 | val checkRequestedPayout: 281 | order 282 | -> requestedPayout: U64.t 283 | -> paymentAmount: U64.t 284 | -> bool `cost` 171 285 | let checkRequestedPayout { underlyingAmount=ua; orderTotal=ot} rp pa = // 85 286 | // we want to check that 287 | // 1) requestedPayout <= underlyingAmount 288 | // 2) paymentAmount <= orderTotal 289 | // 3) requestedPayout = floor (underlyingAmount * (paymentAmount / orderTotal)) 290 | 291 | // note that 3) is equivalent to 292 | // underlyingAmount * paymentAmount 293 | // < requestedPayout * orderTotal + orderTotal 294 | // <= underlyingAmount * paymentAmount + orderTotal 295 | 296 | let open U64 in 297 | // maximum 64 bit unsigned integer 298 | let max64 = 0UL -%^ 1UL in 299 | 300 | // compute underlyingAmount * paymentAmount 301 | let! ua_pa = dmul64 ua pa in // 43 302 | // compute requestedPayout * orderTotal 303 | let! rp_ot = dmul64 rp ot in // 43 304 | // compute requestedPayout * orderTotal + orderTotal 305 | let rp_ot_ot = { hi = if rp_ot.lo >^ max64 -%^ ot // will adding low 64 bits overflow 306 | then rp_ot.hi +%^ 1UL // this never overflows 307 | else rp_ot.hi; 308 | lo = rp_ot.lo +%^ ot } in 309 | // compute underlyingAmount * paymentAmount + orderTotal 310 | let ua_pa_ot = { hi = if ua_pa.lo >^ max64 -%^ ot // will adding low 64 bits overflow 311 | then ua_pa.hi +%^ 1UL // this never overflows 312 | else ua_pa.hi; 313 | lo = ua_pa.lo +%^ ot } in 314 | 315 | // underlyingAmount * paymentAmount < requestedPayout * orderTotal + orderTotal 316 | let ua_pa_lt_rp_ot_ot = (ua_pa.hi <^ rp_ot_ot.hi) 317 | || (ua_pa.hi = rp_ot_ot.hi && ua_pa.lo <^ rp_ot_ot.lo) in 318 | // requestedPayout * orderTotal + orderTotal <= underlyingAmount * paymentAmount + orderTotal 319 | let rp_ot_ot_lte_ua_pa_ot = (rp_ot_ot.hi <^ ua_pa_ot.hi) 320 | || (rp_ot_ot.hi = ua_pa_ot.hi && rp_ot_ot.lo <=^ ua_pa_ot.lo) in 321 | // all 3 inequality relations must hold 322 | ret (rp <=^ ua && pa <=^ ot && ua_pa_lt_rp_ot_ot && rp_ot_ot_lte_ua_pa_ot) 323 | 324 | // updates an order in the case of a partial fill 325 | val updateOrder: 326 | contractId 327 | -> order 328 | -> U64.t 329 | -> U64.t 330 | -> txSkeleton 331 | -> txSkeleton `cost` 3020 332 | let updateOrder contractID order paymentAmount payoutAmount tx = let open U64 in // 17 333 | if paymentAmount <^ order.orderTotal // partial fill, so need to update the order 334 | then // create the new order 335 | let newOrder = { order with 336 | underlyingAmount=order.underlyingAmount-%^payoutAmount; 337 | orderTotal=order.orderTotal-%^paymentAmount } in 338 | createOrder newOrder contractID tx // 3003 339 | else incRet 3003 tx 340 | 341 | val takeTx: 342 | txSkeleton 343 | -> contractId 344 | -> w: wallet 345 | -> U64.t 346 | -> U64.t 347 | -> order 348 | -> lock 349 | -> CR.t `cost` (W.size w * 256 + 6978) 350 | let takeTx tx contractID w paymentAmount payoutAmount order returnAddress = // 23 351 | // lock the payout to the taker 352 | TX.lockToAddress order.underlyingAsset payoutAmount returnAddress tx // 64 353 | // lock the paymentAmount to the maker 354 | >>= lockToPubKey order.pairAsset paymentAmount order.makerPubKey // 604 355 | // create a new order if partial fill, locking the remainder of the underlying to the contract 356 | >>= updateOrder contractID order paymentAmount payoutAmount // 3020 357 | // add inputs from wallet, destroying the order 358 | >>= destroyOrder order contractID w // W.size w * 256 + 3267 359 | 360 | val take': 361 | txSkeleton 362 | -> contractId 363 | -> w: wallet 364 | -> U64.t 365 | -> U64.t 366 | -> lock 367 | -> order 368 | -> CR.t `cost` (W.size w * 256 + 7164) 369 | let take' tx contractID w requestedPayout providedAmount returnAddress order = // 15 370 | begin 371 | let! paymentAmountOK = checkRequestedPayout order requestedPayout providedAmount in // 171 372 | if paymentAmountOK then 373 | takeTx tx contractID w providedAmount requestedPayout order returnAddress // W.size w * 256 + 6978 374 | else 375 | RT.incFailw (W.size w * 256 + 6978) "Incorrect requestedPayout" 376 | end <: CR.t `cost` (W.size w * 256 + 7149) 377 | 378 | val take: 379 | txSkeleton 380 | -> contractId 381 | -> option data 382 | -> w: wallet 383 | -> CR.t `cost` (W.size w * 256 + 8011) 384 | let take tx contractID messageBody w = // 42 385 | let! dict = messageBody >!= tryDict in // 4 386 | let! requestedPayout = getU64 dict "RequestedPayout" in // 80 387 | let! returnAddress = getReturnAddress dict in // 71 388 | let! providedAmount = getU64 dict "ProvidedAmount" in // 80 389 | match requestedPayout, providedAmount, returnAddress with 390 | | Some requestedPayout, Some providedAmount, Some returnAddress -> 391 | let order = getOrder dict in // 570 392 | order `RT.bind` take' tx contractID w requestedPayout providedAmount returnAddress // W.size w * 256 + 7164 393 | <: CR.t `cost` (W.size w * 256 + 7734) 394 | | None, _, _ -> 395 | RT.autoFailw "Could not parse RequestedPayout, or RequestedPayout was 0" 396 | | _, None, _ -> 397 | RT.autoFailw "Could not parse ProvidedAmount, or ProvidedAmount was 0" 398 | | _, _, None -> 399 | RT.autoFailw "Could not parse returnAddress" 400 | 401 | ////////// 402 | // exports 403 | ////////// 404 | 405 | val main: 406 | txSkeleton 407 | -> context 408 | -> contractId 409 | -> command: string 410 | -> sender 411 | -> option data 412 | -> w: wallet 413 | -> option data 414 | -> CR.t `cost` ( 9 + begin match command with 415 | | "Make" -> 3684 416 | | "Cancel" -> W.size w * 256 + 4477 417 | | "Take" -> W.size w * 256 + 8011 418 | | _ -> 0 end ) 419 | let main tx _ contractID command sender messageBody w _ = // 9 420 | begin 421 | match command with 422 | | "Make" -> 423 | make tx contractID sender messageBody // 3684 424 | <: CR.t `cost` begin match command with 425 | | "Make" -> 3684 426 | | "Cancel" -> W.size w * 256 + 4477 427 | | "Take" -> W.size w * 256 + 8011 428 | | _ -> 0 end 429 | | "Cancel" -> 430 | cancel tx contractID sender messageBody w // W.size w * 256 + 4477 431 | | "Take" -> 432 | take tx contractID messageBody w // W.size w * 256 + 8011 433 | | _ -> 434 | RT.failw "Unrecognised command" 435 | end <: CR.t `cost` begin match command with 436 | | "Make" -> 3684 437 | | "Cancel" -> W.size w * 256 + 4477 438 | | "Take" -> W.size w * 256 + 8011 439 | | _ -> 0 end 440 | 441 | val cf: 442 | txSkeleton 443 | -> context 444 | -> string 445 | -> sender 446 | -> option data 447 | -> wallet 448 | -> option data 449 | -> nat `cost` 12 450 | let cf _ _ command _ _ w _ = // 12 451 | ret ( 9 + begin match command with 452 | | "Make" -> 3684 453 | | "Cancel" -> W.size w * 256 + 4477 454 | | "Take" -> W.size w * 256 + 8011 455 | | _ -> 0 end ) 456 | -------------------------------------------------------------------------------- /Dex/README.md: -------------------------------------------------------------------------------- 1 | # ZenDex 2 | 3 | ## Verify/Build 4 | 5 | To verify/record hints, run `zebra e --z3rlimit 8000000 Dex.fst`. 6 | This command may take a long time to run the first time. 7 | Subsequent runs will be significantly faster. 8 | With an AMD Threadripper 1950x @4.0GHz, recording hints can take up to 2 minutes. Subsequent runs take ~11s. 9 | 10 | To build, run `zebra c --z3rlimit 8000000 Dex.fst` 11 | 12 | ## How it works 13 | 14 | ZenDex is a true decentralised exchange, with no operator or fees. 15 | 16 | ZenDex stores orders as utxos that it locks to itself. 17 | In this manner, we avoid having a shared state, allowing great parallelism. 18 | 19 | When an order is made, the order parameters are hashed together. 20 | ZenDex mints a single token with that hash as it's sub-identifier (the '*order asset*'), 21 | and locks that to itself. 22 | 23 | When an order is taken or cancelled, that token is destroyed. 24 | In the case of a partial fill, 25 | ZenDex will create a new order with reduced quantities of the underlying and order total. 26 | The previous order is still destroyed. 27 | 28 | When cancelling or taking an order, 29 | one must supply all of the order parameters directly to ZenDex in the messageBody, 30 | because ZenDex does not store this information, and only possesses a hash of the order. 31 | 32 | Order books can be constructed by folding over the blockchain, 33 | and looking for transactions involving ZenDex. 34 | 35 | ## Usage 36 | 37 | ZenDex accepts three commands: `"Make"`, `"Cancel"`, and `"Take"`. 38 | 39 | ### Making an order 40 | 41 | Use the command `"Make"`. You must sign with a public key - 42 | if the sender is `Anonymous` or `Contract contractID`, then the transaction will fail. 43 | 44 | The messageBody must consist of a dictionary which includes the following fields: 45 | 46 | | Field Name | Type | Description | 47 | |:----------:|:----:| ----------- | 48 | | `"UnderlyingAsset"` | `String` | The identifier of the underlying asset | 49 | | `"UnderlyingAmount"` | `UInt64` | The amount of the underlying asset used to make the order | 50 | | `"PairAsset"` | `String` | The identifier of the pair asset | 51 | | `"OrderTotal"` | `UInt64` | The total amount of the pair being ordered | 52 | | `"MakerPubKey"` | `PublicKey` | The public key of the order maker | 53 | 54 | The amount of the underlying made available to ZenDex in the transaction must be equal to `"UnderlyingAmount"`. 55 | The public key used to sign the transaction must be the same as `"MakerPubKey"`. 56 | 57 | ### Cancelling an order 58 | 59 | Use the command `"Cancel"`. You must sign with the public key that was used to create the order. 60 | 61 | The messageBody must consist of a dictionary which includes the following fields: 62 | 63 | | Field Name | Type | Description | 64 | |:----------:|:----:| ----------- | 65 | | `"UnderlyingAsset"` | `String` | The identifier of the underlying asset of the order| 66 | | `"UnderlyingAmount"` | `UInt64` | The amount of the underlying asset used to make the order | 67 | | `"PairAsset"` | `String` | The identifier of the pair asset in the order | 68 | | `"OrderTotal"` | `UInt64` | The total amount of the pair that was ordered | 69 | | `"MakerPubKey"` | `PublicKey` | The public key of the order maker | 70 | 71 | The transaction must place the order asset in ZenDex's contract wallet, 72 | as well as a sufficient quantity of the underlying. 73 | 74 | ### Taking an order 75 | 76 | Use the command `"Take"`. 77 | 78 | The messageBody must consist of a dictionary which includes the following fields: 79 | 80 | | Field Name | Type | Description | 81 | |:----------:|:----:| ----------- | 82 | | `"UnderlyingAsset"` | `String` | The identifier of the underlying asset of the order| 83 | | `"UnderlyingAmount"` | `UInt64` | The amount of the underlying asset used to make the order | 84 | | `"PairAsset"` | `String` | The identifier of the pair asset in the order | 85 | | `"OrderTotal"` | `UInt64` | The total amount of the pair that was ordered in the order being taken | 86 | | `"MakerPubKey"` | `PublicKey` | The public key of the order maker | 87 | | `"RequestedPayout"` | `UInt64` | The amount of the underlying to pay out | 88 | | `"ProvidedAmount"` | `UInt64` | The amount of the pair supplied | 89 | 90 | The transaction must place the order asset being taken and a sufficient amount of the underlying in ZenDex's contract wallet, 91 | and must lock an amount α of the order's pair asset to the contract, where 92 | 93 | 94 | ## Notes 95 | 96 | Orders are expressed in terms of underlying amount and pair amount to allow for rational price ratios - eg. a trade of 5α for 7β, or 13β for 11γ. 97 | This is not easily expressed as a 'price per' with only integer arithmetic. 98 | The payout for a partial fill should, assuming arbitrarily divisible assets, be calculated as 99 | 100 | However, since we do not have arbitrarily divisible assets, we denote orders in the smallest unit of each asset and compute the floor, so that 101 | 102 | 103 | The underlying amount, order total, and payment amount are all 64 bit unsigned integers. 104 | Version 0 ZF* contracts lack integer representations larger than this, and so we are tasked with implementing double-word arithmetic in order to calculate the payoff. 105 | In order to avoid the complexity and potential for error in implementing double-word division, 106 | we instead ask the user to provide the payoff, and validate that it is correct. 107 | Validating that a user's `RequestedPayout` is correct is simpler than computing the payout, 108 | and requires only double-word multiplication and comparison, 109 | both relatively simple compared to double-word division. 110 | 111 | Note that 112 | ![Requested Payout Identity](doc/tex/RequestedPayoutIdentity.png) 113 | -------------------------------------------------------------------------------- /Dex/README.tex.md: -------------------------------------------------------------------------------- 1 | 2 | # ZenDex 3 | 4 | ## Verify/Build 5 | 6 | To verify/record hints, run `zebra --z3rlimit 8000000 -e Dex001.fst`. 7 | This command may take a long time to run the first time. 8 | Subsequent runs will be significantly faster. 9 | With an AMD Threadripper 1950x @4.0GHz, recording hints can take up to 2 minutes. Subsequent runs take ~11s. 10 | 11 | To build, run `zebra --z3rlimit 8000000 -c Dex001.fst` 12 | 13 | ## How it works 14 | 15 | ZenDex is a true decentralised exchange, with no operator or fees. 16 | 17 | ZenDex stores orders as utxos that it locks to itself. 18 | In this manner, we avoid having a shared state, allowing great parallelism. 19 | 20 | When an order is made, the order parameters are hashed together. 21 | ZenDex mints a single token with that hash as it's sub-identifier (the '*order asset*'), 22 | and locks that to itself. 23 | 24 | When an order is taken or cancelled, that token is destroyed. 25 | In the case of a partial fill, 26 | ZenDex will create a new order with reduced quantities of the underlying and order total. 27 | The previous order is still destroyed. 28 | 29 | When cancelling or taking an order, 30 | one must supply all of the order parameters directly to ZenDex in the messageBody, 31 | because ZenDex does not store this information, and only possesses a hash of the order. 32 | 33 | Order books can be constructed by folding over the blockchain, 34 | and looking for transactions involving ZenDex. 35 | 36 | ## Usage 37 | 38 | ZenDex accepts three commands: `"Make"`, `"Cancel"`, and `"Take"`. 39 | 40 | ### Making an order 41 | 42 | Use the command `"Make"`. You must sign with a public key - 43 | if the sender is `Anonymous` or `Contract contractID`, then the transaction will fail. 44 | 45 | The messageBody must consist of a dictionary which includes the following fields: 46 | 47 | | Field Name | Type | Description | 48 | |:----------:|:----:| ----------- | 49 | | `"UnderlyingAsset"` | `String` | The identifier of the underlying asset | 50 | | `"UnderlyingAmount"` | `UInt64` | The amount of the underlying asset used to make the order | 51 | | `"PairAsset"` | `String` | The identifier of the pair asset | 52 | | `"OrderTotal"` | `UInt64` | The total amount of the pair being ordered | 53 | | `"MakerPubKey"` | `PublicKey` | The public key of the order maker | 54 | 55 | The amount of the underlying made available to ZenDex in the transaction must be equal to `"UnderlyingAmount"`. 56 | The public key used to sign the transaction must be the same as `"MakerPubKey"`. 57 | 58 | ### Cancelling an order 59 | 60 | Use the command `"Cancel"`. You must sign with the public key that was used to create the order. 61 | 62 | The messageBody must consist of a dictionary which includes the following fields: 63 | 64 | | Field Name | Type | Description | 65 | |:----------:|:----:| ----------- | 66 | | `"UnderlyingAsset"` | `String` | The identifier of the underlying asset of the order| 67 | | `"UnderlyingAmount"` | `UInt64` | The amount of the underlying asset used to make the order | 68 | | `"PairAsset"` | `String` | The identifier of the pair asset in the order | 69 | | `"OrderTotal"` | `UInt64` | The total amount of the pair that was ordered | 70 | | `"MakerPubKey"` | `PublicKey` | The public key of the order maker | 71 | 72 | The transaction must place the order asset in ZenDex's contract wallet, 73 | as well as a sufficient quantity of the underlying. 74 | 75 | ### Taking an order 76 | 77 | Use the command `"Take"`. 78 | 79 | The messageBody must consist of a dictionary which includes the following fields: 80 | 81 | | Field Name | Type | Description | 82 | |:----------:|:----:| ----------- | 83 | | `"UnderlyingAsset"` | `String` | The identifier of the underlying asset of the order| 84 | | `"UnderlyingAmount"` | `UInt64` | The amount of the underlying asset used to make the order | 85 | | `"PairAsset"` | `String` | The identifier of the pair asset in the order | 86 | | `"OrderTotal"` | `UInt64` | The total amount of the pair that was ordered in the order being taken | 87 | | `"MakerPubKey"` | `PublicKey` | The public key of the order maker | 88 | | `"RequestedPayout"` | `UInt64` | The amount of the underlying to pay out | 89 | | `"ProvidedAmount"` | `UInt64` | The amount of the pair supplied | 90 | 91 | The transaction must place the order asset being taken and a sufficient amount of the underlying in ZenDex's contract wallet, 92 | and must lock an amount α of the order's pair asset to the contract, where 93 | $\texttt{Payout} = 94 | \texttt{UnderlyingAmount} \times \frac{\texttt{PaymentAmount}}{\texttt{OrderTotal}}$ 95 | 96 | ## Notes 97 | 98 | Orders are expressed in terms of underlying amount and pair amount to allow for rational price ratios - eg. a trade of 5α for 7β, or 13β for 11γ. 99 | This is not easily expressed as a 'price per' with only integer arithmetic. 100 | The payout for a partial fill should, assuming arbitrarily divisible assets, be calculated as $\texttt{Payout} = 101 | \texttt{UnderlyingAmount} \times \frac{\texttt{PaymentAmount}}{\texttt{OrderTotal}}$ 102 | 103 | However, since we do not have arbitrarily divisible assets, we denote orders in the smallest unit of each asset and compute the floor, so that 104 | $\texttt{Payout} = 105 | \left \lfloor 106 | {\texttt{UnderlyingAmount} \times \frac{\texttt{PaymentAmount}}{\texttt{OrderTotal}}} 107 | \right \rfloor$ 108 | 109 | The underlying amount, order total, and payment amount are all 64 bit unsigned integers. 110 | Version 0 ZF* contracts lack integer representations larger than this, and so we are tasked with implementing double-word arithmetic in order to calculate the payoff. 111 | In order to avoid the complexity and potential for error in implementing double-word division, 112 | we instead ask the user to provide the payoff, and validate that it is correct. 113 | Validating that a user's `RequestedPayout` is correct is simpler than computing the payout, 114 | and requires only double-word multiplication and comparison, 115 | both relatively simple compared to double-word division. 116 | 117 | Note that 118 | ![Requested Payout Identity](doc/tex/RequestedPayoutIdentity.png) 119 | -------------------------------------------------------------------------------- /Dex/Tests/Dex_Cancel.fsx: -------------------------------------------------------------------------------- 1 | #load "Dex.fsx" 2 | 3 | open Dex 4 | 5 | let tests = new System.Collections.Generic.Dictionary>() 6 | let test_counter = ref 1 7 | 8 | let test = run_test tests test_counter 9 | 10 | test "valid Cancel order - 100 ZP -> 100 ZP" 11 | begin valid_order_cancel { 12 | odataDefault with 13 | underlyingAsset = Some <| ZEN_ASSET 14 | underlyingAmount = Some <| 100UL 15 | pairAsset = Some <| ZEN_ASSET 16 | orderTotal = Some <| 100UL 17 | makerPubKey = Some <| generatePublicKey() 18 | nonce = Some <| 1UL 19 | } 20 | |> should_PASS 21 | end 22 | 23 | test "valid Cancel order - 100 ZP -> 600 XYZ" 24 | begin valid_order_cancel { 25 | odataDefault with 26 | underlyingAsset = Some <| ZEN_ASSET 27 | underlyingAmount = Some <| 100UL 28 | pairAsset = Some <| XYZ_ASSET 29 | orderTotal = Some <| 600UL 30 | makerPubKey = Some <| generatePublicKey() 31 | nonce = Some <| 1UL 32 | } 33 | |> should_PASS 34 | end 35 | 36 | test "invalid Cancel order - 0 ZP -> 600 XYZ" 37 | begin valid_order_cancel { 38 | odataDefault with 39 | underlyingAsset = Some <| ZEN_ASSET 40 | underlyingAmount = Some <| 0UL 41 | pairAsset = Some <| XYZ_ASSET 42 | orderTotal = Some <| 600UL 43 | makerPubKey = Some <| generatePublicKey() 44 | nonce = Some <| 1UL 45 | } 46 | |> should_FAIL_with "Could not parse UnderlyingAmount, or UnderlyingAmount was 0" 47 | end 48 | 49 | test "invalid Cancel order - 100 ZP -> 0 XYZ" 50 | begin valid_order_cancel { 51 | odataDefault with 52 | underlyingAsset = Some <| ZEN_ASSET 53 | underlyingAmount = Some <| 100UL 54 | pairAsset = Some <| XYZ_ASSET 55 | orderTotal = Some <| 0UL 56 | makerPubKey = Some <| generatePublicKey() 57 | nonce = Some <| 1UL 58 | } 59 | |> should_FAIL_with "Could not parse OrderTotal, or OrderTotal was 0" 60 | end 61 | 62 | test "invalid Cancel order - 0 ZP -> 0 XYZ" 63 | begin valid_order_cancel { 64 | odataDefault with 65 | underlyingAsset = Some <| ZEN_ASSET 66 | underlyingAmount = Some <| 0UL 67 | pairAsset = Some <| XYZ_ASSET 68 | orderTotal = Some <| 0UL 69 | makerPubKey = Some <| generatePublicKey() 70 | nonce = Some <| 1UL 71 | } 72 | |> should_FAIL_with "Could not parse UnderlyingAmount, or UnderlyingAmount was 0" 73 | end 74 | 75 | test "underlying amount is bigger than in wallet" 76 | begin order_cancel_modified_wallet (Some <| 99UL, Some <| 600UL, Some <| 1UL) { 77 | odataDefault with 78 | underlyingAsset = Some <| ZEN_ASSET 79 | underlyingAmount = Some <| 100UL 80 | pairAsset = Some <| XYZ_ASSET 81 | orderTotal = Some <| 600UL 82 | makerPubKey = Some <| generatePublicKey() 83 | nonce = Some <| 1UL 84 | } 85 | |> should_FAIL 86 | end 87 | 88 | test "pair amount is bigger than in wallet" 89 | begin order_cancel_modified_wallet (Some <| 100UL, Some <| 599UL, Some <| 1UL) { 90 | odataDefault with 91 | underlyingAsset = Some <| ZEN_ASSET 92 | underlyingAmount = Some <| 100UL 93 | pairAsset = Some <| XYZ_ASSET 94 | orderTotal = Some <| 600UL 95 | makerPubKey = Some <| generatePublicKey() 96 | nonce = Some <| 1UL 97 | } 98 | |> should_PASS 99 | end 100 | 101 | test "no order token" 102 | begin order_cancel_modified_wallet (Some <| 100UL, Some <| 600UL, None) { 103 | odataDefault with 104 | underlyingAsset = Some <| ZEN_ASSET 105 | underlyingAmount = Some <| 100UL 106 | pairAsset = Some <| XYZ_ASSET 107 | orderTotal = Some <| 600UL 108 | makerPubKey = Some <| generatePublicKey() 109 | nonce = Some <| 1UL 110 | } 111 | |> should_FAIL 112 | end 113 | 114 | test "0 order token" 115 | begin order_cancel_modified_wallet (Some <| 100UL, Some <| 600UL, Some <| 0UL) { 116 | odataDefault with 117 | underlyingAsset = Some <| ZEN_ASSET 118 | underlyingAmount = Some <| 100UL 119 | pairAsset = Some <| XYZ_ASSET 120 | orderTotal = Some <| 600UL 121 | makerPubKey = Some <| generatePublicKey() 122 | nonce = Some <| 1UL 123 | } 124 | |> should_FAIL 125 | end 126 | 127 | test "excess underlying amount" 128 | begin order_cancel_modified_wallet (Some <| 101UL, Some <| 600UL, Some <| 1UL) { 129 | odataDefault with 130 | underlyingAsset = Some <| ZEN_ASSET 131 | underlyingAmount = Some <| 100UL 132 | pairAsset = Some <| XYZ_ASSET 133 | orderTotal = Some <| 600UL 134 | makerPubKey = Some <| generatePublicKey() 135 | nonce = Some <| 1UL 136 | } 137 | |> should_PASS 138 | end 139 | 140 | test "excess pair amount" 141 | begin order_cancel_modified_wallet (Some <| 100UL, Some <| 601UL, Some <| 1UL) { 142 | odataDefault with 143 | underlyingAsset = Some <| ZEN_ASSET 144 | underlyingAmount = Some <| 100UL 145 | pairAsset = Some <| XYZ_ASSET 146 | orderTotal = Some <| 600UL 147 | makerPubKey = Some <| generatePublicKey() 148 | nonce = Some <| 1UL 149 | } 150 | |> should_PASS 151 | end 152 | 153 | test "excess order token" 154 | begin order_cancel_modified_wallet (Some <| 100UL, Some <| 600UL, Some <| 2UL) { 155 | odataDefault with 156 | underlyingAsset = Some <| ZEN_ASSET 157 | underlyingAmount = Some <| 100UL 158 | pairAsset = Some <| XYZ_ASSET 159 | orderTotal = Some <| 600UL 160 | makerPubKey = Some <| generatePublicKey() 161 | nonce = Some <| 1UL 162 | } 163 | |> should_PASS 164 | end 165 | 166 | 167 | 168 | 169 | for test in tests do 170 | match fst test.Value , snd test.Value with 171 | | name , Ok _ -> 172 | () 173 | | name , Error err -> 174 | failwithf "Test %s failed with: %s" name err -------------------------------------------------------------------------------- /Dex/Tests/Dex_Make.fsx: -------------------------------------------------------------------------------- 1 | #load "Dex.fsx" 2 | 3 | open Dex 4 | open System 5 | 6 | let tests = new System.Collections.Generic.Dictionary>() 7 | let test_counter = ref 1 8 | 9 | let test = run_test tests test_counter 10 | 11 | test "valid Make order - 100 ZP -> 100 ZP" 12 | begin valid_order_make { 13 | odataDefault with 14 | underlyingAsset = Some <| ZEN_ASSET 15 | underlyingAmount = Some <| 100UL 16 | pairAsset = Some <| ZEN_ASSET 17 | orderTotal = Some <| 100UL 18 | makerPubKey = Some <| generatePublicKey() 19 | nonce = Some <| 1UL 20 | } 21 | |> should_PASS 22 | end 23 | 24 | test "valid Make order - 100 ZP -> 5 ZP" 25 | begin valid_order_make { 26 | odataDefault with 27 | underlyingAsset = Some <| ZEN_ASSET 28 | underlyingAmount = Some <| 100UL 29 | pairAsset = Some <| ZEN_ASSET 30 | orderTotal = Some <| 5UL 31 | makerPubKey = Some <| generatePublicKey() 32 | nonce = Some <| 1UL 33 | } 34 | |> should_PASS 35 | end 36 | 37 | test "valid Make order - 100 ZP -> 5 XYZ" 38 | begin valid_order_make { 39 | odataDefault with 40 | underlyingAsset = Some <| ZEN_ASSET 41 | underlyingAmount = Some <| 100UL 42 | pairAsset = Some <| XYZ_ASSET 43 | orderTotal = Some <| 5UL 44 | makerPubKey = Some <| generatePublicKey() 45 | nonce = Some <| 1UL 46 | } 47 | |> should_PASS 48 | end 49 | 50 | test "Valid Make order - 5 XYZ -> 100 ZP" 51 | begin valid_order_make { 52 | odataDefault with 53 | underlyingAsset = Some <| XYZ_ASSET 54 | underlyingAmount = Some <| 5UL 55 | pairAsset = Some <| ZEN_ASSET 56 | orderTotal = Some <| 100UL 57 | makerPubKey = Some <| generatePublicKey() 58 | nonce = Some <| 1UL 59 | } 60 | |> should_PASS 61 | end 62 | 63 | test "0 underying amount" 64 | begin valid_order_make { 65 | odataDefault with 66 | underlyingAsset = Some <| ZEN_ASSET 67 | underlyingAmount = Some <| 0UL 68 | pairAsset = Some <| ZEN_ASSET 69 | orderTotal = Some <| 100UL 70 | makerPubKey = Some <| generatePublicKey() 71 | nonce = Some <| 1UL 72 | } 73 | |> should_FAIL_with "Could not parse UnderlyingAmount, or UnderlyingAmount was 0" 74 | end 75 | 76 | test "0 pair amount" 77 | begin valid_order_make { 78 | odataDefault with 79 | underlyingAsset = Some <| ZEN_ASSET 80 | underlyingAmount = Some <| 100UL 81 | pairAsset = Some <| ZEN_ASSET 82 | orderTotal = Some <| 0UL 83 | makerPubKey = Some <| generatePublicKey() 84 | nonce = Some <| 1UL 85 | } 86 | |> should_FAIL_with "Could not parse OrderTotal, or OrderTotal was 0" 87 | end 88 | 89 | test "0 underlying & pair amount" 90 | begin valid_order_make { 91 | odataDefault with 92 | underlyingAsset = Some <| ZEN_ASSET 93 | underlyingAmount = Some <| 0UL 94 | pairAsset = Some <| ZEN_ASSET 95 | orderTotal = Some <| 0UL 96 | makerPubKey = Some <| generatePublicKey() 97 | nonce = Some <| 1UL 98 | } 99 | |> should_FAIL_with "Could not parse UnderlyingAmount, or UnderlyingAmount was 0" 100 | end 101 | 102 | test "no underlying asset in body" 103 | begin order_make_modified_tx [ZEN_ASSET, 100UL] { 104 | odataDefault with 105 | underlyingAsset = None 106 | underlyingAmount = Some <| 100UL 107 | pairAsset = Some <| XYZ_ASSET 108 | orderTotal = Some <| 600UL 109 | makerPubKey = Some <| generatePublicKey() 110 | nonce = Some <| 1UL 111 | } 112 | |> should_FAIL_with "Could not parse UnderlyingAsset" 113 | end 114 | 115 | test "no underlying amount in body" 116 | begin order_make_modified_tx [ZEN_ASSET, 100UL] { 117 | odataDefault with 118 | underlyingAsset = Some <| ZEN_ASSET 119 | underlyingAmount = None 120 | pairAsset = Some <| XYZ_ASSET 121 | orderTotal = Some <| 600UL 122 | makerPubKey = Some <| generatePublicKey() 123 | nonce = Some <| 1UL 124 | } 125 | |> should_FAIL_with "Could not parse UnderlyingAmount, or UnderlyingAmount was 0" 126 | end 127 | 128 | test "no underlying asset & amount in body" 129 | begin order_make_modified_tx [ZEN_ASSET, 100UL] { 130 | odataDefault with 131 | underlyingAsset = None 132 | underlyingAmount = None 133 | pairAsset = Some <| XYZ_ASSET 134 | orderTotal = Some <| 600UL 135 | makerPubKey = Some <| generatePublicKey() 136 | nonce = Some <| 1UL 137 | } 138 | |> should_FAIL_with "Could not parse UnderlyingAsset" 139 | end 140 | 141 | test "empty tx" 142 | begin order_make_modified_tx [] { 143 | odataDefault with 144 | underlyingAsset = Some <| ZEN_ASSET 145 | underlyingAmount = Some <| 100UL 146 | pairAsset = Some <| XYZ_ASSET 147 | orderTotal = Some <| 600UL 148 | makerPubKey = Some <| generatePublicKey() 149 | nonce = Some <| 1UL 150 | } 151 | |> should_FAIL_with "Incorrect amount of UnderlyingAsset Received" 152 | end 153 | 154 | test "composite tx" 155 | begin order_make_modified_tx [(XYZ_ASSET, 5UL); (ZEN_ASSET, 50UL); (XYZ_ASSET, 5UL); (ZEN_ASSET, 50UL); (XYZ_ASSET, 5UL)] { 156 | odataDefault with 157 | underlyingAsset = Some <| ZEN_ASSET 158 | underlyingAmount = Some <| 100UL 159 | pairAsset = Some <| XYZ_ASSET 160 | orderTotal = Some <| 600UL 161 | makerPubKey = Some <| generatePublicKey() 162 | nonce = Some <| 1UL 163 | } 164 | |> should_PASS 165 | end 166 | 167 | test "incorrect asset in tx" 168 | begin order_make_modified_tx [XYZ_ASSET, 100UL] { 169 | odataDefault with 170 | underlyingAsset = Some <| ZEN_ASSET 171 | underlyingAmount = Some <| 100UL 172 | pairAsset = Some <| XYZ_ASSET 173 | orderTotal = Some <| 600UL 174 | makerPubKey = Some <| generatePublicKey() 175 | nonce = Some <| 1UL 176 | } 177 | |> should_FAIL_with "Incorrect amount of UnderlyingAsset Received" 178 | end 179 | 180 | test "incorrect amount in tx (amount too small)" 181 | begin order_make_modified_tx [ZEN_ASSET, 99UL] { 182 | odataDefault with 183 | underlyingAsset = Some <| ZEN_ASSET 184 | underlyingAmount = Some <| 100UL 185 | pairAsset = Some <| XYZ_ASSET 186 | orderTotal = Some <| 600UL 187 | makerPubKey = Some <| generatePublicKey() 188 | nonce = Some <| 1UL 189 | } 190 | |> should_FAIL_with "Incorrect amount of UnderlyingAsset Received" 191 | end 192 | 193 | 194 | test "incorrect amount in tx (amount too big)" 195 | begin order_make_modified_tx [ZEN_ASSET, 101UL] { 196 | odataDefault with 197 | underlyingAsset = Some <| ZEN_ASSET 198 | underlyingAmount = Some <| 100UL 199 | pairAsset = Some <| XYZ_ASSET 200 | orderTotal = Some <| 600UL 201 | makerPubKey = Some <| generatePublicKey() 202 | nonce = Some <| 1UL 203 | } 204 | |> should_FAIL_with "Incorrect amount of UnderlyingAsset Received" 205 | end 206 | 207 | test "wrong maker" 208 | begin order_make_modified_sender (generatePublicKey()) { 209 | odataDefault with 210 | underlyingAsset = Some <| ZEN_ASSET 211 | underlyingAmount = Some <| 100UL 212 | pairAsset = Some <| XYZ_ASSET 213 | orderTotal = Some <| 600UL 214 | makerPubKey = Some <| generatePublicKey() 215 | nonce = Some <| 1UL 216 | } 217 | |> should_FAIL_with "SenderPubKey must match MakerPubKey" 218 | end 219 | 220 | test "nonempty wallet" 221 | begin order_make_modified_wallet (Some 100UL, Some 600UL, Some 10UL) { 222 | odataDefault with 223 | underlyingAsset = Some <| ZEN_ASSET 224 | underlyingAmount = Some <| 100UL 225 | pairAsset = Some <| XYZ_ASSET 226 | orderTotal = Some <| 600UL 227 | makerPubKey = Some <| generatePublicKey() 228 | nonce = Some <| 1UL 229 | } 230 | |> should_PASS 231 | end 232 | 233 | 234 | 235 | 236 | 237 | for test in tests do 238 | match fst test.Value , snd test.Value with 239 | | name , Ok _ -> 240 | () 241 | | name , Error err -> 242 | failwithf "Test %s failed with: %s" name err -------------------------------------------------------------------------------- /Dex/Tests/Dex_Take.fsx: -------------------------------------------------------------------------------- 1 | #load "Dex.fsx" 2 | 3 | module Types = Consensus.Types 4 | 5 | open Dex 6 | 7 | let tests = new System.Collections.Generic.Dictionary>() 8 | let test_counter = ref 1 9 | 10 | let test = run_test tests test_counter 11 | 12 | let scale (p : uint8) = Option.map (fun x -> (x * uint64 p) / 100UL) 13 | 14 | let _ = 15 | let name = "take order 100 ZP -> 600 XYZ" 16 | let maker = generatePublicKey() 17 | let taker = generatePublicKey() 18 | let odata = { 19 | odataDefault with 20 | underlyingAsset = Some <| ZEN_ASSET 21 | underlyingAmount = Some <| 100UL 22 | pairAsset = Some <| XYZ_ASSET 23 | orderTotal = Some <| 600UL 24 | makerPubKey = Some <| maker 25 | nonce = Some <| 1UL 26 | returnAddress = Some <| taker 27 | providedAmount = Some <| 600UL 28 | } 29 | test name 30 | begin valid_order_take_full odata 31 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 32 | checkTx 33 | [ hasInput None odata.underlyingAsset odata.underlyingAmount 34 | ; hasOutput (lockPK taker) odata.underlyingAsset odata.underlyingAmount 35 | 36 | ; hasInput None odata.pairAsset odata.orderTotal 37 | ; hasOutput (lockPK maker) odata.pairAsset odata.orderTotal 38 | 39 | ; hasInput lockContract orderAsset (Some 1UL) 40 | ; hasOutput lockDestroy orderAsset (Some 1UL) 41 | ] 42 | end 43 | 44 | let _ = 45 | let name = "take order 0 ZP -> 600 XYZ" 46 | let maker = generatePublicKey() 47 | let taker = generatePublicKey() 48 | let odata = { 49 | odataDefault with 50 | underlyingAsset = Some <| ZEN_ASSET 51 | underlyingAmount = Some <| 0UL 52 | pairAsset = Some <| XYZ_ASSET 53 | orderTotal = Some <| 600UL 54 | makerPubKey = Some <| maker 55 | nonce = Some <| 1UL 56 | returnAddress = Some <| taker 57 | providedAmount = Some <| 600UL 58 | } 59 | test name 60 | begin valid_order_take_full odata 61 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 62 | should_FAIL_with "Could not parse RequestedPayout, or RequestedPayout was 0" 63 | end 64 | 65 | let _ = 66 | let name = "take order 100 ZP -> 0 XYZ" 67 | let maker = generatePublicKey() 68 | let taker = generatePublicKey() 69 | let odata = { 70 | odataDefault with 71 | underlyingAsset = Some <| ZEN_ASSET 72 | underlyingAmount = Some <| 100UL 73 | pairAsset = Some <| XYZ_ASSET 74 | orderTotal = Some <| 0UL 75 | makerPubKey = Some <| maker 76 | nonce = Some <| 1UL 77 | returnAddress = Some <| taker 78 | providedAmount = Some <| 0UL 79 | } 80 | test name 81 | begin valid_order_take_full odata 82 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 83 | should_FAIL_with "Could not parse ProvidedAmount, or ProvidedAmount was 0" 84 | end 85 | 86 | let _ = 87 | let name = "take order 0 ZP -> 0 XYZ" 88 | let maker = generatePublicKey() 89 | let taker = generatePublicKey() 90 | let odata = { 91 | odataDefault with 92 | underlyingAsset = Some <| ZEN_ASSET 93 | underlyingAmount = Some <| 0UL 94 | pairAsset = Some <| XYZ_ASSET 95 | orderTotal = Some <| 0UL 96 | makerPubKey = Some <| maker 97 | nonce = Some <| 1UL 98 | returnAddress = Some <| taker 99 | providedAmount = Some <| 0UL 100 | } 101 | test name 102 | begin valid_order_take_full odata 103 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 104 | should_FAIL_with "Could not parse RequestedPayout, or RequestedPayout was 0" 105 | end 106 | 107 | let _ = 108 | let name = "take order 100 ZP -> 600 XYZ with 20% partial fill (20 ZP -> 120 XYZ)" 109 | let maker = generatePublicKey() 110 | let taker = generatePublicKey() 111 | let p = 20uy 112 | let odata = { 113 | odataDefault with 114 | underlyingAsset = Some <| ZEN_ASSET 115 | underlyingAmount = Some <| 100UL 116 | pairAsset = Some <| XYZ_ASSET 117 | orderTotal = Some <| 600UL 118 | makerPubKey = Some <| maker 119 | nonce = Some <| 1UL 120 | returnAddress = Some <| taker 121 | providedAmount = Some <| 120UL 122 | } 123 | test name 124 | begin valid_order_take_partial p odata 125 | |> let oldOrderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 126 | let newOrderAsset = 127 | computeOrderAsset 128 | { odata with 129 | underlyingAmount = scale (100uy-p) odata.underlyingAmount 130 | orderTotal = scale (100uy-p) odata.orderTotal 131 | } 132 | |> Option.map Consensus.Asset.toString in 133 | checkTx 134 | [ hasInput None odata.underlyingAsset odata.underlyingAmount 135 | ; hasOutput (lockPK taker) odata.underlyingAsset (scale p odata.underlyingAmount) 136 | ; hasOutput lockContract odata.underlyingAsset (scale (100uy-p) odata.underlyingAmount) 137 | 138 | ; hasInput None odata.pairAsset (scale p odata.orderTotal) 139 | ; hasOutput (lockPK maker) odata.pairAsset (scale p odata.orderTotal) 140 | 141 | ; hasInput lockContract oldOrderAsset (Some 1UL) 142 | ; hasOutput lockDestroy oldOrderAsset (Some 1UL) 143 | 144 | ; hasMint newOrderAsset (Some 1UL) 145 | ; hasOutput lockContract newOrderAsset (Some 1UL) 146 | ] 147 | end 148 | 149 | let _ = 150 | let name = "take order 100 ZP -> 600 XYZ with 110% partial fill (110 ZP -> 660 XYZ)" 151 | let maker = generatePublicKey() 152 | let taker = generatePublicKey() 153 | let p = 110uy 154 | let odata = { 155 | odataDefault with 156 | underlyingAsset = Some <| ZEN_ASSET 157 | underlyingAmount = Some <| 100UL 158 | pairAsset = Some <| XYZ_ASSET 159 | orderTotal = Some <| 600UL 160 | makerPubKey = Some <| maker 161 | nonce = Some <| 1UL 162 | returnAddress = Some <| taker 163 | providedAmount = Some <| 600UL 164 | } 165 | test name 166 | begin valid_order_take_partial p odata 167 | |> let oldOrderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 168 | let newOrderAsset = 169 | computeOrderAsset 170 | { odata with 171 | underlyingAmount = scale (100uy-p) odata.underlyingAmount 172 | orderTotal = scale (100uy-p) odata.orderTotal 173 | } 174 | |> Option.map Consensus.Asset.toString in 175 | should_FAIL 176 | end 177 | 178 | let _ = 179 | let name = "take order 100 ZP -> 600 XYZ with 20% partial fill (20 ZP -> 120 XYZ) (SANITY CHECK! - for modified tx)" 180 | let maker = generatePublicKey() 181 | let taker = generatePublicKey() 182 | let p = 20uy 183 | let odata = { 184 | odataDefault with 185 | underlyingAsset = Some <| ZEN_ASSET 186 | underlyingAmount = Some <| 100UL 187 | pairAsset = Some <| XYZ_ASSET 188 | orderTotal = Some <| 600UL 189 | makerPubKey = Some <| maker 190 | nonce = Some <| 1UL 191 | returnAddress = Some <| taker 192 | requestedPayout = Some <| 20UL 193 | providedAmount = Some <| 120UL 194 | } 195 | test name 196 | begin order_take_modified_tx [XYZ_ASSET, 120UL] odata 197 | |> let oldOrderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 198 | let newOrderAsset = 199 | computeOrderAsset 200 | { odata with 201 | underlyingAmount = scale (100uy-p) odata.underlyingAmount 202 | orderTotal = scale (100uy-p) odata.orderTotal 203 | } 204 | |> Option.map Consensus.Asset.toString in 205 | checkTx 206 | [ hasInput None odata.underlyingAsset odata.underlyingAmount 207 | ; hasOutput (lockPK taker) odata.underlyingAsset (scale p odata.underlyingAmount) 208 | ; hasOutput lockContract odata.underlyingAsset (scale (100uy-p) odata.underlyingAmount) 209 | 210 | ; hasInput None odata.pairAsset (scale p odata.orderTotal) 211 | ; hasOutput (lockPK maker) odata.pairAsset (scale p odata.orderTotal) 212 | 213 | ; hasInput lockContract oldOrderAsset (Some 1UL) 214 | ; hasOutput lockDestroy oldOrderAsset (Some 1UL) 215 | 216 | ; hasMint newOrderAsset (Some 1UL) 217 | ; hasOutput lockContract newOrderAsset (Some 1UL) 218 | ] 219 | end 220 | 221 | let _ = 222 | let name = "take order 100 ZP -> 600 XYZ with 20% partial fill and wrong requested payout (too much)" 223 | let maker = generatePublicKey() 224 | let taker = generatePublicKey() 225 | let p = 20uy 226 | let odata = { 227 | odataDefault with 228 | underlyingAsset = Some <| ZEN_ASSET 229 | underlyingAmount = Some <| 100UL 230 | pairAsset = Some <| XYZ_ASSET 231 | orderTotal = Some <| 600UL 232 | makerPubKey = Some <| maker 233 | nonce = Some <| 1UL 234 | returnAddress = Some <| taker 235 | requestedPayout = Some <| 21UL 236 | providedAmount = Some <| 120UL 237 | } 238 | test name 239 | begin order_take_modified_tx [XYZ_ASSET, 120UL] odata 240 | |> let oldOrderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 241 | let newOrderAsset = 242 | computeOrderAsset 243 | { odata with 244 | underlyingAmount = scale (100uy-p) odata.underlyingAmount 245 | orderTotal = scale (100uy-p) odata.orderTotal 246 | } 247 | |> Option.map Consensus.Asset.toString in 248 | should_FAIL_with "Incorrect requestedPayout" 249 | end 250 | 251 | let _ = 252 | let name = "take order 100 ZP -> 600 XYZ with 20% partial fill and wrong requested payout (not enough)" 253 | let maker = generatePublicKey() 254 | let taker = generatePublicKey() 255 | let p = 20uy 256 | let odata = { 257 | odataDefault with 258 | underlyingAsset = Some <| ZEN_ASSET 259 | underlyingAmount = Some <| 100UL 260 | pairAsset = Some <| XYZ_ASSET 261 | orderTotal = Some <| 600UL 262 | makerPubKey = Some <| maker 263 | nonce = Some <| 1UL 264 | returnAddress = Some <| taker 265 | requestedPayout = Some <| 19UL 266 | providedAmount = Some <| 120UL 267 | } 268 | test name 269 | begin order_take_modified_tx [XYZ_ASSET, 120UL] odata 270 | |> let oldOrderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 271 | let newOrderAsset = 272 | computeOrderAsset 273 | { odata with 274 | underlyingAmount = scale (100uy-p) odata.underlyingAmount 275 | orderTotal = scale (100uy-p) odata.orderTotal 276 | } 277 | |> Option.map Consensus.Asset.toString in 278 | should_FAIL_with "Incorrect requestedPayout" 279 | end 280 | 281 | let _ = 282 | let name = "take order 100 ZP -> 600 XYZ with 20% partial fill and wrong requested payout (0)" 283 | let maker = generatePublicKey() 284 | let taker = generatePublicKey() 285 | let p = 20uy 286 | let odata = { 287 | odataDefault with 288 | underlyingAsset = Some <| ZEN_ASSET 289 | underlyingAmount = Some <| 100UL 290 | pairAsset = Some <| XYZ_ASSET 291 | orderTotal = Some <| 600UL 292 | makerPubKey = Some <| maker 293 | nonce = Some <| 1UL 294 | returnAddress = Some <| taker 295 | requestedPayout = Some <| 0UL 296 | providedAmount = Some <| 120UL 297 | } 298 | test name 299 | begin order_take_modified_tx [XYZ_ASSET, 120UL] odata 300 | |> let oldOrderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 301 | let newOrderAsset = 302 | computeOrderAsset 303 | { odata with 304 | underlyingAmount = scale (100uy-p) odata.underlyingAmount 305 | orderTotal = scale (100uy-p) odata.orderTotal 306 | } 307 | |> Option.map Consensus.Asset.toString in 308 | should_FAIL_with "Could not parse RequestedPayout, or RequestedPayout was 0" 309 | end 310 | 311 | let _ = 312 | let name = "take order 100 ZP -> 600 XYZ with 20% partial fill and wrong requested payout (none)" 313 | let maker = generatePublicKey() 314 | let taker = generatePublicKey() 315 | let p = 20uy 316 | let odata = { 317 | odataDefault with 318 | underlyingAsset = Some <| ZEN_ASSET 319 | underlyingAmount = Some <| 100UL 320 | pairAsset = Some <| XYZ_ASSET 321 | orderTotal = Some <| 600UL 322 | makerPubKey = Some <| maker 323 | nonce = Some <| 1UL 324 | returnAddress = Some <| taker 325 | requestedPayout = None 326 | providedAmount = Some <| 120UL 327 | } 328 | test name 329 | begin order_take_modified_tx [XYZ_ASSET, 120UL] odata 330 | |> let oldOrderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 331 | let newOrderAsset = 332 | computeOrderAsset 333 | { odata with 334 | underlyingAmount = scale (100uy-p) odata.underlyingAmount 335 | orderTotal = scale (100uy-p) odata.orderTotal 336 | } 337 | |> Option.map Consensus.Asset.toString in 338 | should_FAIL_with "Could not parse RequestedPayout, or RequestedPayout was 0" 339 | end 340 | 341 | let _ = 342 | let name = "take order 100 ZP -> 600 XYZ - (SANITY CHECK! - for modified wallet)" 343 | let maker = generatePublicKey() 344 | let taker = generatePublicKey() 345 | let odata = { 346 | odataDefault with 347 | underlyingAsset = Some <| ZEN_ASSET 348 | underlyingAmount = Some <| 100UL 349 | pairAsset = Some <| XYZ_ASSET 350 | orderTotal = Some <| 600UL 351 | makerPubKey = Some <| maker 352 | nonce = Some <| 1UL 353 | returnAddress = Some <| taker 354 | providedAmount = Some <| 600UL 355 | } 356 | test name 357 | begin order_take_modified_wallet (odata.underlyingAmount, Some <| 0UL, Some <| 1UL) odata 358 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 359 | checkTx 360 | [ hasInput None odata.underlyingAsset odata.underlyingAmount 361 | ; hasOutput (lockPK taker) odata.underlyingAsset odata.underlyingAmount 362 | 363 | ; hasInput None odata.pairAsset odata.orderTotal 364 | ; hasOutput (lockPK maker) odata.pairAsset odata.orderTotal 365 | 366 | ; hasInput lockContract orderAsset (Some 1UL) 367 | ; hasOutput lockDestroy orderAsset (Some 1UL) 368 | ] 369 | end 370 | 371 | let _ = 372 | let name = "take order 100 ZP -> 600 XYZ - empty wallet" 373 | let maker = generatePublicKey() 374 | let taker = generatePublicKey() 375 | let odata = { 376 | odataDefault with 377 | underlyingAsset = Some <| ZEN_ASSET 378 | underlyingAmount = Some <| 100UL 379 | pairAsset = Some <| XYZ_ASSET 380 | orderTotal = Some <| 600UL 381 | makerPubKey = Some <| maker 382 | nonce = Some <| 1UL 383 | returnAddress = Some <| taker 384 | providedAmount = Some <| 600UL 385 | } 386 | test name 387 | begin order_take_modified_wallet (None, None, None) odata 388 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 389 | should_FAIL 390 | end 391 | 392 | let _ = 393 | let name = "take order 100 ZP -> 600 XYZ - not enough underlying in wallet" 394 | let maker = generatePublicKey() 395 | let taker = generatePublicKey() 396 | let odata = { 397 | odataDefault with 398 | underlyingAsset = Some <| ZEN_ASSET 399 | underlyingAmount = Some <| 100UL 400 | pairAsset = Some <| XYZ_ASSET 401 | orderTotal = Some <| 600UL 402 | makerPubKey = Some <| maker 403 | nonce = Some <| 1UL 404 | returnAddress = Some <| taker 405 | providedAmount = Some <| 600UL 406 | } 407 | test name 408 | begin order_take_modified_wallet (Some <| 99UL, Some <| 0UL, Some <| 1UL) odata 409 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 410 | should_FAIL 411 | end 412 | 413 | let _ = 414 | let name = "take order 100 ZP -> 600 XYZ - 0 order token in wallet" 415 | let maker = generatePublicKey() 416 | let taker = generatePublicKey() 417 | let odata = { 418 | odataDefault with 419 | underlyingAsset = Some <| ZEN_ASSET 420 | underlyingAmount = Some <| 100UL 421 | pairAsset = Some <| XYZ_ASSET 422 | orderTotal = Some <| 600UL 423 | makerPubKey = Some <| maker 424 | nonce = Some <| 1UL 425 | returnAddress = Some <| taker 426 | providedAmount = Some <| 600UL 427 | } 428 | test name 429 | begin order_take_modified_wallet (Some <| 100UL, Some <| 0UL, Some <| 0UL) odata 430 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 431 | should_FAIL 432 | end 433 | 434 | let _ = 435 | let name = "take order 100 ZP -> 600 XYZ - more than 1 order token" 436 | let maker = generatePublicKey() 437 | let taker = generatePublicKey() 438 | let odata = { 439 | odataDefault with 440 | underlyingAsset = Some <| ZEN_ASSET 441 | underlyingAmount = Some <| 100UL 442 | pairAsset = Some <| XYZ_ASSET 443 | orderTotal = Some <| 600UL 444 | makerPubKey = Some <| maker 445 | nonce = Some <| 1UL 446 | returnAddress = Some <| taker 447 | providedAmount = Some <| 600UL 448 | } 449 | test name 450 | begin order_take_modified_wallet (odata.underlyingAmount, Some <| 0UL, Some <| 5UL) odata 451 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 452 | checkTx 453 | [ hasInput None odata.underlyingAsset odata.underlyingAmount 454 | ; hasOutput (lockPK taker) odata.underlyingAsset odata.underlyingAmount 455 | 456 | ; hasInput None odata.pairAsset odata.orderTotal 457 | ; hasOutput (lockPK maker) odata.pairAsset odata.orderTotal 458 | 459 | ; hasInput lockContract orderAsset (Some 5UL) 460 | ; hasOutput lockContract orderAsset (Some 4UL) 461 | ; hasOutput lockDestroy orderAsset (Some 1UL) 462 | ] 463 | end 464 | 465 | let _ = 466 | let name = "take order 100 ZP -> 600 XYZ - wallet with surplus" 467 | let maker = generatePublicKey() 468 | let taker = generatePublicKey() 469 | let odata = { 470 | odataDefault with 471 | underlyingAsset = Some <| ZEN_ASSET 472 | underlyingAmount = Some <| 100UL 473 | pairAsset = Some <| XYZ_ASSET 474 | orderTotal = Some <| 600UL 475 | makerPubKey = Some <| maker 476 | nonce = Some <| 1UL 477 | returnAddress = Some <| taker 478 | providedAmount = Some <| 600UL 479 | } 480 | test name 481 | begin order_take_modified_wallet (Some <| 9100UL, Some <| 9000UL, Some <| 9001UL) odata 482 | |> let orderAsset = computeOrderAsset odata |> Option.map Consensus.Asset.toString in 483 | checkTx 484 | [ hasInput None odata.underlyingAsset (Some 9100UL) 485 | ; hasOutput (lockPK taker) odata.underlyingAsset (Some 100UL) 486 | ; hasOutput lockContract odata.underlyingAsset (Some 9000UL) 487 | 488 | ; hasInput None odata.pairAsset odata.orderTotal 489 | ; hasOutput (lockPK maker) odata.pairAsset odata.orderTotal 490 | 491 | ; hasInput lockContract orderAsset (Some 9001UL) 492 | ; hasOutput lockContract orderAsset (Some 9000UL) 493 | ; hasOutput lockDestroy orderAsset (Some 1UL) 494 | ] 495 | end 496 | 497 | 498 | 499 | 500 | for test in tests do 501 | match fst test.Value , snd test.Value with 502 | | name , Ok _ -> 503 | () 504 | | name , Error err -> 505 | failwithf "Test %s failed with: %s" name err -------------------------------------------------------------------------------- /Dex/doc/tex/RequestedPayoutIdentity.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zenprotocol/contracts/c7c0c5e2a9853088b3b65b1bc4ea9182f95c4be9/Dex/doc/tex/RequestedPayoutIdentity.png -------------------------------------------------------------------------------- /Dex/doc/tex/RequestedPayoutIdentity.tex: -------------------------------------------------------------------------------- 1 | &\texttt{RequestedPayout} = 2 | \left \lfloor 3 | {\texttt{UnderlyingAmount} \times \frac{\alpha}{\texttt{OrderTotal}}} 4 | \right \rfloor 5 | \\ 6 | \iff& \texttt{UnderlyingAmount} \times \frac{\alpha}{\texttt{OrderTotal}} - 1 7 | < \texttt{RequestedPayout} \leq 8 | \texttt{UnderlyingAmount} \times \frac{\alpha}{\texttt{OrderTotal}} 9 | \\ 10 | \iff& \texttt{UnderlyingAmount} \times \alpha - \texttt{OrderTotal} 11 | < \texttt{RequestedPayout} \times \texttt{OrderTotal} \leq 12 | \texttt{UnderlyingAmount} \times \alpha 13 | \\ 14 | \iff& \texttt{UnderlyingAmount} \times \alpha 15 | < \texttt{RequestedPayout} \times \texttt{OrderTotal} + \texttt{OrderTotal} \leq 16 | \texttt{UnderlyingAmount} \times \alpha + \texttt{OrderTotal} 17 | -------------------------------------------------------------------------------- /Empty/Empty.fst: -------------------------------------------------------------------------------- 1 | module Empty 2 | 3 | open Zen.Cost 4 | open Zen.Types 5 | 6 | module CR = Zen.ContractResult 7 | 8 | let main txSkel context contractId command sender messageBody w state = // 15 9 | CR.ofTxSkel txSkel 10 | 11 | val cf: 12 | txSkel : txSkeleton 13 | -> context : context 14 | -> command : string 15 | -> sender : sender 16 | -> messageBody: option data 17 | -> w : wallet 18 | -> state : option data 19 | -> nat `cost` 1 20 | let cf _ _ command _ _ w _ = 21 | ret (4 <: nat) -------------------------------------------------------------------------------- /Empty/README.md: -------------------------------------------------------------------------------- 1 | # Empty contract 2 | 3 | This contract simply takes a transaction and returns it without changing anything. 4 | 5 | Useful as a placeholder for the main and cost functions while writing contracts, allowing them to be verified before the actual main function is written. -------------------------------------------------------------------------------- /FixedPayout/FixedPayout.fst: -------------------------------------------------------------------------------- 1 | module FixedPayout 2 | 3 | open Zen.Base 4 | open Zen.Cost 5 | open Zen.Types 6 | open Zen.Data 7 | 8 | module U8 = FStar.UInt8 9 | module U64 = FStar.UInt64 10 | module RT = Zen.ResultT 11 | module Dict = Zen.Dictionary 12 | module Sha3 = Zen.Sha3 13 | module TX = Zen.TxSkeleton 14 | module CR = Zen.ContractResult 15 | module Asset = Zen.Asset 16 | module Opt = Zen.Option 17 | module OptT = Zen.OptionT 18 | module Array = Zen.Array 19 | module Str = FStar.String 20 | module CId = Zen.ContractId 21 | module Merkle = Zen.MerkleTree 22 | module W = Zen.Wallet 23 | module PK = Zen.PublicKey 24 | 25 | 26 | 27 | let auditPathMaxLength : nat = 30 28 | 29 | type parser (a:Type) (m:nat) = 30 | option (Dict.t data) -> result a `cost` m 31 | 32 | type hashUpdate (a:Type) (m:nat) = 33 | a -> Sha3.t -> Sha3.t `cost` m 34 | 35 | type ticker = 36 | s:string { Str.length s <= 4 } 37 | 38 | type preAuditPath = 39 | p: list data { length p <= auditPathMaxLength } 40 | 41 | type auditPath = 42 | p: list hash { length p <= auditPathMaxLength } 43 | 44 | type commit = { 45 | c_root : hash; 46 | c_timestamp : timestamp; 47 | } 48 | 49 | type attestation = { 50 | commit : commit; 51 | pubKey : publicKey; 52 | } 53 | 54 | type position = 55 | | Bull 56 | | Bear 57 | 58 | type betEvent = { 59 | oraclePubKey : publicKey; 60 | oracleContractId : contractId; 61 | ticker : ticker; 62 | price : U64.t; 63 | start : U64.t; 64 | expiry : option U64.t; 65 | collateral : asset; 66 | } 67 | 68 | type bet = { 69 | bevent : betEvent; 70 | position : position; 71 | } 72 | 73 | type proof = { 74 | key : ticker; 75 | value : U64.t; 76 | root : hash; 77 | auditPath : auditPath; 78 | index : U64.t; 79 | } 80 | 81 | type redemption = { 82 | bet : bet; 83 | attestation : attestation; 84 | timestamp : timestamp; 85 | proof : proof; 86 | } 87 | 88 | 89 | 90 | (* 91 | ------------------------------------------------------------------------------- 92 | ========== UTILITY FUNCTIONS ================================================== 93 | ------------------------------------------------------------------------------- 94 | *) 95 | 96 | let runOpt (#a #s:Type) (#m:nat) (update:a -> s -> s `cost` m) (x:option a) (st:s) : s `cost` (m + 5) = 97 | Opt.maybe (incRet m) update x st 98 | 99 | val lockToSender: asset -> U64.t -> sender -> txSkeleton -> result txSkeleton `cost` 624 100 | let lockToSender asset amount sender txSkel = // 14 101 | match sender with 102 | | PK pk -> 103 | ret txSkel 104 | >>= TX.lockToPublicKey asset amount pk // 610 105 | >>= RT.ok 106 | | Contract cid -> 107 | ret txSkel 108 | >>= TX.lockToContract asset amount cid // 64 109 | >>= RT.incOK 546 110 | | Anonymous -> 111 | RT.incFailw 610 "Sender can't be anonymous" 112 | 113 | 114 | 115 | (* 116 | ------------------------------------------------------------------------------- 117 | ========== DATA PARSING ======================================================= 118 | ------------------------------------------------------------------------------- 119 | *) 120 | 121 | val parseDict: option data -> result (option (Dict.t data)) `cost` 15 122 | let parseDict data = // 11 123 | match data with 124 | | Some data -> 125 | data 126 | |> tryDict // 4 127 | |> RT.ofOptionT "Data parsing failed - the message body isn't a dictionary" 128 | |> RT.map Some 129 | | None -> 130 | RT.incFailw 4 "Data parsing failed - the message body is empty" 131 | 132 | val parseField (#a:Type) (#m:nat) 133 | : (data -> option a `cost` m) 134 | -> fieldName:string 135 | -> errMsg:string 136 | -> option (Dict.t data) 137 | -> result a `cost` (m + 75) 138 | let parseField #_ #_ parser fieldName errMsg dict = // 11 139 | let! value = dict >!= Dict.tryFind fieldName >?= parser in // (m + 64) 140 | match value with 141 | | Some value -> 142 | RT.ok value 143 | | None -> 144 | RT.failw errMsg 145 | 146 | val parseOptField (#a:Type) (#m:nat) 147 | : (data -> option a `cost` m) 148 | -> fieldName:string 149 | -> option (Dict.t data) 150 | -> result (option a) `cost` (m + 71) 151 | let parseOptField #_ #_ parser fieldName dict = // 7 152 | dict 153 | >!= Dict.tryFind fieldName // 64 154 | >?= parser // m 155 | >>= RT.ok 156 | 157 | val parseTicker: string -> string -> option (Dict.t data) -> result ticker `cost` 90 158 | let parseTicker fieldName errMsg dict = // 6 159 | let open RT in 160 | parseField tryString fieldName errMsg dict >>= // 77 161 | begin fun s -> // 7 162 | if Str.length s <= 4 163 | then RT.ok (s <: ticker) 164 | else RT.failw "Ticker size can't be bigger than 4" 165 | end 166 | 167 | val extractHashes: string -> ls:list data -> result (ls':list hash { length ls' == length ls }) `cost` (length ls * (2 + 20) + 20 + 5) 168 | let extractHashes errMsg ls = // 5 169 | OptT.tryMapT tryHash ls // (length ls * 22 + 20) 170 | |> RT.ofOptionT errMsg 171 | 172 | val extractAuditPath': ls:preAuditPath -> result auditPath `cost` (length ls * 22 + 29) 173 | let extractAuditPath' ls = // 4 174 | let open RT in 175 | extractHashes "All the items in the audit path must be hashes" ls // = X * 22 + 25 176 | $> (fun xs -> let (xs:list hash { length xs <= auditPathMaxLength }) = xs in xs) 177 | 178 | val extractAuditPath: ls:preAuditPath 179 | -> result auditPath `cost` (auditPathMaxLength * 22 + 40) 180 | let extractAuditPath (ls:preAuditPath) = 181 | extractAuditPath' ls 182 | |> inc ((auditPathMaxLength - length ls) * 22) 183 | |> (fun x -> x <: result auditPath `cost` (auditPathMaxLength * 22 + 29)) 184 | 185 | val parsePreAuditPath: string -> string -> option (Dict.t data) -> result preAuditPath `cost` 92 186 | let parsePreAuditPath fieldName errMsg dict = // 6 187 | let open RT in 188 | parseField tryList fieldName errMsg dict >>= // 79 189 | begin fun ls -> // 7 190 | if length ls <= auditPathMaxLength 191 | then RT.ok (ls <: preAuditPath) 192 | else RT.failw "AuditPath length must be 256" 193 | end 194 | 195 | val parseAuditPath: string -> string -> option (Dict.t data) 196 | -> result auditPath `cost` (auditPathMaxLength * 22 + 139) 197 | let parseAuditPath fieldName errMsg dict = // 7 198 | let open RT in 199 | ret dict 200 | >>= parsePreAuditPath fieldName errMsg // 92 201 | >>= extractAuditPath // (length ls * 22 + 25 + (auditPathMaxLength - length ls) * 22 + 12) 202 | 203 | val parsePosition: string -> string -> option (Dict.t data) -> result position `cost` 87 204 | let parsePosition fieldName errMsg dict = // 6 205 | let open RT in 206 | parseField tryString fieldName errMsg dict >>= // 77 207 | begin fun s -> match s with // 4 208 | | "Bull" -> ret Bull 209 | | "Bear" -> ret Bear 210 | | _ -> RT.failw "Position must be either Bull or Bear" 211 | end 212 | 213 | val parseContractId: string -> string -> option (Dict.t data) -> result contractId `cost` 158 214 | let parseContractId fieldName errMsg dict = // 6 215 | let open RT in 216 | parseField tryString fieldName errMsg dict >>= // 77 217 | begin fun s -> // 11 218 | if Str.length s = 72 219 | then 220 | let (s:string { Str.length s = 72 }) = s in 221 | s 222 | |> CId.parse // 64 223 | |> RT.ofOptionT "The given OracleContractId is not a valid contractId" 224 | else 225 | RT.incFailw 64 "OracleContractId must be 72 characters long" 226 | end 227 | 228 | val parseAsset: string -> string -> option (Dict.t data) -> result asset `cost` 150 229 | let parseAsset fieldName errMsg dict = // 5 230 | let open RT in 231 | parseField tryString fieldName errMsg dict >>= // 73 232 | begin 233 | Asset.parse // 64 234 | >> RT.ofOptionT "The given asset is not a valid asset" 235 | end 236 | 237 | val getTimestamp : parser U64.t 82 238 | val getRoot : parser hash 82 239 | val getOraclePubKey : parser publicKey 82 240 | val getTicker : parser ticker 94 241 | val getPrice : parser U64.t 82 242 | val getStart : parser U64.t 82 243 | val getExpiry : parser (option U64.t) 77 244 | val getAuditPath : parser auditPath (auditPathMaxLength * 22 + 139 + 4) 245 | val getValue : parser U64.t 82 246 | val getIndex : parser U64.t 82 247 | val getPosition : parser position 91 248 | val getOracleContractId : parser contractId 162 249 | val getCollateral : parser asset 154 250 | 251 | let getTimestamp dict = dict |> 252 | parseField tryU64 "Timestamp" "Could not parse Timestamp" 253 | let getRoot dict = dict |> 254 | parseField tryHash "Root" "Could not parse Root" 255 | let getOraclePubKey dict = dict |> 256 | parseField tryPublicKey "OraclePubKey" "Could not parse OraclePubKey" 257 | let getTicker dict = dict |> 258 | parseTicker "Ticker" "Could not parse Ticker" 259 | let getPrice dict = dict |> 260 | parseField tryU64 "Price" "Could not parse Price" 261 | let getStart dict = dict |> 262 | parseField tryU64 "Start" "Could not parse Start" 263 | let getExpiry dict = dict |> 264 | parseOptField tryU64 "Expiry" 265 | let getAuditPath dict = dict |> 266 | parseAuditPath "AuditPath" "Could not parse AuditPath" 267 | let getValue dict = dict |> 268 | parseField tryU64 "Value" "Could not parse Value" 269 | let getIndex dict = dict |> 270 | parseField tryU64 "Index" "Could not parse Index" 271 | let getPosition dict = dict |> 272 | parsePosition "Position" "Could not parse Position" 273 | let getOracleContractId dict = dict |> 274 | parseContractId "OracleContractId" "Could not parse OracleContractId" 275 | let getCollateral dict = dict |> 276 | parseAsset "Collateral" "Could not parse Collateral" 277 | 278 | val parseProof': option (Dict.t data) 279 | -> result proof `cost` (94 + (auditPathMaxLength * 22 + 415)) 280 | let parseProof' dict = // 31 281 | let open RT in 282 | dict |> getTicker >>= (fun key -> // 94 283 | dict |> getValue >>= (fun value -> // 82 284 | dict |> getRoot >>= (fun root -> // 82 285 | dict |> getAuditPath >>= (fun auditPath -> // auditPathMaxLength * 22 + 139 + 4 286 | dict |> getIndex >>= (fun index -> // 82 287 | RT.ok ({ 288 | key = key; 289 | value = value; 290 | root = root; 291 | auditPath = auditPath; 292 | index = index; 293 | })))))) 294 | 295 | val parseProof: option (Dict.t data) 296 | -> result proof `cost` (auditPathMaxLength * 22 + 512) 297 | let parseProof dict = 298 | parseProof' dict 299 | |> (fun x -> x <: result proof `cost` (auditPathMaxLength * 22 + 509)) 300 | 301 | val parseCommit: option (Dict.t data) -> result commit `cost` 175 302 | let parseCommit dict = // 11 303 | let open RT in 304 | dict |> getRoot >>= (fun root -> // 82 305 | dict |> getTimestamp >>= (fun timestamp -> // 82 306 | RT.ok ({ 307 | c_root = root; 308 | c_timestamp = timestamp; 309 | }))) 310 | 311 | val parseAttestation: option (Dict.t data) -> result attestation `cost` 268 312 | let parseAttestation dict = // 11 313 | let open RT in 314 | dict |> parseCommit >>= (fun commit -> // 175 315 | dict |> getOraclePubKey >>= (fun pubKey -> // 82 316 | RT.ok ({ 317 | commit = commit; 318 | pubKey = pubKey; 319 | }))) 320 | 321 | val parseEvent: option (Dict.t data) -> result betEvent `cost` 769 322 | let parseEvent dict = // 36 323 | let open RT in 324 | dict |> getOraclePubKey >>= (fun oraclePubKey -> // 82 325 | dict |> getOracleContractId >>= (fun oracleContractId -> // 162 326 | dict |> getTicker >>= (fun ticker -> // 94 327 | dict |> getPrice >>= (fun price -> // 82 328 | dict |> getStart >>= (fun start -> // 82 329 | dict |> getExpiry >>= (fun expiry -> // 77 330 | dict |> getCollateral >>= (fun collateral -> // 154 331 | RT.ok ({ 332 | oraclePubKey = oraclePubKey; 333 | oracleContractId = oracleContractId; 334 | ticker = ticker; 335 | price = price ; 336 | start = start; 337 | expiry = expiry; 338 | collateral = collateral; 339 | })))))))) 340 | 341 | val parseRedemption': option (Dict.t data) -> result redemption `cost` (1051 + (auditPathMaxLength * 22 + 698)) 342 | let parseRedemption' dict = // 22 343 | let open RT in 344 | dict |> parseEvent >>= (fun bevent -> // 769 345 | dict |> getPosition >>= (fun position -> // 91 346 | dict |> parseAttestation >>= (fun attestation -> // 262 347 | dict |> getTimestamp >>= (fun timestamp -> // 82 348 | dict |> parseProof >>= (fun proof -> // (auditPathMaxLength * 22 + 512) 349 | RT.ok ({ 350 | bet = { 351 | bevent = bevent; 352 | position = position; 353 | }; 354 | attestation = attestation; 355 | timestamp = timestamp; 356 | proof = proof; 357 | })))))) 358 | 359 | val parseRedemption: option (Dict.t data) -> result redemption `cost` (auditPathMaxLength * 22 + 1752) 360 | let parseRedemption dict = // 3 361 | parseRedemption' dict 362 | |> (fun x -> x <: result redemption `cost` (auditPathMaxLength * 22 + 1749)) 363 | 364 | 365 | 366 | (* 367 | ------------------------------------------------------------------------------- 368 | ========== TOKENIZATION ======================================================= 369 | ------------------------------------------------------------------------------- 370 | *) 371 | 372 | val updatePublicKey : hashUpdate publicKey 517 373 | let updatePublicKey pk s = // 7 374 | let! cpk = PK.compress pk in // 305 375 | ret s 376 | >>= Sha3.updateCPK cpk // 205 377 | 378 | // Sha3.updateString with a constant cost 379 | val updateTicker : hashUpdate ticker 36 380 | let updateTicker tick s = // 12 381 | ret s 382 | >>= Sha3.updateString tick // (6 * Str.length tick) 383 | >>= incRet (6 * (4 - Str.length tick)) 384 | 385 | val updateEvent : hashUpdate betEvent 1339 386 | let updateEvent bevent s = // 30 387 | ret s 388 | >>= updatePublicKey bevent.oraclePubKey // 517 389 | >>= Sha3.updateContractId bevent.oracleContractId // 223 390 | >>= updateTicker bevent.ticker // 36 391 | >>= Sha3.updateU64 bevent.price // 48 392 | >>= Sha3.updateU64 bevent.start // 48 393 | >>= Sha3.updateU64 `runOpt` bevent.expiry // 53 394 | >>= Sha3.updateAsset bevent.collateral // 384 395 | 396 | val updatePosition : hashUpdate position 28 397 | let updatePosition position s = // 4 398 | match position with 399 | | Bull -> Sha3.updateString "Bull" s // 24 400 | | Bear -> Sha3.updateString "Bear" s // 24 401 | 402 | val hashCommit : commit -> hash `cost` 271 403 | let hashCommit commit = // 11 404 | ret Sha3.empty 405 | >>= Sha3.updateHash commit.c_root // 192 406 | >>= Sha3.updateU64 commit.c_timestamp // 48 407 | >>= Sha3.finalize // 20 408 | 409 | val hashCommitment : attestation -> hash `cost` 1014 410 | let hashCommitment attestation = // 14 411 | let! commitHash = hashCommit attestation.commit in // 271 412 | ret Sha3.empty 413 | >>= Sha3.updateHash commitHash // 192 414 | >>= updatePublicKey attestation.pubKey // 517 415 | >>= Sha3.finalize // 20 416 | 417 | val hashAttestation : attestation -> hash `cost` 1235 418 | let hashAttestation attestation = // 9 419 | let! commit = hashCommitment attestation in // 1014 420 | ret Sha3.empty 421 | >>= Sha3.updateHash commit // 192 422 | >>= Sha3.finalize // 20 423 | 424 | val hashBet : bet -> hash `cost` 1398 425 | let hashBet bet = // 11 426 | ret Sha3.empty 427 | >>= updateEvent bet.bevent // 1339 428 | >>= updatePosition bet.position // 28 429 | >>= Sha3.finalize // 20 430 | 431 | val mkBetToken : contractId -> bet -> asset `cost` 1405 432 | let mkBetToken (v, h) bet = // 7 433 | let! betHash = hashBet bet in 434 | ret (v, h, betHash) 435 | 436 | val mkAttestToken : contractId -> attestation -> asset `cost` 1242 437 | let mkAttestToken (v,h) attestation = // 7 438 | let! attestHash = hashAttestation attestation in // 1235 439 | ret (v, h, attestHash) 440 | 441 | 442 | 443 | (* 444 | ------------------------------------------------------------------------------- 445 | ========== VALIDATION ========================================================= 446 | ------------------------------------------------------------------------------- 447 | *) 448 | 449 | val inBounds : U64.t -> option U64.t -> U64.t -> bool `cost` 10 450 | let inBounds low high value = 451 | (low `U64.lte` value && Opt.maybe true (U64.lte value) high) 452 | |> ret 453 | 454 | val validateTime: redemption -> result redemption `cost` 24 455 | let validateTime redemption = // 14 456 | let bevent = redemption.bet.bevent in 457 | let low = bevent.start in 458 | let high = bevent.expiry in 459 | let value = redemption.timestamp in 460 | let! inb = inBounds low high value in // 10 461 | if inb 462 | then RT.ok redemption 463 | else RT.failw "Attestation time is not within the given time bounds" 464 | 465 | val validatePrice: redemption -> result redemption `cost` 17 466 | let validatePrice redemption = // 17 467 | let bevent = redemption.bet.bevent in 468 | let price = bevent.price in 469 | let value = redemption.proof.value in 470 | let pos = redemption.bet.position in 471 | match price `U64.lte` value, pos with 472 | | true , Bull 473 | | false, Bear -> 474 | RT.ok redemption 475 | | _ -> 476 | RT.failw "Position doesn't match the event" 477 | 478 | val hashLeaf : key:ticker -> U64.t -> hash `cost` 111 479 | let hashLeaf (key : ticker) (value : U64.t) = // 19 480 | ret Sha3.empty 481 | >>= Sha3.updateString key // 6 * 4 482 | >>= Sha3.updateU64 value // 48 483 | >>= Sha3.finalize // 20 484 | |> inc (24 - 6 * Str.length key) 485 | |> (fun x -> x <: hash `cost` 92) 486 | 487 | val verifyAuditPath' : proof:proof 488 | -> bool `cost` (111 + (length proof.auditPath * 420 + 4 + (auditPathMaxLength * 420 - length proof.auditPath * 420)) + 25) 489 | let verifyAuditPath' proof = // 14 490 | let! leaf = hashLeaf proof.key proof.value in // 111 491 | Merkle.verify proof.root proof.auditPath (U64.v proof.index) leaf // (length proof.auditPath * 420 + 4) 492 | |> inc (auditPathMaxLength * 420 - length proof.auditPath * 420) 493 | 494 | val verifyAuditPath : proof:proof -> bool `cost` (auditPathMaxLength * 420 + 143) 495 | let verifyAuditPath proof = // 3 496 | verifyAuditPath' proof 497 | |> (fun x -> x <: bool `cost` (auditPathMaxLength * 420 + 140)) 498 | 499 | val validateAuditPath: redemption -> result redemption `cost` (auditPathMaxLength * 420 + 151) 500 | let validateAuditPath redemption = // 8 501 | let! b = verifyAuditPath redemption.proof in // (auditPathMaxLength * 420 + 143) 502 | if b 503 | then RT.ok redemption 504 | else RT.failw "Invalid audit path" 505 | 506 | val validateRedemption: redemption -> result redemption `cost` (auditPathMaxLength * 420 + 199) 507 | let validateRedemption redemption = // 7 508 | let open RT in 509 | ret redemption 510 | >>= validateTime // 24 511 | >>= validatePrice // 17 512 | >>= validateAuditPath // (auditPathMaxLength * 420 + 151) 513 | 514 | 515 | 516 | (* 517 | ------------------------------------------------------------------------------- 518 | ========== COMMAND: Issue ==================================================== 519 | ------------------------------------------------------------------------------- 520 | *) 521 | 522 | val issueEvent: txSkeleton -> contractId -> sender -> betEvent -> CR.t `cost` 4369 523 | let issueEvent txSkel contractId sender bevent = // 52 524 | let! bullToken = mkBetToken contractId ({ bevent=bevent; position=Bull }) in // 1405 525 | let! bearToken = mkBetToken contractId ({ bevent=bevent; position=Bear }) in // 1405 526 | let! m = TX.getAvailableTokens bevent.collateral txSkel in // 64 527 | let open RT in 528 | ret txSkel 529 | >>= (TX.safeMint m bullToken >> ofOptionT "No collateral provided") // 64 530 | >>= (TX.safeMint m bearToken >> ofOptionT "No collateral provided") // 64 531 | >>= lockToSender bullToken m sender // 624 532 | >>= lockToSender bearToken m sender // 624 533 | >>= (TX.lockToContract bevent.collateral m contractId >> liftCost) // 64 534 | >>= CR.ofTxSkel // 3 535 | 536 | val issue: txSkeleton -> contractId -> sender -> option data -> CR.t `cost` 5163 537 | let issue txSkel contractId sender dict = // 10 538 | let open RT in 539 | ret dict 540 | >>= parseDict // 15 541 | >>= parseEvent // 769 542 | >>= issueEvent txSkel contractId sender // 4369 543 | 544 | 545 | 546 | (* 547 | ------------------------------------------------------------------------------- 548 | ========== COMMAND: Redeem ==================================================== 549 | ------------------------------------------------------------------------------- 550 | *) 551 | 552 | val redeemRedemption' : 553 | (w:wallet) 554 | -> txSkeleton 555 | -> contractId 556 | -> sender 557 | -> redemption 558 | -> CR.t `cost` (1405 + (1242 + (64 + (0 + 64 + (Zen.Wallet.size w * 128 + 192) + 624 + (Zen.Wallet.size w * 128 + 192) + 64 + 3))) + 62) 559 | let redeemRedemption' w txSkel contractId sender redemption = // 62 560 | let! betToken = mkBetToken contractId redemption.bet in // 1405 561 | let oracleContractId = redemption.bet.bevent.oracleContractId in 562 | let attestation = redemption.attestation in 563 | let! attestToken = mkAttestToken oracleContractId attestation in // 1242 564 | let! m = TX.getAvailableTokens betToken txSkel in // 64 565 | let open RT in 566 | ret txSkel 567 | >>= (liftCost << TX.destroy m betToken) // 64 568 | >>= (ofOptionT "Insufficient funds" << TX.fromWallet redemption.bet.bevent.collateral m contractId w) // W.size w * 128 + 192 569 | >>= lockToSender redemption.bet.bevent.collateral m sender // 624 570 | >>= (ofOptionT "Attestation token not found" << TX.fromWallet attestToken 1UL contractId w) // W.size wallet * 128 + 192 571 | >>= (liftCost << TX.lockToContract attestToken 1UL contractId) // 64 572 | >>= CR.ofTxSkel // 3 573 | 574 | val redeemRedemption: (w:wallet) -> txSkeleton -> contractId -> sender -> redemption 575 | -> CR.t `cost` (W.size w * 256 + 3919) 576 | let redeemRedemption w txSkel contractId sender redemption = // 7 577 | redeemRedemption' w txSkel contractId sender redemption 578 | |> (fun x -> x <: CR.t `cost` (W.size w * 256 + 3912)) 579 | 580 | val redeem' : 581 | (w:wallet) 582 | -> txSkeleton 583 | -> contractId 584 | -> sender 585 | -> option data 586 | -> CR.t `cost` (0 + 15 + (auditPathMaxLength * 22 + 1752) + (auditPathMaxLength * 420 + 199) + (W.size w * 256 + 3919) + 13) 587 | let redeem' w txSkel contractId sender dict = // 13 588 | let open RT in 589 | ret dict 590 | >>= parseDict // 15 591 | >>= parseRedemption // (auditPathMaxLength * 22 + 1752) 592 | >>= validateRedemption // (auditPathMaxLength * 420 + 199) 593 | >>= redeemRedemption w txSkel contractId sender // (W.size w * 256 + 3919) 594 | 595 | val redeem: (w:wallet) -> txSkeleton -> contractId -> sender 596 | -> option data -> CR.t `cost` (auditPathMaxLength * 442 + W.size w * 256 + 5905) 597 | let redeem w txSkel contractId sender dict = // 7 598 | redeem' w txSkel contractId sender dict 599 | |> (fun x -> x <: CR.t `cost` (auditPathMaxLength * 442 + W.size w * 256 + 5898)) 600 | 601 | 602 | 603 | (* 604 | ------------------------------------------------------------------------------- 605 | ========== COMMAND: Cancel ==================================================== 606 | ------------------------------------------------------------------------------- 607 | *) 608 | 609 | val cancelEqualTokens : 610 | contractId 611 | -> (w : wallet) 612 | -> sender 613 | -> U64.t 614 | -> asset 615 | -> asset 616 | -> txSkeleton 617 | -> betEvent 618 | -> txSkeleton `RT.t` (0 + (W.size w * 128 + 192) + 624 + 64 + 64 + 29) 619 | let cancelEqualTokens contractId w sender m bullToken bearToken txSkel bevent = // 29 620 | let open RT in 621 | ret txSkel 622 | >>= (ofOptionT "Insufficient funds" << TX.fromWallet bevent.collateral m contractId w) // W.size w * 128 + 192 623 | >>= lockToSender bevent.collateral m sender // 624 624 | >>= (liftCost << TX.destroy m bullToken) // 64 625 | >>= (liftCost << TX.destroy m bearToken) // 64 626 | 627 | val cancelEvent': 628 | (w : wallet) 629 | -> contractId 630 | -> sender 631 | -> txSkeleton 632 | -> betEvent 633 | -> CR.t `cost` (1405 + (1405 + (64 + (64 + (0 + (W.size w * 128 + 192) + 624 + 64 + 64 + 29 + 3)))) + 45) 634 | let cancelEvent' w contractId sender txSkel bevent = // 45 635 | let! bullToken = mkBetToken contractId ({ bevent=bevent; position=Bull }) in // 1405 636 | let! bearToken = mkBetToken contractId ({ bevent=bevent; position=Bear }) in // 1405 637 | let! mBull = TX.getAvailableTokens bullToken txSkel in // 64 638 | let! mBear = TX.getAvailableTokens bearToken txSkel in // 64 639 | let open RT in 640 | begin if U64.eq mBull mBear then 641 | cancelEqualTokens contractId w sender mBull bullToken bearToken txSkel bevent // (0 + (W.size w * 128 + 192) + 624 + 64 + 64 + 29) 642 | else 643 | "There must be an equal amount of both bull and bear tokens in the transaction" 644 | |> incFailw (0 + (W.size w * 128 + 192) + 624 + 64 + 64 + 29) 645 | end 646 | >>= CR.ofTxSkel // 3 647 | 648 | val cancelEvent: 649 | (w : wallet) 650 | -> contractId 651 | -> sender 652 | -> txSkeleton 653 | -> betEvent 654 | -> CR.t `cost` (W.size w * 128 + 3966) 655 | let cancelEvent w contractId sender txSkel bevent = // 7 656 | cancelEvent' w contractId sender txSkel bevent 657 | |> (fun x -> x <: CR.t `cost` (W.size w * 128 + 3959)) 658 | 659 | val cancel' : 660 | (w : wallet) 661 | -> contractId 662 | -> sender 663 | -> txSkeleton 664 | -> option data 665 | -> CR.t `cost` (0 + 15 + 769 + (W.size w * 128 + 3966) + 11) 666 | let cancel' w contractId sender txSkel dict = // 11 667 | let open RT in 668 | ret dict 669 | >>= parseDict // 15 670 | >>= parseEvent // 769 671 | >>= cancelEvent w contractId sender txSkel // (W.size w * 128 + 3966) 672 | 673 | val cancel : 674 | (w : wallet) 675 | -> contractId 676 | -> sender 677 | -> txSkeleton 678 | -> option data 679 | -> CR.t `cost` (W.size w * 128 + 4768) 680 | let cancel w contractId sender txSkel dict = // 7 681 | cancel' w contractId sender txSkel dict 682 | |> (fun x -> x <: CR.t `cost` (W.size w * 128 + 4761)) 683 | 684 | 685 | 686 | (* 687 | ------------------------------------------------------------------------------- 688 | ========== MAIN =============================================================== 689 | ------------------------------------------------------------------------------- 690 | *) 691 | 692 | val main: 693 | txSkel : txSkeleton 694 | -> context : context 695 | -> contractId : contractId 696 | -> command : string 697 | -> sender : sender 698 | -> messageBody : option data 699 | -> w : wallet 700 | -> state : option data 701 | -> CR.t `cost` ( 702 | match command with 703 | | "Issue" -> 704 | 5163 + 9 705 | | "Redeem" -> 706 | auditPathMaxLength * 442 + W.size w * 256 + 5905 + 9 707 | | "Cancel" -> 708 | W.size w * 128 + 4768 + 9 709 | | _ -> 710 | 9) 711 | let main txSkel context contractId command sender messageBody w state = // 9 712 | match command with 713 | | "Issue" -> 714 | issue txSkel contractId sender messageBody // 5163 715 | <: CR.t `cost` ( 716 | match command with 717 | | "Issue" -> 718 | 5163 719 | | "Redeem" -> 720 | auditPathMaxLength * 442 + W.size w * 256 + 5905 721 | | "Cancel" -> 722 | W.size w * 128 + 4768 723 | | _ -> 724 | 0) 725 | | "Redeem" -> 726 | redeem w txSkel contractId sender messageBody // auditPathMaxLength * 442 + W.size w * 256 + 5905 727 | | "Cancel" -> 728 | cancel w contractId sender txSkel messageBody // W.size w * 128 + 4768 729 | | _ -> 730 | RT.failw "Unsupported command" 731 | 732 | val cf: 733 | txSkel : txSkeleton 734 | -> context : context 735 | -> command : string 736 | -> sender : sender 737 | -> messageBody: option data 738 | -> w : wallet 739 | -> state : option data 740 | -> nat `cost` 17 741 | let cf _ _ command _ _ w _ = 742 | (( 743 | match command with 744 | | "Issue" -> 745 | 5163 + 9 746 | | "Redeem" -> 747 | auditPathMaxLength * 442 + W.size w * 256 + 5905 + 9 748 | | "Cancel" -> 749 | W.size w * 128 + 4768 + 9 750 | | _ -> 751 | 9 752 | ) <: nat) |> ret 753 | 754 | 755 | -------------------------------------------------------------------------------- /FixedPayout/README.md: -------------------------------------------------------------------------------- 1 | # Fixed Payout 2 | 3 | ## Verify/Build 4 | 5 | To verify/record hints, run `zebra e --z3rlimit 30000000 FixedPayout.fst`. 6 | This command may take a long time to run the first time, subsequent runs will be significantly faster. 7 | The elaborated source file will be created in the `output` directory. 8 | 9 | To build, run `zebra c --z3rlimit 30000000 FixedPayout.fst`. 10 | Both the elaborated source file and the compiled binary (`.dll`) file will be created in the `output` directory. 11 | 12 | ## How it works 13 | 14 | This contract assumes there is a working oracle service and an oracle contract which commits on a data set of `` pairs on different times. 15 | 16 | The Fixed Payout contract can issue Bull and Bear positions on one of the tickers on which the oracle commits for a future event, and provides the winner with the collateral payed by the issuer. 17 | 18 | First - the issuer issues **position tokens** for both positions, derived from the public key of the oracle service, the contract ID of the oracle contract, the name of the forex ticker, the time frame in which the event will take place, the price on which the positions diverge, and the position name. 19 | 20 | The contract issues two position tokens, according to the possible positions: 21 | 22 | 1. Bull - which believes the price will be **above** or **equal to** the specified price during the specified time frame. 23 | 2. Bear - which believes the price will be **below** the specified price during the specified time frame. 24 | 25 | Both of the tokens (issued by the same amount as the collateral) are sent to the issuer at the time of the issuing. 26 | 27 | The issuer will hold the position they believe in and sell the other tokens, the buyers will hold the opposite position, then they will both wait until the event date will occur. 28 | 29 | Once the event for which the position was issued has occurred, and the oracle has committed on the event data, the rightful redeemers must ask the oracle service to provide the proof data (which contains the timestamp, the value of the asset at the time of the commitment, the root of the Merkle tree of the committed data set, the audit path of the `` pair within the Merkle tree, the index of the `` within the leaves array of the Merkle tree, and the parameters of the Merkle tree), and the oracle contract has to attest for the global proof data (the timestamp, the root of the Merkle tree, and the oracle service public key), which would send the Fixed Payout contract an **attestation token** which will give the redeemer the right for the collateral when found in the wallet of the Fixed Payout contract, since the attestation token is the embodiment of the attestation of the oracle on the occurrence and details of the event. 30 | 31 | If the specified redemption data fits both the given attestation token (which guarantees the occurrence of the event) and the position of the given position token (which guarantees the right of the redeemer for the collateral) - the contract will send the redeemer a portion of the collateral equal to the number of winning position tokens provided. 32 | 33 | ## Usage 34 | 35 | The Fixed Payout contract accepts 3 commands: 36 | 37 | 1. `"Issue"` 38 | 2. `"Redeem"` 39 | 3. `"Cancel"` 40 | 41 | ### `"Issue"` 42 | 43 | To issue new position tokens - execute the contract with the `"Issue"` command while providing it with a dictionary in the message body which contains the following data: 44 | 45 | | Field Name | Type | Description 46 | |:--------------------:|:------------------:| ----------- 47 | | `"OraclePubKey"` | `publicKey` | Public key of the oracle service 48 | | `"OracleContractId"` | `contractId` | Contract ID of the oracle contract 49 | | `"Ticker"` | `String` | Name of the forex ticker 50 | | `"Price"` | `UInt64` | Lowest price for the Bull position and the highest for the Bear position 51 | | `"Start"` | `UInt64` | Beginning of the time frame in which the event will take place 52 | | `"Expiry"` | `UInt64` | End of the time frame in which the event will take place (optional) 53 | | `"Collateral"` | `String` | Collateral asset (as an asset string) 54 | 55 | The contract will lock to itself all the collateral tokens (of the asset defined in the `"Collateral"` field in the message body) which were provided to it in the TX by the issuer, and will mint and lock to the issuer the same amount of position tokens of both kinds (so if the issuer supplies the contract with `m` collateral tokens - the contract will mint and lock to the issuer `m` Bear tokens and `m` Bull tokens based on the event). 56 | 57 | Diagrammatically it looks like this: 58 | 59 | ``` 60 | Collateral × m 61 | Issuer ---------------------------------------------------------------> Contract 62 | data = 63 | 64 | [[ data ; "Bull" ]] × m + [[ data ; "Bear" ]] × m 65 | Contract |------------------------------------------------------------> Issuer 66 | 67 | ``` 68 | 69 | ### `"Redeem"` 70 | 71 | To redeem a position token - execute the contract with the `"Redeem"` command while providing it with a dictionary in the message body which contains the following data: 72 | 73 | | Field Name | Type | Description 74 | |:--------------------:|:------------------:| ----------- 75 | | `"OraclePubKey"` | `publicKey` | Public key of the oracle service 76 | | `"OracleContractId"` | `contractId` | Contract ID of the oracle contract 77 | | `"Ticker"` | `String` | Name of the forex ticker 78 | | `"Price"` | `UInt64` | Lowest price for the Bull position and the highest for the Bear position 79 | | `"Start"` | `UInt64` | Beginning of the time frame in which the event will take place 80 | | `"Expiry"` | `UInt64` | End of the time frame in which the event will take place (optional) 81 | | `"Timestamp"` | `UInt64` | Time of the commitment made by the oracle (in milliseconds since Epoch - 00:00:00 UTC, January 1, 1970) 82 | | `"Root"` | `Hash` | Root hash of the Merkle tree on which the oracle has committed 83 | | `"Value"` | `UInt64` | Commited value of the asset (attested by the oracle) 84 | | `"AuditPath"` | `list Hash` | Audit path on the Merkle tree from the leaf of the `` pair to the root of the tree 85 | | `"Index"` | `UInt64` | Index of the `` pair in the Merkle tree 86 | | `"Position"` | `String` | Position of the redeemer - can be either `"Bull"` or `"Bear"` 87 | | `"Collateral"` | `String` | Collateral asset (as an asset string) 88 | 89 | You'll have to ensure the Fixed Payout contract has an attestation token from the oracle contract specified in `"OracleContractId"` which commits to the data specified in `"Root"`, `"Timestamp"`, and `"OraclePubKey"`. 90 | 91 | You'll also have to provide the contract with the position tokens according to the position specified in `"Position"` - to redeem a Bull position provide the contract with Bull tokens, and make sure the attested value is above the price specified in `"Price"` or equal to it; to redeem a Bear position provide the contract with Bear tokens, and make sure the attested value is below the price specified in `"Price"`. 92 | 93 | For both positions you'll also have to make sure that all of the following conditions hold: 94 | 95 | 1. The specified `"Timestamp"` is within the time bounds specified in `"Start"` and `"Expiry"`. 96 | 2. The specified `"AuditPath"` is valid for the Merkle root specified in `"Root"` for the leaf given by the `"Ticker"` key with the specified `"Value"` in the specified `"Index"`. 97 | 3. The data hashed in the position tokens is according to the specified `"OraclePubKey"`, `"OracleContractId"`, `"Ticker"`, `"Price"`, `"Start"`, `"Expiry"`, and `"Collateral"`. 98 | 99 | When all of the conditions hold (including the conditions which are specific for the position) the contract will destroy the provided tokens and will lock to the redeemer collateral tokens of the same amount as the provided position tokens of the specified position. 100 | 101 | Diagrammatically it looks like this: 102 | 103 | ``` 104 | Postion Token × m 105 | Redeemer -----------------------------------------------------> Contract 106 | < event data, attestation data, proof data > 107 | 108 | AttestationToken = [[[ attestation data ]]] 109 | Contract ------------------------------------------------------> Contract 110 | 111 | (if all the conditions hold): 112 | 113 | [[event data ; position]] × m 114 | Contract ------------------------------------------------------| 115 | 116 | Collateral × m 117 | Contract ------------------------------------------------------> Redeemer 118 | 119 | ``` 120 | 121 | The only way for the resulting transaction to be valid is if: 122 | `Position Token` = `[[event data ; position]]` 123 | 124 | ### `"Cancel"` 125 | 126 | To cancel some or all of the issued position tokens you execute the contract with the `"Cancel"` 127 | command and send the contract an equal amount of both position tokens, the same amount of collateral will be sent back to you and the given position tokens will be destroyed. 128 | 129 | You'll also need to put in the message body the exact same data that was given at the issuance of the given tokens. 130 | 131 | Diagrammatically: 132 | 133 | ``` 134 | Collateral × m 135 | Contract --------------------------------------------------------> Canceler 136 | data = 137 | 138 | [[ data ; "Bull" ]] × m + [[ data ; "Bear" ]] × m 139 | Canceler --------------------------------------------------------| 140 | 141 | ``` 142 | 143 | As you can see this is the exact dual situation to the `"Issue"` command. 144 | 145 | ## Problems 146 | 147 | If the time frame is too narrow there's a chance the oracle will not commit on the event during that time frame; if the time frame is too wide there's a chance the oracle will commit and attest for both the Bull and the Bear positions, so the collateral will go to whoever redeems it first ("the early bird gets the worm"). 148 | 149 | ## Generated Assets 150 | 151 | ### Attestation Token 152 | 153 | Generated by the **Oracle** contract. 154 | 155 | ```fsharp 156 | [[[ [[ root ; timestamp ]] ; oraclePublicKey ]]] 157 | ``` 158 | 159 | ### Position Token 160 | 161 | Generated by the **Fixed Payout** contract. 162 | 163 | ```fsharp 164 | [[ oracleContractId ; ticker ; price ; start ; expiry ; collateral ; position ]] 165 | ``` 166 | -------------------------------------------------------------------------------- /FixedPayout/tests/ProofData.fsx: -------------------------------------------------------------------------------- 1 | module PK = Consensus.Crypto.PublicKey 2 | 3 | let fromString s = 4 | match Consensus.Hash.fromString s with 5 | | Some x -> Consensus.Hash.bytes x 6 | | None -> failwithf "%s isn't a valid hash string" s 7 | 8 | //let __derivationPath = "m/44'/258'/0'/3/0" 9 | 10 | let oracle_pk_str = "02ad784974b3f86ad97e008e20d2c107429041ed2d991ada2a1461b5077c11944c" 11 | 12 | let oracle_pk = PK.fromString oracle_pk_str |> Option.get 13 | 14 | let timestamp = 1234UL 15 | 16 | let ticker = "ABCD" 17 | 18 | let price = 12UL 19 | 20 | let leaf = fromString "9b46882c07f5213e938d57de4c5871b82bff5fc7a04a82c06df1b4c4b9001293" |> Hash.Hash 21 | 22 | let root = fromString "3e47241505bca37f3356fd8dda544c2a3c9c043601f147ea0c6da1362c85a472" |> Hash.Hash 23 | 24 | let index = 0UL 25 | 26 | let strings_path = 27 | [ "8bedf63712734899064f7c342d38447360ce4d0377cf8b984710b1fd48341a3b" 28 | ; "0ecb254e1ff36f9b6a09f35926041a01a955171a29d8500775fb58a0acbff54c" 29 | ] 30 | 31 | let path = 32 | Infrastructure.Option.traverseM Consensus.Hash.fromString strings_path 33 | |> function 34 | | Some x -> x 35 | | None -> failwith "Couldn't parse path" 36 | -------------------------------------------------------------------------------- /FixedPayout/tests/TestData.fsx: -------------------------------------------------------------------------------- 1 | module FString = FStar.String 2 | module Hash = Consensus.Hash 3 | module ZFStar = Consensus.ZFStar 4 | module Crypto = Consensus.Crypto 5 | module Types = Consensus.Types 6 | module Data = Zen.Types.Data 7 | module Extracted = Zen.Types.Extracted 8 | module Sha3 = Zen.Hash.Sha3 9 | module PKModule = Crypto.PublicKey 10 | 11 | #load "ProofData.fsx" 12 | 13 | module Input = ContractInput 14 | module AddRealized = Input.MessageBody.Realized.Option 15 | module AddInput = Input.MessageBody.Option 16 | module Abs = AbstractContract 17 | 18 | open TestResult 19 | 20 | #r "../output/FixedPayout.dll" 21 | 22 | open FixedPayout 23 | 24 | 25 | type fpcCommand = 26 | | CMD_Issue 27 | | CMD_Redeem 28 | | CMD_Cancel 29 | | CMD_Other 30 | 31 | type fpcCid = 32 | | CID_Oracle 33 | | CID_FP 34 | | CID_Other 35 | 36 | type fpcPK = 37 | | PK_Issuer 38 | | PK_Redeemer 39 | | PK_Oracle 40 | | PK_Other 41 | 42 | type fpcData = { 43 | _Timestamp : uint64 option; 44 | _Root : Types.Hash option; 45 | _OraclePubKey : fpcPK option; 46 | _Ticker : string option; 47 | _PriceLow : uint64 option; 48 | _PriceHigh : uint64 option; 49 | _Start : uint64 option; 50 | _Expiry : uint64 option; 51 | _AuditPath : (Types.Hash list) option; 52 | _Value : uint64 option; 53 | _Index : uint64 option; 54 | _Position : string option; 55 | _OracleContractId : fpcCid option; 56 | _Collateral : fpcAsset option; 57 | } 58 | 59 | and proof = { 60 | key : string; 61 | value : uint64; 62 | root : Types.Hash; 63 | auditPath : Types.Hash list; 64 | index : uint64; 65 | } 66 | 67 | and commit = { 68 | c_root : Types.Hash; 69 | c_timestamp : uint64; 70 | } 71 | 72 | and attestation = { 73 | commit : commit; 74 | pubKey : fpcPK; 75 | } 76 | 77 | and betEvent = { 78 | oraclePubKey : fpcPK; 79 | oracleContractId : fpcCid; 80 | ticker : string; 81 | priceLow : uint64; 82 | priceHigh : uint64 option; 83 | start : uint64; 84 | expiry : uint64 option; 85 | collateral : fpcAsset; 86 | } 87 | 88 | and betToken = 89 | | BullToken of betEvent 90 | | BearToken of betEvent 91 | 92 | and fpcAsset = 93 | | BetToken of betToken 94 | | AttestToken of attestation 95 | | ZenToken 96 | | OtherToken 97 | 98 | let CONTRACT_ID_FP = Load.computeContractId "output/FixedPayout.fst" 99 | let CONTRACT_ID_ORACLE = Load.computeContractId "../Oracle2/output/Oracle2.fst" 100 | let CONTRACT_ID_OTHER = Load.computeContractId "../Dex001/Dex001.fst" 101 | 102 | let generatePublicKey() = 103 | Crypto.KeyPair.create() |> snd 104 | 105 | let PK_ISSUER = generatePublicKey() 106 | let PK_REDEEMER = generatePublicKey() 107 | let PK_ORACLE = ProofData.oracle_pk 108 | let PK_OTHER = generatePublicKey() 109 | 110 | let fpcMain, fpcCost = Load.extractMainAndCost "output/FixedPayout.dll" 111 | 112 | let OTHER_TOKEN_STRING = "00000000ea0491531b62de13d9760c6d9dd4046316080d1339daae5d2072811815c6bbe39597cfa4856a2863d63c554f0d9d81541f1de480af3709cd81f4a8d43f3aab8f" 113 | 114 | let fromString s = 115 | match Consensus.Hash.fromString s with 116 | | Ok h -> Some h 117 | | Error _ -> None 118 | 119 | 120 | (* 121 | ------------------------------------------------------------------------------------------------------------------------ 122 | ======================================== CREATE DATA =================================================================== 123 | ------------------------------------------------------------------------------------------------------------------------ 124 | *) 125 | 126 | let FIELD_TIMESTAMP = "Timestamp"B 127 | let FIELD_ROOT = "Root"B 128 | let FIELD_ORACLE_PUB_KEY = "OraclePubKey"B 129 | let FIELD_TICKER = "Ticker"B 130 | let FIELD_PRICE_LOW = "PriceLow"B 131 | let FIELD_PRICE_HIGH = "PriceHigh"B 132 | let FIELD_START = "Start"B 133 | let FIELD_EXPIRY = "Expiry"B 134 | let FIELD_AUDIT_PATH = "AuditPath"B 135 | let FIELD_INDEX = "Index"B 136 | let FIELD_VALUE = "Value"B 137 | let FIELD_POSITION = "Position"B 138 | let FIELD_ORACLE_CONTRACT_ID = "OracleContractId"B 139 | let FIELD_COLLATERAL = "Collateral"B 140 | 141 | 142 | 143 | (* 144 | ------------------------------------------------------------------------------------------------------------------------ 145 | ======================================== REALIZER ====================================================================== 146 | ------------------------------------------------------------------------------------------------------------------------ 147 | *) 148 | 149 | let realizeCommand cmd = 150 | match cmd with 151 | | CMD_Issue -> "Issue" 152 | | CMD_Redeem -> "Redeem" 153 | | CMD_Cancel -> "Cancel" 154 | | CMD_Other -> "Other" 155 | 156 | let realizePK pk = 157 | match pk with 158 | | PK_Issuer -> PK_ISSUER 159 | | PK_Redeemer -> PK_REDEEMER 160 | | PK_Oracle -> PK_ORACLE 161 | | PK_Other -> PK_OTHER 162 | 163 | let realizeContract c = 164 | match c with 165 | | CID_Oracle -> CONTRACT_ID_ORACLE 166 | | CID_FP -> CONTRACT_ID_FP 167 | | CID_Other -> CONTRACT_ID_OTHER 168 | 169 | let updateCPK (parity, h) (s:Sha3.t): Sha3.t = 170 | s 171 | |> Sha3.updateByte parity |> Zen.Cost.Realized.__force 172 | |> Sha3.updateHash h |> Zen.Cost.Realized.__force 173 | 174 | let hashCPK cpk = 175 | Sha3.empty 176 | |> updateCPK cpk 177 | |> Sha3.finalize 178 | |> Zen.Cost.Realized.__force 179 | 180 | let compress pk = 181 | let cpk = PKModule.serialize pk 182 | (cpk.[0], cpk.[1..]) 183 | 184 | let updatePublicKey pk s = 185 | updateCPK (compress pk) s 186 | 187 | let updateContractId (Consensus.Types.ContractId (v, Hash.Hash h)) s = 188 | s 189 | |> Sha3.updateU32 v |> Zen.Cost.Realized.__force 190 | |> Sha3.updateHash h |> Zen.Cost.Realized.__force 191 | 192 | let runOpt update ox st = 193 | match ox with 194 | | Some x -> update x st |> Zen.Cost.Realized.__force 195 | | None -> st 196 | 197 | let rec updateEvent bevent s = 198 | s 199 | |> updatePublicKey (bevent.oraclePubKey |> realizePK ) 200 | |> updateContractId (bevent.oracleContractId |> realizeContract ) 201 | |> Sha3.updateString (bevent.ticker |> ZFStar.fsToFstString) |> Zen.Cost.Realized.__force 202 | |> Sha3.updateU64 bevent.priceLow |> Zen.Cost.Realized.__force 203 | |> runOpt Sha3.updateU64 bevent.priceHigh 204 | |> Sha3.updateU64 bevent.start |> Zen.Cost.Realized.__force 205 | |> runOpt Sha3.updateU64 bevent.expiry 206 | |> Sha3.updateAsset (bevent.collateral |> realizeAsset |> Option.get |> fun (Types.Asset (Types.ContractId(v, Consensus.Hash.Hash cid),Consensus.Hash.Hash h)) -> (v,cid,h)) |> Zen.Cost.Realized.__force 207 | 208 | and updateString str s = 209 | s 210 | |> Sha3.updateString (ZFStar.fsToFstString str) 211 | |> Zen.Cost.Realized.__force 212 | 213 | and hashBet btoken = 214 | Sha3.empty |> 215 | (match btoken with 216 | | BullToken bevent -> updateEvent bevent >> updateString "Bull" 217 | | BearToken bevent -> updateEvent bevent >> updateString "Bear" 218 | ) 219 | |> Sha3.finalize 220 | |> Zen.Cost.Realized.__force 221 | |> Some 222 | 223 | and hashCommit commit = 224 | Sha3.empty 225 | |> Sha3.updateHash (commit.c_root |> Hash.bytes) |> Zen.Cost.Realized.__force 226 | |> Sha3.updateU64 commit.c_timestamp |> Zen.Cost.Realized.__force 227 | |> Sha3.finalize |> Zen.Cost.Realized.__force 228 | 229 | and hashAttest attest = 230 | Sha3.empty 231 | |> Sha3.updateHash 232 | (Sha3.empty 233 | |> Sha3.updateHash (hashCommit attest.commit) |> Zen.Cost.Realized.__force 234 | |> updatePublicKey (attest.pubKey |> realizePK) 235 | |> Sha3.finalize |> Zen.Cost.Realized.__force 236 | ) 237 | |> Zen.Cost.Realized.__force 238 | |> Sha3.finalize |> Zen.Cost.Realized.__force 239 | 240 | and realizeAsset asset : Option = 241 | let (|@>) x f = Option.map f x 242 | match asset with 243 | | BetToken btoken -> 244 | hashBet btoken |@> (fun betHash -> Types.Asset (CONTRACT_ID_FP, Hash.Hash betHash)) 245 | | AttestToken attest -> 246 | match hashAttest attest with | attestHash -> Some (Types.Asset (CONTRACT_ID_ORACLE, Hash.Hash attestHash)) 247 | | ZenToken -> 248 | Some Consensus.Asset.Zen 249 | | OtherToken -> 250 | OTHER_TOKEN_STRING 251 | |> Consensus.Asset.fromString 252 | 253 | 254 | let rec fpcRealizer : Abs.Realizer = 255 | { 256 | realizePK = realizePK 257 | realizeContract = realizeContract 258 | realizeAsset = realizeAsset 259 | realizeCommand = realizeCommand 260 | realizeData = realizeData 261 | thisContract = CONTRACT_ID_FP 262 | } 263 | 264 | and realizeData (data : fpcData) = 265 | let rl = fpcRealizer in 266 | Input.MessageBody.emptyDict 267 | |> AddInput.add_uint64 FIELD_TIMESTAMP data._Timestamp 268 | |> AddInput.add_hash FIELD_ROOT data._Root 269 | |> AddRealized.add_pk rl FIELD_ORACLE_PUB_KEY data._OraclePubKey 270 | |> AddInput.add_string FIELD_TICKER data._Ticker 271 | |> AddInput.add_uint64 FIELD_PRICE_LOW data._PriceLow 272 | |> AddInput.add_uint64 FIELD_PRICE_HIGH data._PriceHigh 273 | |> AddInput.add_uint64 FIELD_START data._Start 274 | |> AddInput.add_uint64 FIELD_EXPIRY data._Expiry 275 | |> AddInput.add_hash_list FIELD_AUDIT_PATH data._AuditPath 276 | |> AddInput.add_uint64 FIELD_VALUE data._Value 277 | |> AddInput.add_uint64 FIELD_INDEX data._Index 278 | |> AddInput.add_string FIELD_POSITION data._Position 279 | |> AddRealized.add_contract rl FIELD_ORACLE_CONTRACT_ID data._OracleContractId 280 | |> AddInput.add_string FIELD_COLLATERAL (data._Collateral |> Option.bind realizeAsset |> Option.map Consensus.Asset.toString) 281 | |> Zen.Types.Data.Dict 282 | |> Zen.Types.Data.Collection 283 | |> Some 284 | 285 | 286 | 287 | (* 288 | ------------------------------------------------------------------------------------------------------------------------ 289 | ======================================== TEST DATA ===================================================================== 290 | ------------------------------------------------------------------------------------------------------------------------ 291 | *) 292 | 293 | let data001 = realizeData { 294 | _Timestamp = Some 1234UL 295 | _Root = "3e47241505bca37f3356fd8dda544c2a3c9c043601f147ea0c6da1362c85a472" |> fromString 296 | _OraclePubKey = Some PK_Oracle 297 | _Ticker = Some "ABCD" 298 | _PriceLow = Some 10UL 299 | _PriceHigh = Some 20UL 300 | _Start = Some 1111UL 301 | _Expiry = Some 2222UL 302 | _AuditPath = Some ProofData.path 303 | _Value = Some 12UL 304 | _Index = Some 0UL 305 | _Position = Some "Bull" 306 | _OracleContractId = Some CID_Oracle 307 | _Collateral = Some OtherToken 308 | } 309 | 310 | let bevent001 = { 311 | oraclePubKey = PK_Oracle 312 | oracleContractId = CID_Oracle 313 | ticker = "ABCD" 314 | priceLow = 10UL 315 | priceHigh = None 316 | start = 1111UL 317 | expiry = None 318 | collateral = OtherToken 319 | } 320 | 321 | let hashWith upd x = 322 | Sha3.empty 323 | |> upd x 324 | |> Sha3.finalize 325 | |> Zen.Cost.Realized.__force 326 | 327 | let h_bevent001 = 328 | hashWith updateEvent bevent001 329 | 330 | let h_bull001 = 331 | hashBet (BullToken bevent001) 332 | |> Option.get 333 | 334 | let h_bear001 = 335 | hashBet (BearToken bevent001) 336 | |> Option.get 337 | 338 | 339 | let h_publicKey = hashWith updatePublicKey ProofData.oracle_pk 340 | let h_contractId = hashWith updateContractId CONTRACT_ID_ORACLE 341 | let h_ticker = hashWith updateString bevent001.ticker 342 | let h_priceLow = hashWith ((<<) Zen.Cost.Realized.__force << Sha3.updateU64) bevent001.priceLow 343 | let h_start = hashWith ((<<) Zen.Cost.Realized.__force << Sha3.updateU64) bevent001.start 344 | let h_collateral = hashWith ((<<) Zen.Cost.Realized.__force << Sha3.updateAsset) (bevent001.collateral |> realizeAsset |> Option.get |> fun (Types.Asset (Types.ContractId(v, Consensus.Hash.Hash cid),Consensus.Hash.Hash h)) -> (v,cid,h)) 345 | 346 | 347 | printfn "oraclePubKey = %s" ProofData.oracle_pk_str 348 | printfn "oracleContractId = %s" (CONTRACT_ID_ORACLE.ToString()) 349 | printfn "ticker = %s" bevent001.ticker 350 | printfn "priceLow = %d" bevent001.priceLow 351 | printfn "start = %d" bevent001.start 352 | printfn "collateral_asset = %s" OTHER_TOKEN_STRING 353 | printfn "h_event = %s" (Consensus.Hash.Hash h_bevent001).AsString 354 | printfn "h_bull = %s" (Consensus.Hash.Hash h_bull001).AsString 355 | printfn "h_bear = %s" (Consensus.Hash.Hash h_bear001).AsString 356 | printfn "h_publicKey = %s" (Consensus.Hash.Hash h_publicKey).AsString 357 | printfn "h_contractId = %s" (Consensus.Hash.Hash h_contractId).AsString 358 | printfn "h_ticker = %s" (Consensus.Hash.Hash h_ticker).AsString 359 | printfn "h_priceLow = %s" (Consensus.Hash.Hash h_priceLow).AsString 360 | printfn "h_start = %s" (Consensus.Hash.Hash h_start).AsString 361 | printfn "h_collateral = %s" (Consensus.Hash.Hash h_collateral).AsString 362 | 363 | 364 | let h_hashzero = 365 | let h = 366 | Consensus.Hash.fromString "0000000000000000000000000000000000000000000000000000000000000000" 367 | |> Infrastructure.Result.get 368 | Sha3.empty 369 | |> Sha3.updateHash ((fun (Consensus.Hash.Hash h) -> h) h) 370 | |> Zen.Cost.Realized.__force 371 | |> Sha3.finalize 372 | |> Zen.Cost.Realized.__force 373 | 374 | printfn "updateHash zeros = %s" (Consensus.Hash.Hash h_hashzero).AsString 375 | 376 | 377 | let h_zenasset = 378 | Sha3.empty 379 | |> Sha3.updateAsset Zen.Asset.zenAsset 380 | |> Zen.Cost.Realized.__force 381 | |> Sha3.finalize 382 | |> Zen.Cost.Realized.__force 383 | 384 | printfn "h_zenasset = %s" (Consensus.Hash.Hash h_zenasset).AsString -------------------------------------------------------------------------------- /NamedToken/NamedToken.fst: -------------------------------------------------------------------------------- 1 | module NamedToken 2 | 3 | open Zen.Types 4 | open Zen.Base 5 | open Zen.Cost 6 | open Zen.Asset 7 | open Zen.Data 8 | 9 | module D = Zen.Dictionary 10 | module Tx = Zen.TxSkeleton 11 | module CR = Zen.ContractResult 12 | module RT = Zen.ResultT 13 | module String = FStar.String 14 | module C = Zen.Cost 15 | 16 | let main txSkeleton _ contractId command sender messageBody wallet state = 17 | let dict = messageBody >!= tryDict in 18 | 19 | let! returnAddress = 20 | dict 21 | >?= D.tryFind "returnAddress" 22 | >?= tryLock 23 | in 24 | 25 | let! amount = 26 | dict 27 | >?= D.tryFind "amount" 28 | >?= tryU64 29 | in 30 | 31 | let! name = 32 | dict 33 | >?= D.tryFind "name" 34 | >?= tryString 35 | in 36 | 37 | match returnAddress,amount,name with 38 | | Some returnAddress, Some amount, Some name -> 39 | if String.length name <= 32 then 40 | begin 41 | let! token = Zen.Asset.fromSubtypeString contractId name in 42 | 43 | let! txSkeleton = 44 | Tx.lockToAddress token amount returnAddress txSkeleton 45 | >>= Tx.mint amount token in 46 | 47 | CR.ofTxSkel txSkeleton 48 | end 49 | else 50 | RT.autoFailw "name is too long" 51 | | _ -> 52 | RT.autoFailw "parameters are missing" 53 | 54 | let cf _ _ _ _ _ wallet _ = 55 | (4 + 64 + 2 + (4 + 64 + 2 + (4 + 64 + 2 + (64 + (64 + 64 + 3)))) + 54) 56 | |> cast nat 57 | |> C.ret -------------------------------------------------------------------------------- /Oracle/Oracle.fst: -------------------------------------------------------------------------------- 1 | module Oracle 2 | 3 | open Zen.Base 4 | open Zen.Cost 5 | open Zen.Types 6 | open Zen.Data 7 | 8 | module CR = Zen.ContractResult 9 | module Dict = Zen.Dictionary 10 | module OT = Zen.OptionT 11 | module RT = Zen.ResultT 12 | module Sha3 = Zen.Hash.Sha3 13 | module TX = Zen.TxSkeleton 14 | module W = Zen.Wallet 15 | module U64 = FStar.UInt64 16 | module Asset = Zen.Asset 17 | 18 | 19 | 20 | type commitData = 21 | { commit : hash 22 | ; oraclePubKey : publicKey 23 | ; feeAsset : asset 24 | ; feeAmount : option U64.t 25 | } 26 | 27 | type attestData = 28 | { commitData : commitData 29 | ; recipient : lock 30 | ; returnAddress : option lock 31 | } 32 | 33 | type assets = 34 | { commitment : asset 35 | ; attestation : asset 36 | } 37 | 38 | // compressed public key 39 | type cpk = byte ** hash 40 | 41 | 42 | 43 | (* 44 | ------------------------------------------------------------------------------- 45 | ========== COMPRESSED PUBLIC KEY ============================================== 46 | ------------------------------------------------------------------------------- 47 | *) 48 | 49 | val compress : publicKey -> cpk `cost` 305 50 | let compress pk = // 13 51 | let open FStar.UInt8 in 52 | let parity = (Zen.Array.item 32 pk %^ 2uy) +^ 2uy in 53 | let aux (i:nat{i < 32}): byte `cost` 5 = ret (Zen.Array.item (31-i) pk) in 54 | let! x = Zen.Array.init_pure 32 aux in // 292 55 | ret (parity , x) 56 | 57 | val updateCPK : cpk -> Sha3.t -> Sha3.t `cost` 205 58 | let updateCPK (parity , h) s = // 7 59 | ret s 60 | >>= Sha3.updateByte parity 61 | >>= Sha3.updateHash h 62 | 63 | val hashCPK : cpk -> hash `cost` 231 64 | let hashCPK cpk = // 6 65 | ret Sha3.empty 66 | >>= updateCPK cpk // 205 67 | >>= Sha3.finalize // 20 68 | 69 | 70 | 71 | (* 72 | ------------------------------------------------------------------------------- 73 | ========== DATA PARSING ======================================================= 74 | ------------------------------------------------------------------------------- 75 | *) 76 | 77 | val senderToLock : sender -> lock `OT.t` 551 78 | let senderToLock sender = // 15 79 | begin match sender with 80 | | PK pk -> 81 | let! pkHash = 82 | ret pk 83 | >>= compress // 305 84 | >>= hashCPK // 231 85 | in ret (Some (PKLock pkHash)) 86 | | Contract cid -> 87 | Some (ContractLock cid) 88 | |> incRet 536 89 | | Anonymous -> 90 | None 91 | |> incRet 536 92 | end 93 | 94 | val parseDict: option data -> Dict.t data `RT.t` 12 95 | let parseDict data = // 8 96 | match data with 97 | | Some data -> 98 | data 99 | |> tryDict // 4 100 | |> RT.ofOptionT "Data parsing failed - the message body isn't a dictionary" 101 | | None -> 102 | RT.incFailw 4 "Data parsing failed - the message body is empty" 103 | 104 | val parseCommit : Dict.t data -> hash `RT.t` 78 105 | let parseCommit dict = // 12 106 | let open RT in 107 | ret dict 108 | >>= (Dict.tryFind "Commit" >> ofOptionT "Couldn't find Commit in message body") // 64 109 | >>= (tryHash >> ofOptionT "Commit must be an hash") // 2 110 | 111 | val parseOraclePubKey : Dict.t data -> publicKey `RT.t` 78 112 | let parseOraclePubKey dict = // 12 113 | let open RT in 114 | ret dict 115 | >>= (Dict.tryFind "OraclePubKey" >> ofOptionT "Couldn't find OraclePubKey in message body") // 64 116 | >>= (tryPublicKey >> ofOptionT "OraclePubKey must be a public key") // 2 117 | 118 | val parseRecipient : sender -> Dict.t data -> lock `RT.t` 632 119 | let parseRecipient sender dict = // 17 120 | let open RT in 121 | let! recipient = Dict.tryFind "Recipient" dict in // 64 122 | begin match recipient with 123 | | Some (Lock recip) -> 124 | incRet 551 recip 125 | | Some _ -> 126 | incFailw 551 "Recipient (if specified) must be a lock" 127 | | None -> 128 | let! senderLock = senderToLock sender in // 551 129 | match senderLock with 130 | | Some recip -> 131 | ret recip 132 | | None -> 133 | failw "When the recipient is unspecified the sender can't be anonymous" 134 | end 135 | 136 | val parseReturnAddress : Dict.t data -> option lock `RT.t` 76 137 | let parseReturnAddress dict = // 12 138 | let open RT in 139 | let! returnAddress = Dict.tryFind "ReturnAddress" dict in // 64 140 | match returnAddress with 141 | | None -> 142 | ret None 143 | | Some (Lock address) -> 144 | ret (Some address) 145 | | Some _ -> 146 | failw "ReturnAddress (if specified) must be a lock" 147 | 148 | val parseFeeAsset : Dict.t data -> asset `RT.t` 142 149 | let parseFeeAsset dict = // 14 150 | let open RT in 151 | let! feeAsset = Dict.tryFind "FeeAsset" dict in // 64 152 | match feeAsset with 153 | | None -> 154 | incRet 64 Asset.zenAsset 155 | | Some (String asset) -> 156 | Asset.parse asset // 64 157 | |> ofOptionT "Invalid FeeAsset - failed to parse asset string" 158 | | Some _ -> 159 | incFailw 64 "FeeAsset must be a string" 160 | 161 | val parseFeeAmount : Dict.t data -> option U64.t `RT.t` 81 162 | let parseFeeAmount dict = // 17 163 | let open RT in 164 | let! feeAmount = Dict.tryFind "FeeAmount" dict in // 64 165 | match feeAmount with 166 | | None -> 167 | ret None 168 | | Some (U64 amount) -> 169 | if amount `U64.gt` 0UL then ret (Some amount) else ret None 170 | | Some _ -> 171 | failw "FeeAmount (if specified) must be a UInt64" 172 | 173 | val parseCommitData : publicKey -> option data -> commitData `RT.t` 331 174 | let parseCommitData pk msgBody = // 18 175 | let open RT in 176 | parseDict msgBody >>= (fun dict -> // 12 177 | parseCommit dict >>= (fun commit -> // 78 178 | parseFeeAsset dict >>= (fun feeAsset -> // 142 179 | parseFeeAmount dict >>= (fun feeAmount -> // 81 180 | { commit = commit 181 | ; oraclePubKey = pk 182 | ; feeAsset = feeAsset 183 | ; feeAmount = feeAmount 184 | } |> ret 185 | )))) 186 | 187 | val parseAttestData : sender -> option data -> attestData `RT.t` 1130 188 | let parseAttestData sender msgBody = // 31 189 | let open RT in 190 | parseDict msgBody >>= (fun dict -> // 12 191 | parseCommit dict >>= (fun commit -> // 78 192 | parseOraclePubKey dict >>= (fun oraclePubKey -> // 78 193 | parseRecipient sender dict >>= (fun recipient -> // 632 194 | parseReturnAddress dict >>= (fun returnAddress -> // 76 195 | parseFeeAsset dict >>= (fun feeAsset -> // 142 196 | parseFeeAmount dict >>= (fun feeAmount -> // 81 197 | { commitData = 198 | { commit = commit 199 | ; oraclePubKey = oraclePubKey 200 | ; feeAsset = feeAsset 201 | ; feeAmount = feeAmount 202 | } 203 | ; recipient = recipient 204 | ; returnAddress = returnAddress 205 | } |> ret 206 | ))))))) 207 | 208 | 209 | 210 | (* 211 | ------------------------------------------------------------------------------- 212 | ========== TOKENIZATION ======================================================= 213 | ------------------------------------------------------------------------------- 214 | *) 215 | 216 | val hashCommitData : commitData -> hash `cost` 1179 217 | let hashCommitData data = // 25 218 | let! cpk = compress data.oraclePubKey in // 305 219 | match data.feeAmount with 220 | | None -> 221 | ret Sha3.empty 222 | >>= Sha3.updateHash data.commit // 192 223 | >>= updateCPK cpk // 205 224 | >>= Sha3.finalize // 20 225 | |> inc 432 226 | | Some amount -> 227 | ret Sha3.empty 228 | >>= Sha3.updateHash data.commit // 192 229 | >>= updateCPK cpk // 205 230 | >>= Sha3.updateAsset data.feeAsset // 384 231 | >>= Sha3.updateU64 amount // 48 232 | >>= Sha3.finalize // 20 233 | 234 | val hashAttestData : commitData -> hash `cost` 736 235 | let hashAttestData data = // 14 236 | let! cpk = compress data.oraclePubKey in // 305 237 | ret Sha3.empty 238 | >>= Sha3.updateHash data.commit // 192 239 | >>= updateCPK cpk // 205 240 | >>= Sha3.finalize // 20 241 | 242 | val mkAssets : contractId -> commitData -> assets `cost` 2150 243 | let mkAssets (v, h) data = // 23 244 | let! commitHash = 245 | hashCommitData data in // 1179 246 | let! attestHash1 = 247 | hashAttestData data in // 736 248 | let! attestHash2 = 249 | ret Sha3.empty 250 | >>= Sha3.updateHash attestHash1 // 192 251 | >>= Sha3.finalize in // 20 252 | ret ({ commitment=v,h,commitHash; attestation=v,h,attestHash2 }) 253 | 254 | 255 | 256 | (* 257 | ------------------------------------------------------------------------------- 258 | ========== COMMAND: Commit ==================================================== 259 | ------------------------------------------------------------------------------- 260 | *) 261 | 262 | val dataCommit : 263 | txSkeleton 264 | -> contractId 265 | -> commitData 266 | -> txSkeleton `cost` 2292 267 | let dataCommit txSkel cid args = // 14 268 | let! ({commitment = commitment}) = mkAssets cid args in // 2150 269 | ret txSkel 270 | >>= TX.mint 1UL commitment // 64 271 | >>= TX.lockToContract commitment 1UL cid // 64 272 | 273 | val commit : 274 | contractId 275 | -> sender 276 | -> option data 277 | -> txSkeleton 278 | -> CR.t `cost` 2642 279 | let commit cid sender msgBody txSkel = // 16 280 | let open RT in 281 | let! tx = 282 | begin match sender with 283 | | PK pk -> 284 | ret msgBody 285 | >>= parseCommitData pk // 331 286 | >>= (liftCost << dataCommit txSkel cid) // 2292 287 | | _ -> 288 | "Sender must be a public key" 289 | |> RT.incFailw 2623 290 | end 291 | in CR.ofResultTxSkel tx // 3 292 | 293 | 294 | 295 | (* 296 | ------------------------------------------------------------------------------- 297 | ========== COMMAND: Attest ==================================================== 298 | ------------------------------------------------------------------------------- 299 | *) 300 | 301 | val returnChange : attestData -> sender -> U64.t -> U64.t -> txSkeleton -> txSkeleton `RT.t` 637 302 | let returnChange data sender available fee txSkel = // 27 303 | let open RT in 304 | if available `U64.gt` fee then 305 | let change = available `U64.sub` fee in 306 | match data.returnAddress with 307 | | Some address -> 308 | TX.lockToAddress data.commitData.feeAsset change address txSkel // 64 309 | |> liftCost |> inc 546 310 | | None -> 311 | match sender with 312 | | PK pk -> 313 | TX.lockToPublicKey data.commitData.feeAsset change pk txSkel // 610 314 | |> liftCost 315 | | Contract cid -> 316 | TX.lockToContract data.commitData.feeAsset change cid txSkel // 64 317 | |> liftCost |> inc 546 318 | | Anonymous -> 319 | "When the sender is anonymous you must provide a returnAddress" 320 | |> incFailw 610 321 | else if available `U64.eq` fee then 322 | txSkel 323 | |> incRet 610 324 | else 325 | "Insufficient oracle fee" 326 | |> incFailw 610 327 | 328 | val addFee : sender -> attestData -> txSkeleton -> txSkeleton `RT.t` 1338 329 | let addFee sender data txSkel = // 27 330 | match data.commitData.feeAmount with 331 | | Some fee -> 332 | let! available = TX.getAvailableTokens data.commitData.feeAsset txSkel in // 64 333 | ret txSkel 334 | >>= TX.lockToPublicKey data.commitData.feeAsset fee data.commitData.oraclePubKey // 610 335 | >>= returnChange data sender available fee // 637 336 | | None -> 337 | txSkel 338 | |> RT.incRet 1311 339 | 340 | val attestTx : 341 | assets 342 | -> sender 343 | -> contractId 344 | -> (w : wallet) 345 | -> attestData 346 | -> txSkeleton 347 | -> txSkeleton `RT.t` (0 + 64 + 64 + (W.size w * 128 + 192) + 64 + 1338 + 39) 348 | let attestTx assets sender cid w data txSkel = // 39 349 | let open RT in 350 | ret txSkel 351 | >>= (liftCost << TX.mint 1UL assets.attestation) // 64 352 | >>= (liftCost << TX.lockToAddress assets.attestation 1UL data.recipient) // 64 353 | >>= (ofOptionT "Data wasn't committed" << TX.fromWallet assets.commitment 1UL cid w) // W.size w * 128 + 192 354 | >>= (liftCost << TX.lockToContract assets.commitment 1UL cid) // 64 355 | >>= addFee sender data // 1338 356 | 357 | val dataAttest' : 358 | sender 359 | -> contractId 360 | -> (w : wallet) 361 | -> txSkeleton 362 | -> attestData 363 | -> txSkeleton `RT.t` (2150 + (0 + 64 + 64 + (W.size w * 128 + 192) + 64 + 1338 + 39) + 11) 364 | let dataAttest' sender cid w txSkel data = // 16 365 | let! assets = mkAssets cid data.commitData in // 2150 366 | attestTx assets sender cid w data txSkel // ... 367 | 368 | val dataAttest : 369 | sender 370 | -> contractId 371 | -> (w : wallet) 372 | -> txSkeleton 373 | -> attestData 374 | -> txSkeleton `RT.t` (W.size w * 128 + 3929) 375 | let dataAttest sender cid w txSkel data = // 7 376 | dataAttest' sender cid w txSkel data 377 | |> (fun x -> x <: txSkeleton `RT.t` (W.size w * 128 + 3922)) 378 | 379 | val attest : 380 | contractId -> 381 | (w : wallet) -> 382 | sender -> 383 | option data -> 384 | txSkeleton -> 385 | CR.t `cost` (W.size w * 128 + 5073) 386 | let attest cid w sender msgBody txSkel = // 11 387 | let open RT in 388 | let! tx = 389 | parseAttestData sender msgBody // 1130 390 | >>= dataAttest sender cid w txSkel // W.size w * 128 + 3929 391 | in CR.ofResultTxSkel tx // 3 392 | 393 | 394 | 395 | (* 396 | ------------------------------------------------------------------------------- 397 | ========== MAIN =============================================================== 398 | ------------------------------------------------------------------------------- 399 | *) 400 | 401 | val main : 402 | txSkel : txSkeleton 403 | -> context : context 404 | -> cid : contractId 405 | -> command : string 406 | -> sender : sender 407 | -> msgBody : option data 408 | -> w : wallet 409 | -> state : option data 410 | -> CR.t `cost` 411 | begin match command with 412 | | "Commit" -> 2642 + 8 413 | | "Attest" -> W.size w * 128 + 5073 + 8 414 | | _ -> 8 415 | end 416 | let main txSkel _ cid command sender msgBody w _ = // 8 417 | begin match command with 418 | | "Commit" -> 419 | commit cid sender msgBody txSkel // 2642 420 | <: CR.t `cost` 421 | begin match command with 422 | | "Commit" -> 2642 423 | | "Attest" -> W.size w * 128 + 5073 424 | | _ -> 0 425 | end 426 | | "Attest" -> 427 | attest cid w sender msgBody txSkel // W.size w * 128 + 5073 428 | | _ -> 429 | RT.failw "Command not recognized" 430 | end 431 | 432 | val cf : 433 | txSkel : txSkeleton 434 | -> context : context 435 | -> command : string 436 | -> sender : sender 437 | -> messageBody: option data 438 | -> w : wallet 439 | -> state : option data 440 | -> nat `cost` 10 441 | let cf _ _ command _ _ w _ = // 10 442 | begin match command with 443 | | "Commit" -> 2650 444 | | "Attest" -> W.size w * 128 + 5081 445 | | _ -> 8 446 | end 447 | |> ret 448 | -------------------------------------------------------------------------------- /Oracle/README.md: -------------------------------------------------------------------------------- 1 | # Fee Oracle 2 | 3 | ## Verify/Build 4 | 5 | To verify/record hints, run `zebra e Oracle.fst`. 6 | 7 | The elaborated source file will be created in the `output` directory. 8 | 9 | To build, run `zebra c Oracle.fst`. 10 | 11 | Both the elaborated source file and the compiled binary (`.dll`) file will be created in the `output` directory. 12 | 13 | ## How it works 14 | 15 | The *oracle contract* allows a *data provider* to make a *commitment* (with the `"Commit"` command) in the form of a hash, which will be recorded on the blockchain, and can provide *attestation* tokens (with the `"Attest"` command) to prove that a commitment was recorded on the blockchain. 16 | 17 | The *commitment token* is minted by the *contract using a signed transaction (the contract witness is signed by the data provider)* and is derived from the committed hash and the *public key* of the *provider* who sent the data, optionally along with the required attestation fee asset identifier and fee amount (if they are required by the committing oracle). 18 | 19 | The *token* is then locked to the *oracle contract* and stays in the possession of the *contract* indefinitely. 20 | 21 | Whenever a proof of a commitment is needed, an attestation token can be minted (with the `"Attest"` command) by providing the commitment data (i.e - the committed hash, the *public key* of the *data provider*, and optionally the fee asset and fee amount if there is an attestation fee*)*, from which the *contract* derives once again a *commitment token* which is taken from the *contract wallet* and then locked back to the *contract*, and mints from the same data an *attestation token* which is sent to the *recipient* specified by the *sender*. 22 | 23 | If the commitment required an attestation fee, the contract also locks the required attestation fee to the *public key* of the *data provider*, which means the attestation transaction will only be valid if the required attestation fee was provided to the contract as inputs in the transaction (any provided amount of the attestation fee asset behind the required amount will be locked back to the provided *return address* or to the sender if no was *return address* provided). 24 | 25 | Since the *contract* tries to take the *commitment token* from its *wallet* and lock it to itself - the only way for the *attestation transaction* to be valid is if the *contract* has the *commitment token* to begin with (otherwise it would create an invalid execution), meaning that the data provider must have first executed the contract with the `"Commit"` command. 26 | 27 | ## Usage 28 | 29 | The Oracle contract has 2 commands: 30 | 31 | 1. `"Commit"` 32 | 2. `"Attest"` 33 | 34 | ### `"Commit"` 35 | 36 | To commit a hash execute the Oracle contract with the `"Commit"` command and provide the hash in the message body as a dictionary with the field name `"Commit"`. 37 | 38 | If you want to require an attestation fee to be payed to the committing oracle in return for attestation tokens, you'll need to add a `"FeeAmount"` to specify the required fee, and a `"FeeAsset"` to specify the asset of the fee (if you only provide `"FeeAmount"` without a `"FeeAsset"` the fee asset will automatically be ZP). 39 | **Note:** The transaction must be signed, the provider who executed this command **must authenticate the transaction**. 40 | 41 | | Field Name | Type | Description | Comments 42 | |:------------------:|:------------------:|:----------------------------------:|:-------------------- 43 | | `"Commit"` | `hash` | The committed hash | 44 | | `"FeeAsset"` | `asset` | Attestation fee asset (optional) | Defaults to ZP when omitted 45 | | `"FeeAmount"` | `uint64` | Attestation fee amount (optional) | Omitting it or setting it to 0 means no fee will be required 46 | 47 | The contract will then take the *public key* of the *provider*, concatenate it to the provided hash, concatenate the *fee asset* and *fee amount* (if they are provided) to the result, mint a *commitment token* from the hash of the concatenation, and lock it to itself. 48 | 49 | ``` 50 | commitment token = [[ Commit ; public key ]] 51 | Contract |------------------------------------------------------------> Contract 52 | ``` 53 | 54 | (or with attestation fee): 55 | 56 | ``` 57 | commitment token = [[ Commit ; public key ; FeeAsset ; FeeAmount ]] 58 | Contract |------------------------------------------------------------> Contract 59 | ``` 60 | 61 | From now on the contract will hold the *commitment token* indefinitely. 62 | 63 | ### `"Attest"` 64 | 65 | To ask for an *attestation* on a committed hash by a specific *provider* execute the contract with the `"Attest"` command and provide a message body as a dictionary with the following data: 66 | 67 | | Field Name | Type | Description | Comments 68 | |:------------------:|:------------------:|:--------------------------------------------------:|:----------------------------------------------- 69 | | `"Commit"` | `hash` | The committed hash | 70 | | `"OraclePubKey"` | `publicKey` | The public key of the provider | 71 | | `"Recipient"` | `lock` | The recipient lock of the attestation token | 72 | | `"FeeAsset"` | `asset` | Attestation fee asset (optional) | Defaults to ZP when omitted 73 | | `"FeeAmount"` | `uint64` | Attestation fee amount (optional) | Omit it or set it to 0 when no fee is required 74 | | `"ReturnAddress"` | `lock` | Return address for change from the attestation fee | 75 | 76 | To ensure that the specified hash was indeed committed the contract will take the *public key* of the *provider*, concatenate it to the provided *commitment hash*, concatenate the *fee asset* and *fee amount* (if they are provided) to the result, look up in its *wallet* for a *commitment token* derived from the hash of the concatenation, and lock it to itself. 77 | 78 | The contract will also take the **double hash** (the hash of the hash) of the concatenation of the *commitment hash* to the *public key*, mint an *attestation token* out of it, and lock it to the *recipient* - this will provide the *recipient* with a concrete and exchangeable evidence that the specified hash was indeed committed to. 79 | 80 | ``` 81 | commitment token = [[ Commit ; OraclePubKey ]] 82 | Contract ------------------------------------------------------------> Contract 83 | 84 | attestation token = [[[ Commit ; OraclePubKey ]]] 85 | Contract |------------------------------------------------------------> Recipient 86 | ``` 87 | 88 | (or with attestation fee): 89 | 90 | ``` 91 | commitment token = [[ Commit ; OraclePubKey ; FeeAsset ; FeeAmount ]] 92 | Contract ------------------------------------------------------------> Contract 93 | 94 | FeeAsset x FeeAmount 95 | Sender ------------------------------------------------------------> Contract 96 | 97 | attestation token = [[[ Commit ; OraclePubKey ]]] 98 | Contract |------------------------------------------------------------> Recipient 99 | ``` 100 | 101 | ## Generated Assets 102 | 103 | ### Commitment Token 104 | 105 | Without attestation fee: 106 | 107 | ``` 108 | [[ hash ; oraclePublicKey ]] 109 | ``` 110 | 111 | with attestation fee: 112 | 113 | ``` 114 | [[ hash ; oraclePublicKey ; feeAsset ; feeAmount ]] 115 | ``` 116 | 117 | ### Attestation Token 118 | 119 | ``` 120 | [[[ hash ; oraclePublicKey ]]] 121 | ``` -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Contract Examples 2 | 3 | This repository contains several example Zen Protocol contracts, which are ready to be deployed, and can be used as a developer reference. 4 | 5 | A README.md in each directory should provide further details as to build and testing instructions. 6 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | image: Ubuntu1804 2 | 3 | environment: 4 | matrix: 5 | - nodejs_version: '14' 6 | install: 7 | - sudo apt install gnupg ca-certificates 8 | - sudo apt-key adv --keyserver hkp://keyserver.ubuntu.com:80 --recv-keys 3FA7E0328081BFF6A14DA29AA6A19B38D3D831EF 9 | - echo "deb https://download.mono-project.com/repo/ubuntu stable-bionic/snapshots/6.10 main" | sudo tee /etc/apt/sources.list.d/mono-official-stable.list 10 | - sudo apt update 11 | - sudo apt install fsharp=4.5-0xamarin12+ubuntu1804b1 -y 12 | - nvm install --lts 13 | - npm config set @zen:registry https://www.myget.org/F/zenprotocol/npm/ 14 | - npm install @zen/zebra -g 15 | 16 | build: off 17 | shallow_clone: true 18 | matrix: 19 | # stop build on first failure 20 | fast_finish: true 21 | 22 | test_script: 23 | - sh run-test.sh -------------------------------------------------------------------------------- /run-test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | 4 | RLIMIT=800000000 5 | 6 | cd AuthenticatedSupply 7 | zebra c -z $RLIMIT AuthenticatedSupply.fst 8 | cd .. 9 | 10 | cd Bet 11 | zebra c -z $RLIMIT Bet.fst 12 | zebra r Tests/Buy.fsx 13 | zebra r Tests/Redeem.fsx 14 | cd .. 15 | 16 | cd CGP 17 | zebra c -z $RLIMIT CGP.fst 18 | zebra r tests/CGP.fsx 19 | cd .. 20 | 21 | cd Dex 22 | zebra c -z $RLIMIT Dex.fst 23 | zebra r Tests/Dex_Make.fsx 24 | zebra r Tests/Dex_Take.fsx 25 | zebra r Tests/Dex_Cancel.fsx 26 | cd .. 27 | 28 | cd Empty 29 | zebra c -z $RLIMIT Empty.fst 30 | cd .. 31 | 32 | cd FixedPayout 33 | zebra c -z $RLIMIT FixedPayout.fst 34 | zebra r tests/FPC3.fsx 35 | cd .. 36 | 37 | cd NamedToken 38 | zebra c -z $RLIMIT NamedToken.fst 39 | cd .. 40 | 41 | cd Oracle 42 | zebra c -z $RLIMIT Oracle.fst 43 | zebra r tests/OracleTests.fsx 44 | cd .. 45 | 46 | --------------------------------------------------------------------------------