Skip to content

Commit 3d8ea62

Browse files
committed
WIP gasM
1 parent 2d05576 commit 3d8ea62

File tree

12 files changed

+454
-350
lines changed

12 files changed

+454
-350
lines changed

pact-tng.cabal

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -97,6 +97,7 @@ common pact-common
9797
FlexibleInstances
9898
NumericUnderscores
9999
TypeOperators
100+
PartialTypeSignatures
100101

101102
-- internal crypto lirbary
102103
library pact-crypto
@@ -156,6 +157,8 @@ library
156157
Pact.Core.Info
157158
Pact.Core.Errors
158159
Pact.Core.Persistence
160+
Pact.Core.Persistence.Types
161+
Pact.Core.Persistence.Utils
159162
Pact.Core.Persistence.SQLite
160163
Pact.Core.Persistence.MockPersistence
161164
Pact.Core.PactValue
@@ -278,7 +281,7 @@ benchmark bench
278281
, mtl
279282
, pact-tng
280283
, text
281-
ghc-options: -WAll -threaded -rtsopts "-with-rtsopts=-N"
284+
ghc-options: -WAll -threaded -rtsopts "-with-rtsopts=-N"
282285
hs-source-dirs: bench
283286
default-language: Haskell2010
284287

pact/Pact/Core/Environment/Types.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ import Control.Monad.Catch as Exceptions
6969
import qualified Data.Text as T
7070
import qualified Data.Map.Strict as M
7171

72-
import Pact.Core.Persistence
72+
import Pact.Core.Persistence.Types
7373
import Pact.Core.Pretty
7474
import Pact.Core.Capabilities
7575
import Pact.Core.Guards
@@ -241,9 +241,9 @@ defaultEvalEnv pdb m = do
241241

242242
type Bytes = Word64
243243

244-
newtype SizeOfByteLimit
244+
newtype SizeOfByteLimit
245245
= SizeOfByteLimit Bytes
246246
deriving Show
247247

248248
instance Pretty SizeOfByteLimit where
249-
pretty = pretty . show
249+
pretty = pretty . show

pact/Pact/Core/Environment/Utils.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ import qualified Data.Map.Strict as M
3636
import qualified Data.Set as S
3737

3838
import Pact.Core.Names
39-
import Pact.Core.Persistence
39+
import Pact.Core.Persistence.Types
4040
import Pact.Core.IR.Term
4141
import Pact.Core.Errors
4242
import Pact.Core.Environment.Types

pact/Pact/Core/Gas.hs

Lines changed: 33 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
{-# LANGUAGE TemplateHaskell #-}
66
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
77
{-# LANGUAGE DeriveAnyClass #-}
8+
{-# LANGUAGE DerivingVia #-}
89

910
module Pact.Core.Gas
1011
( MilliGas(..)
@@ -35,10 +36,16 @@ module Pact.Core.Gas
3536
, GasObjectSize(..)
3637
, ComparisonType(..)
3738
, SearchType(..)
39+
, GasMEnv(..)
40+
, GasM(..)
41+
, runGasM
3842
) where
3943

4044
import Control.Lens
4145
import Control.DeepSeq
46+
import Control.Monad.Reader
47+
import Control.Monad.Except
48+
import Data.IORef
4249
import Data.Decimal(Decimal)
4350
import Data.Word(Word64)
4451
import Data.Monoid(Sum(..))
@@ -121,7 +128,9 @@ data ZKGroup
121128
-- ^ Group one, that is Fq in Pairing
122129
| ZKG2
123130
-- ^ Group two, that is, Fq2 Pairing
124-
deriving (Show, Generic, NFData)
131+
deriving (Show, Generic)
132+
133+
instance NFData ZKGroup
125134

126135
data ZKArg
127136
= PointAdd !ZKGroup
@@ -262,3 +271,26 @@ gasToMilliGas (Gas n) = MilliGas (n * millisPerGas)
262271
milliGasToGas :: MilliGas -> Gas
263272
milliGasToGas (MilliGas n) = Gas (n `quot` millisPerGas)
264273
{-# INLINE milliGasToGas #-}
274+
275+
data GasMEnv
276+
= GasMEnv
277+
{ _gasMRef :: IORef MilliGas
278+
, _gasMLimit :: MilliGasLimit
279+
}
280+
281+
newtype GasM e a
282+
= GasM (ReaderT GasMEnv (ExceptT e IO) a)
283+
deriving
284+
( Functor
285+
, Applicative
286+
, Monad
287+
, MonadReader GasMEnv
288+
, MonadError e
289+
, MonadIO) via (ReaderT GasMEnv (ExceptT e IO))
290+
291+
runGasM
292+
:: GasMEnv
293+
-> GasM e a
294+
-> IO (Either e a)
295+
runGasM env (GasM m) =
296+
runExceptT $ runReaderT m env

pact/Pact/Core/IR/Eval/Runtime/Utils.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -247,7 +247,8 @@ readOnlyEnv e
247247
PactDb
248248
{ _pdbPurity = PReadOnly
249249
, _pdbRead = _pdbRead pdb
250-
, _pdbWrite = \_ _ _ _ _ -> dbOpDisallowed2
250+
, _pdbWrite = \info _wt _d _k _v ->
251+
throwError (PEExecutionError (DbOpFailure OpDisallowed) info)
251252
, _pdbKeys = \_ -> dbOpDisallowed
252253
, _pdbCreateUserTable = \_ -> dbOpDisallowed
253254
, _pdbBeginTx = \_ -> dbOpDisallowed

0 commit comments

Comments
 (0)