module Morley.Michelson.Runtime.GState
(
ContractState (..)
, VotingPowers (..)
, vpPick
, vpTotal
, mkVotingPowers
, mkVotingPowersFromMap
, dummyVotingPowers
, BigMapCounter(..)
, bigMapCounter
, GState (..)
, gsChainIdL
, gsImplicitAddressesL
, gsContractAddressesL
, gsImplicitAddressAliasesL
, gsContractAddressAliasesL
, gsVotingPowersL
, gsCounterL
, gsBigMapCounterL
, addressesL
, genesisAddresses
, genesisKeyHashes
, genesisAddress
, genesisAddress1
, genesisAddress2
, genesisAddress3
, genesisAddressN
, genesisKeyHash
, genesisSecretKey
, genesisSecrets
, initGState
, readGState
, writeGState
, 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
data ContractState =
forall cp st. (ParameterScope cp, StorageScope st) => ContractState
{ ContractState -> Mutez
csBalance :: Mutez
, ()
csContract :: T.Contract cp st
, ()
csStorage :: T.Value st
, ContractState -> Maybe KeyHash
csDelegate :: Maybe KeyHash
}
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
]
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
""
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
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
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
mkVotingPowersFromMap :: Map KeyHash Natural -> VotingPowers
mkVotingPowersFromMap :: Map KeyHash Natural -> VotingPowers
mkVotingPowersFromMap = Map KeyHash Natural -> VotingPowers
VotingPowers
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
(+)
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
data GState = GState
{ GState -> ChainId
gsChainId :: ChainId
, GState -> Map ImplicitAddress Mutez
gsImplicitAddresses :: Map ImplicitAddress Mutez
, GState -> Map ContractAddress ContractState
gsContractAddresses :: Map ContractAddress ContractState
, GState -> Map TxRollupAddress ()
gsTxRollupAddresses :: Map TxRollupAddress ()
, GState -> VotingPowers
gsVotingPowers :: VotingPowers
, GState -> GlobalCounter
gsCounter :: GlobalCounter
, GState -> BigMapCounter
gsBigMapCounter :: BigMapCounter
, GState -> Bimap ImplicitAlias ImplicitAddress
gsImplicitAddressAliases :: Bimap ImplicitAlias ImplicitAddress
, GState -> Bimap ContractAlias ContractAddress
gsContractAddressAliases :: Bimap ContractAlias ContractAddress
} 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
type GenesisAddressesNum = 10
type GenesisList a = SizedList GenesisAddressesNum a
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
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
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
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
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
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
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
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
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
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)]
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
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
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
}
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
""
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
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))
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
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
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
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
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 ()
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
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
extractAllContracts :: GState -> TcOriginatedContracts
= [(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)