Skip to content

Commit 922aea5

Browse files
kk-hainqkk-hainq
committed
eleks/oracle: demonstrate how expensive || can be!
1 parent 5cd0fae commit 922aea5

File tree

4 files changed

+84
-79
lines changed

4 files changed

+84
-79
lines changed

‎eleks/oracle/src/Contracts/Oracle/OffChain.hs‎

Lines changed: 24 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ module Contracts.Oracle.OffChain
2222
, requestOracleForAddress
2323
, findOracleRequest
2424
, awaitNextOracleRequest
25-
, getActiveOracleRequests
25+
, getActiveOracleRequests
2626
, getActiveGames
2727
, oracleScriptAsShortBs
2828
, oraclePlutusScript
@@ -33,7 +33,7 @@ module Contracts.Oracle.OffChain
3333
, useOracle
3434
) where
3535

36-
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
36+
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
3737
import Control.Lens (view)
3838
import Control.Monad hiding (fmap)
3939
import Contracts.Oracle.Types
@@ -95,21 +95,21 @@ updateOracle oracle operatorPrivateKey params = do
9595
gameStatus = uoGameStatus params
9696

9797
activeRequests <- getActiveOracleRequests oracle
98-
let requests = filter (isGameOracleRequest gameId) activeRequests
98+
let requests = filter (isGameOracleRequest gameId) activeRequests
9999
forM_ requests $ \(oref, o, oracleData) -> do
100-
let oracleSignMessage = OracleSignedMessage
100+
let oracleSignMessage = OracleSignedMessage
101101
{ osmWinnerId = winnerId
102102
, osmGameId = gameId
103103
, osmGameStatus = gameStatus
104104
}
105-
let oracleData' = oracleData{ ovSignedMessage = Just $ signMessage oracleSignMessage operatorPrivateKey }
105+
let oracleData' = oracleData{ ovSignedMessage = Nothing }
106106
when (oracleData' /= oracleData) $ do
107107
let requestTokenVal = assetClassValue (requestTokenClassFromOracle oracle) 1
108-
collateralVal = Ada.toValue $ oCollateral oracle
109-
let lookups = Constraints.unspentOutputs (Map.singleton oref o)
110-
<> Constraints.typedValidatorLookups (typedOracleValidator oracle)
108+
collateralVal = Ada.toValue $ oCollateral oracle
109+
let lookups = Constraints.unspentOutputs (Map.singleton oref o)
110+
<> Constraints.typedValidatorLookups (typedOracleValidator oracle)
111111
<> Constraints.otherScript (oracleValidator oracle)
112-
tx = Constraints.mustPayToTheScript oracleData' (requestTokenVal <> collateralVal)
112+
tx = Constraints.mustPayToTheScript oracleData' (requestTokenVal <> collateralVal)
113113
<> Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData Update)
114114

115115
logInfo ("submit transaction " ++ (show $ oracleData'))
@@ -133,26 +133,26 @@ data OracleContractState =
133133
| Updated GameId
134134
deriving (Show, Generic, FromJSON, ToJSON)
135135

136-
type OracleSchema = Endpoint "update" UpdateOracleParams
137-
.\/ Endpoint "games" ()
136+
type OracleSchema = Endpoint "update" UpdateOracleParams
137+
.\/ Endpoint "games" ()
138138

139139
requestOracleForAddress :: forall w s. Oracle -> GameId -> Contract w s Text ()
140-
requestOracleForAddress oracle gameId = do
140+
requestOracleForAddress oracle gameId = do
141141
pkh <- pubKeyHash <$> ownPubKey
142142
let inst = typedOracleValidator oracle
143143
mrScript = oracleValidator oracle
144144
tokenMintingPolicy = requestTokenPolicy $ oracleToRequestToken oracle
145145
forgedToken = requestTokenValue oracle
146-
oracleFee = oFee oracle
146+
oracleFee = oFee oracle
147147
feeVal = Ada.toValue oracleFee
148148
collateralVal = Ada.toValue $ oCollateral oracle
149-
oracleData = OracleData
149+
oracleData = OracleData
150150
{ ovRequestAddress = pkh
151151
, ovGame = gameId
152152
, ovSignedMessage = Nothing
153153
}
154154
mintRedeemer = Redeemer $ PlutusTx.toBuiltinData $ Request
155-
let lookups = Constraints.typedValidatorLookups inst
155+
let lookups = Constraints.typedValidatorLookups inst
156156
<> Constraints.otherScript mrScript
157157
<> Constraints.mintingPolicy tokenMintingPolicy
158158

@@ -168,7 +168,7 @@ getActiveOracleRequests:: Oracle -> Contract w s Text [(TxOutRef, ChainIndexTxOu
168168
getActiveOracleRequests oracle = do
169169
xs <- utxosAt (oracleAddress oracle)
170170
let requests = filter (isActiveRequest oracle) . filterOracleRequest oracle . Map.toList $ xs
171-
return requests
171+
return requests
172172

173173
getActiveGames:: Oracle -> Contract w s Text ([GameId])
174174
getActiveGames oracle = do
@@ -188,7 +188,7 @@ awaitNextOracleRequest oracle =
188188
let filterValidTx = catMaybes . concat
189189
let filtered = filterOracleRequest oracle . filterValidTx $ txs
190190
return filtered
191-
191+
192192
runOracle :: OracleParams -> Contract (Last OracleContractState) OracleSchema Text ()
193193
runOracle op = do
194194
oracle <- startOracle op
@@ -207,7 +207,7 @@ runOracle op = do
207207
tell $ Last $ Just $ Games gamesIds
208208

209209
hasOracleRequestToken :: Oracle -> (TxOutRef, ChainIndexTxOut) -> Bool
210-
hasOracleRequestToken oracle (oref, o) =
210+
hasOracleRequestToken oracle (oref, o) =
211211
assetClassValueOf (view ciTxOutValue o) (requestTokenClassFromOracle oracle) == 1
212212

213213
hasOracelRequestDatum :: (TxOutRef, ChainIndexTxOut) -> Bool
@@ -222,7 +222,7 @@ mapDatum (oref, o) = case oracleValueFromTxOutTx o of
222222
Nothing -> Nothing
223223

224224
isGameOracleRequest :: GameId -> (TxOutRef, ChainIndexTxOut, OracleData) -> Bool
225-
isGameOracleRequest gameId (_, _, od) = gameId == (ovGame od)
225+
isGameOracleRequest gameId (_, _, od) = gameId == (ovGame od)
226226

227227
isOwnerOracleRequest :: PubKeyHash -> (TxOutRef, ChainIndexTxOut, OracleData) -> Bool
228228
isOwnerOracleRequest owner (_, _, od) = owner == (ovRequestAddress od)
@@ -239,7 +239,7 @@ isActiveRequest oracle (_, _, od) = case ovSignedMessage od of
239239
Nothing -> False
240240
Just (oracleMessage, _) -> isActiveSignedMessage oracleMessage
241241

242-
findOracleRequest ::
242+
findOracleRequest ::
243243
forall w s. Oracle
244244
-> GameId
245245
-> PubKeyHash
@@ -248,14 +248,14 @@ findOracleRequest oracle gameId owner = do
248248
xs <- utxosAt (oracleAddress oracle)
249249
let findCriteria = find (\tx -> isOwnerOracleRequest owner tx && isGameOracleRequest gameId tx)
250250
let request = findCriteria . filterOracleRequest oracle . Map.toList $ xs
251-
pure request
251+
pure request
252252

253253
data UseOracleParams = UseOracleParams
254254
{ uoGame :: Integer -- use owned oracle request
255255
}
256256
deriving stock (Haskell.Eq, Haskell.Show, Generic)
257257
deriving anyclass (ToJSON, FromJSON, ToSchema)
258-
258+
259259
type UseOracleSchema = Endpoint "use" UseOracleParams
260260

261261
-- example endpoint how to consume oracle request owned by user
@@ -278,7 +278,7 @@ useOracle oracle =
278278
collateralValue = Ada.toValue $ oCollateral oracle
279279
mintRedeemer = Redeemer $ PlutusTx.toBuiltinData $ RedeemToken
280280

281-
let lookups = Constraints.typedValidatorLookups inst
281+
let lookups = Constraints.typedValidatorLookups inst
282282
<> Constraints.otherScript mrScript
283283
<> Constraints.unspentOutputs (Map.singleton oref o)
284284
<> Constraints.mintingPolicy tokenMintingPolicy
@@ -287,4 +287,4 @@ useOracle oracle =
287287
<> Constraints.mustPayToPubKey pkh collateralValue
288288

289289
ledgerTx <- submitTxConstraintsWith lookups tx
290-
void $ awaitTxConfirmed $ txId ledgerTx
290+
void $ awaitTxConfirmed $ txId ledgerTx

‎eleks/oracle/src/Contracts/Oracle/OnChain.hs‎

Lines changed: 16 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ module Contracts.Oracle.OnChain
2525
) where
2626

2727
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
28-
import Types.Game
28+
import Types.Game
2929
import Control.Monad hiding (fmap)
3030
import Codec.Serialise
3131
import Data.Aeson (FromJSON, ToJSON)
@@ -66,9 +66,9 @@ mkOracleValidator oracle oracleData r ctx =
6666
OracleRedeem -> traceIfFalse "signed by request owner" (txSignedBy info $ ovRequestAddress oracleData )
6767
&& traceIfFalse "value signed by oracle" (isCurrentValueSigned)
6868
&& traceIfFalse "should redeem request token" (requestTokenValOf forged == -1)
69-
-- && traceIfFalse "expected requester to get oracle token"
69+
-- && traceIfFalse "expected requester to get oracle token"
7070
-- (sentToAddress (Just $ ovRequestAddress oracleData) (requestTokenExpectedVal))
71-
Update -> traceIfFalse "operator signature missing" (txSignedBy info $ oOperator oracle)
71+
Update -> traceIfFalse "operator signature missing" (txSignedBy info $ oOperator oracle)
7272
&& traceIfFalse "invalid output datum" validOutputDatum
7373
&& traceIfFalse "update data is invalid" isUpdateValid
7474

@@ -82,7 +82,7 @@ mkOracleValidator oracle oracleData r ctx =
8282
requestTokenExpectedVal:: Value
8383
requestTokenExpectedVal = Value.singleton (oRequestTokenSymbol oracle) oracleRequestTokenName 1
8484

85-
requestTokenValOf:: Value -> Integer
85+
requestTokenValOf:: Value -> Integer
8686
requestTokenValOf value = valueOf value (oRequestTokenSymbol oracle) oracleRequestTokenName
8787

8888
sentToAddress :: Maybe PubKeyHash -> Value -> Bool
@@ -129,14 +129,21 @@ mkOracleValidator oracle oracleData r ctx =
129129

130130
extractSigendMessage :: Maybe (SignedMessage OracleSignedMessage) -> Maybe OracleSignedMessage
131131
extractSigendMessage signedMessage = signedMessage
132-
>>= verifyOracleValueSigned (oOperatorKey oracle)
132+
>>= verifyOracleValueSigned (oOperatorKey oracle)
133133
>>= (\(message, _) -> Just message)
134134

135-
isUpdateValid = (not isCurrentValueSigned) ||
136-
(fromMaybe False $ validateGameStatusChanges <$>
137-
(osmGameStatus <$> extractSigendMessage (ovSignedMessage oracleData)) <*>
135+
-- if then else is way cheaper!
136+
isUpdateValid = if not isCurrentValueSigned then True else
137+
(fromMaybe False $ validateGameStatusChanges <$>
138+
(osmGameStatus <$> extractSigendMessage (ovSignedMessage oracleData)) <*>
138139
(osmGameStatus <$> extractSigendMessage outputSignedMessage))
139140

141+
-- || is surprisingly way more expensive!
142+
-- isUpdateValid = (not isCurrentValueSigned) ||
143+
-- (fromMaybe False $ validateGameStatusChanges <$>
144+
-- (osmGameStatus <$> extractSigendMessage (ovSignedMessage oracleData)) <*>
145+
-- (osmGameStatus <$> extractSigendMessage outputSignedMessage))
146+
140147
{-# INLINABLE verifyOracleValueSigned #-}
141148
verifyOracleValueSigned :: PubKey -> SignedMessage OracleSignedMessage -> Maybe (OracleSignedMessage, TxConstraints Void Void)
142149
verifyOracleValueSigned pubKey sm = case verifySignedMessageConstraints pubKey sm of
@@ -168,4 +175,4 @@ oracleScriptAsShortBs :: Oracle -> SBS.ShortByteString
168175
oracleScriptAsShortBs = SBS.toShort . LBS.toStrict . serialise . oracleValidator
169176

170177
oraclePlutusScript :: Oracle -> PlutusScript PlutusScriptV1
171-
oraclePlutusScript = PlutusScriptSerialised . oracleScriptAsShortBs
178+
oraclePlutusScript = PlutusScriptSerialised . oracleScriptAsShortBs

‎eleks/oracle/src/test/Spec.hs‎

Lines changed: 17 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,24 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
module Main(main) where
33

4-
import qualified Spec.MutualBet
5-
import qualified Spec.Oracle
6-
import Test.Tasty
7-
import Test.Tasty.Hedgehog (HedgehogTestLimit (..))
4+
import Data.Default
5+
import Ledger.Index
6+
import Plutus.Trace
7+
import Spec.Oracle
88

99
main :: IO ()
10-
main = defaultMain tests
10+
main = print =<< writeScriptsTo
11+
(ScriptsConfig "." (Scripts UnappliedValidators))
12+
"updateOracleTrace"
13+
updateOracleTrace
14+
def
1115

12-
-- | Number of successful tests for each hedgehog property.
13-
-- The default is 100 but we use a smaller number here in order to speed up
14-
-- the test suite.
15-
--
16-
limit :: HedgehogTestLimit
17-
limit = HedgehogTestLimit (Just 5)
16+
-- With `||`:
17+
-- ( Sum {getSum = 9539}
18+
-- , ExBudget {exBudgetCPU = ExCPU 1124168956, exBudgetMemory = ExMemory 3152700}
19+
-- )
1820

19-
tests :: TestTree
20-
tests = localOption limit $ testGroup "use cases" [
21-
Spec.MutualBet.tests
22-
,
23-
Spec.Oracle.tests
24-
]
21+
-- With `if then else`:
22+
-- ( Sum {getSum = 3531}
23+
-- , ExBudget {exBudgetCPU = ExCPU 698345767,, exBudgetMemory = ExMemory 2069978}
24+
-- )

0 commit comments

Comments
 (0)