-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Global blockchain state (emulated).

module Morley.Michelson.Runtime.GState
  (
    -- * Auxiliary types
    ContractState (..)
  , VotingPowers (..)
  , vpPick
  , vpTotal
  , mkVotingPowers
  , mkVotingPowersFromMap
  , dummyVotingPowers
  , BigMapCounter(..)
  , bigMapCounter

  -- * GState
  , GState (..)
  , gsChainIdL
  , gsImplicitAddressesL
  , gsContractAddressesL
  , gsImplicitAddressAliasesL
  , gsContractAddressAliasesL
  , gsVotingPowersL
  , gsCounterL
  , gsBigMapCounterL
  , addressesL
  , genesisAddresses
  , genesisKeyHashes
  , genesisAddress
  -- * More genesisAddresses which can be used in tests
  , genesisAddress1
  , genesisAddress2
  , genesisAddress3
  , genesisAddressN
  , genesisKeyHash
  -- * Genesis secret keys
  , genesisSecretKey
  , genesisSecrets

  , initGState
  , readGState
  , writeGState

  -- * Operations on GState
  , GStateUpdate (..)
  , GStateUpdateError (..)
  , applyUpdate
  , applyUpdates
  , extractAllContracts
  , lookupBalance
  , AddressStateFam
  ) where

import Control.Lens (at, makeLenses, (?~))
import Data.Aeson (FromJSON(..), ToJSON(..), object, withObject, (.:), (.:?), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Encode.Pretty qualified as Aeson
import Data.Aeson.TH (deriveJSON)
import Data.ByteString.Lazy qualified as LBS
import Data.Default (def)
import Data.Map.Strict qualified as Map
import Data.Type.Equality ((:~:)(..))
import Fmt (Buildable(build), pretty, (+|), (|+))
import System.IO.Error (IOError, isDoesNotExistError)

import Morley.Michelson.TypeCheck
  (SomeParamType(..), TcOriginatedContracts, typeCheckContractAndStorage, typeCheckingWith)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Existential (SomeContractAndStorage(..))
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Untyped (Contract, Value)
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Core (ChainId, Mutez, divModMutezInt, dummyChainId)
import Morley.Tezos.Crypto
import Morley.Util.Aeson
import Morley.Util.Bimap (Bimap)
import Morley.Util.Bimap qualified as Bimap
import Morley.Util.Lens
import Morley.Util.Peano (ToPeano, type (>))
import Morley.Util.Sing (eqI, eqParamSing, eqParamSing2)
import Morley.Util.SizedList qualified as SL
import Morley.Util.SizedList.Types

-- | State of a contract with code.
data ContractState =
  forall cp st. (ParameterScope cp, StorageScope st) => ContractState
  { ContractState -> Mutez
csBalance :: Mutez
  -- ^ Amount of mutez owned by this contract.
  , ()
csContract :: T.Contract cp st
  -- ^ Contract itself.
  , ()
csStorage :: T.Value st
  -- ^ Storage value associated with this contract.
  , ContractState -> Maybe KeyHash
csDelegate :: Maybe KeyHash
  -- ^ Delegate associated with this contract.
  }

makeLensesWith postfixLFields ''ContractState

deriving stock instance Show ContractState

instance Eq ContractState where
  ContractState Mutez
b1 Contract cp st
c1 Value st
s1 Maybe KeyHash
d1 == :: ContractState -> ContractState -> Bool
== ContractState Mutez
b2 Contract cp st
c2 Value st
s2 Maybe KeyHash
d2 =
    Mutez
b1 Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
b2
    Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Contract cp st -> Contract cp st -> Bool
forall {k1} {k2} (a1 :: k1) (a2 :: k1) (b1 :: k2) (b2 :: k2)
       (t :: k1 -> k2 -> *).
(SingI a1, SingI a2, SingI b1, SingI b2, SDecide k1, SDecide k2,
 Eq (t a1 b2)) =>
t a1 b1 -> t a2 b2 -> Bool
eqParamSing2 Contract cp st
c1 Contract cp st
c2
    Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Value st -> Value st -> Bool
forall {k} (a1 :: k) (a2 :: k) (t :: k -> *).
(SingI a1, SingI a2, SDecide k, Eq (t a1)) =>
t a1 -> t a2 -> Bool
eqParamSing Value st
s1 Value st
s2
    Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Maybe KeyHash
d1 Maybe KeyHash -> Maybe KeyHash -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe KeyHash
d2

instance ToJSON ContractState where
  toJSON :: ContractState -> Value
toJSON ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csDelegate :: Maybe KeyHash
csStorage :: Value st
csContract :: Contract cp st
csBalance :: Mutez
csDelegate :: ContractState -> Maybe KeyHash
csStorage :: ()
csContract :: ()
csBalance :: ContractState -> Mutez
..} =
    [Pair] -> Value
object ([Pair] -> Value) -> ([Pair] -> [Pair]) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([Pair] -> [Pair])
-> (KeyHash -> [Pair] -> [Pair])
-> Maybe KeyHash
-> [Pair]
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair] -> [Pair]
forall a. a -> a
id ((:) (Pair -> [Pair] -> [Pair])
-> (KeyHash -> Pair) -> KeyHash -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"delegate" Key -> KeyHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)) Maybe KeyHash
csDelegate ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"balance" Key -> Mutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Mutez
csBalance
    , Key
"storage" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value st -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
T.untypeValue Value st
csStorage
    , Key
"contract" Key -> Contract -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Contract cp st -> Contract
forall (param :: T) (store :: T). Contract param store -> Contract
T.convertContract Contract cp st
csContract
    ]

-- These instance is a bit hacky because it is quite painful to
-- write proper JSON instances for typed `Instr` and `Value` so
-- we typecheck untyped representation instead of parsing.
instance FromJSON ContractState where
  parseJSON :: Value -> Parser ContractState
parseJSON =
    String
-> (Object -> Parser ContractState)
-> Value
-> Parser ContractState
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"contractstate" ((Object -> Parser ContractState) -> Value -> Parser ContractState)
-> (Object -> Parser ContractState)
-> Value
-> Parser ContractState
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      (Mutez
balance :: Mutez) <- Object
o Object -> Key -> Parser Mutez
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"balance"
      (Value
uStorage :: Value) <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"storage"
      (Contract
uContract :: Contract) <- Object
o Object -> Key -> Parser Contract
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contract"
      (Maybe KeyHash
delegate :: Maybe KeyHash) <- Object
o Object -> Key -> Parser (Maybe KeyHash)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delegate"
      case TypeCheckOptions
-> TypeCheckResult SomeContractAndStorage
-> Either TCError SomeContractAndStorage
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult SomeContractAndStorage
 -> Either TCError SomeContractAndStorage)
-> TypeCheckResult SomeContractAndStorage
-> Either TCError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ Contract -> Value -> TypeCheckResult SomeContractAndStorage
typeCheckContractAndStorage Contract
uContract Value
uStorage of
        Right (SomeContractAndStorage Contract cp st
contract Value st
storage) ->
          ContractState -> Parser ContractState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractState -> Parser ContractState)
-> ContractState -> Parser ContractState
forall a b. (a -> b) -> a -> b
$ Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
ContractState Mutez
balance Contract cp st
contract Value st
storage Maybe KeyHash
delegate
        Left TCError
err -> String -> Parser ContractState
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ContractState) -> String -> Parser ContractState
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse `ContractState`: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TCError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty TCError
err

instance Buildable ContractState where
  build :: ContractState -> Builder
build ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csDelegate :: Maybe KeyHash
csStorage :: Value st
csContract :: Contract cp st
csBalance :: Mutez
csDelegate :: ContractState -> Maybe KeyHash
csStorage :: ()
csContract :: ()
csBalance :: ContractState -> Mutez
..} =
    Builder
"Contractstate:\n Balance: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
csBalance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
    Builder
"\n  Storage: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value st -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
T.untypeValue Value st
csStorage Value -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
    Builder
"\n  Contract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Contract cp st -> Contract
forall (param :: T) (store :: T). Contract param store -> Contract
T.convertContract Contract cp st
csContract Contract -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
    Builder
"\n  Delegate: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Maybe KeyHash
csDelegate Maybe KeyHash -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

-- | Distribution of voting power among the contracts.
--
-- Voting power reflects the ability of bakers to accept, deny or pass new
-- proposals for protocol updates. I.e. each baker has its vote weight.
--
-- This datatype definition may change in future, so its internals are not
-- exported.
newtype VotingPowers
  = VotingPowers (Map KeyHash Natural)
  deriving stock (Int -> VotingPowers -> ShowS
[VotingPowers] -> ShowS
VotingPowers -> String
(Int -> VotingPowers -> ShowS)
-> (VotingPowers -> String)
-> ([VotingPowers] -> ShowS)
-> Show VotingPowers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VotingPowers] -> ShowS
$cshowList :: [VotingPowers] -> ShowS
show :: VotingPowers -> String
$cshow :: VotingPowers -> String
showsPrec :: Int -> VotingPowers -> ShowS
$cshowsPrec :: Int -> VotingPowers -> ShowS
Show, VotingPowers -> VotingPowers -> Bool
(VotingPowers -> VotingPowers -> Bool)
-> (VotingPowers -> VotingPowers -> Bool) -> Eq VotingPowers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VotingPowers -> VotingPowers -> Bool
$c/= :: VotingPowers -> VotingPowers -> Bool
== :: VotingPowers -> VotingPowers -> Bool
$c== :: VotingPowers -> VotingPowers -> Bool
Eq)

deriveJSON morleyAesonOptions ''VotingPowers

-- | Get voting power of the given address.
vpPick :: KeyHash -> VotingPowers -> Natural
vpPick :: KeyHash -> VotingPowers -> Natural
vpPick KeyHash
key (VotingPowers Map KeyHash Natural
distr) = KeyHash -> Map KeyHash Natural -> Maybe Natural
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash
key Map KeyHash Natural
distr Maybe Natural -> Natural -> Natural
forall a. Maybe a -> a -> a
?: Natural
0

-- | Get total voting power.
vpTotal :: VotingPowers -> Natural
vpTotal :: VotingPowers -> Natural
vpTotal (VotingPowers Map KeyHash Natural
distr) = Map KeyHash Natural -> Element (Map KeyHash Natural)
forall t. (Container t, Num (Element t)) => t -> Element t
sum Map KeyHash Natural
distr

-- | Create voting power distribution from map.
mkVotingPowersFromMap :: Map KeyHash Natural -> VotingPowers
mkVotingPowersFromMap :: Map KeyHash Natural -> VotingPowers
mkVotingPowersFromMap = Map KeyHash Natural -> VotingPowers
VotingPowers

-- | Create voting power distribution.
--
-- If some key is encountered multiple times, voting power will be summed up.
mkVotingPowers :: [(KeyHash, Natural)] -> VotingPowers
mkVotingPowers :: [(KeyHash, Natural)] -> VotingPowers
mkVotingPowers = Map KeyHash Natural -> VotingPowers
mkVotingPowersFromMap (Map KeyHash Natural -> VotingPowers)
-> ([(KeyHash, Natural)] -> Map KeyHash Natural)
-> [(KeyHash, Natural)]
-> VotingPowers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Natural)
-> [(KeyHash, Natural)] -> Map KeyHash Natural
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+)

-- | All big_maps stored in a chain have a globally unique ID.
--
-- We use this counter to keep track of how many big_maps have been created so far,
-- and to generate new IDs whenever a new big_map is created.
newtype BigMapCounter = BigMapCounter { BigMapCounter -> Natural
_bigMapCounter :: Natural }
  deriving stock (Int -> BigMapCounter -> ShowS
[BigMapCounter] -> ShowS
BigMapCounter -> String
(Int -> BigMapCounter -> ShowS)
-> (BigMapCounter -> String)
-> ([BigMapCounter] -> ShowS)
-> Show BigMapCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BigMapCounter] -> ShowS
$cshowList :: [BigMapCounter] -> ShowS
show :: BigMapCounter -> String
$cshow :: BigMapCounter -> String
showsPrec :: Int -> BigMapCounter -> ShowS
$cshowsPrec :: Int -> BigMapCounter -> ShowS
Show, BigMapCounter -> BigMapCounter -> Bool
(BigMapCounter -> BigMapCounter -> Bool)
-> (BigMapCounter -> BigMapCounter -> Bool) -> Eq BigMapCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BigMapCounter -> BigMapCounter -> Bool
$c/= :: BigMapCounter -> BigMapCounter -> Bool
== :: BigMapCounter -> BigMapCounter -> Bool
$c== :: BigMapCounter -> BigMapCounter -> Bool
Eq, (forall x. BigMapCounter -> Rep BigMapCounter x)
-> (forall x. Rep BigMapCounter x -> BigMapCounter)
-> Generic BigMapCounter
forall x. Rep BigMapCounter x -> BigMapCounter
forall x. BigMapCounter -> Rep BigMapCounter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BigMapCounter x -> BigMapCounter
$cfrom :: forall x. BigMapCounter -> Rep BigMapCounter x
Generic)
  deriving anyclass (BigMapCounter -> ()
(BigMapCounter -> ()) -> NFData BigMapCounter
forall a. (a -> ()) -> NFData a
rnf :: BigMapCounter -> ()
$crnf :: BigMapCounter -> ()
NFData)
  deriving newtype ([BigMapCounter] -> Encoding
[BigMapCounter] -> Value
BigMapCounter -> Encoding
BigMapCounter -> Value
(BigMapCounter -> Value)
-> (BigMapCounter -> Encoding)
-> ([BigMapCounter] -> Value)
-> ([BigMapCounter] -> Encoding)
-> ToJSON BigMapCounter
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BigMapCounter] -> Encoding
$ctoEncodingList :: [BigMapCounter] -> Encoding
toJSONList :: [BigMapCounter] -> Value
$ctoJSONList :: [BigMapCounter] -> Value
toEncoding :: BigMapCounter -> Encoding
$ctoEncoding :: BigMapCounter -> Encoding
toJSON :: BigMapCounter -> Value
$ctoJSON :: BigMapCounter -> Value
ToJSON, Value -> Parser [BigMapCounter]
Value -> Parser BigMapCounter
(Value -> Parser BigMapCounter)
-> (Value -> Parser [BigMapCounter]) -> FromJSON BigMapCounter
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BigMapCounter]
$cparseJSONList :: Value -> Parser [BigMapCounter]
parseJSON :: Value -> Parser BigMapCounter
$cparseJSON :: Value -> Parser BigMapCounter
FromJSON, Integer -> BigMapCounter
BigMapCounter -> BigMapCounter
BigMapCounter -> BigMapCounter -> BigMapCounter
(BigMapCounter -> BigMapCounter -> BigMapCounter)
-> (BigMapCounter -> BigMapCounter -> BigMapCounter)
-> (BigMapCounter -> BigMapCounter -> BigMapCounter)
-> (BigMapCounter -> BigMapCounter)
-> (BigMapCounter -> BigMapCounter)
-> (BigMapCounter -> BigMapCounter)
-> (Integer -> BigMapCounter)
-> Num BigMapCounter
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BigMapCounter
$cfromInteger :: Integer -> BigMapCounter
signum :: BigMapCounter -> BigMapCounter
$csignum :: BigMapCounter -> BigMapCounter
abs :: BigMapCounter -> BigMapCounter
$cabs :: BigMapCounter -> BigMapCounter
negate :: BigMapCounter -> BigMapCounter
$cnegate :: BigMapCounter -> BigMapCounter
* :: BigMapCounter -> BigMapCounter -> BigMapCounter
$c* :: BigMapCounter -> BigMapCounter -> BigMapCounter
- :: BigMapCounter -> BigMapCounter -> BigMapCounter
$c- :: BigMapCounter -> BigMapCounter -> BigMapCounter
+ :: BigMapCounter -> BigMapCounter -> BigMapCounter
$c+ :: BigMapCounter -> BigMapCounter -> BigMapCounter
Num, BigMapCounter -> Builder
(BigMapCounter -> Builder) -> Buildable BigMapCounter
forall p. (p -> Builder) -> Buildable p
build :: BigMapCounter -> Builder
$cbuild :: BigMapCounter -> Builder
Buildable)

makeLenses ''BigMapCounter

-- | Persistent data passed to Morley contracts which can be updated
-- as result of contract execution.
data GState = GState
  { GState -> ChainId
gsChainId :: ChainId
  -- ^ Identifier of chain.
  , GState -> Map ImplicitAddress Mutez
gsImplicitAddresses :: Map ImplicitAddress Mutez
  -- ^ All known implicit addresses and their state (i.e. balance)
  , GState -> Map ContractAddress ContractState
gsContractAddresses :: Map ContractAddress ContractState
  -- ^ All known contract addresses and their state.
  , GState -> Map TxRollupAddress ()
gsTxRollupAddresses :: Map TxRollupAddress ()
  -- ^ All known transaction rollup addresses and their state.
  , GState -> VotingPowers
gsVotingPowers :: VotingPowers
  -- ^ Voting power distribution.
  , GState -> GlobalCounter
gsCounter :: GlobalCounter
  -- ^ Ever increasing operation counter.
  , GState -> BigMapCounter
gsBigMapCounter :: BigMapCounter
  , GState -> Bimap ImplicitAlias ImplicitAddress
gsImplicitAddressAliases :: Bimap ImplicitAlias ImplicitAddress
  -- ^ Implicit addresses with the associated aliases/names.
  , GState -> Bimap ContractAlias ContractAddress
gsContractAddressAliases :: Bimap ContractAlias ContractAddress
  -- ^ Contract addresses with the associated aliases/names.
  } deriving stock (Int -> GState -> ShowS
[GState] -> ShowS
GState -> String
(Int -> GState -> ShowS)
-> (GState -> String) -> ([GState] -> ShowS) -> Show GState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GState] -> ShowS
$cshowList :: [GState] -> ShowS
show :: GState -> String
$cshow :: GState -> String
showsPrec :: Int -> GState -> ShowS
$cshowsPrec :: Int -> GState -> ShowS
Show, GState -> GState -> Bool
(GState -> GState -> Bool)
-> (GState -> GState -> Bool) -> Eq GState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GState -> GState -> Bool
$c/= :: GState -> GState -> Bool
== :: GState -> GState -> Bool
$c== :: GState -> GState -> Bool
Eq)

makeLensesWith postfixLFields ''GState

deriveJSON morleyAesonOptions ''GState

-- | Number of genesis addresses, type-level
type GenesisAddressesNum = 10

-- | Convenience synonym
type GenesisList a = SizedList GenesisAddressesNum a

-- | Number of genesis addresses, term-level
genesisAddressesNum :: Natural
genesisAddressesNum :: Natural
genesisAddressesNum = forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal @GenesisAddressesNum Proxy GenesisAddressesNum
forall {k} (t :: k). Proxy t
Proxy

-- | Secrets from which genesis addresses are derived from.
genesisSecrets :: GenesisList SecretKey
genesisSecrets :: GenesisList SecretKey
genesisSecrets = forall (n :: Nat) (n' :: Peano) a.
(SingIPeano n, IsoNatPeano n n') =>
(Natural -> a) -> SizedList n a
SL.generate @GenesisAddressesNum ((Natural -> SecretKey) -> GenesisList SecretKey)
-> (Natural -> SecretKey) -> GenesisList SecretKey
forall a b. (a -> b) -> a -> b
$ \Natural
i ->
    let seed :: ByteString
seed = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Natural -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Natural
i Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) :: Text)
    in HasCallStack => ByteString -> SecretKey
ByteString -> SecretKey
detSecretKey ByteString
seed

-- | KeyHash of genesis address.
genesisKeyHashes :: GenesisList KeyHash
genesisKeyHashes :: GenesisList KeyHash
genesisKeyHashes = PublicKey -> KeyHash
hashKey (PublicKey -> KeyHash)
-> (SecretKey -> PublicKey) -> SecretKey -> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey
toPublic (SecretKey -> KeyHash)
-> SizedList'
     ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) SecretKey
-> SizedList'
     ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) SecretKey
GenesisList SecretKey
genesisSecrets

-- | Initially these addresses have a lot of money.
genesisAddresses :: GenesisList ImplicitAddress
genesisAddresses :: GenesisList ImplicitAddress
genesisAddresses = KeyHash -> ImplicitAddress
ImplicitAddress (KeyHash -> ImplicitAddress)
-> SizedList'
     ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) KeyHash
-> SizedList'
     ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
     ImplicitAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) KeyHash
GenesisList KeyHash
genesisKeyHashes

-- | One of genesis key hashes.
genesisKeyHash :: KeyHash
genesisKeyHash :: KeyHash
genesisKeyHash = SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) KeyHash
-> KeyHash
forall (n :: Peano) a. SizedList' ('S n) a -> a
SL.head SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) KeyHash
GenesisList KeyHash
genesisKeyHashes

-- | One of genesis addresses.
genesisAddress :: ImplicitAddress
genesisAddress :: ImplicitAddress
genesisAddress = SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
  ImplicitAddress
-> ImplicitAddress
forall (n :: Peano) a. SizedList' ('S n) a -> a
SL.head SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
  ImplicitAddress
GenesisList ImplicitAddress
genesisAddresses

-- | Secret key assotiated with 'genesisAddress'.
genesisSecretKey :: SecretKey
genesisSecretKey :: SecretKey
genesisSecretKey = SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) SecretKey
-> SecretKey
forall (n :: Peano) a. SizedList' ('S n) a -> a
SL.head SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) SecretKey
GenesisList SecretKey
genesisSecrets

-- | More genesis addresses
genesisAddress1, genesisAddress2, genesisAddress3 :: ImplicitAddress
ImplicitAddress
_ :< ImplicitAddress
genesisAddress1 :< ImplicitAddress
genesisAddress2 :< ImplicitAddress
genesisAddress3
  :< SizedList' n1 ImplicitAddress
_ = SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
  ImplicitAddress
GenesisList ImplicitAddress
genesisAddresses

-- | More genesis addresses, via a type-level natural
--
-- > genesisAddressN @7
--
-- Note that @'genesisAddress' == genesisAddressN \@0@, @'genesisAddress1' == genesisAddressN \@1@,
-- etc.
genesisAddressN
  :: forall n. (SingIPeano n, ToPeano GenesisAddressesNum > ToPeano n ~ 'True)
  => ImplicitAddress
genesisAddressN :: forall (n :: Nat).
(SingIPeano n,
 (ToPeano GenesisAddressesNum > ToPeano n) ~ 'True) =>
ImplicitAddress
genesisAddressN = forall (i :: Nat) (m :: Peano) a.
((m > ToPeano i) ~ 'True, SingIPeano i) =>
SizedList' m a -> a
SL.index @n SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
  ImplicitAddress
GenesisList ImplicitAddress
genesisAddresses

-- | Dummy 'VotingPowers'. We give all the voting power to two genesis addreses
-- as the addresses holding lot of money. Only two addresses are involved for
-- simplicity.
dummyVotingPowers :: VotingPowers
dummyVotingPowers :: VotingPowers
dummyVotingPowers = case GenesisList KeyHash
genesisKeyHashes of
  KeyHash
k1 :< KeyHash
k2 :< SizedList' n1 KeyHash
_ -> [(KeyHash, Natural)] -> VotingPowers
mkVotingPowers [(KeyHash
k1, Natural
50), (KeyHash
k2, Natural
50)]

-- | Initial 'GState'. It's supposed to be used if no 'GState' is
-- provided. It puts plenty of money on each genesis address.
initGState :: GState
initGState :: GState
initGState =
  GState :: ChainId
-> Map ImplicitAddress Mutez
-> Map ContractAddress ContractState
-> Map TxRollupAddress ()
-> VotingPowers
-> GlobalCounter
-> BigMapCounter
-> Bimap ImplicitAlias ImplicitAddress
-> Bimap ContractAlias ContractAddress
-> GState
GState
  { gsChainId :: ChainId
gsChainId = ChainId
dummyChainId
  , gsImplicitAddresses :: Map ImplicitAddress Mutez
gsImplicitAddresses = [(ImplicitAddress, Mutez)] -> Map ImplicitAddress Mutez
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (ImplicitAddress
genesis, Mutez
money)
    | let (Mutez
money, Mutez
_) = forall a. Bounded a => a
maxBound @Mutez Mutez -> Natural -> Maybe (Mutez, Mutez)
forall a. Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
`divModMutezInt` Natural
genesisAddressesNum
                    Maybe (Mutez, Mutez) -> (Mutez, Mutez) -> (Mutez, Mutez)
forall a. Maybe a -> a -> a
?: Text -> (Mutez, Mutez)
forall a. HasCallStack => Text -> a
error Text
"Number of genesis addresses is 0"
    , ImplicitAddress
genesis <- SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
  ImplicitAddress
-> [Element
      (SizedList'
         ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
         ImplicitAddress)]
forall t. Container t => t -> [Element t]
toList SizedList'
  ('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z))))))))))
  ImplicitAddress
GenesisList ImplicitAddress
genesisAddresses
    ]
  , gsContractAddresses :: Map ContractAddress ContractState
gsContractAddresses = Map ContractAddress ContractState
forall k a. Map k a
Map.empty
  , gsTxRollupAddresses :: Map TxRollupAddress ()
gsTxRollupAddresses = Map TxRollupAddress ()
forall k a. Map k a
Map.empty
  , gsVotingPowers :: VotingPowers
gsVotingPowers = VotingPowers
dummyVotingPowers
  , gsCounter :: GlobalCounter
gsCounter = Word64 -> GlobalCounter
GlobalCounter Word64
0
  , gsBigMapCounter :: BigMapCounter
gsBigMapCounter = Natural -> BigMapCounter
BigMapCounter Natural
0
  , gsImplicitAddressAliases :: Bimap ImplicitAlias ImplicitAddress
gsImplicitAddressAliases = Bimap ImplicitAlias ImplicitAddress
forall a b. Bimap a b
Bimap.empty
  , gsContractAddressAliases :: Bimap ContractAlias ContractAddress
gsContractAddressAliases = Bimap ContractAlias ContractAddress
forall a b. Bimap a b
Bimap.empty
  }

data GStateParseError =
  GStateParseError String
  deriving stock (Int -> GStateParseError -> ShowS
[GStateParseError] -> ShowS
GStateParseError -> String
(Int -> GStateParseError -> ShowS)
-> (GStateParseError -> String)
-> ([GStateParseError] -> ShowS)
-> Show GStateParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GStateParseError] -> ShowS
$cshowList :: [GStateParseError] -> ShowS
show :: GStateParseError -> String
$cshow :: GStateParseError -> String
showsPrec :: Int -> GStateParseError -> ShowS
$cshowsPrec :: Int -> GStateParseError -> ShowS
Show)

instance Exception GStateParseError where
  displayException :: GStateParseError -> String
displayException (GStateParseError String
str) = String
"Failed to parse GState: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str

-- | Read 'GState' from a file.
readGState :: FilePath -> IO GState
readGState :: String -> IO GState
readGState String
fp = (String -> IO LByteString
LBS.readFile String
fp IO LByteString -> (LByteString -> IO GState) -> IO GState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LByteString -> IO GState
parseFile) IO GState -> (IOError -> IO GState) -> IO GState
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` IOError -> IO GState
onExc
  where
    parseFile :: LByteString -> IO GState
    parseFile :: LByteString -> IO GState
parseFile LByteString
lByteString =
      if LByteString -> Bool
forall t. Container t => t -> Bool
null LByteString
lByteString
      then GState -> IO GState
forall (f :: * -> *) a. Applicative f => a -> f a
pure GState
initGState
      else ((String -> IO GState)
-> (GState -> IO GState) -> Either String GState -> IO GState
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GStateParseError -> IO GState
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (GStateParseError -> IO GState)
-> (String -> GStateParseError) -> String -> IO GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GStateParseError
GStateParseError) GState -> IO GState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String GState -> IO GState)
-> (LByteString -> Either String GState)
-> LByteString
-> IO GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> Either String GState
forall a. FromJSON a => LByteString -> Either String a
Aeson.eitherDecode') LByteString
lByteString
    onExc :: IOError -> IO GState
    onExc :: IOError -> IO GState
onExc IOError
exc
      | IOError -> Bool
isDoesNotExistError IOError
exc = GState -> IO GState
forall (f :: * -> *) a. Applicative f => a -> f a
pure GState
initGState
      | Bool
otherwise = IOError -> IO GState
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IOError
exc

-- | Write 'GState' to a file.
writeGState :: FilePath -> GState -> IO ()
writeGState :: String -> GState -> IO ()
writeGState String
fp GState
gs = String -> LByteString -> IO ()
LBS.writeFile String
fp (Config -> GState -> LByteString
forall a. ToJSON a => Config -> a -> LByteString
Aeson.encodePretty' Config
config GState
gs)
  where
    config :: Config
config =
      Config
Aeson.defConfig
      { confTrailingNewline :: Bool
Aeson.confTrailingNewline = Bool
True
      }

-- | Updates that can be applied to 'GState'.
data GStateUpdate where
  GSAddImplicitAddress :: ImplicitAddress -> Mutez -> GStateUpdate
  GSAddContractAddress :: ContractAddress -> ContractState -> GStateUpdate
  GSAddContractAddressAlias :: ContractAlias -> ContractAddress -> GStateUpdate
  GSSetStorageValue :: StorageScope st => ContractAddress -> T.Value st -> GStateUpdate
  GSSetBalance :: L1AddressKind kind => KindedAddress kind -> Mutez -> GStateUpdate
  GSIncrementCounter :: GStateUpdate
  GSUpdateCounter :: GlobalCounter -> GStateUpdate
  GSSetBigMapCounter :: BigMapCounter -> GStateUpdate
  GSSetDelegate :: ContractAddress -> Maybe KeyHash -> GStateUpdate

deriving stock instance Show GStateUpdate

instance Buildable GStateUpdate where
  build :: GStateUpdate -> Builder
build =
    \case
      GSAddImplicitAddress ImplicitAddress
addr Mutez
st ->
        Builder
"Add implicit address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" with balance " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
st Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      GSAddContractAddress ContractAddress
addr ContractState
st ->
        Builder
"Add contract address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
addr ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" with state " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractState
st ContractState -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      GSAddContractAddressAlias ContractAlias
alias ContractAddress
addr ->
        Builder
"Add an alias " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAlias
alias ContractAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" for address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
addr ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      GSSetStorageValue ContractAddress
addr Value st
tVal ->
        Builder
"Set storage value of address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
addr ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value st -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
T.untypeValue Value st
tVal Value -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      GSSetBalance KindedAddress kind
addr Mutez
balance ->
        Builder
"Set balance of address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| KindedAddress kind
addr KindedAddress kind -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
balance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      GStateUpdate
GSIncrementCounter ->
        Builder
"Increment internal counter after operation"
      GSUpdateCounter GlobalCounter
v ->
        Builder
"Set internal counter to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| GlobalCounter
v GlobalCounter -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" after interpreting " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"several 'CREATE_CONTRACT' instructions"
      GSSetBigMapCounter BigMapCounter
inc ->
        Builder
"Increment internal big_map counter by: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| BigMapCounter -> Builder
forall p. Buildable p => p -> Builder
build BigMapCounter
inc
      GSSetDelegate ContractAddress
addr Maybe KeyHash
key ->
        Builder
"Set delegate for contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
addr ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder -> (KeyHash -> Builder) -> Maybe KeyHash -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"<nobody>" KeyHash -> Builder
forall p. Buildable p => p -> Builder
build Maybe KeyHash
key

data GStateUpdateError
  = GStateAddressExists Address
  | GStateUnknownAddress Address
  | GStateStorageNotMatch ContractAddress
  | GStateTxRollup TxRollupAddress GStateUpdate
  deriving stock (Int -> GStateUpdateError -> ShowS
[GStateUpdateError] -> ShowS
GStateUpdateError -> String
(Int -> GStateUpdateError -> ShowS)
-> (GStateUpdateError -> String)
-> ([GStateUpdateError] -> ShowS)
-> Show GStateUpdateError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GStateUpdateError] -> ShowS
$cshowList :: [GStateUpdateError] -> ShowS
show :: GStateUpdateError -> String
$cshow :: GStateUpdateError -> String
showsPrec :: Int -> GStateUpdateError -> ShowS
$cshowsPrec :: Int -> GStateUpdateError -> ShowS
Show)

instance Buildable GStateUpdateError where
  build :: GStateUpdateError -> Builder
build =
    \case
      GStateAddressExists Address
addr -> Builder
"Address already exists: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr
      GStateUnknownAddress Address
addr -> Builder
"Unknown address: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr
      GStateStorageNotMatch ContractAddress
addr ->
        Builder
"Storage type does not match the contract in run-time state\
        \ when updating new storage value to address: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Builder
forall p. Buildable p => p -> Builder
build ContractAddress
addr
      GStateTxRollup TxRollupAddress
addr GStateUpdate
op ->
        Builder
"Transaction rollup address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TxRollupAddress
addr TxRollupAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" doesn't support this operation: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| GStateUpdate
op GStateUpdate -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

-- | Apply 'GStateUpdate' to 'GState'.
applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState
applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState
applyUpdate =
  \case
    GSAddImplicitAddress ImplicitAddress
addr Mutez
st -> ImplicitAddress
-> Mutez -> GState -> Either GStateUpdateError GState
addImplicitAddress ImplicitAddress
addr Mutez
st
    GSAddContractAddress ContractAddress
addr ContractState
st -> ContractAddress
-> ContractState -> GState -> Either GStateUpdateError GState
addContractAddress ContractAddress
addr ContractState
st
    GSAddContractAddressAlias ContractAlias
alias ContractAddress
addr -> GState -> Either GStateUpdateError GState
forall a b. b -> Either a b
Right (GState -> Either GStateUpdateError GState)
-> (GState -> GState) -> GState -> Either GStateUpdateError GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractAlias -> ContractAddress -> GState -> GState
addContractAddressAlias ContractAlias
alias ContractAddress
addr
    GSSetStorageValue ContractAddress
addr Value st
newValue ->
      ContractAddress
-> Value st -> GState -> Either GStateUpdateError GState
forall (st :: T).
StorageScope st =>
ContractAddress
-> Value st -> GState -> Either GStateUpdateError GState
setStorageValue ContractAddress
addr Value st
newValue
    GSSetBalance KindedAddress kind
addr Mutez
newBalance -> KindedAddress kind
addr KindedAddress kind
-> Mutez -> GState -> Either GStateUpdateError GState
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind
-> Mutez -> GState -> Either GStateUpdateError GState
`setBalance` Mutez
newBalance
    GStateUpdate
GSIncrementCounter -> GState -> Either GStateUpdateError GState
forall a b. b -> Either a b
Right (GState -> Either GStateUpdateError GState)
-> (GState -> GState) -> GState -> Either GStateUpdateError GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter GState GState GlobalCounter GlobalCounter
-> (GlobalCounter -> GlobalCounter) -> GState -> GState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter GState GState GlobalCounter GlobalCounter
Lens' GState GlobalCounter
gsCounterL (GlobalCounter -> GlobalCounter -> GlobalCounter
forall a. Num a => a -> a -> a
+GlobalCounter
1)
    GSUpdateCounter GlobalCounter
newCounter -> GState -> Either GStateUpdateError GState
forall a b. b -> Either a b
Right (GState -> Either GStateUpdateError GState)
-> (GState -> GState) -> GState -> Either GStateUpdateError GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter GState GState GlobalCounter GlobalCounter
-> GlobalCounter -> GState -> GState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter GState GState GlobalCounter GlobalCounter
Lens' GState GlobalCounter
gsCounterL GlobalCounter
newCounter
    GSSetBigMapCounter BigMapCounter
bmCounter -> GState -> Either GStateUpdateError GState
forall a b. b -> Either a b
Right (GState -> Either GStateUpdateError GState)
-> (GState -> GState) -> GState -> Either GStateUpdateError GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter GState GState BigMapCounter BigMapCounter
-> BigMapCounter -> GState -> GState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter GState GState BigMapCounter BigMapCounter
Lens' GState BigMapCounter
gsBigMapCounterL BigMapCounter
bmCounter
    GSSetDelegate ContractAddress
addr Maybe KeyHash
key -> ContractAddress
-> Maybe KeyHash -> GState -> Either GStateUpdateError GState
setDelegate ContractAddress
addr Maybe KeyHash
key

-- | Apply a list of 'GStateUpdate's to 'GState'.
applyUpdates :: [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates :: [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates = (GState -> [GStateUpdate] -> Either GStateUpdateError GState)
-> [GStateUpdate] -> GState -> Either GStateUpdateError GState
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((GState -> GStateUpdate -> Either GStateUpdateError GState)
-> GState -> [GStateUpdate] -> Either GStateUpdateError GState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((GStateUpdate -> GState -> Either GStateUpdateError GState)
-> GState -> GStateUpdate -> Either GStateUpdateError GState
forall a b c. (a -> b -> c) -> b -> a -> c
flip GStateUpdate -> GState -> Either GStateUpdateError GState
applyUpdate))

-- | Add an address if it hasn't been added before.
addImplicitAddress :: ImplicitAddress -> Mutez -> GState -> Either GStateUpdateError GState
addImplicitAddress :: ImplicitAddress
-> Mutez -> GState -> Either GStateUpdateError GState
addImplicitAddress ImplicitAddress
addr Mutez
st GState
gs
  | ImplicitAddress
addr ImplicitAddress -> Map ImplicitAddress Mutez -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` (GState -> Map ImplicitAddress Mutez
gsImplicitAddresses GState
gs) = GStateUpdateError -> Either GStateUpdateError GState
forall a b. a -> Either a b
Left (GStateUpdateError -> Either GStateUpdateError GState)
-> GStateUpdateError -> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$ Address -> GStateUpdateError
GStateAddressExists (ImplicitAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ImplicitAddress
addr)
  | Bool
otherwise = GState -> Either GStateUpdateError GState
forall a b. b -> Either a b
Right (GState -> Either GStateUpdateError GState)
-> GState -> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$ GState
gs GState -> (GState -> GState) -> GState
forall a b. a -> (a -> b) -> b
& (Map ImplicitAddress Mutez -> Identity (Map ImplicitAddress Mutez))
-> GState -> Identity GState
Lens' GState (Map ImplicitAddress Mutez)
gsImplicitAddressesL ((Map ImplicitAddress Mutez
  -> Identity (Map ImplicitAddress Mutez))
 -> GState -> Identity GState)
-> ((Maybe Mutez -> Identity (Maybe Mutez))
    -> Map ImplicitAddress Mutez
    -> Identity (Map ImplicitAddress Mutez))
-> (Maybe Mutez -> Identity (Maybe Mutez))
-> GState
-> Identity GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ImplicitAddress Mutez)
-> Lens'
     (Map ImplicitAddress Mutez)
     (Maybe (IxValue (Map ImplicitAddress Mutez)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ImplicitAddress Mutez)
ImplicitAddress
addr ((Maybe Mutez -> Identity (Maybe Mutez))
 -> GState -> Identity GState)
-> Mutez -> GState -> GState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Mutez
st

-- | Add an address if it hasn't been added before.
addContractAddress :: ContractAddress -> ContractState -> GState -> Either GStateUpdateError GState
addContractAddress :: ContractAddress
-> ContractState -> GState -> Either GStateUpdateError GState
addContractAddress ContractAddress
addr ContractState
st GState
gs
  | ContractAddress
addr ContractAddress -> Map ContractAddress ContractState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` (GState -> Map ContractAddress ContractState
gsContractAddresses GState
gs) = GStateUpdateError -> Either GStateUpdateError GState
forall a b. a -> Either a b
Left (GStateUpdateError -> Either GStateUpdateError GState)
-> GStateUpdateError -> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$ Address -> GStateUpdateError
GStateAddressExists (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr)
  | Bool
otherwise = GState -> Either GStateUpdateError GState
forall a b. b -> Either a b
Right (GState -> Either GStateUpdateError GState)
-> GState -> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$ GState
gs GState -> (GState -> GState) -> GState
forall a b. a -> (a -> b) -> b
& (Map ContractAddress ContractState
 -> Identity (Map ContractAddress ContractState))
-> GState -> Identity GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL ((Map ContractAddress ContractState
  -> Identity (Map ContractAddress ContractState))
 -> GState -> Identity GState)
-> ((Maybe ContractState -> Identity (Maybe ContractState))
    -> Map ContractAddress ContractState
    -> Identity (Map ContractAddress ContractState))
-> (Maybe ContractState -> Identity (Maybe ContractState))
-> GState
-> Identity GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ContractAddress ContractState)
-> Lens'
     (Map ContractAddress ContractState)
     (Maybe (IxValue (Map ContractAddress ContractState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractAddress ContractState)
ContractAddress
addr ((Maybe ContractState -> Identity (Maybe ContractState))
 -> GState -> Identity GState)
-> ContractState -> GState -> GState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ContractState
st

-- | Add an alias for given address, overwriting any existing address for the same alias.
addContractAddressAlias :: ContractAlias -> ContractAddress -> GState -> GState
addContractAddressAlias :: ContractAlias -> ContractAddress -> GState -> GState
addContractAddressAlias ContractAlias
alias ContractAddress
addr = (Bimap ContractAlias ContractAddress
 -> Identity (Bimap ContractAlias ContractAddress))
-> GState -> Identity GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
  -> Identity (Bimap ContractAlias ContractAddress))
 -> GState -> Identity GState)
-> ((Maybe ContractAddress -> Identity (Maybe ContractAddress))
    -> Bimap ContractAlias ContractAddress
    -> Identity (Bimap ContractAlias ContractAddress))
-> (Maybe ContractAddress -> Identity (Maybe ContractAddress))
-> GState
-> Identity GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAlias ContractAddress)
-> Lens'
     (Bimap ContractAlias ContractAddress)
     (Maybe (IxValue (Bimap ContractAlias ContractAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ContractAlias ContractAddress)
ContractAlias
alias ((Maybe ContractAddress -> Identity (Maybe ContractAddress))
 -> GState -> Identity GState)
-> ContractAddress -> GState -> GState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ContractAddress
addr

-- | Update storage value associated with given address.
setStorageValue :: forall st. (StorageScope st) =>
     ContractAddress -> T.Value st -> GState -> Either GStateUpdateError GState
setStorageValue :: forall (st :: T).
StorageScope st =>
ContractAddress
-> Value st -> GState -> Either GStateUpdateError GState
setStorageValue ContractAddress
addr Value st
newValue = ContractAddress
-> (AddressStateFam 'AddressKindContract
    -> Either GStateUpdateError (AddressStateFam 'AddressKindContract))
-> GState
-> Either GStateUpdateError GState
forall (kind :: AddressKind).
KindedAddress kind
-> (AddressStateFam kind
    -> Either GStateUpdateError (AddressStateFam kind))
-> GState
-> Either GStateUpdateError GState
updateAddressState ContractAddress
addr ContractState -> Either GStateUpdateError ContractState
AddressStateFam 'AddressKindContract
-> Either GStateUpdateError (AddressStateFam 'AddressKindContract)
modifier
  where
    modifier :: ContractState -> Either GStateUpdateError ContractState
    modifier :: ContractState -> Either GStateUpdateError ContractState
modifier ContractState{csStorage :: ()
csStorage = Value st
_ :: T.Value st', Maybe KeyHash
Mutez
Contract cp st
csDelegate :: Maybe KeyHash
csContract :: Contract cp st
csBalance :: Mutez
csDelegate :: ContractState -> Maybe KeyHash
csContract :: ()
csBalance :: ContractState -> Mutez
..} = do
      case forall {k} (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
forall (a :: T) (b :: T).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @st @st' of
        Just st :~: st
Refl -> ContractState -> Either GStateUpdateError ContractState
forall a b. b -> Either a b
Right (ContractState -> Either GStateUpdateError ContractState)
-> ContractState -> Either GStateUpdateError ContractState
forall a b. (a -> b) -> a -> b
$ ContractState :: forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
ContractState{csStorage :: Value st
csStorage = Value st
newValue, Maybe KeyHash
Mutez
Contract' Instr cp st
Contract cp st
csDelegate :: Maybe KeyHash
csContract :: Contract cp st
csBalance :: Mutez
csDelegate :: Maybe KeyHash
csContract :: Contract' Instr cp st
csBalance :: Mutez
..}
        Maybe (st :~: st)
_ -> GStateUpdateError -> Either GStateUpdateError ContractState
forall a b. a -> Either a b
Left (GStateUpdateError -> Either GStateUpdateError ContractState)
-> GStateUpdateError -> Either GStateUpdateError ContractState
forall a b. (a -> b) -> a -> b
$ ContractAddress -> GStateUpdateError
GStateStorageNotMatch ContractAddress
addr

-- | Update balance value associated with given address.
setBalance
  :: forall kind. L1AddressKind kind
  => KindedAddress kind
  -> Mutez
  -> GState
  -> Either GStateUpdateError GState
setBalance :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind
-> Mutez -> GState -> Either GStateUpdateError GState
setBalance KindedAddress kind
addr Mutez
newBalance = KindedAddress kind
-> (AddressStateFam kind
    -> Either GStateUpdateError (AddressStateFam kind))
-> GState
-> Either GStateUpdateError GState
forall (kind :: AddressKind).
KindedAddress kind
-> (AddressStateFam kind
    -> Either GStateUpdateError (AddressStateFam kind))
-> GState
-> Either GStateUpdateError GState
updateAddressState KindedAddress kind
addr ((AddressStateFam kind
  -> Either GStateUpdateError (AddressStateFam kind))
 -> GState -> Either GStateUpdateError GState)
-> (AddressStateFam kind
    -> Either GStateUpdateError (AddressStateFam kind))
-> GState
-> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$
  AddressStateFam kind
-> Either GStateUpdateError (AddressStateFam kind)
forall a b. b -> Either a b
Right (AddressStateFam kind
 -> Either GStateUpdateError (AddressStateFam kind))
-> (AddressStateFam kind -> AddressStateFam kind)
-> AddressStateFam kind
-> Either GStateUpdateError (AddressStateFam kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (AddressStateFam kind) (AddressStateFam kind) Mutez Mutez
-> Mutez -> AddressStateFam kind -> AddressStateFam kind
forall s t a b. ASetter s t a b -> b -> s -> t
set (KindedAddress kind -> Lens' (AddressStateFam kind) Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Lens' (AddressStateFam kind) Mutez
balanceLens KindedAddress kind
addr) Mutez
newBalance

lookupBalance :: forall kind. L1AddressKind kind => KindedAddress kind -> GState -> Maybe Mutez
lookupBalance :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> GState -> Maybe Mutez
lookupBalance KindedAddress kind
addr = Getting (First Mutez) GState Mutez -> GState -> Maybe Mutez
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Mutez) GState Mutez -> GState -> Maybe Mutez)
-> Getting (First Mutez) GState Mutez -> GState -> Maybe Mutez
forall a b. (a -> b) -> a -> b
$ KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
forall (kind :: AddressKind).
KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
addressesL KindedAddress kind
addr ((Map (KindedAddress kind) (AddressStateFam kind)
  -> Const
       (First Mutez) (Map (KindedAddress kind) (AddressStateFam kind)))
 -> GState -> Const (First Mutez) GState)
-> ((Mutez -> Const (First Mutez) Mutez)
    -> Map (KindedAddress kind) (AddressStateFam kind)
    -> Const
         (First Mutez) (Map (KindedAddress kind) (AddressStateFam kind)))
-> Getting (First Mutez) GState Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (KindedAddress kind) (AddressStateFam kind))
-> Lens'
     (Map (KindedAddress kind) (AddressStateFam kind))
     (Maybe (IxValue (Map (KindedAddress kind) (AddressStateFam kind))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (KindedAddress kind) (AddressStateFam kind))
KindedAddress kind
addr ((Maybe (AddressStateFam kind)
  -> Const (First Mutez) (Maybe (AddressStateFam kind)))
 -> Map (KindedAddress kind) (AddressStateFam kind)
 -> Const
      (First Mutez) (Map (KindedAddress kind) (AddressStateFam kind)))
-> ((Mutez -> Const (First Mutez) Mutez)
    -> Maybe (AddressStateFam kind)
    -> Const (First Mutez) (Maybe (AddressStateFam kind)))
-> (Mutez -> Const (First Mutez) Mutez)
-> Map (KindedAddress kind) (AddressStateFam kind)
-> Const
     (First Mutez) (Map (KindedAddress kind) (AddressStateFam kind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddressStateFam kind
 -> Const (First Mutez) (AddressStateFam kind))
-> Maybe (AddressStateFam kind)
-> Const (First Mutez) (Maybe (AddressStateFam kind))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((AddressStateFam kind
  -> Const (First Mutez) (AddressStateFam kind))
 -> Maybe (AddressStateFam kind)
 -> Const (First Mutez) (Maybe (AddressStateFam kind)))
-> ((Mutez -> Const (First Mutez) Mutez)
    -> AddressStateFam kind
    -> Const (First Mutez) (AddressStateFam kind))
-> (Mutez -> Const (First Mutez) Mutez)
-> Maybe (AddressStateFam kind)
-> Const (First Mutez) (Maybe (AddressStateFam kind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> Lens' (AddressStateFam kind) Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Lens' (AddressStateFam kind) Mutez
balanceLens KindedAddress kind
addr

balanceLens
  :: forall kind. L1AddressKind kind
  => KindedAddress kind
  -> Lens' (AddressStateFam kind) Mutez
balanceLens :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Lens' (AddressStateFam kind) Mutez
balanceLens = \case
  ImplicitAddress{} -> (Mutez -> f Mutez)
-> AddressStateFam kind -> f (AddressStateFam kind)
forall a. a -> a
id
  ContractAddress{} -> (Mutez -> f Mutez)
-> AddressStateFam kind -> f (AddressStateFam kind)
Lens' ContractState Mutez
csBalanceL
  where ()
_ = forall (kind :: AddressKind) a. L1AddressKind kind => a -> a
usingImplicitOrContractKind @kind ()

-- | Set delegate for a given address
setDelegate :: ContractAddress -> Maybe KeyHash -> GState -> Either GStateUpdateError GState
setDelegate :: ContractAddress
-> Maybe KeyHash -> GState -> Either GStateUpdateError GState
setDelegate ContractAddress
addr Maybe KeyHash
key = ContractAddress
-> (AddressStateFam 'AddressKindContract
    -> Either GStateUpdateError (AddressStateFam 'AddressKindContract))
-> GState
-> Either GStateUpdateError GState
forall (kind :: AddressKind).
KindedAddress kind
-> (AddressStateFam kind
    -> Either GStateUpdateError (AddressStateFam kind))
-> GState
-> Either GStateUpdateError GState
updateAddressState ContractAddress
addr ((AddressStateFam 'AddressKindContract
  -> Either GStateUpdateError (AddressStateFam 'AddressKindContract))
 -> GState -> Either GStateUpdateError GState)
-> (AddressStateFam 'AddressKindContract
    -> Either GStateUpdateError (AddressStateFam 'AddressKindContract))
-> GState
-> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$ ContractState -> Either GStateUpdateError ContractState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractState -> Either GStateUpdateError ContractState)
-> (ContractState -> ContractState)
-> ContractState
-> Either GStateUpdateError ContractState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe KeyHash -> Identity (Maybe KeyHash))
-> ContractState -> Identity ContractState
Lens' ContractState (Maybe KeyHash)
csDelegateL ((Maybe KeyHash -> Identity (Maybe KeyHash))
 -> ContractState -> Identity ContractState)
-> Maybe KeyHash -> ContractState -> ContractState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe KeyHash
key)

type family AddressStateFam kind where
  AddressStateFam 'AddressKindImplicit = Mutez
  AddressStateFam 'AddressKindContract = ContractState
  -- TODO [#838]: support transaction rollups on the emulator
  AddressStateFam 'AddressKindTxRollup = ()

updateAddressState
  :: forall kind. KindedAddress kind
  -> (AddressStateFam kind -> Either GStateUpdateError (AddressStateFam kind))
  -> GState
  -> Either GStateUpdateError GState
updateAddressState :: forall (kind :: AddressKind).
KindedAddress kind
-> (AddressStateFam kind
    -> Either GStateUpdateError (AddressStateFam kind))
-> GState
-> Either GStateUpdateError GState
updateAddressState KindedAddress kind
addr AddressStateFam kind
-> Either GStateUpdateError (AddressStateFam kind)
f GState
gs =
  let addrL :: Lens' GState (Maybe (AddressStateFam kind))
      addrL :: Lens' GState (Maybe (AddressStateFam kind))
addrL = KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
forall (kind :: AddressKind).
KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
addressesL KindedAddress kind
addr ((Map (KindedAddress kind) (AddressStateFam kind)
  -> f (Map (KindedAddress kind) (AddressStateFam kind)))
 -> GState -> f GState)
-> ((Maybe (AddressStateFam kind)
     -> f (Maybe (AddressStateFam kind)))
    -> Map (KindedAddress kind) (AddressStateFam kind)
    -> f (Map (KindedAddress kind) (AddressStateFam kind)))
-> (Maybe (AddressStateFam kind)
    -> f (Maybe (AddressStateFam kind)))
-> GState
-> f GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (KindedAddress kind) (AddressStateFam kind))
-> Lens'
     (Map (KindedAddress kind) (AddressStateFam kind))
     (Maybe (IxValue (Map (KindedAddress kind) (AddressStateFam kind))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (KindedAddress kind) (AddressStateFam kind))
KindedAddress kind
addr
  in case GState
gs GState
-> Getting
     (Maybe (AddressStateFam kind))
     GState
     (Maybe (AddressStateFam kind))
-> Maybe (AddressStateFam kind)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (AddressStateFam kind))
  GState
  (Maybe (AddressStateFam kind))
Lens' GState (Maybe (AddressStateFam kind))
addrL of
    Maybe (AddressStateFam kind)
Nothing -> GStateUpdateError -> Either GStateUpdateError GState
forall a b. a -> Either a b
Left (GStateUpdateError -> Either GStateUpdateError GState)
-> GStateUpdateError -> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$ Address -> GStateUpdateError
GStateUnknownAddress (Address -> GStateUpdateError) -> Address -> GStateUpdateError
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr
    Just AddressStateFam kind
as -> do
      AddressStateFam kind
newState <- AddressStateFam kind
-> Either GStateUpdateError (AddressStateFam kind)
f AddressStateFam kind
as
      return $ GState
gs GState -> (GState -> GState) -> GState
forall a b. a -> (a -> b) -> b
& (Maybe (AddressStateFam kind)
 -> Identity (Maybe (AddressStateFam kind)))
-> GState -> Identity GState
Lens' GState (Maybe (AddressStateFam kind))
addrL ((Maybe (AddressStateFam kind)
  -> Identity (Maybe (AddressStateFam kind)))
 -> GState -> Identity GState)
-> Maybe (AddressStateFam kind) -> GState -> GState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AddressStateFam kind -> Maybe (AddressStateFam kind)
forall a. a -> Maybe a
Just AddressStateFam kind
newState

addressesL
  :: KindedAddress kind
  -> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
addressesL :: forall (kind :: AddressKind).
KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
addressesL = \case
  ImplicitAddress{} -> (Map (KindedAddress kind) (AddressStateFam kind)
 -> f (Map (KindedAddress kind) (AddressStateFam kind)))
-> GState -> f GState
Lens' GState (Map ImplicitAddress Mutez)
gsImplicitAddressesL
  ContractAddress{} -> (Map (KindedAddress kind) (AddressStateFam kind)
 -> f (Map (KindedAddress kind) (AddressStateFam kind)))
-> GState -> f GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL
  TxRollupAddress{} -> (Map (KindedAddress kind) (AddressStateFam kind)
 -> f (Map (KindedAddress kind) (AddressStateFam kind)))
-> GState -> f GState
Lens' GState (Map TxRollupAddress ())
gsTxRollupAddressesL

-- | Retrieve all contracts stored in GState
extractAllContracts :: GState -> TcOriginatedContracts
extractAllContracts :: GState -> TcOriginatedContracts
extractAllContracts = [(ContractHash, SomeParamType)] -> TcOriginatedContracts
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ContractHash, SomeParamType)] -> TcOriginatedContracts)
-> (GState -> [(ContractHash, SomeParamType)])
-> GState
-> TcOriginatedContracts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ContractAddress, ContractState)
 -> Maybe (ContractHash, SomeParamType))
-> [(ContractAddress, ContractState)]
-> [(ContractHash, SomeParamType)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ContractAddress, ContractState)
-> Maybe (ContractHash, SomeParamType)
extractContract ([(ContractAddress, ContractState)]
 -> [(ContractHash, SomeParamType)])
-> (GState -> [(ContractAddress, ContractState)])
-> GState
-> [(ContractHash, SomeParamType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ContractAddress ContractState
-> [(ContractAddress, ContractState)]
forall t. ToPairs t => t -> [(Key t, Val t)]
toPairs (Map ContractAddress ContractState
 -> [(ContractAddress, ContractState)])
-> (GState -> Map ContractAddress ContractState)
-> GState
-> [(ContractAddress, ContractState)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GState -> Map ContractAddress ContractState
gsContractAddresses
 where
    extractContract
      :: (ContractAddress, ContractState) -> Maybe (ContractHash, SomeParamType)
    extractContract :: (ContractAddress, ContractState)
-> Maybe (ContractHash, SomeParamType)
extractContract =
      \case (ContractAddress ContractHash
ca, ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csDelegate :: Maybe KeyHash
csStorage :: Value st
csContract :: Contract cp st
csBalance :: Mutez
csDelegate :: ContractState -> Maybe KeyHash
csStorage :: ()
csContract :: ()
csBalance :: ContractState -> Mutez
..}) ->
              (ContractHash, SomeParamType)
-> Maybe (ContractHash, SomeParamType)
forall a. a -> Maybe a
Just (ContractHash
ca, ParamNotes cp -> SomeParamType
forall (t :: T). ParameterScope t => ParamNotes t -> SomeParamType
SomeParamType (ParamNotes cp -> SomeParamType) -> ParamNotes cp -> SomeParamType
forall a b. (a -> b) -> a -> b
$ Contract cp st -> ParamNotes cp
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
T.cParamNotes (Contract cp st -> ParamNotes cp)
-> Contract cp st -> ParamNotes cp
forall a b. (a -> b) -> a -> b
$ Contract cp st
csContract)