module Michelson.Runtime.GState
(
ContractState (..)
, getTypedContract
, getTypedStorage
, SomeContractAndStorage (..)
, getTypedContractAndStorage
, AddressState (..)
, asBalance
, GState (..)
, gsChainIdL
, gsAddressesL
, genesisAddresses
, genesisKeyHashes
, genesisAddress
, genesisAddress1
, genesisAddress2
, genesisAddress3
, genesisAddress4
, genesisAddress5
, genesisAddress6
, genesisKeyHash
, initGState
, readGState
, writeGState
, GStateUpdate (..)
, GStateUpdateError (..)
, applyUpdate
, applyUpdates
, extractAllContracts
) where
import Control.Lens (at)
import Data.Aeson (FromJSON(..), ToJSON(..), object, withObject, (.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encode.Pretty as Aeson
import Data.Aeson.TH (deriveJSON)
import qualified Data.ByteString.Lazy as LBS
import Data.List.NonEmpty ((!!))
import qualified Data.Map.Strict as Map
import Data.Typeable ((:~:)(..), eqT)
import Fmt ((+|), (|+), (||+))
import Formatting.Buildable (Buildable(build))
import System.IO.Error (IOError, isDoesNotExistError)
import Michelson.TypeCheck
(SomeContract(..), TCError, TcOriginatedContracts, typeCheckContract, typeCheckTopLevelType)
import Michelson.Typed (SomeValue, SomeValue'(..))
import qualified Michelson.Typed as T
import Michelson.Typed.Scope
import Michelson.Untyped (Contract, ParameterType, Value, contractParameter, contractStorage)
import Tezos.Address (Address(..), ContractHash)
import Tezos.Core (ChainId, Mutez, divModMutezInt, dummyChainId)
import Tezos.Crypto
import Util.Aeson
import Util.Lens
data ContractState = ContractState
{ ContractState -> Mutez
csBalance :: Mutez
, ContractState -> Value
csStorage :: Value
, ContractState -> Contract
csContract :: Contract
, ContractState -> Maybe SomeContract
csTypedContract :: (Maybe SomeContract)
, ContractState -> Maybe SomeValue
csTypedStorage :: (Maybe SomeValue)
}
deriving stock instance Show ContractState
instance ToJSON ContractState where
toJSON :: ContractState -> Value
toJSON ContractState{..} = [Pair] -> Value
object
[ "balance" Text -> Mutez -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Mutez
csBalance
, "storage" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
csStorage
, "contract" Text -> Contract -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Contract
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 "contractstate" ((Object -> Parser ContractState) -> Value -> Parser ContractState)
-> (Object -> Parser ContractState)
-> Value
-> Parser ContractState
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Mutez
csBalance <- Object
o Object -> Text -> Parser Mutez
forall a. FromJSON a => Object -> Text -> Parser a
.: "balance"
Value
csStorage <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "storage"
Contract
csContract <- Object
o Object -> Text -> Parser Contract
forall a. FromJSON a => Object -> Text -> Parser a
.: "contract"
let csTypedContract :: Maybe a
csTypedContract = Maybe a
forall a. Maybe a
Nothing
let csTypedStorage :: Maybe a
csTypedStorage = Maybe a
forall a. Maybe a
Nothing
return $WContractState :: Mutez
-> Value
-> Contract
-> Maybe SomeContract
-> Maybe SomeValue
-> ContractState
ContractState {..}
instance Buildable ContractState where
build :: ContractState -> Builder
build ContractState{..} =
"Contractstate:\n csBalance: " 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
|+
"\n csStorage: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value
csStorage Value -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
"\n csContract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Contract
csContract Contract -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
"\n csTypedContract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Maybe SomeContract
csTypedContract Maybe SomeContract -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+
"\n csTypedStorage: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Maybe SomeValue
csTypedStorage Maybe SomeValue -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+ ""
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, (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 balance :: Mutez
balance -> "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
|+ ""
ASContract cs :: 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 b :: Mutez
b -> Mutez
b
ASContract cs :: ContractState
cs -> ContractState -> Mutez
csBalance ContractState
cs
data GState = GState
{ GState -> ChainId
gsChainId :: ChainId
, GState -> Map Address AddressState
gsAddresses :: Map Address AddressState
} 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)
makeLensesWith postfixLFields ''GState
deriveJSON morleyAesonOptions ''GState
getTypedContract :: GState -> ContractState -> Either TCError SomeContract
getTypedContract :: GState -> ContractState -> Either TCError SomeContract
getTypedContract gs :: GState
gs ContractState{..} =
TcOriginatedContracts -> Contract -> Either TCError SomeContract
typeCheckContract (GState -> TcOriginatedContracts
extractAllContracts GState
gs) Contract
csContract
getTypedStorage :: GState -> ContractState -> Either TCError SomeValue
getTypedStorage :: GState -> ContractState -> Either TCError SomeValue
getTypedStorage gs :: GState
gs ContractState{..} =
HasCallStack =>
TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue
TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue
typeCheckTopLevelType (GState -> TcOriginatedContracts
extractAllContracts GState
gs) (Contract -> Type
forall op. Contract' op -> Type
contractStorage Contract
csContract) Value
csStorage
data SomeContractAndStorage =
forall cp st. (ParameterScope cp, StorageScope st) => SomeContractAndStorage
{ ()
scsContract :: T.FullContract cp st
, ()
scsStorage :: T.Value st
}
getTypedContractAndStorage
:: (TCError -> err)
-> (TCError -> err)
-> GState
-> ContractState
-> Either err SomeContractAndStorage
getTypedContractAndStorage :: (TCError -> err)
-> (TCError -> err)
-> GState
-> ContractState
-> Either err SomeContractAndStorage
getTypedContractAndStorage liftContractErr :: TCError -> err
liftContractErr liftStorageErr :: TCError -> err
liftStorageErr gs :: GState
gs cs :: ContractState
cs = do
SomeContract (contract :: FullContract cp st
contract@T.FullContract{} :: T.FullContract cp st) <-
(TCError -> err)
-> Either TCError SomeContract -> Either err SomeContract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TCError -> err
liftContractErr (Either TCError SomeContract -> Either err SomeContract)
-> Either TCError SomeContract -> Either err SomeContract
forall a b. (a -> b) -> a -> b
$ GState -> ContractState -> Either TCError SomeContract
getTypedContract GState
gs ContractState
cs
SomeValue (Value t
storage :: T.Value st') <-
(TCError -> err)
-> Either TCError SomeValue -> Either err SomeValue
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TCError -> err
liftStorageErr (Either TCError SomeValue -> Either err SomeValue)
-> Either TCError SomeValue -> Either err SomeValue
forall a b. (a -> b) -> a -> b
$ GState -> ContractState -> Either TCError SomeValue
getTypedStorage GState
gs ContractState
cs
st :~: t
Refl <- (st :~: t) -> Either err (st :~: t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((st :~: t) -> Either err (st :~: t))
-> (st :~: t) -> Either err (st :~: t)
forall a b. (a -> b) -> a -> b
$ (Typeable st, Typeable t) => Maybe (st :~: t)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @st @st'
Maybe (st :~: t) -> (st :~: t) -> st :~: t
forall a. Maybe a -> a -> a
?: Text -> st :~: t
forall a. HasCallStack => Text -> a
error "Storage type does not match the contract in runtime state"
SomeContractAndStorage -> Either err SomeContractAndStorage
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeContractAndStorage -> Either err SomeContractAndStorage)
-> SomeContractAndStorage -> Either err SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ FullContract cp st -> Value st -> SomeContractAndStorage
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
FullContract cp st -> Value st -> SomeContractAndStorage
SomeContractAndStorage FullContract cp st
contract Value st
Value t
storage
genesisAddressesNum :: Word
genesisAddressesNum :: Word
genesisAddressesNum = 10
genesisSecrets :: NonEmpty SecretKey
genesisSecrets :: NonEmpty SecretKey
genesisSecrets = do
Word
i <- 1 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [2 .. Word
genesisAddressesNum]
let seed :: ByteString
seed = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Word -> Text
forall b a. (Show a, IsString b) => a -> b
show Word
i :: Text)
SecretKey -> NonEmpty SecretKey
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretKey -> NonEmpty SecretKey)
-> SecretKey -> NonEmpty SecretKey
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> SecretKey
ByteString -> SecretKey
detSecretKey ByteString
seed
genesisKeyHashes :: NonEmpty KeyHash
genesisKeyHashes :: NonEmpty 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) -> NonEmpty SecretKey -> NonEmpty KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty SecretKey
genesisSecrets
genesisAddresses :: NonEmpty Address
genesisAddresses :: NonEmpty Address
genesisAddresses = KeyHash -> Address
KeyAddress (KeyHash -> Address) -> NonEmpty KeyHash -> NonEmpty Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty KeyHash
genesisKeyHashes
genesisKeyHash :: KeyHash
genesisKeyHash :: KeyHash
genesisKeyHash = NonEmpty KeyHash -> KeyHash
forall a. NonEmpty a -> a
head NonEmpty KeyHash
genesisKeyHashes
genesisAddress :: Address
genesisAddress :: Address
genesisAddress = NonEmpty Address -> Address
forall a. NonEmpty a -> a
head NonEmpty Address
genesisAddresses
genesisAddress1, genesisAddress2, genesisAddress3 :: Address
genesisAddress4, genesisAddress5, genesisAddress6 :: Address
genesisAddress1 :: Address
genesisAddress1 = NonEmpty Address
genesisAddresses NonEmpty Address -> Int -> Address
forall a. NonEmpty a -> Int -> a
!! 1
genesisAddress2 :: Address
genesisAddress2 = NonEmpty Address
genesisAddresses NonEmpty Address -> Int -> Address
forall a. NonEmpty a -> Int -> a
!! 2
genesisAddress3 :: Address
genesisAddress3 = NonEmpty Address
genesisAddresses NonEmpty Address -> Int -> Address
forall a. NonEmpty a -> Int -> a
!! 3
genesisAddress4 :: Address
genesisAddress4 = NonEmpty Address
genesisAddresses NonEmpty Address -> Int -> Address
forall a. NonEmpty a -> Int -> a
!! 4
genesisAddress5 :: Address
genesisAddress5 = NonEmpty Address
genesisAddresses NonEmpty Address -> Int -> Address
forall a. NonEmpty a -> Int -> a
!! 5
genesisAddress6 :: Address
genesisAddress6 = NonEmpty Address
genesisAddresses NonEmpty Address -> Int -> Address
forall a. NonEmpty a -> Int -> a
!! 6
initGState :: GState
initGState :: GState
initGState =
$WGState :: ChainId -> Map Address AddressState -> 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 (money :: Mutez
money, _) = Bounded Mutez => Mutez
forall a. Bounded a => a
maxBound @Mutez Mutez -> Word -> Maybe (Mutez, Mutez)
forall a. Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
`divModMutezInt` Word
genesisAddressesNum
Maybe (Mutez, Mutez) -> (Mutez, Mutez) -> (Mutez, Mutez)
forall a. Maybe a -> a -> a
?: Text -> (Mutez, Mutez)
forall a. HasCallStack => Text -> a
error "Number of genesis addresses is 0"
, Address
genesis <- NonEmpty Address -> [Element (NonEmpty Address)]
forall t. Container t => t -> [Element t]
toList NonEmpty Address
genesisAddresses
]
}
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 str :: String
str) = "Failed to parse GState: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str
readGState :: FilePath -> IO GState
readGState :: String -> IO GState
readGState fp :: 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 lByteString :: 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 exc :: 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 fp :: String
fp gs :: 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
= GSAddAddress Address AddressState
| GSSetStorageValue Address Value SomeValue
| GSSetBalance Address Mutez
deriving stock (Int -> GStateUpdate -> ShowS
[GStateUpdate] -> ShowS
GStateUpdate -> String
(Int -> GStateUpdate -> ShowS)
-> (GStateUpdate -> String)
-> ([GStateUpdate] -> ShowS)
-> Show GStateUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GStateUpdate] -> ShowS
$cshowList :: [GStateUpdate] -> ShowS
show :: GStateUpdate -> String
$cshow :: GStateUpdate -> String
showsPrec :: Int -> GStateUpdate -> ShowS
$cshowsPrec :: Int -> GStateUpdate -> ShowS
Show)
instance Buildable GStateUpdate where
build :: GStateUpdate -> Builder
build =
\case
GSAddAddress addr :: Address
addr st :: AddressState
st ->
"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
|+ " 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
|+ ""
GSSetStorageValue addr :: Address
addr val :: Value
val _ ->
"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
|+ " to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value
val Value -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
GSSetBalance addr :: Address
addr balance :: Mutez
balance ->
"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
|+ " 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
|+ ""
data GStateUpdateError
= GStateAddressExists Address
| GStateUnknownAddress Address
| GStateNotContract 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 addr :: Address
addr -> "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 addr :: Address
addr -> "Unknown address: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr
GStateNotContract addr :: Address
addr -> "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
applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState
applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState
applyUpdate =
\case
GSAddAddress addr :: Address
addr st :: 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 addr :: Address
addr newValue :: Value
newValue newTypedValue :: SomeValue
newTypedValue ->
Address
-> Value -> SomeValue -> GState -> Either GStateUpdateError GState
setStorageValue Address
addr Value
newValue SomeValue
newTypedValue
GSSetBalance addr :: Address
addr newBalance :: Mutez
newBalance -> Address -> Mutez -> GState -> Either GStateUpdateError GState
setBalance Address
addr Mutez
newBalance
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 addr :: Address
addr st :: AddressState
st gs :: 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 ::
Address -> Value -> SomeValue -> GState -> Either GStateUpdateError GState
setStorageValue :: Address
-> Value -> SomeValue -> GState -> Either GStateUpdateError GState
setStorageValue addr :: Address
addr newValue :: Value
newValue newTypedValue :: SomeValue
newTypedValue = Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState Address
addr AddressState -> Either GStateUpdateError AddressState
modifier
where
modifier :: AddressState -> Either GStateUpdateError AddressState
modifier (ASSimple _) = GStateUpdateError -> Either GStateUpdateError AddressState
forall a b. a -> Either a b
Left (Address -> GStateUpdateError
GStateNotContract Address
addr)
modifier (ASContract cs :: 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 -> AddressState) -> ContractState -> AddressState
forall a b. (a -> b) -> a -> b
$
ContractState
cs { csStorage :: Value
csStorage = Value
newValue
, csTypedStorage :: Maybe SomeValue
csTypedStorage = SomeValue -> Maybe SomeValue
forall a. a -> Maybe a
Just SomeValue
newTypedValue
}
setBalance :: Address -> Mutez -> GState -> Either GStateUpdateError GState
setBalance :: Address -> Mutez -> GState -> Either GStateUpdateError GState
setBalance addr :: Address
addr newBalance :: Mutez
newBalance = Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState Address
addr (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
. AddressState -> AddressState
modifier)
where
modifier :: AddressState -> AddressState
modifier (ASSimple _) = Mutez -> AddressState
ASSimple Mutez
newBalance
modifier (ASContract cs :: ContractState
cs) = ContractState -> AddressState
ASContract (ContractState
cs {csBalance :: Mutez
csBalance = Mutez
newBalance})
updateAddressState ::
Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState :: Address
-> (AddressState -> Either GStateUpdateError AddressState)
-> GState
-> Either GStateUpdateError GState
updateAddressState addr :: Address
addr f :: AddressState -> Either GStateUpdateError AddressState
f gs :: 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
Nothing -> GStateUpdateError -> Either GStateUpdateError GState
forall a b. a -> Either a b
Left (Address -> GStateUpdateError
GStateUnknownAddress Address
addr)
Just as :: 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, ParameterType)] -> TcOriginatedContracts
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ContractHash, ParameterType)] -> TcOriginatedContracts)
-> (GState -> [(ContractHash, ParameterType)])
-> GState
-> TcOriginatedContracts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, AddressState) -> Maybe (ContractHash, ParameterType))
-> [(Address, AddressState)] -> [(ContractHash, ParameterType)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Address, AddressState) -> Maybe (ContractHash, ParameterType)
extractContract ([(Address, AddressState)] -> [(ContractHash, ParameterType)])
-> (GState -> [(Address, AddressState)])
-> GState
-> [(ContractHash, ParameterType)]
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, ParameterType)
extractContract :: (Address, AddressState) -> Maybe (ContractHash, ParameterType)
extractContract =
\case (KeyAddress _, ASSimple {}) -> Maybe (ContractHash, ParameterType)
forall a. Maybe a
Nothing
(KeyAddress _, _) -> Text -> Maybe (ContractHash, ParameterType)
forall a. HasCallStack => Text -> a
error "broken GState"
(ContractAddress ca :: ContractHash
ca, ASContract cs :: ContractState
cs) ->
(ContractHash, ParameterType)
-> Maybe (ContractHash, ParameterType)
forall a. a -> Maybe a
Just (ContractHash
ca, Contract -> ParameterType
forall op. Contract' op -> ParameterType
contractParameter (Contract -> ParameterType) -> Contract -> ParameterType
forall a b. (a -> b) -> a -> b
$ ContractState -> Contract
csContract ContractState
cs)
(ContractAddress _, _) -> Text -> Maybe (ContractHash, ParameterType)
forall a. HasCallStack => Text -> a
error "broken GState"