-
Notifications
You must be signed in to change notification settings - Fork 205
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Move exercise context computation to the client side
We probably want to start displaying the full ptx on the client side but for now this at least moves things out of speedy and into the rendering layer where they belong. It also fixes IncompleteTransaction to unwind properly so the roots are really the roots. changelog_begin changelog_end
- Loading branch information
1 parent
c8faed8
commit 1a92fd8
Showing
7 changed files
with
230 additions
and
37 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
117 changes: 117 additions & 0 deletions
117
compiler/scenario-service/client/test/DA/Daml/LF/PrettyScenarioSpec.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,117 @@ | ||
| -- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. | ||
| -- SPDX-License-Identifier: Apache-2.0 | ||
|
|
||
| module DA.Daml.LF.PrettyScenarioSpec (main) where | ||
|
|
||
| import DA.Daml.LF.PrettyScenario | ||
| import qualified ScenarioService as S | ||
|
|
||
| import Control.Monad.State.Strict | ||
| import Data.Bifunctor | ||
| import qualified Data.Text.Lazy as TL | ||
| import qualified Data.Vector as V | ||
| import Test.Tasty | ||
| import Test.Tasty.HUnit | ||
|
|
||
| main :: IO () | ||
| main = defaultMain $ testGroup "PrettyScenario" | ||
| [ ptxExerciseContextTests | ||
| ] | ||
|
|
||
| ctx :: String -> ExerciseContext | ||
| ctx choice = ExerciseContext | ||
| { targetId = Just (S.ContractRef "#0" Nothing) | ||
| , choiceId = TL.pack choice | ||
| , exerciseLocation = Nothing | ||
| , chosenValue = Nothing | ||
| } | ||
|
|
||
| ptxExerciseContextTests :: TestTree | ||
| ptxExerciseContextTests = testGroup "ptxExerciseContext" | ||
| [ testCase "returns the last root exercise node" $ do | ||
| ptxExerciseContext (toPtx [Exercise "1" False [], Exercise "2" False []]) @?= Just (ctx "2") | ||
| , testCase "ignores complete exercise nodes" $ do | ||
| ptxExerciseContext (toPtx [Exercise "1" False [], Exercise "2" True []]) @?= Nothing | ||
| , testCase "ignores create, fetch and lookup nodes" $ do | ||
| ptxExerciseContext (toPtx [Create, Fetch, Lookup]) @?= Nothing | ||
| , testCase "does not decend in rollback node" $ do | ||
| ptxExerciseContext (toPtx [Rollback [Exercise "1" False []]]) @?= Nothing | ||
| , testCase "decends in exercise" $ do | ||
| ptxExerciseContext (toPtx [Exercise "0" False [Exercise "1" False []]]) @?= Just (ctx "1") | ||
| ] | ||
|
|
||
| type Transaction = [Node] | ||
|
|
||
| data Node | ||
| = Create | ||
| | Lookup | ||
| | Fetch | ||
| | Exercise String Bool [Node] | ||
| | Rollback [Node] | ||
|
|
||
| toPtx :: Transaction -> S.PartialTransaction | ||
| toPtx nodes = case runState (mapM go nodes) (0, []) of | ||
| (roots, (_, nodes)) -> S.PartialTransaction | ||
| { partialTransactionRoots = V.fromList roots | ||
| , partialTransactionNodes = V.fromList (reverse nodes) | ||
| } | ||
| where | ||
| go :: Node -> State (Int, [S.Node]) S.NodeId | ||
| go n = do | ||
| nid <- nextNodeId | ||
| nodeNode <- case n of | ||
| Create -> pure $ S.NodeNodeCreate S.Node_Create | ||
| { node_CreateContractInstance = Nothing | ||
| , node_CreateSignatories = V.empty | ||
| , node_CreateStakeholders = V.empty | ||
| , node_CreateKeyWithMaintainers = Nothing | ||
| } | ||
| Fetch -> pure $ S.NodeNodeFetch S.Node_Fetch | ||
| { node_FetchContractId = "#0" | ||
| , node_FetchTemplateId = Nothing | ||
| , node_FetchSignatories = V.empty | ||
| , node_FetchStakeholders = V.empty | ||
| } | ||
| Lookup -> pure $ S.NodeNodeLookupByKey S.Node_LookupByKey | ||
| { node_LookupByKeyTemplateId = Nothing | ||
| , node_LookupByKeyKeyWithMaintainers = Nothing | ||
| , node_LookupByKeyContractId = "#0" | ||
| } | ||
| Rollback children -> do | ||
| children' <- mapM go children | ||
| pure $ S.NodeNodeRollback (S.Node_Rollback (V.fromList children')) | ||
| Exercise choice complete children -> do | ||
| children' <- mapM go children | ||
| pure $ S.NodeNodeExercise S.Node_Exercise | ||
| { node_ExerciseTargetContractId = "#0" | ||
| , node_ExerciseTemplateId = Nothing | ||
| , node_ExerciseChoiceId = TL.pack choice | ||
| , node_ExerciseActingParties = V.empty | ||
| , node_ExerciseChosenValue = Nothing | ||
| , node_ExerciseObservers = V.empty | ||
| , node_ExerciseSignatories = V.empty | ||
| , node_ExerciseStakeholders = V.empty | ||
| , node_ExerciseChildren = V.fromList children' | ||
| , node_ExerciseExerciseResult = if complete then Just (S.Value (Just (S.ValueSumUnit S.Empty))) else Nothing | ||
| , node_ExerciseConsuming = False | ||
| } | ||
| let node = S.Node | ||
| { nodeNodeId = Just nid | ||
| , nodeNode = Just nodeNode | ||
| , nodeEffectiveAt = 0 | ||
| , nodeDisclosures = V.empty | ||
| , nodeReferencedBy = V.empty | ||
| , nodeConsumedBy = Nothing | ||
| , nodeRolledbackBy = Nothing | ||
| , nodeParent = Nothing | ||
| , nodeLocation = Nothing | ||
| } | ||
| modify' $ second (node :) | ||
| pure nid | ||
| nextNodeId :: State (Int, b) S.NodeId | ||
| nextNodeId = do | ||
| (i, nodes) <- get | ||
| let !i' = i + 1 | ||
| put (i', nodes) | ||
| pure (S.NodeId (TL.pack $ show i)) | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters