Fixing fetching RPC

src/EVM.hs

@@ -1270,27 +1270,24 @@ choose = assign #result . Just . HandleEffect . Choose
 
 -- | Construct RPC Query and halt execution until resolved
 fetchAccount :: VMOps t => Expr EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
-fetchAccount addr continue =
- use (#env % #contracts % at addr) >>= \case
- Just c -> continue c
- Nothing -> case addr of
- SymAddr _ -> do
- pc <- use (#state % #pc)
- partial $ UnexpectedSymbolicArg pc "trying to access a symbolic address that isn't already present in storage" (wrap [addr])
- LitAddr a -> do
- use (#cache % #fetched % at a) >>= \case
- Just c -> do
- assign (#env % #contracts % at addr) (Just c)
- continue c
- Nothing -> do
- base <- use (#config % #baseState)
- assign (#result) . Just . HandleEffect . Query $
- PleaseFetchContract a base
- (\c -> do assign (#cache % #fetched % at a) (Just c)
- assign (#env % #contracts % at addr) (Just c)
- assign #result Nothing
- continue c)
- GVar _ -> internalError "Unexpected GVar"
+fetchAccount addr continue = case addr of
+ SymAddr _ -> do
+ pc <- use (#state % #pc)
+ partial $ UnexpectedSymbolicArg pc "trying to access a symbolic address that isn't already present in storage" (wrap [addr])
+ LitAddr a -> do
+ use (#cache % #fetched % at a) >>= \case
+ Just c -> do
+ assign (#env % #contracts % at addr) (Just c)
+ continue c
+ Nothing -> do
+ base <- use (#config % #baseState)
+ assign (#result) . Just . HandleEffect . Query $
+ PleaseFetchContract a base
+ (\c -> do assign (#cache % #fetched % at a) (Just c)
+ assign (#env % #contracts % at addr) (Just c)
+ assign #result Nothing
+ continue c)
+ GVar _ -> internalError "Unexpected GVar"
 
 accessStorage
  :: VMOps t => Expr EAddr
@@ -1315,13 +1312,14 @@ accessStorage addr slot continue = do
  fetchAccount addr $ \_ ->
  accessStorage addr slot continue
  where
- rpcCall c slotConc = if c.external
+ rpcCall c slotConc = fetchAccount addr $ \_ ->
+ if c.external
  then forceConcreteAddr addr "cannot read storage from symbolic addresses via rpc" $ \addr' ->
  forceConcrete slotConc "cannot read symbolic slots via RPC" $ \slot' -> do
  -- check if the slot is cached
  contract <- preuse (#cache % #fetched % ix addr')
  case contract of
- Nothing -> internalError "contract marked external not found in cache"
+ Nothing -> internalError $ "contract addr " <> show addr' <> " marked external not found in cache"
  Just fetched -> case readStorage (Lit slot') fetched.storage of
  Nothing -> mkQuery addr' slot'
  Just val -> continue val