diff --git a/eleks/nft/pab/Main.hs b/eleks/nft/pab/Main.hs index 2645b7150..6f4aa115a 100644 --- a/eleks/nft/pab/Main.hs +++ b/eleks/nft/pab/Main.hs @@ -98,9 +98,12 @@ instance HasDefinitions NFTMarketContracts where NFTStartContract -> Builtin.endpointsToSchemas @NFTMarket.MarketOwnerSchema NFTUserContract _ -> Builtin.endpointsToSchemas @NFTMarket.MarketUserSchema getContract = \case - NFTStartContract -> SomeBuiltin (NFTMarket.ownerEndpoint NFTMarket.forgeMarketToken) + NFTStartContract -> SomeBuiltin (NFTMarket.ownerEndpoint NFTMarket.forgeMarketToken nftMarketFee) NFTUserContract market -> SomeBuiltin (NFTMarket.userEndpoints market) +nftMarketFee :: Integer +nftMarketFee = 500000 + handlers :: SimulatorEffectHandlers (Builtin NFTMarketContracts) handlers = Simulator.mkSimulatorHandlers def def diff --git a/eleks/nft/src/Contracts/NFT/OffChain.hs b/eleks/nft/src/Contracts/NFT/OffChain.hs index 832331885..1c1862e7b 100644 --- a/eleks/nft/src/Contracts/NFT/OffChain.hs +++ b/eleks/nft/src/Contracts/NFT/OffChain.hs @@ -16,6 +16,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE NumericUnderscores #-} -- | Implements a custom currency with a monetary policy that allows -- the forging of a fixed amount of units. @@ -143,14 +144,15 @@ forgeMarketToken tokenName pk = fmap Currency.currencySymbol $ -- | Creates a Marketplace "factory". This factory will keep track of the existing nft tokens start :: forall w w' s. (TokenName -> PubKeyHash -> Contract w s Text CurrencySymbol) + -> Integer -> Contract w s Text NFTMarket -start forgeNft = do +start forgeNft fee = do pkh <- pubKeyHash <$> ownPubKey cs <- forgeNft marketplaceTokenName pkh let c = assetClass cs marketplaceTokenName nftTokenCur = mkNFTCurrency c nftTokenMetaCur = mkNFTCurrency c - market = marketplace cs nftTokenCur nftTokenMetaCur + market = marketplace cs nftTokenCur nftTokenMetaCur fee pkh inst = marketInstance market tx = mustPayToTheScript (Factory []) $ assetClassValue c 1 ledgerTx <- submitTxConstraints inst tx @@ -292,6 +294,9 @@ buy market BuyParams{..} = do when (PlutusTx.Prelude.isNothing $ nftSeller nftMetadata) $ throwError $ pack $ printf "NFT token is not on sale" let marketInst = marketInstance market + mOwner = marketOwner market + mFee = marketFee market + mFeeValue = Ada.lovelaceValueOf mFee nftMetadata' = nftMetadata { nftSeller = Nothing, nftSellPrice = 0 } nftSeller' = fromMaybe "" $ nftSeller nftMetadata nftMetadataDatum = NFTMeta nftMetadata' @@ -299,7 +304,7 @@ buy market BuyParams{..} = do redeemer = Redeemer $ PlutusTx.toBuiltinData $ Buy pkh nftValue = getNftValue (nftTokenSymbol nftMetadata) (nftTokenName nftMetadata) nftMetadataValue = getNftValue (nftMetaTokenSymbol nftMetadata) (nftMetaTokenName nftMetadata) - nftSellPriceValue = Ada.lovelaceValueOf $ nftSellPrice nftMetadata + nftSellPriceValue = Ada.lovelaceValueOf $ (nftSellPrice nftMetadata - mFee) lookups = Constraints.typedValidatorLookups marketInst <> Constraints.otherScript mrScript @@ -309,6 +314,7 @@ buy market BuyParams{..} = do <> Constraints.mustSpendScriptOutput oref redeemer <> Constraints.mustPayToPubKey pkh nftValue <> Constraints.mustPayToPubKey nftSeller' nftSellPriceValue + <> Constraints.mustPayToPubKey mOwner mFeeValue ledgerTx <- submitTxConstraintsWith lookups tx void $ awaitTxConfirmed $ txId ledgerTx let nftMetaDto = nftMetadataToDto nftMetadata' @@ -331,13 +337,15 @@ transfer market TransferParams{..} = do logInfo $ "transfer NFT: " ++ show nftMetaDto return nftMetaDto -marketplace :: CurrencySymbol -> NFTCurrency -> NFTCurrency -> NFTMarket -marketplace cs tokenCur metaTokenCur = +marketplace :: CurrencySymbol -> NFTCurrency -> NFTCurrency -> Integer -> PubKeyHash -> NFTMarket +marketplace cs tokenCur metaTokenCur fee pkh = NFTMarket{ marketId = assetClass cs marketplaceTokenName , marketTokenSymbol = nftCurrencySymbol tokenCur , marketTokenMetaSymbol = nftCurrencySymbol metaTokenCur , marketTokenMetaNameSuffix = toBuiltin . B.pack $ metadataTokenNamePrefix + , marketFee = fee + , marketOwner = pkh } getNFTMarketDatum :: TxOutTx -> Contract w s Text NFTMarketDatum @@ -469,9 +477,10 @@ ownerEndpoint :: -> PubKeyHash -> Contract (Last (Either Text NFTMarket)) MarketOwnerSchema Text CurrencySymbol ) + -> Integer -> Contract (Last (Either Text NFTMarket)) MarketOwnerSchema ContractError () -ownerEndpoint forgeNft = do - e <- mapError absurd $ runError $ start forgeNft +ownerEndpoint forgeNft fee = do + e <- mapError absurd $ runError $ start forgeNft fee void $ waitNSlots 1 tell $ Last $ Just e diff --git a/eleks/nft/src/Contracts/NFT/OnChain.hs b/eleks/nft/src/Contracts/NFT/OnChain.hs index 1c16042a1..bc8560c66 100644 --- a/eleks/nft/src/Contracts/NFT/OnChain.hs +++ b/eleks/nft/src/Contracts/NFT/OnChain.hs @@ -182,11 +182,13 @@ validateBuy :: -> ScriptContext -> Bool validateBuy NFTMarket{..} nftMeta@NFTMetadata{nftMetaTokenSymbol, nftMetaTokenName, nftTokenSymbol, nftTokenName} buyer ctx = - traceIfFalse "nft metadata token missing from input" $ isNftToken inVal nftMetaTokenSymbol nftMetaTokenName && - traceIfFalse "ouptut nftMetadata should be same" (nftMeta == outDatum) && - traceIfFalse "expected seller to get money" (addressGetValue (nftSeller nftMeta) $ Ada.lovelaceValueOf (nftSellPrice nftMeta)) && - traceIfFalse "expected buyer to get NFT token" (addressGetValue (Just buyer) $ getNftValue nftTokenSymbol nftTokenName) && - traceIfFalse "price should be grater 0" (nftSellPrice outDatum == 0) && + traceIfFalse "nft metadata token missing from input" $ isNftToken inVal nftMetaTokenSymbol nftMetaTokenName && + traceIfFalse "ouptut nftMetadata should be same" (nftMeta == outDatum) && + traceIfFalse "expected seller to get money" (addressGetValue (nftSeller nftMeta) $ Ada.lovelaceValueOf (nftSellPrice nftMeta - marketFee)) && + traceIfFalse "expected buyer to get NFT token" (addressGetValue (Just buyer) $ getNftValue nftTokenSymbol nftTokenName) && + traceIfFalse "expected market owner to get fee" (addressGetValue (Just marketOwner) $ Ada.lovelaceValueOf marketFee) && + traceIfFalse "price should be grater 0" (nftSellPrice outDatum == 0) && + traceIfFalse "fee should be grater 0" (marketFee > 0) && traceIfFalse "seller should be emptied" (PlutusTx.Prelude.isNothing $ nftSeller outDatum) where info :: TxInfo diff --git a/eleks/nft/src/Contracts/NFT/Types.hs b/eleks/nft/src/Contracts/NFT/Types.hs index 0873bcf7d..7ca407961 100644 --- a/eleks/nft/src/Contracts/NFT/Types.hs +++ b/eleks/nft/src/Contracts/NFT/Types.hs @@ -36,6 +36,8 @@ data NFTMarket = NFTMarket , marketTokenSymbol :: CurrencySymbol , marketTokenMetaSymbol :: CurrencySymbol , marketTokenMetaNameSuffix:: BuiltinByteString + , marketFee :: Integer + , marketOwner :: PubKeyHash } deriving (Show, Generic, ToJSON, FromJSON, ToSchema, Prelude.Eq, Prelude.Ord) PlutusTx.makeLift ''NFTMarket diff --git a/eleks/nft/src/test/Spec/Helper.hs b/eleks/nft/src/test/Spec/Helper.hs index a0c71b05d..5f4b8a339 100644 --- a/eleks/nft/src/test/Spec/Helper.hs +++ b/eleks/nft/src/test/Spec/Helper.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NumericUnderscores #-} module Spec.Helper where @@ -15,7 +16,10 @@ import Ledger (PubKeyHash, pubKeyHash) import Ledger.Value (CurrencySymbol(..), TokenName (..), AssetClass(..), toString) import qualified Plutus.Trace.Emulator as Trace import PlutusTx.Prelude (toBuiltin) -import Wallet.Emulator (Wallet, walletPubKey) +import Wallet.Emulator (Wallet(..), walletPubKey) + +ownerWallet' :: Wallet +ownerWallet' = Wallet 5 mockMarketId :: AssetClass mockMarketId = createMarketTokenMock NFTMarket.marketplaceTokenName @@ -29,6 +33,8 @@ nftMarketMock = NFTMarket , marketTokenSymbol = nftCurrencySymbol mockNftCurrency , marketTokenMetaSymbol = nftCurrencySymbol mockNftCurrency , marketTokenMetaNameSuffix = toBuiltin . B.pack $ metadataTokenNamePrefix + , marketFee = 500000 + , marketOwner = pubKeyHash $ walletPubKey ownerWallet' } data TestTokenMeta = TestTokenMeta @@ -83,7 +89,10 @@ createMarketTokenMock:: TokenName -> AssetClass createMarketTokenMock tokenName = AssetClass (getMarketTokenSymbol tokenName, tokenName) nftMaketSellPrice:: Integer -nftMaketSellPrice = 1000 +nftMaketSellPrice = 2000000 + +nftMarketFee :: Integer +nftMarketFee = marketFee nftMarketMock toMetaDto:: TestTokenMeta -> NFTMetadataDto toMetaDto = nftMetadataToDto . createNftMeta diff --git a/eleks/nft/src/test/Spec/NFT.hs b/eleks/nft/src/test/Spec/NFT.hs index 0f05c69a4..3c00dad62 100644 --- a/eleks/nft/src/test/Spec/NFT.hs +++ b/eleks/nft/src/test/Spec/NFT.hs @@ -50,7 +50,8 @@ t1 = Trace.walletInstanceTag w1 t2 = Trace.walletInstanceTag w2 ownerContract :: Contract (Last (Either Text NFTMarket)) MarketOwnerSchema ContractError () -ownerContract = NFTMarket.ownerEndpoint forgeMockNftToken +ownerContract = NFTMarket.ownerEndpoint forgeMockNftToken $ marketFee nftMarketMock + userContract :: Promise (Last (Either Text MarketContractState)) MarketUserSchema Void () userContract = NFTMarket.userEndpoints nftMarketMock @@ -161,8 +162,9 @@ tests = testGroup "nft" .&&. valueAtAddress (marketAddress nftMarketMock) (== (assetClassValue (testTokenMetaClass testToken1) 1 <> assetClassValue (marketId nftMarketMock) 1)) - .&&. walletFundsChange w1 (Ada.lovelaceValueOf nftMaketSellPrice) -   .&&. walletFundsChange w2 (Ada.lovelaceValueOf (negate nftMaketSellPrice) <> assetClassValue (testTokenClass testToken1) 1) + .&&. walletFundsChange w1 (Ada.lovelaceValueOf (nftMaketSellPrice - nftMarketFee)) +   .&&. walletFundsChange w2 (Ada.lovelaceValueOf (negate (nftMaketSellPrice)) <> assetClassValue (testTokenClass testToken1) 1) + .&&. walletFundsChange ownerWallet (Ada.lovelaceValueOf nftMarketFee) .&&. assertAccumState userContract t2 (\case Last (Just (Right (NFTMarket.Buyed meta))) -> meta == testToken1MetaDto; _ -> False) "should create buy NFT state" diff --git a/eleks/oracle/README.md b/eleks/oracle/README.md index a49d2bace..a5f1ff04d 100644 --- a/eleks/oracle/README.md +++ b/eleks/oracle/README.md @@ -70,6 +70,13 @@ NS - "Not Started", LIVE - "In Progress", FT - "Match Finished" CANC - "Match Cancelled" + +switch to live +curl -v -X PUT -H "Content-Type: application/json" \ + -d '{"ugpSatus": "LIVE", "ugpWinnerTeamId": 0}' \ + http://localhost:8081/games/1 + +finish with winner curl -v -X PUT -H "Content-Type: application/json" \ -d '{"ugpSatus": "FT", "ugpWinnerTeamId": 55}' \ http://localhost:8081/games/1 @@ -85,9 +92,9 @@ cabal build mutualbetserver cabal exec -- mutualbetserver ``` -### game server API +### mutual bet server API -1. Wallet info +1. Wallet info (WalletId, PubKey) curl -s http://localhost:8082/wallet/1 ## The Plutus Application Backend (PAB) example @@ -115,20 +122,24 @@ cabal exec -- bet-pab export INSTANCE_ID=... curl -s http://localhost:9080/api/new/contract/instance/$INSTANCE_ID/status | jq -2. Running mutual bat contract info and instance id -curl -s http://localhost:9080/api/contract/instances/wallet/1 | jq '.[] | select(.cicDefinition.tag=="MutualBetBettorContract") | .cicDefinition, .cicContract.unContractInstanceId' +2. Get all contract ids and wallet ids +curl -s http://localhost:9080/api/contract/instances/ | jq '.[] | select(.cicDefinition.tag=="MutualBetBettorContract") | .cicDefinition, .cicContract, .cicWallet' +3. Running mutual bat contract info and instance id +export WALLET_ID=76d5e1291d51f16eb442267faccd0ab51a3b0c4a21eb6b8f72d5f0a4ca467189ac5f70a018c6df3f632b48fd8ead1b68f39a44de06f5a5de42a6a131af0f085d44becd56fa30041efea5ff2637205181837dffd03545d3db1c11e6dcbbd3415ce8f85aad41776b99eb62a797b8c5abbe82061e1634efc4c7d5ac6fff3ca94d7f +curl -s http://localhost:9080/api/contract/instances/wallet/$WALLET_ID | jq '.[] | select(.cicDefinition.tag=="MutualBetBettorContract") | .cicDefinition, .cicContract' -curl -s http://localhost:9080/api/contract/instances/wallet/1 | jq '.[] | .cicDefinition, .cicContract.unContractInstanceId' ### Pab transactions 1. Make a bet -export INSTANCE_ID=... +export INSTANCE_ID=c2affd9b-3269-414e-9919-891150611639 curl -H "Content-Type: application/json" \ --request POST \ - --data '{"nbpAmount":1500000, "nbpWinnerId": 55}' \ + --data '{"nbpAmount":3000000, "nbpWinnerId": 55}' \ http://localhost:9080/api/contract/instance/$INSTANCE_ID/endpoint/bet 2. Get contract state curl -H "Content-Type: application/json" \ --request GET \ - http://localhost:9080/api/contract/instance/$INSTANCE_ID/status | jq '.cicCurrentState.observableState' \ No newline at end of file + http://localhost:9080/api/contract/instance/$INSTANCE_ID/status | jq '.cicCurrentState.observableState' + + 76d5e1291d51f16eb442267faccd0ab51a3b0c4a21eb6b8f72d5f0a4ca467189ac5f70a018c6df3f632b48fd8ead1b68f39a44de06f5a5de42a6a131af0f085d44becd56fa30041efea5ff2637205181837dffd03545d3db1c11e6dcbbd3415ce8f85aad41776b99eb62a797b8c5abbe82061e1634efc4c7d5ac6fff3ca94d7f \ No newline at end of file diff --git a/eleks/oracle/cabal.project b/eleks/oracle/cabal.project index 9be7beda7..4b25afb96 100644 --- a/eleks/oracle/cabal.project +++ b/eleks/oracle/cabal.project @@ -28,7 +28,8 @@ source-repository-package prettyprinter-configurable quickcheck-dynamic word-array - tag: 8c83c4abe211b4bbcaca3cdf1b2c0e38d0eb683f + tag: 1426912c3f8c29e7ca8754dafae81eaf281e1ee6 + --tag: 8c83c4abe211b4bbcaca3cdf1b2c0e38d0eb683f -- We never, ever, want this. write-ghc-environment-files: never @@ -74,28 +75,23 @@ package ouroboros-consensus-cardano package cardano-api optimization: False --- Turn off the tests for a while -package plutus-metatheory - tests: False - -- https://github.com/Quid2/flat/pull/22 fixes a potential exception -- when decoding invalid (e.g. malicious) text literals. source-repository-package type: git - -- location: https://github.com/Quid2/flat.git - location: https://github.com/michaelpj/flat.git + location: https://github.com/Quid2/flat.git tag: ee59880f47ab835dbd73bea0847dab7869fc20d8 -- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year) source-repository-package type: git - location: https://github.com/shmish111/purescript-bridge.git + location: https://github.com/input-output-hk/purescript-bridge.git tag: 6a92d7853ea514be8b70bab5e72077bf5a510596 source-repository-package type: git - location: https://github.com/shmish111/servant-purescript.git - tag: a76104490499aa72d40c2790d10e9383e0dbde63 + location: https://github.com/input-output-hk/servant-purescript.git + tag: a0c7c7e37c95564061247461aef4be505a853538 source-repository-package type: git @@ -105,17 +101,17 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/cardano-base - tag: cb0f19c85e5bb5299839ad4ed66af6fa61322cc4 + tag: 592aa61d657ad5935a33bace1243abce3728b643 subdir: base-deriving-via binary binary/test - measures - orphans-deriving-via - slotting cardano-crypto-class cardano-crypto-praos cardano-crypto-tests + measures + orphans-deriving-via + slotting strict-containers source-repository-package @@ -126,10 +122,28 @@ source-repository-package cardano-prelude cardano-prelude-test +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-addresses + tag: d2f86caa085402a953920c6714a0de6a50b655ec + subdir: + core + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-wallet + tag: ae7569293e94241ef6829139ec02bd91abd069df + subdir: + lib/text-class + lib/strict-non-empty-containers + lib/core + lib/test-utils + lib/numeric + source-repository-package type: git location: https://github.com/input-output-hk/ouroboros-network - tag: f149c1c1e4e4bb5bab51fa055e9e3a7084ddc30e + tag: 5d37a927046bc7da2887830d8e35cf604622ce09 subdir: monoidal-synchronisation typed-protocols @@ -144,11 +158,22 @@ source-repository-package io-sim io-classes network-mux + ntp-client source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: 808724ff8a19a33d0ed06f9ef59fbd900b08553c + -- Important Note: Read below, before changing this! + tag: 46f994e216a1f8b36fe4669b47b2a7011b0e153c + -- Are you thinking of updating this tag to some other commit? Please + -- ensure that the commit you are about to use is the latest one from + -- the *develop* branch of this repo: + -- * + -- (not master!) + -- + -- In particular we rely on the code from this PR: + -- * + -- being merged. subdir: iohk-monitoring tracer-transformers @@ -161,8 +186,8 @@ source-repository-package source-repository-package type: git - location: https://github.com/input-output-hk/cardano-ledger-specs - tag: 12a0ef69d64a55e737fbf4e846bd8ed9fb30a956 + location: https://github.com/raduom/cardano-ledger-specs + tag: ef6bb99782d61316da55470620c7da994cc352b2 subdir: byron/chain/executable-spec byron/crypto @@ -171,6 +196,7 @@ source-repository-package byron/ledger/impl byron/ledger/impl/test semantics/executable-spec + cardano-protocol-tpraos semantics/small-steps-test shelley/chain-and-ledger/dependencies/non-integer shelley/chain-and-ledger/executable-spec @@ -185,7 +211,7 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/cardano-node.git - tag: 3a56ac245c83d3345f81123ec3bb496bb23477a3 + tag: ed7fdbf65f40f8e194850b87dd8c631fe26154e6 subdir: cardano-api cardano-node diff --git a/eleks/oracle/gameserver/Service.hs b/eleks/oracle/gameserver/Service.hs index 17c2ae0c5..6cf1cfeda 100644 --- a/eleks/oracle/gameserver/Service.hs +++ b/eleks/oracle/gameserver/Service.hs @@ -64,11 +64,12 @@ updateGameState winnerId status gameId = updateGameStatus :: FixtureStatusShort -> Game -> Either String Game updateGameStatus newStatus game = do let currentStatus = game ^. fixture . status . short - when (validateGameStatusChanges currentStatus newStatus) (Left $ "Invalid state change from " ++ show currentStatus ++ " to new " ++ show newStatus) + when (not $ validateGameStatusChanges currentStatus newStatus) (Left $ "Invalid state change from " ++ show currentStatus ++ " to new " ++ show newStatus) return $ game & fixture . status .~ (createFixtureStatus newStatus) updateGameWinner :: TeamId -> Game -> Either String Game updateGameWinner teamIdParam game + | teamIdParam == 0 && game ^. fixture . status . short /= FT = Right game | game ^. teams . home . teamId == teamIdParam = Right $ game & teams . home . winner .~ True | game ^. teams . away . teamId == teamIdParam = Right $ game & teams . away . winner .~ True | otherwise = Left "Error winner update" diff --git a/eleks/oracle/gameserver/fixture-template.json b/eleks/oracle/gameserver/fixture-template.json index 781be1803..468d76194 100644 --- a/eleks/oracle/gameserver/fixture-template.json +++ b/eleks/oracle/gameserver/fixture-template.json @@ -24,187 +24,5 @@ "logo": "https://media.api-sports.io/football/teams/42.png" } } - }, - { - "fixture": { - "status": { - "long": "Not Started", - "short": "NS" - }, - "referee": "David Coote, England", - "id": 710557, - "date": "2021-08-14T14:00:00+00:00", - "timezone": "UTC" - }, - "teams": { - "home": { - "id": 44, - "name": "Burnley", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/44.png" - }, - "away": { - "id": 51, - "name": "Brighton", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/51.png" - } - } - }, - { - "fixture": { - "status": { - "long": "Match Cancelled", - "short": "CANC" - }, - "referee": "Jonathan Moss, England", - "id": 710558, - "date": "2021-08-14T14:00:00+00:00", - "timezone": "UTC" - }, - "teams": { - "home": { - "id": 49, - "name": "Chelsea", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/49.png" - }, - "away": { - "id": 52, - "name": "Crystal Palace", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/52.png" - } - } - }, - { - "fixture": { - "status": { - "long": "Not Started", - "short": "NS" - }, - "referee": "Kevin Friend, England", - "id": 710559, - "date": "2021-08-14T14:00:00+00:00", - "timezone": "UTC" - }, - "teams": { - "home": { - "id": 45, - "name": "Everton", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/45.png" - }, - "away": { - "id": 41, - "name": "Southampton", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/41.png" - } - } - }, - { - "fixture": { - "status": { - "long": "Match Finished", - "short": "FT" - }, - "referee": "Craig Pawson, England", - "id": 710560, - "date": "2021-08-14T14:00:00+00:00", - "timezone": "UTC" - }, - "teams": { - "home": { - "id": 46, - "name": "Leicester", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/46.png" - }, - "away": { - "id": 39, - "name": "Wolves", - "winner": true, - "logo": "https://media.api-sports.io/football/teams/39.png" - } - } - }, - { - "fixture": { - "status": { - "long": "In Progress", - "short": "LIVE" - }, - "referee": "P. Tierney", - "id": 710561, - "date": "2021-08-14T11:30:00+00:00", - "timezone": "UTC" - }, - "teams": { - "home": { - "id": 33, - "name": "Manchester United", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/33.png" - }, - "away": { - "id": 63, - "name": "Leeds", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/63.png" - } - } - }, - { - "fixture": { - "status": { - "long": "Match Finished", - "short": "FT" - }, - "referee": "Andre Marriner, England", - "id": 710563, - "date": "2021-08-14T16:30:00+00:00", - "timezone": "UTC" - }, - "teams": { - "home": { - "id": 71, - "name": "Norwich", - "winner": true, - "logo": "https://media.api-sports.io/football/teams/71.png" - }, - "away": { - "id": 40, - "name": "Liverpool", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/40.png" - } - } - }, - { - "fixture": { - "status": { - "long": "Not Started", - "short": "NS" - }, - "referee": "Mike Dean, England", - "id": 710565, - "date": "2021-08-14T14:00:00+00:00", - "timezone": "UTC" - }, - "teams": { - "home": { - "id": 38, - "name": "Watford", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/38.png" - }, - "away": { - "id": 66, - "name": "Aston Villa", - "winner": false, - "logo": "https://media.api-sports.io/football/teams/66.png" - } - } } ] \ No newline at end of file diff --git a/eleks/oracle/mutual-bet.cabal b/eleks/oracle/mutual-bet.cabal index 2b67939f3..9f8588825 100644 --- a/eleks/oracle/mutual-bet.cabal +++ b/eleks/oracle/mutual-bet.cabal @@ -39,10 +39,12 @@ library bytestring, base64-bytestring, cardano-api -any, + cardano-crypto -any, + containers -any, data-default -any, text -any, lens -any, - containers -any, + openapi3 -any, semigroups -any, serialise, playground-common, @@ -108,10 +110,12 @@ executable bet-pab base >= 4.9 && < 5, bytestring, base64-bytestring, + containers -any, data-default -any, text -any, - containers -any, lens -any, + openapi3 -any, + playground-common, plutus-contract -any, plutus-pab -any, mutual-bet, diff --git a/eleks/oracle/pab/Main.hs b/eleks/oracle/pab/Main.hs index 4acf0b7a4..41df76760 100644 --- a/eleks/oracle/pab/Main.hs +++ b/eleks/oracle/pab/Main.hs @@ -10,6 +10,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE StandaloneDeriving #-} module Main(main) where @@ -46,9 +47,9 @@ import qualified Plutus.PAB.Webserver.Server as PAB.Server import Contracts.MutualBet import Contracts.Oracle import Types.Game -import Wallet.Emulator.Types (Wallet (..)) import qualified Data.ByteString.Char8 as B import Ledger (PubKeyHash(..), pubKeyHash, CurrencySymbol(..), pubKeyAddress) +import Ledger.Crypto (PrivateKey, privateKey5) import qualified Ledger.Value as Value import Ledger.Value (TokenName (..), Value) import Ledger.TimeSlot (SlotConfig) @@ -58,6 +59,12 @@ import Wallet.Types (ContractInstanceId (..)) import qualified Ledger.Typed.Scripts as Scripts import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg) import qualified GameClient as GameClient +import Wallet.Emulator (Wallet (..), knownWallets, knownWallet, walletPubKey) +import qualified Data.OpenApi.Schema as OpenApi +import Playground.Contract (ToSchema) + +deriving instance OpenApi.ToSchema SlotConfig +deriving instance OpenApi.ToSchema ThreadToken initGame :: Oracle -> Game -> Simulator.Simulation (Builtin MutualBetContracts) () initGame oracle game = do @@ -89,6 +96,7 @@ initGame oracle game = do main :: IO () main = void $ Simulator.runSimulationWith handlers $ do + Simulator.logString @(Builtin MutualBetContracts) "Starting mutual bet" shutdown <- PAB.Server.startServerDebug @@ -97,7 +105,7 @@ main = void $ Simulator.runSimulationWith handlers $ do let oracleParams = OracleParams { opSymbol = Currency.currencySymbol currency , opFees = 1_500_000 - , opSigner = (walletPrivKey oracleWallet) + , opSigner = oraclePrivateKey , opCollateral = 1_000_000 } cidOracle <- Simulator.activateContract oracleWallet $ OracleСontract oracleParams @@ -131,10 +139,10 @@ main = void $ Simulator.runSimulationWith handlers $ do updatedGameId <- waitForOracleUpdated cidOracle Simulator.logString @(Builtin MutualBetContracts) $ "updated for " ++ show updatedGameId - Simulator.logString @(Builtin MutualBetContracts) $ "wait 5 seconds" + Simulator.logString @(Builtin MutualBetContracts) $ "wait 10 seconds" -- todo query active games and create contract - void $ liftIO $ threadDelay 10_000_000 + void $ liftIO $ threadDelay 5_000_000 data MutualBetContracts = OracleTokenInit @@ -142,8 +150,8 @@ data MutualBetContracts = | MutualBetBettorContract SlotConfig ThreadToken MutualBetParams | OracleСontract OracleParams deriving (Eq, Show, Generic) - deriving anyclass (FromJSON, ToJSON) - + deriving anyclass (FromJSON, ToJSON, OpenApi.ToSchema) + instance Pretty MutualBetContracts where pretty = viaShow @@ -196,13 +204,16 @@ waitForLastBetOuput cid = _ -> Nothing bettorWallets :: [Wallet] -bettorWallets = [Wallet i | i <- [1 .. 4]] +bettorWallets = take 4 knownWallets mutualBetOwnerWallet :: Wallet -mutualBetOwnerWallet = Wallet 6 +mutualBetOwnerWallet = knownWallet 6 oracleWallet :: Wallet -oracleWallet = Wallet 5 +oracleWallet = knownWallet 5 + +oraclePrivateKey :: PrivateKey +oraclePrivateKey = privateKey5 slotCfg :: SlotConfig slotCfg = def diff --git a/eleks/oracle/pab/MutualBetServer.hs b/eleks/oracle/pab/MutualBetServer.hs index 9fe039079..c22f97b00 100644 --- a/eleks/oracle/pab/MutualBetServer.hs +++ b/eleks/oracle/pab/MutualBetServer.hs @@ -18,16 +18,16 @@ import qualified Data.ByteString.Char8 as B import Ledger (pubKeyHash, getPubKeyHash, pubKeyAddress, PubKey, Address, PubKeyHash) import Network.Wai.Handler.Warp import Types.Game -import Wallet.Emulator (walletPubKey, Wallet (..)) +import Wallet.Emulator (walletPubKey, Wallet (..), knownWallet) import qualified PlutusTx.Prelude as PlutusTx type GamesAPI = "wallet" :> Capture "id" Integer :> Get '[JSON] WalletData data WalletData = WalletData - { walletDataPubKey :: PubKey - , walletDataPubKeyHash :: PubKeyHash - , walletDataPubKeyHashStr :: Text - , walletDataAddress :: !Address + { walletDataPubKey :: !PubKey + , walletDataPubKeyHash :: !PubKeyHash + , walletDataAddress :: !Address + , walletId :: !Text } deriving Generic instance FromJSON WalletData instance ToJSON WalletData @@ -40,11 +40,13 @@ mutualBetServer = wallet where wallet:: Integer -> Handler WalletData wallet walletId = do - let pubKey = walletPubKey . Wallet $ walletId + + let walletInst = knownWallet $ walletId + pubKey = walletPubKey walletInst return WalletData { walletDataPubKey = pubKey , walletDataPubKeyHash = pubKeyHash pubKey - , walletDataPubKeyHashStr = Aeson.encodeByteString $ PlutusTx.fromBuiltin $ getPubKeyHash $ pubKeyHash pubKey , walletDataAddress = pubKeyAddress pubKey + , walletId = toUrlPiece walletInst } mutualBetApp :: Application diff --git a/eleks/oracle/src/Contracts/MutualBet/OffChain.hs b/eleks/oracle/src/Contracts/MutualBet/OffChain.hs index 87bfa9135..7ce805b41 100644 --- a/eleks/oracle/src/Contracts/MutualBet/OffChain.hs +++ b/eleks/oracle/src/Contracts/MutualBet/OffChain.hs @@ -5,7 +5,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} @@ -128,6 +130,7 @@ mutualBetStart params = do waitGameStateChange client = do gameState <- waitForGameStateChange params case osmGameStatus $ gmsSignedMessageData gameState of + NS -> waitGameStateChange client FT -> payout params client gameState LIVE -> do logInfo @Haskell.String "Make bet over" @@ -150,7 +153,7 @@ payout params client GameStateChange{gmsOutRef, gmsOutTx, gmsOracleData, gmsSign let lookups = ScriptLookups { slMPS = Map.singleton (oracleRequestMintPolicyHash oracleRequest) (requestTokenPolicy oracleRequest) , slTxOutputs = Map.singleton gmsOutRef gmsOutTx - , slOtherScripts = Map.singleton (oracleAddress oracle) (oracleValidator oracle) + , slOtherScripts = Map.singleton (oracleValidatorHash oracle) (oracleValidator oracle) , slOtherData = Map.empty , slTypedValidator = Nothing , slOwnPubkey = Nothing @@ -191,7 +194,7 @@ cancelGame params client GameStateChange{gmsOutRef, gmsOutTx} = do let lookups = ScriptLookups { slMPS = Map.singleton (oracleRequestMintPolicyHash oracleRequest) (requestTokenPolicy oracleRequest) , slTxOutputs = Map.singleton gmsOutRef gmsOutTx - , slOtherScripts = Map.singleton (oracleAddress oracle) (oracleValidator oracle) + , slOtherScripts = Map.singleton (oracleValidatorHash oracle) (oracleValidator oracle) , slOtherData = Map.empty , slTypedValidator = Nothing , slOwnPubkey = Nothing @@ -239,7 +242,7 @@ isCurrentGame pk params oracleData | (mbpGame params) /= (ovGame oracleData) = Left "Not current game" | otherwise = Right oracleData -mapSignedMessage :: MutualBetParams -> (TxOutRef, TxOutTx, OracleData) -> Maybe GameStateChange +mapSignedMessage :: MutualBetParams -> (TxOutRef, ChainIndexTxOut, OracleData) -> Maybe GameStateChange mapSignedMessage params (oref, o, od) = case ovSignedMessage od of Just signed -> case Oracle.verifySignedMessageOffChain (oOperatorKey $ mbpOracle params) signed of Left err -> Nothing @@ -277,39 +280,26 @@ data BettorEvent = deriving (Haskell.Show) waitForChange :: SlotConfig -> MutualBetParams -> StateMachineClient MutualBetState MutualBetInput -> [Bet] -> Contract MutualBetOutput BettorSchema MutualBetError BettorEvent waitForChange slotCfg params client bets = do - t <- currentTime + now <- currentTime + let waitFor = now + 10_000 + smUpdatePromise <- SM.waitForUpdateTimeout client (isTime waitFor) let makeBet = endpoint @"bet" $ \params -> do logInfo ("last bets" ++ Haskell.show params) pure $ MakeBet params otherBid = do - let address = Scripts.validatorAddress (SM.typedValidator (SM.scInstance client)) - targetTime = TimeSlot.slotToBeginPOSIXTime slotCfg - $ Haskell.succ - $ TimeSlot.posixTimeToEnclosingSlot slotCfg t promiseBind - (addressChangeRequest - AddressChangeRequest - { acreqSlotRangeFrom = TimeSlot.posixTimeToEnclosingSlot slotCfg targetTime - , acreqSlotRangeTo = TimeSlot.posixTimeToEnclosingSlot slotCfg targetTime - , acreqAddress = address - }) - $ \AddressChangeResponse{acrTxns} -> - case acrTxns of - [] -> do - state <- currentState client - case state of - Nothing -> pure (MutualBetIsOver bets) - _ -> pure (NoChange bets) - - _ -> do - state <- currentState client - case state of - Just (Ongoing bets) -> pure (OtherBet bets) - Just (BettingClosed bets) -> pure (BettingHasСlosed bets) - _ -> pure (MutualBetIsOver bets) - - + smUpdatePromise + $ \case + ContractEnded {} -> pure (MutualBetIsOver bets) + -- The state machine transitionned to a new state + Transition {} -> do + state <- currentState client + case state of + Just (Ongoing bets) -> pure (OtherBet bets) + Just (BettingClosed bets) -> pure (BettingHasСlosed bets) + _ -> pure (MutualBetIsOver bets) + _ -> pure (NoChange bets) selectList [makeBet, otherBid] handleEvent :: StateMachineClient MutualBetState MutualBetInput -> [Bet] -> BettorEvent -> Contract MutualBetOutput BettorSchema MutualBetError (Either [Bet] ()) @@ -319,7 +309,7 @@ handleEvent client bets change = -- see note [Bettor client] in case change of MutualBetIsOver s -> do - logInfo @Haskell.String "Mutual bet over" + logInfo ("Mutual bet over" ++ Haskell.show bets) tell (mutualBetStateOut $ Finished s) stop BettingHasСlosed s -> do @@ -336,7 +326,9 @@ handleEvent client bets change = logInfo @Haskell.String "SM: runStep done" case r of SM.TransitionFailure i -> logError (TransitionFailed i) >> continue bets - SM.TransitionSuccess (Ongoing bets) -> logInfo (BetSubmitted bets) >> continue bets + SM.TransitionSuccess (Ongoing bets) -> do + tell (mutualBetStateOut $ Ongoing bets) + logInfo (BetSubmitted bets) >> continue bets SM.TransitionSuccess (BettingClosed bets) -> logInfo (MutualBetBettingClosed bets) >> continue bets SM.TransitionSuccess (Finished bets) -> logError (MutualBetGameEnded bets) >> stop OtherBet s -> do diff --git a/eleks/oracle/src/Contracts/MutualBet/Types.hs b/eleks/oracle/src/Contracts/MutualBet/Types.hs index 0146aacf1..0a4870085 100644 --- a/eleks/oracle/src/Contracts/MutualBet/Types.hs +++ b/eleks/oracle/src/Contracts/MutualBet/Types.hs @@ -32,8 +32,9 @@ import Playground.Contract (Show, FromJSON, Generic, ToJS import qualified Plutus.Contract.StateMachine as SM import qualified PlutusTx import PlutusTx.Prelude -import qualified Prelude as Haskell +import qualified Prelude as Haskell import Types.Game +import qualified Data.OpenApi.Schema as OpenApi -- | Definition of an mutual bet data MutualBetParams @@ -47,7 +48,7 @@ data MutualBetParams , mbpBetFee :: Ada -- Platform fee, for each bet you need additionally to pay the fee, fee is no returned if game in case game cancelled or no one wins } deriving stock (Haskell.Eq, Haskell.Show, Generic) - deriving anyclass (ToJSON, FromJSON, ToSchema) + deriving anyclass (ToJSON, FromJSON, ToSchema, OpenApi.ToSchema) PlutusTx.makeLift ''MutualBetParams @@ -108,7 +109,7 @@ PlutusTx.unstableMakeIsData ''MutualBetInput data GameStateChange = GameStateChange { gmsOutRef :: TxOutRef - , gmsOutTx :: TxOutTx + , gmsOutTx :: ChainIndexTxOut , gmsOracleData :: OracleData , gmsSignedMessage :: SignedMessage OracleSignedMessage , gmsSignedMessageData :: OracleSignedMessage diff --git a/eleks/oracle/src/Contracts/Oracle/OffChain.hs b/eleks/oracle/src/Contracts/Oracle/OffChain.hs index 7b4aa5d43..005b42ba5 100644 --- a/eleks/oracle/src/Contracts/Oracle/OffChain.hs +++ b/eleks/oracle/src/Contracts/Oracle/OffChain.hs @@ -34,6 +34,7 @@ module Contracts.Oracle.OffChain ) where import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1) +import Control.Lens (view) import Control.Monad hiding (fmap) import Contracts.Oracle.Types import Contracts.Oracle.RequestToken @@ -66,14 +67,7 @@ import Plutus.Contract.Types (Promise (..)) import Prelude (Semigroup (..), Show (..), String) import qualified Prelude as Haskell import Schema (ToSchema) - -data OracleParams = OracleParams - { opSymbol :: !CurrencySymbol - , opFees :: !Ada - , opCollateral :: !Ada - , opSigner :: !PrivateKey - } deriving (Haskell.Eq, Haskell.Show, Generic, FromJSON, ToJSON) - +import Plutus.ChainIndex () startOracle :: forall w s. OracleParams -> Contract w s Text Oracle startOracle op = do pk <- Contract.ownPubKey @@ -122,8 +116,10 @@ updateOracle oracle operatorPrivateKey params = do ledgerTx <- submitTxConstraintsWith lookups tx awaitTxConfirmed $ txId ledgerTx -oracleValueFromTxOutTx :: TxOutTx -> Maybe OracleData -oracleValueFromTxOutTx o = oracleValue (txOutTxOut o) $ \dh -> Map.lookup dh $ txData $ txOutTxTx o +oracleValueFromTxOutTx :: ChainIndexTxOut -> Maybe OracleData +oracleValueFromTxOutTx o = do + Datum d <- either (const Nothing) Just (_ciTxOutDatum o) + PlutusTx.fromBuiltinData d data UpdateOracleParams = UpdateOracleParams { uoGameId :: !GameId -- ^ Game @@ -168,9 +164,9 @@ requestOracleForAddress oracle gameId = do void $ awaitTxConfirmed $ txId ledgerTx --get active request lists for oracle to process -getActiveOracleRequests:: Oracle -> Contract w s Text [(TxOutRef, TxOutTx, OracleData)] +getActiveOracleRequests:: Oracle -> Contract w s Text [(TxOutRef, ChainIndexTxOut, OracleData)] getActiveOracleRequests oracle = do - xs <- utxoAt (oracleAddress oracle) + xs <- utxosAt (oracleAddress oracle) let requests = filter (isActiveRequest oracle) . filterOracleRequest oracle . Map.toList $ xs return requests @@ -179,18 +175,17 @@ getActiveGames oracle = do requests <- nub . map (\(_, _, or) -> ovGame or) <$> getActiveOracleRequests oracle return requests -awaitNextOracleRequest:: Oracle -> Contract w s Text [(TxOutRef, TxOutTx, OracleData)] +awaitNextOracleRequest:: Oracle -> Contract w s Text [(TxOutRef, ChainIndexTxOut, OracleData)] awaitNextOracleRequest oracle = awaitNext where - awaitNext :: Contract w s Text [(TxOutRef, TxOutTx, OracleData)] + convertChainIndexOut:: (Maybe ChainIndexTxOut, TxOutRef) -> Maybe (TxOutRef, ChainIndexTxOut) + convertChainIndexOut (o, oref) = (\to -> (oref, to)) <$> o + awaitNext :: Contract w s Text [(TxOutRef, ChainIndexTxOut, OracleData)] awaitNext = do utxos <- awaitUtxoProduced $ oracleAddress oracle - let txs = (flip map) ( NonEmpty.toList $ utxos) (\onchainTx -> do - case onchainTx of - (Valid tx) -> Just $ map (\(o, oref) -> (oref, TxOutTx tx o)) $ txOutRefs tx - _ -> Nothing) - let filterValidTx = concat . catMaybes + let txs = map (\tx -> map convertChainIndexOut $ chainIndexTxOutsWithRef tx) (NonEmpty.toList $ utxos) + let filterValidTx = catMaybes . concat let filtered = filterOracleRequest oracle . filterValidTx $ txs return filtered @@ -203,6 +198,7 @@ runOracle op = do update :: Oracle -> Promise (Last OracleContractState) OracleSchema Text () update oracle = endpoint @"update" $ \updateOracleParams -> do logInfo @String "update called" + logInfo $ show updateOracleParams updateOracle oracle (opSigner op) updateOracleParams tell $ Last $ Just $ Updated $ uoGameId updateOracleParams games :: Oracle -> Promise (Last OracleContractState) OracleSchema Text () @@ -210,31 +206,31 @@ runOracle op = do gamesIds <- getActiveGames oracle tell $ Last $ Just $ Games gamesIds -hasOracleRequestToken :: Oracle -> (TxOutRef, TxOutTx) -> Bool +hasOracleRequestToken :: Oracle -> (TxOutRef, ChainIndexTxOut) -> Bool hasOracleRequestToken oracle (oref, o) = - assetClassValueOf (txOutValue $ txOutTxOut o) (requestTokenClassFromOracle oracle) == 1 + assetClassValueOf (view ciTxOutValue o) (requestTokenClassFromOracle oracle) == 1 -hasOracelRequestDatum :: (TxOutRef, TxOutTx) -> Bool +hasOracelRequestDatum :: (TxOutRef, ChainIndexTxOut) -> Bool hasOracelRequestDatum (oref, o) = isJust . oracleValueFromTxOutTx $ o -filterOracleRequest :: Oracle -> [(TxOutRef, TxOutTx)] -> [(TxOutRef, TxOutTx, OracleData)] +filterOracleRequest :: Oracle -> [(TxOutRef, ChainIndexTxOut)] -> [(TxOutRef, ChainIndexTxOut, OracleData)] filterOracleRequest oracle txs = catMaybes . map mapDatum . filter (hasOracleRequestToken oracle) $ txs -mapDatum :: (TxOutRef, TxOutTx) -> Maybe (TxOutRef, TxOutTx, OracleData) +mapDatum :: (TxOutRef, ChainIndexTxOut) -> Maybe (TxOutRef, ChainIndexTxOut, OracleData) mapDatum (oref, o) = case oracleValueFromTxOutTx o of Just datum -> Just (oref, o, datum) Nothing -> Nothing -isGameOracleRequest :: GameId -> (TxOutRef, TxOutTx, OracleData) -> Bool +isGameOracleRequest :: GameId -> (TxOutRef, ChainIndexTxOut, OracleData) -> Bool isGameOracleRequest gameId (_, _, od) = gameId == (ovGame od) -isOwnerOracleRequest :: PubKeyHash -> (TxOutRef, TxOutTx, OracleData) -> Bool +isOwnerOracleRequest :: PubKeyHash -> (TxOutRef, ChainIndexTxOut, OracleData) -> Bool isOwnerOracleRequest owner (_, _, od) = owner == (ovRequestAddress od) isActiveSignedMessage :: OracleSignedMessage -> Bool isActiveSignedMessage message = osmGameStatus message /= FT -isActiveRequest:: Oracle -> (TxOutRef, TxOutTx, OracleData) -> Bool +isActiveRequest:: Oracle -> (TxOutRef, ChainIndexTxOut, OracleData) -> Bool isActiveRequest oracle (_, _, od) = case ovSignedMessage od of -- not processed Nothing -> True @@ -247,9 +243,9 @@ findOracleRequest :: forall w s. Oracle -> GameId -> PubKeyHash - -> Contract w s Text (Maybe (TxOutRef, TxOutTx, OracleData)) + -> Contract w s Text (Maybe (TxOutRef, ChainIndexTxOut, OracleData)) findOracleRequest oracle gameId owner = do - xs <- utxoAt (oracleAddress oracle) + xs <- utxosAt (oracleAddress oracle) let findCriteria = find (\tx -> isOwnerOracleRequest owner tx && isGameOracleRequest gameId tx) let request = findCriteria . filterOracleRequest oracle . Map.toList $ xs pure request diff --git a/eleks/oracle/src/Contracts/Oracle/OnChain.hs b/eleks/oracle/src/Contracts/Oracle/OnChain.hs index f3bfc5f9f..9113f97a6 100644 --- a/eleks/oracle/src/Contracts/Oracle/OnChain.hs +++ b/eleks/oracle/src/Contracts/Oracle/OnChain.hs @@ -17,6 +17,7 @@ module Contracts.Oracle.OnChain ( typedOracleValidator , oracleValidator + , oracleValidatorHash , oracleAddress , oracleScriptAsShortBs , oraclePlutusScript diff --git a/eleks/oracle/src/Contracts/Oracle/Types.hs b/eleks/oracle/src/Contracts/Oracle/Types.hs index 7e8a5768c..e5c69802e 100644 --- a/eleks/oracle/src/Contracts/Oracle/Types.hs +++ b/eleks/oracle/src/Contracts/Oracle/Types.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -21,16 +22,29 @@ module Contracts.Oracle.Types where -import Ledger -import Ledger.Oracle (SignedMessage(..)) -import Ledger.Value (TokenName (..), AssetClass (..), assetClass, assetClassValue, assetClassValueOf) -import Playground.Contract (Show, FromJSON, Generic, ToJSON, ToSchema) +import Cardano.Crypto.Wallet (xprv, unXPrv, XPrv) +import Cardano.Crypto.Wallet.Encrypted (EncryptedKey) +import Control.Monad (mzero) +import Data.Aeson +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Either (fromRight) +import Data.Map (lookup) +import Ledger hiding (txOutRefs) +import Ledger.Oracle (SignedMessage(..)) +import Ledger.Value (TokenName (..), AssetClass (..), assetClass, assetClassValue, assetClassValueOf) +import Playground.Contract (Show, FromJSON, Generic, ToJSON, ToSchema) +import Plutus.ChainIndex.Tx (txOutRefs, ChainIndexTx (..), ChainIndexTxOutputs (..)) import qualified PlutusTx import PlutusTx.Prelude -import qualified Prelude as Haskell -import Text.Printf (PrintfArg) -import Types.Game (GameId, TeamId, FixtureStatusShort (..)) - +import qualified Prelude as Haskell +import Text.Printf (PrintfArg) +import Types.Game (GameId, TeamId, FixtureStatusShort (..)) +import Data.ByteString (ByteString) +import qualified Data.OpenApi.Schema as OpenApi +import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential)) + +deriving instance OpenApi.ToSchema Ada data Oracle = Oracle { --oSymbol :: !CurrencySymbol oRequestTokenSymbol :: !CurrencySymbol -- Oracle request token currency symbol @@ -38,7 +52,7 @@ data Oracle = Oracle , oOperatorKey :: !PubKey -- Oracle owner key used to verify signed data , oFee :: !Ada -- Oracle fee amount , oCollateral :: !Ada -- Oracle fee amount - } deriving (Show, Generic, FromJSON, ToJSON, ToSchema, Haskell.Eq, Haskell.Ord) + } deriving (Show, Generic, FromJSON, ToJSON, ToSchema, Haskell.Eq, Haskell.Ord, OpenApi.ToSchema) PlutusTx.makeLift ''Oracle @@ -99,11 +113,12 @@ instance Eq OracleData where (ovRequestAddress l == ovRequestAddress r) && (ovSignedMessage l PlutusTx.Prelude.== ovSignedMessage r) -instance Eq a => Eq (SignedMessage a) where - l == r = - osmSignature l == osmSignature r - && osmMessageHash l == osmMessageHash r - && osmDatum l == osmDatum r +instance FromJSON XPrv where + parseJSON (Object v) = (v .: "encryptedKey" :: Parser ByteString) >>= (\s -> case (xprv s) of Left _ -> mzero; Right r -> return r) + +instance ToJSON XPrv where + toJSON xprv = + object ["encryptedKey" .= unXPrv xprv] data OracleRedeemer = Update | OracleRedeem deriving Show @@ -113,6 +128,13 @@ data OracleRequestRedeemer = Request | RedeemToken deriving Show PlutusTx.makeIsDataIndexed ''OracleRequestRedeemer [('Request, 0), ('RedeemToken, 1)] +data OracleParams = OracleParams + { opSymbol :: !CurrencySymbol + , opFees :: !Ada + , opCollateral :: !Ada + , opSigner :: !PrivateKey + } deriving (Haskell.Eq, Haskell.Show, Generic, FromJSON, ToJSON, OpenApi.ToSchema) + {-# INLINABLE oracleRequestTokenName #-} oracleRequestTokenName :: TokenName oracleRequestTokenName = TokenName "oracleRequestTokenName" @@ -122,4 +144,18 @@ oracleValue :: TxOut -> (DatumHash -> Maybe Datum) -> Maybe OracleData oracleValue o f = do dh <- txOutDatum o Datum d <- f dh - PlutusTx.fromBuiltinData d \ No newline at end of file + PlutusTx.fromBuiltinData d + +fromTxOutToChainIndexTxOut :: ChainIndexTx -> TxOut -> Maybe ChainIndexTxOut +fromTxOutToChainIndexTxOut ChainIndexTx{_citxData} TxOut { txOutAddress, txOutValue, txOutDatumHash } = + case addressCredential txOutAddress of + PubKeyCredential _ -> pure $ PublicKeyChainIndexTxOut txOutAddress txOutValue + ScriptCredential vh -> + txOutDatumHash >>= + \h -> lookup h _citxData >>= + \datum -> pure $ ScriptChainIndexTxOut txOutAddress (Left vh) (Right datum) txOutValue + +-- | Get tx output references and tx outputs from tx. +chainIndexTxOutsWithRef :: ChainIndexTx -> [(Maybe ChainIndexTxOut, TxOutRef)] +chainIndexTxOutsWithRef tx@ChainIndexTx { _citxOutputs = ValidTx outputs } = zip (map (fromTxOutToChainIndexTxOut tx) outputs) $ txOutRefs tx +chainIndexTxOutsWithRef ChainIndexTx { _citxOutputs = InvalidTx } = [] \ No newline at end of file diff --git a/eleks/oracle/src/test/Spec/MutualBet.hs b/eleks/oracle/src/test/Spec/MutualBet.hs index 51825a73f..13b2a3a3b 100644 --- a/eleks/oracle/src/test/Spec/MutualBet.hs +++ b/eleks/oracle/src/test/Spec/MutualBet.hs @@ -31,6 +31,7 @@ import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (toLazyText) import Ledger (Ada, Slot (..), Value, pubKeyHash) import qualified Ledger.Ada as Ada +import Ledger.Crypto (PrivateKey, privateKey5) import Ledger.Oracle (Observation, SignedMessage, signMessage) import Ledger.TimeSlot (SlotConfig) import qualified Ledger.TimeSlot as TimeSlot @@ -60,7 +61,7 @@ oracleParams = OracleParams { opSymbol = oracleCurrency , opFees = 1_000_000 , opCollateral = 2_000_000 - , opSigner = walletPrivKey oracleWallet + , opSigner = oraclePrivateKey } oracleRequestToken :: OracleRequestToken @@ -120,17 +121,15 @@ bettorContract cur = mutualBetBettor slotCfg cur mutualBetParams oracleContract :: Contract (Last OracleContractState) OracleSchema Text () oracleContract = runOracle oracleParams -w1, w2, w3, bettor1, bettor2 :: Wallet -w1 = Wallet 1 -w2 = Wallet 2 -w3 = Wallet 3 -w4 = Wallet 4 -w5 = Wallet 5 +betOwnerWallet, bettor1, bettor2, oracleWallet :: Wallet betOwnerWallet = w1 bettor1 = w2 bettor2 = w3 oracleWallet = w5 +oraclePrivateKey :: PrivateKey +oraclePrivateKey = privateKey5 + trace1Bettor1Bet :: Integer trace1Bettor1Bet = 10_000_000 @@ -152,13 +151,14 @@ mutualBetSuccessTrace = do bettor2Hdl <- Trace.activateContractWallet bettor2 (bettorContract threadToken) _ <- Trace.waitNSlots 1 let bet1Params = NewBetParams { nbpAmount = trace1Bettor1Bet, nbpWinnerId = team1Id} + Extras.logInfo $ "Make bet Uraaaaaaaaaa " ++ show threadToken Trace.callEndpoint @"bet" bettor1Hdl bet1Params - _ <- Trace.waitNSlots 2 + _ <- Trace.waitNSlots 10 let bet2Params = NewBetParams { nbpAmount = trace1Bettor2Bet, nbpWinnerId = team2Id} Trace.callEndpoint @"bet" bettor2Hdl bet2Params let updateParams = UpdateOracleParams{ uoGameId = gameId, uoWinnerId = 0, uoGameStatus = LIVE } Trace.callEndpoint @"update" oracleHdl updateParams - void $ Trace.waitNSlots 5 + void $ Trace.waitNSlots 10 let updateParams = UpdateOracleParams{ uoGameId = gameId, uoWinnerId = team1Id, uoGameStatus = FT } Trace.callEndpoint @"update" oracleHdl updateParams void $ Trace.waitNSlots 5 diff --git a/eleks/oracle/src/test/Spec/Oracle.hs b/eleks/oracle/src/test/Spec/Oracle.hs index 8b7833880..5bf3b3187 100644 --- a/eleks/oracle/src/test/Spec/Oracle.hs +++ b/eleks/oracle/src/test/Spec/Oracle.hs @@ -28,6 +28,7 @@ import Data.Text (Text, pack) import Data.Sort (sort) import Ledger (Ada, Slot (..), Value, pubKeyHash) import qualified Ledger.Ada as Ada +import Ledger.Crypto (PrivateKey, privateKey1) import Ledger.Index (ValidationError (ScriptFailure)) import Ledger.Scripts (ScriptError (EvaluationError)) import Ledger.Oracle (Observation, SignedMessage, signMessage, verifySignedMessageOffChain, verifySignedMessageConstraints) @@ -68,7 +69,7 @@ oracleParams = OracleParams { opSymbol = oracleCurrency , opFees = 5_000_000 , opCollateral = 10_000_000 - , opSigner = walletPrivKey oracleWallet + , opSigner = oraclePrivateKey } oracleRequestToken :: OracleRequestToken @@ -102,16 +103,14 @@ requestOracleTokenContract oracle gameId = requestOracleForAddress oracle gameId useOracleContract :: Oracle -> Contract Text UseOracleSchema Text () useOracleContract oracle = useOracle oracle -w1, w2, w3 :: Wallet -w1 = Wallet 1 -w2 = Wallet 2 -w3 = Wallet 3 -w4 = Wallet 4 -w5 = Wallet 5 +oracleWallet, oracleClientWallet, otherWallet :: Wallet oracleWallet = w1 oracleClientWallet = w2 otherWallet = w3 +oraclePrivateKey :: PrivateKey +oraclePrivateKey = privateKey1 + winTeamId:: Integer winTeamId = 1 @@ -133,7 +132,7 @@ signOracleTestState :: OracleData signOracleTestState = OracleData { ovGame = gameId , ovRequestAddress = pubKeyHash $ walletPubKey oracleClientWallet - , ovSignedMessage = Just $ signMessage OracleSignedMessage{ osmGameId = gameId, osmWinnerId = 0, osmGameStatus = NS } (walletPrivKey oracleWallet) + , ovSignedMessage = Just $ signMessage OracleSignedMessage{ osmGameId = gameId, osmWinnerId = 0, osmGameStatus = NS } oraclePrivateKey } updateOracleTrace :: Trace.EmulatorTrace () @@ -259,7 +258,7 @@ tests = ) .&&. walletFundsChange oracleWallet ((Ada.toValue (oFee oracle + oCollateral oracle))) .&&. walletFundsChange oracleClientWallet (inv (Ada.toValue (oFee oracle + oCollateral oracle))) - .&&. dataAtAddress (oracleAddress oracle) (== requestOracleTestState) + .&&. dataAtAddress (oracleAddress oracle) (== [requestOracleTestState]) ) requestOracleTrace , @@ -288,7 +287,7 @@ tests = , checkPredicateOptions options "Should fail on incorrect update oracle data" ( - assertFailedTransaction (\_ err _ -> case err of {ScriptFailure (EvaluationError ["update data is invalid", "Pd"] _) -> True; _ -> False }) + assertFailedTransaction (\_ err _ -> case err of {ScriptFailure (EvaluationError ["update data is invalid", "PT5"] _) -> True; _ -> False }) ) invalidUpdateOracleTrace , @@ -309,7 +308,7 @@ tests = , checkPredicateOptions options "Only oracle signed request can be used" ( - assertFailedTransaction (\_ err _ -> case err of {ScriptFailure (EvaluationError ["value signed by oracle", "Pd"] _) -> True; _ -> False }) + assertFailedTransaction (\_ err _ -> case err of {ScriptFailure (EvaluationError ["value signed by oracle", "PT5"] _) -> True; _ -> False }) ) useFailIfNotSignedTrace ,