Merge pull request #346 from input-output-hk/j-mueller/lenses

wallet-api: Be explicit about block order
IntersectMBO · Nov 29, 2018 · bdfa2cc · bdfa2cc
2 parents 171bd93 + 7017914
commit bdfa2cc
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 16 deletions.
diff --git a/wallet-api/src/Wallet/Emulator/Http.hs b/wallet-api/src/Wallet/Emulator/Http.hs
@@ -36,8 +36,8 @@ import           Wallet.Emulator.AddressMap (AddressMap)
 import           Wallet.Emulator.Types      (Assertion (IsValidated, OwnFundsEqual), EmulatedWalletApi,
                                              EmulatorState (_txPool, _walletStates),
                                              Notification (BlockHeight, BlockValidated), Wallet, WalletState, assert,
-                                             chain, emptyEmulatorState, emptyWalletState, liftEmulatedWallet, txPool,
-                                             walletStates)
+                                             chainNewestFirst, emptyEmulatorState, emptyWalletState, liftEmulatedWallet,
+                                             txPool, walletStates)
 
 import qualified Wallet.Emulator.Types      as Types
 import           Wallet.UTXO                (Block, Height, Tx, TxIn', TxOut', Value)
@@ -255,7 +255,7 @@ processPendingSTM var = do
   writeTVar var newState
   pure block
   where
-    addBlock block = over chain ((:) block)
+    addBlock block = over chainNewestFirst ((:) block)
     emptyPool = set txPool []
 
 api :: Proxy API

diff --git a/wallet-api/src/Wallet/Emulator/Types.hs b/wallet-api/src/Wallet/Emulator/Types.hs
@@ -44,7 +44,8 @@ module Wallet.Emulator.Types(
     EmulatorState(..),
     emptyEmulatorState,
     emulatorState,
-    chain,
+    chainNewestFirst,
+    chainOldestFirst,
     txPool,
     walletStates,
     index,
@@ -252,20 +253,25 @@ data Event n a where
 type Trace m = Op.Program (Event m)
 
 data EmulatorState = EmulatorState {
-    _chain        :: Blockchain,
-    _txPool       :: TxPool,
-    _walletStates :: Map Wallet WalletState,
-    _index        :: Index.UtxoIndex,
-    _emulatorLog  :: [EmulatorEvent] -- ^ emulator events, newest first
+    _chainNewestFirst :: Blockchain,
+    _txPool           :: TxPool,
+    _walletStates     :: Map Wallet WalletState,
+    _index            :: Index.UtxoIndex,
+    _emulatorLog      :: [EmulatorEvent] -- ^ emulator events, newest first
     } deriving (Show)
 
 makeLenses ''EmulatorState
 
+-- | The blockchain as a list of blocks, starting with the oldest (genesis)
+--   block
+chainOldestFirst :: Lens' EmulatorState Blockchain
+chainOldestFirst = chainNewestFirst . reversed
+
 type MonadEmulator m = (MonadState EmulatorState m, MonadError AssertionError m)
 
 emptyEmulatorState :: EmulatorState
 emptyEmulatorState = EmulatorState {
-    _chain = [],
+    _chainNewestFirst = [],
     _txPool = [],
     _walletStates = Map.empty,
     _index = Index.empty,
@@ -293,14 +299,14 @@ ownFundsEqual wallet value = do
 isValidated :: (MonadEmulator m) => Tx -> m ()
 isValidated txn = do
     emState <- get
-    if notElem txn (join $ _chain emState)
+    if notElem txn (join $ _chainNewestFirst emState)
         then throwError $ AssertionError $ "Txn not validated: " <> T.pack (show txn)
         else pure ()
 
 -- | Initialise the emulator state with a blockchain
 emulatorState :: Blockchain -> EmulatorState
 emulatorState bc = emptyEmulatorState
-    & chain .~ bc
+    & chainNewestFirst .~ bc
     & index .~ Index.initialise bc
 
 -- | Initialise the emulator state with a pool of pending transactions
@@ -310,7 +316,7 @@ emulatorState' tp = emptyEmulatorState
 
 -- | Validate a transaction in the current emulator state
 validateEm :: EmulatorState -> Tx -> Maybe Index.ValidationError
-validateEm EmulatorState{_index=idx, _chain = ch} txn =
+validateEm EmulatorState{_index=idx, _chainNewestFirst = ch} txn =
     let h = height ch
         result = Index.runValidation (Index.validateTransaction h txn) idx in
     either Just (const Nothing) result
@@ -341,9 +347,9 @@ evalEmulated = \case
     BlockchainProcessPending -> do
         emState <- get
         let (block, events) = validateBlock emState (_txPool emState)
-            newChain = block : _chain emState
+            newChain = block : _chainNewestFirst emState
         put emState {
-            _chain = newChain,
+            _chainNewestFirst = newChain,
             _txPool = [],
             _index = Index.insertBlock block (_index emState),
             _emulatorLog   = BlockAdd (height newChain) : events ++ _emulatorLog emState

diff --git a/wallet-api/test/Spec.hs b/wallet-api/test/Spec.hs
@@ -72,7 +72,7 @@ txnIndex :: Property
 txnIndex = property $ do
     (m, txn) <- forAll genChainTxn
     let (result, st) = Gen.runTrace m $ processPending >> simpleTrace txn
-    Hedgehog.assert (Index.initialise (_chain st) == _index st)
+    Hedgehog.assert (Index.initialise (_chainNewestFirst st) == _index st)
 
 txnIndexValid :: Property
 txnIndexValid = property $ do