module Morley.Michelson.Runtime.GState
(
ContractState (..)
, AddressState (..)
, asBalance
, VotingPowers (..)
, vpPick
, vpTotal
, mkVotingPowers
, mkVotingPowersFromMap
, dummyVotingPowers
, BigMapCounter(..)
, bigMapCounter
, GState (..)
, gsChainIdL
, gsAddressesL
, gsVotingPowersL
, gsCounterL
, gsBigMapCounterL
, genesisAddresses
, genesisKeyHashes
, genesisAddress
, genesisAddress1
, genesisAddress2
, genesisAddress3
, genesisAddress4
, genesisAddress5
, genesisAddress6
, genesisAddressN
, genesisKeyHash
, genesisSecretKey
, genesisSecrets
, initGState
, readGState
, writeGState
, GStateUpdate (..)
, GStateUpdateError (..)
, applyUpdate
, applyUpdates
, extractAllContracts
) 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 (Address(..), ContractHash, GlobalCounter(..))
import Morley.Tezos.Core (ChainId, Mutez, divModMutezInt, dummyChainId)
import Morley.Tezos.Crypto
import Morley.Util.Aeson
import Morley.Util.Lens
import Morley.Util.Peano
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
}
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
. (Text
"delegate" Text -> KeyHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=)) Maybe KeyHash
csDelegate ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ Text
"balance" Text -> Mutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Mutez
csBalance
, Text
"storage" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value st -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
T.untypeValue Value st
csStorage
, Text
"contract" Text -> Contract -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 -> Text -> Parser Mutez
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"balance"
(Value
uStorage :: Value) <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"storage"
(Contract
uContract :: Contract) <- Object
o Object -> Text -> Parser Contract
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contract"
(Maybe KeyHash
delegate :: Maybe KeyHash) <- Object
o Object -> Text -> Parser (Maybe KeyHash)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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
""
data AddressState
= ASSimple Mutez
| ASContract ContractState
deriving stock (Int -> AddressState -> ShowS
[AddressState] -> ShowS
AddressState -> String
(Int -> AddressState -> ShowS)
-> (AddressState -> String)
-> ([AddressState] -> ShowS)
-> Show AddressState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressState] -> ShowS
$cshowList :: [AddressState] -> ShowS
show :: AddressState -> String
$cshow :: AddressState -> String
showsPrec :: Int -> AddressState -> ShowS
$cshowsPrec :: Int -> AddressState -> ShowS
Show, AddressState -> AddressState -> Bool
(AddressState -> AddressState -> Bool)
-> (AddressState -> AddressState -> Bool) -> Eq AddressState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressState -> AddressState -> Bool
$c/= :: AddressState -> AddressState -> Bool
== :: AddressState -> AddressState -> Bool
$c== :: AddressState -> AddressState -> Bool
Eq, (forall x. AddressState -> Rep AddressState x)
-> (forall x. Rep AddressState x -> AddressState)
-> Generic AddressState
forall x. Rep AddressState x -> AddressState
forall x. AddressState -> Rep AddressState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddressState x -> AddressState
$cfrom :: forall x. AddressState -> Rep AddressState x
Generic)
instance Buildable AddressState where
build :: AddressState -> Builder
build =
\case
ASSimple Mutez
balance -> Builder
"Balance = " 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
""
ASContract ContractState
cs -> ContractState -> Builder
forall p. Buildable p => p -> Builder
build ContractState
cs
deriveJSON morleyAesonOptions ''AddressState
asBalance :: AddressState -> Mutez
asBalance :: AddressState -> Mutez
asBalance =
\case
ASSimple Mutez
b -> Mutez
b
ASContract ContractState
cs -> ContractState -> Mutez
csBalance ContractState
cs
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 Address AddressState
gsAddresses :: Map Address AddressState
, GState -> VotingPowers
gsVotingPowers :: VotingPowers
, GState -> GlobalCounter
gsCounter :: GlobalCounter
, GState -> BigMapCounter
gsBigMapCounter :: BigMapCounter
} 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 = Proxy GenesisAddressesNum -> Natural
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
forall (n' :: Peano) a.
(SingIPeano GenesisAddressesNum,
IsoNatPeano GenesisAddressesNum n') =>
(Natural -> a) -> SizedList GenesisAddressesNum 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 Address
genesisAddresses :: GenesisList Address
genesisAddresses = KeyHash -> Address
KeyAddress (KeyHash -> Address)
-> 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)))))))))) Address
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 :: Address
genesisAddress :: Address
genesisAddress = SizedList'
('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) Address
-> Address
forall (n :: Peano) a. SizedList' ('S n) a -> a
SL.head SizedList'
('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) Address
GenesisList Address
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 :: Address
genesisAddress4, genesisAddress5, genesisAddress6 :: Address
Address
_ :< Address
genesisAddress1 :< Address
genesisAddress2 :< Address
genesisAddress3
:< Address
genesisAddress4 :< Address
genesisAddress5 :< Address
genesisAddress6
:< SizedList' n Address
_ = SizedList'
('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) Address
GenesisList Address
genesisAddresses
{-# DEPRECATED genesisAddress4, genesisAddress5, genesisAddress6
"Consider using 'genesisAddressN' instead" #-}
genesisAddressN :: forall n. (SingIPeano n, ToPeano GenesisAddressesNum > ToPeano n ~ 'True) => Address
genesisAddressN :: Address
genesisAddressN = SizedList'
('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) Address
-> Address
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)))))))))) Address
GenesisList Address
genesisAddresses
dummyVotingPowers :: VotingPowers
dummyVotingPowers :: VotingPowers
dummyVotingPowers = case GenesisList KeyHash
genesisKeyHashes of
KeyHash
k1 :< KeyHash
k2 :< SizedList' n KeyHash
_ -> [(KeyHash, Natural)] -> VotingPowers
mkVotingPowers [(KeyHash
k1, Natural
50), (KeyHash
k2, Natural
50)]
initGState :: GState
initGState :: GState
initGState =
GState :: ChainId
-> Map Address AddressState
-> VotingPowers
-> GlobalCounter
-> BigMapCounter
-> GState
GState
{ gsChainId :: ChainId
gsChainId = ChainId
dummyChainId
, gsAddresses :: Map Address AddressState
gsAddresses = [(Address, AddressState)] -> Map Address AddressState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Address
genesis, Mutez -> AddressState
ASSimple Mutez
money)
| let (Mutez
money, Mutez
_) = Bounded Mutez => 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"
, Address
genesis <- SizedList'
('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) Address
-> [Element
(SizedList'
('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) Address)]
forall t. Container t => t -> [Element t]
toList SizedList'
('S ('S ('S ('S ('S ('S ('S ('S ('S ('S 'Z)))))))))) Address
GenesisList Address
genesisAddresses
]
, gsVotingPowers :: VotingPowers
gsVotingPowers = VotingPowers
dummyVotingPowers
, gsCounter :: GlobalCounter
gsCounter = Word64 -> GlobalCounter
GlobalCounter Word64
0
, gsBigMapCounter :: BigMapCounter
gsBigMapCounter = Natural -> BigMapCounter
BigMapCounter Natural
0
}
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 ByteString
LBS.readFile String
fp IO ByteString -> (ByteString -> IO GState) -> IO GState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> 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 :: ByteString -> IO GState
parseFile ByteString
lByteString =
if ByteString -> Bool
forall t. Container t => t -> Bool
null ByteString
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)
-> (ByteString -> Either String GState) -> ByteString -> IO GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String GState
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode') ByteString
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 -> ByteString -> IO ()
LBS.writeFile String
fp (Config -> GState -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Aeson.encodePretty' Config
config GState
gs)
where
config :: Config
config =
Config
Aeson.defConfig
{ confTrailingNewline :: Bool
Aeson.confTrailingNewline = Bool
True
}
data GStateUpdate where
GSAddAddress :: Address -> AddressState -> GStateUpdate
GSSetStorageValue :: StorageScope st => Address -> T.Value st -> GStateUpdate
GSSetBalance :: Address -> Mutez -> GStateUpdate
GSIncrementCounter :: GStateUpdate
GSUpdateCounter :: GlobalCounter -> GStateUpdate
GSSetBigMapCounter :: BigMapCounter -> GStateUpdate
GSSetDelegate :: Address -> Maybe KeyHash -> GStateUpdate
deriving stock instance Show GStateUpdate
instance Buildable GStateUpdate where
build :: GStateUpdate -> Builder
build =
\case
GSAddAddress Address
addr AddressState
st ->
Builder
"Add address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> 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
+| AddressState
st AddressState -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
GSSetStorageValue Address
addr Value st
tVal ->
Builder
"Set storage value of address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> 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 Address
addr Mutez
balance ->
Builder
"Set balance of address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> 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 Address
addr Maybe KeyHash
key ->
Builder
"Set delegate for contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> 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
| GStateNotContract Address
| GStateStorageNotMatch Address
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
GStateNotContract Address
addr -> Builder
"Address doesn't have contract: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr
GStateStorageNotMatch Address
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
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr
applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState
applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState
applyUpdate =
\case
GSAddAddress Address
addr AddressState
st ->
GStateUpdateError
-> Maybe GState -> Either GStateUpdateError GState
forall l r. l -> Maybe r -> Either l r
maybeToRight (Address -> GStateUpdateError
GStateAddressExists Address
addr) (Maybe GState -> Either GStateUpdateError GState)
-> (GState -> Maybe GState)
-> GState
-> Either GStateUpdateError GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> AddressState -> GState -> Maybe GState
addAddress Address
addr AddressState
st
GSSetStorageValue Address
addr Value st
newValue ->
Address -> Value st -> GState -> Either GStateUpdateError GState
forall (st :: T).
StorageScope st =>
Address -> Value st -> GState -> Either GStateUpdateError GState
setStorageValue Address
addr Value st
newValue
GSSetBalance Address
addr Mutez
newBalance -> Address -> Mutez -> GState -> Either GStateUpdateError GState
setBalance Address
addr 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 Address
addr Maybe KeyHash
key -> Address
-> Maybe KeyHash -> GState -> Either GStateUpdateError GState
setDelegate Address
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))
addAddress :: Address -> AddressState -> GState -> Maybe GState
addAddress :: Address -> AddressState -> GState -> Maybe GState
addAddress Address
addr AddressState
st GState
gs
| Address
addr Address -> Map Address AddressState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Address AddressState
accounts = Maybe GState
forall a. Maybe a
Nothing
| Bool
otherwise = GState -> Maybe GState
forall a. a -> Maybe a
Just (GState
gs {gsAddresses :: Map Address AddressState
gsAddresses = Map Address AddressState
accounts Map Address AddressState
-> (Map Address AddressState -> Map Address AddressState)
-> Map Address AddressState
forall a b. a -> (a -> b) -> b
& Index (Map Address AddressState)
-> Lens'
(Map Address AddressState)
(Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr ((Maybe AddressState -> Identity (Maybe AddressState))
-> Map Address AddressState -> Identity (Map Address AddressState))
-> Maybe AddressState
-> Map Address AddressState
-> Map Address AddressState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AddressState -> Maybe AddressState
forall a. a -> Maybe a
Just AddressState
st})
where
accounts :: Map Address AddressState
accounts = GState -> Map Address AddressState
gsAddresses GState
gs
setStorageValue :: forall st. (StorageScope st) =>
Address -> T.Value st -> GState -> Either GStateUpdateError GState
setStorageValue :: Address -> Value st -> GState -> Either GStateUpdateError GState
setStorageValue Address
addr Value st
newValue = Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState Address
addr AddressState -> Either GStateUpdateError AddressState
modifier
where
modifier :: AddressState -> Either GStateUpdateError AddressState
modifier :: AddressState -> Either GStateUpdateError AddressState
modifier (ASSimple Mutez
_) = GStateUpdateError -> Either GStateUpdateError AddressState
forall a b. a -> Either a b
Left (Address -> GStateUpdateError
GStateNotContract Address
addr)
modifier (ASContract 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 (SingI st, SingI st, TestEquality Sing) => Maybe (st :~: st)
forall k (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @st @st' of
Just st :~: st
Refl -> AddressState -> Either GStateUpdateError AddressState
forall a b. b -> Either a b
Right (AddressState -> Either GStateUpdateError AddressState)
-> AddressState -> Either GStateUpdateError AddressState
forall a b. (a -> b) -> a -> b
$ ContractState -> AddressState
ASContract (ContractState -> AddressState) -> ContractState -> AddressState
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 AddressState
forall a b. a -> Either a b
Left (GStateUpdateError -> Either GStateUpdateError AddressState)
-> GStateUpdateError -> Either GStateUpdateError AddressState
forall a b. (a -> b) -> a -> b
$ Address -> GStateUpdateError
GStateStorageNotMatch Address
addr
setBalance :: Address -> Mutez -> GState -> Either GStateUpdateError GState
setBalance :: Address -> Mutez -> GState -> Either GStateUpdateError GState
setBalance Address
addr Mutez
newBalance = Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState Address
addr ((AddressState -> Either GStateUpdateError AddressState)
-> GState -> Either GStateUpdateError GState)
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
forall a b. (a -> b) -> a -> b
$ AddressState -> Either GStateUpdateError AddressState
forall a b. b -> Either a b
Right (AddressState -> Either GStateUpdateError AddressState)
-> (AddressState -> AddressState)
-> AddressState
-> Either GStateUpdateError AddressState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
ASSimple Mutez
_ -> Mutez -> AddressState
ASSimple Mutez
newBalance
ASContract ContractState
cs -> ContractState -> AddressState
ASContract (ContractState
cs {csBalance :: Mutez
csBalance = Mutez
newBalance})
setDelegate :: Address -> Maybe KeyHash -> GState -> Either GStateUpdateError GState
setDelegate :: Address
-> Maybe KeyHash -> GState -> Either GStateUpdateError GState
setDelegate Address
addr Maybe KeyHash
key = Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState Address
addr \case
ASSimple Mutez
_ -> GStateUpdateError -> Either GStateUpdateError AddressState
forall a b. a -> Either a b
Left (GStateUpdateError -> Either GStateUpdateError AddressState)
-> GStateUpdateError -> Either GStateUpdateError AddressState
forall a b. (a -> b) -> a -> b
$ Address -> GStateUpdateError
GStateNotContract Address
addr
ASContract ContractState
cs -> AddressState -> Either GStateUpdateError AddressState
forall a b. b -> Either a b
Right (AddressState -> Either GStateUpdateError AddressState)
-> AddressState -> Either GStateUpdateError AddressState
forall a b. (a -> b) -> a -> b
$ ContractState -> AddressState
ASContract ContractState
cs{csDelegate :: Maybe KeyHash
csDelegate = Maybe KeyHash
key}
updateAddressState ::
Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState :: Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState Address
addr AddressState -> Either GStateUpdateError AddressState
f GState
gs =
case Map Address AddressState
addresses Map Address AddressState
-> Getting
(Maybe AddressState)
(Map Address AddressState)
(Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
(Map Address AddressState)
(Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr of
Maybe AddressState
Nothing -> GStateUpdateError -> Either GStateUpdateError GState
forall a b. a -> Either a b
Left (Address -> GStateUpdateError
GStateUnknownAddress Address
addr)
Just AddressState
as -> do
AddressState
newState <- AddressState -> Either GStateUpdateError AddressState
f AddressState
as
return $ GState
gs { gsAddresses :: Map Address AddressState
gsAddresses = Map Address AddressState
addresses Map Address AddressState
-> (Map Address AddressState -> Map Address AddressState)
-> Map Address AddressState
forall a b. a -> (a -> b) -> b
& Index (Map Address AddressState)
-> Lens'
(Map Address AddressState)
(Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr ((Maybe AddressState -> Identity (Maybe AddressState))
-> Map Address AddressState -> Identity (Map Address AddressState))
-> Maybe AddressState
-> Map Address AddressState
-> Map Address AddressState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AddressState -> Maybe AddressState
forall a. a -> Maybe a
Just AddressState
newState }
where
addresses :: Map Address AddressState
addresses = GState -> Map Address AddressState
gsAddresses GState
gs
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
. ((Address, AddressState) -> Maybe (ContractHash, SomeParamType))
-> [(Address, AddressState)] -> [(ContractHash, SomeParamType)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Address, AddressState) -> Maybe (ContractHash, SomeParamType)
extractContract ([(Address, AddressState)] -> [(ContractHash, SomeParamType)])
-> (GState -> [(Address, AddressState)])
-> GState
-> [(ContractHash, SomeParamType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Address AddressState -> [(Address, AddressState)]
forall t. ToPairs t => t -> [(Key t, Val t)]
toPairs (Map Address AddressState -> [(Address, AddressState)])
-> (GState -> Map Address AddressState)
-> GState
-> [(Address, AddressState)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GState -> Map Address AddressState
gsAddresses
where
extractContract
:: (Address, AddressState) -> Maybe (ContractHash, SomeParamType)
extractContract :: (Address, AddressState) -> Maybe (ContractHash, SomeParamType)
extractContract =
\case (KeyAddress KeyHash
_, ASSimple {}) -> Maybe (ContractHash, SomeParamType)
forall a. Maybe a
Nothing
(KeyAddress KeyHash
_, AddressState
_) -> Text -> Maybe (ContractHash, SomeParamType)
forall a. HasCallStack => Text -> a
error Text
"broken GState"
(ContractAddress ContractHash
ca, ASContract (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)
(ContractAddress ContractHash
_, AddressState
_) -> Text -> Maybe (ContractHash, SomeParamType)
forall a. HasCallStack => Text -> a
error Text
"broken GState"