module Lorentz.Run
( Contract(..)
, toMichelsonContract
, defaultContract
, CompilationOptions(..)
, defaultCompilationOptions
, intactCompilationOptions
, coBytesTransformerL
, coOptimizerConfL
, coStringTransformerL
, compileLorentz
, compileLorentzWithOptions
, mkContract
, mkContractWith
, ContractData(..)
, defaultContractData
, compileLorentzContract
, cdCodeL
, coDisableInitialCastL
, cdCompilationOptionsL
, interpretLorentzInstr
, interpretLorentzLambda
, analyzeLorentz
) where
import Control.Lens.Type as Lens (Lens, Lens')
import Data.Constraint ((\\))
import Data.Default (def)
import Data.Vinyl.Core (Rec(..))
import Lorentz.Annotation
import Lorentz.Base
import Lorentz.Constraints
import Lorentz.Doc
import Lorentz.Entrypoints
import Lorentz.Entrypoints.Doc
import Michelson.Analyzer (AnalyzerRes, analyze)
import Michelson.Interpret
import Michelson.Optimizer (OptimizerConf, optimizeWithConf)
import Michelson.Text (MText)
import Michelson.Typed (Instr(..), IsoValue, IsoValuesStack(..), ToTs, starParamNotes)
import qualified Michelson.Typed as M (Contract(..))
import qualified Michelson.Untyped as U (canonicalEntriesOrder)
import Util.Lens
data CompilationOptions = CompilationOptions
{ CompilationOptions -> Maybe OptimizerConf
coOptimizerConf :: Maybe OptimizerConf
, CompilationOptions -> (Bool, MText -> MText)
coStringTransformer :: (Bool, MText -> MText)
, CompilationOptions -> (Bool, ByteString -> ByteString)
coBytesTransformer :: (Bool, ByteString -> ByteString)
, CompilationOptions -> Bool
coDisableInitialCast :: Bool
}
defaultCompilationOptions :: CompilationOptions
defaultCompilationOptions :: CompilationOptions
defaultCompilationOptions = CompilationOptions :: Maybe OptimizerConf
-> (Bool, MText -> MText)
-> (Bool, ByteString -> ByteString)
-> Bool
-> CompilationOptions
CompilationOptions
{ coOptimizerConf :: Maybe OptimizerConf
coOptimizerConf = OptimizerConf -> Maybe OptimizerConf
forall a. a -> Maybe a
Just OptimizerConf
forall a. Default a => a
def
, coStringTransformer :: (Bool, MText -> MText)
coStringTransformer = (Bool
False, MText -> MText
forall a. a -> a
id)
, coBytesTransformer :: (Bool, ByteString -> ByteString)
coBytesTransformer = (Bool
False, ByteString -> ByteString
forall a. a -> a
id)
, coDisableInitialCast :: Bool
coDisableInitialCast = Bool
False
}
intactCompilationOptions :: CompilationOptions
intactCompilationOptions :: CompilationOptions
intactCompilationOptions = CompilationOptions :: Maybe OptimizerConf
-> (Bool, MText -> MText)
-> (Bool, ByteString -> ByteString)
-> Bool
-> CompilationOptions
CompilationOptions
{ coOptimizerConf :: Maybe OptimizerConf
coOptimizerConf = Maybe OptimizerConf
forall a. Maybe a
Nothing
, coStringTransformer :: (Bool, MText -> MText)
coStringTransformer = (Bool
False, MText -> MText
forall a. a -> a
id)
, coBytesTransformer :: (Bool, ByteString -> ByteString)
coBytesTransformer = (Bool
False, ByteString -> ByteString
forall a. a -> a
id)
, coDisableInitialCast :: Bool
coDisableInitialCast = Bool
False
}
compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz = CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentzWithOptions CompilationOptions
defaultCompilationOptions
compileLorentzWithOptions :: CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentzWithOptions :: CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentzWithOptions CompilationOptions{Bool
Maybe OptimizerConf
(Bool, ByteString -> ByteString)
(Bool, MText -> MText)
coDisableInitialCast :: Bool
coBytesTransformer :: (Bool, ByteString -> ByteString)
coStringTransformer :: (Bool, MText -> MText)
coOptimizerConf :: Maybe OptimizerConf
coDisableInitialCast :: CompilationOptions -> Bool
coBytesTransformer :: CompilationOptions -> (Bool, ByteString -> ByteString)
coStringTransformer :: CompilationOptions -> (Bool, MText -> MText)
coOptimizerConf :: CompilationOptions -> Maybe OptimizerConf
..} =
(Instr (ToTs inp) (ToTs out) -> Instr (ToTs inp) (ToTs out))
-> (OptimizerConf
-> Instr (ToTs inp) (ToTs out) -> Instr (ToTs inp) (ToTs out))
-> Maybe OptimizerConf
-> Instr (ToTs inp) (ToTs out)
-> Instr (ToTs inp) (ToTs out)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Instr (ToTs inp) (ToTs out) -> Instr (ToTs inp) (ToTs out)
forall a. a -> a
id OptimizerConf
-> Instr (ToTs inp) (ToTs out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [T]) (out :: [T]).
OptimizerConf -> Instr inp out -> Instr inp out
optimizeWithConf Maybe OptimizerConf
coOptimizerConf
(Instr (ToTs inp) (ToTs out) -> Instr (ToTs inp) (ToTs out))
-> ((inp :-> out) -> Instr (ToTs inp) (ToTs out))
-> (inp :-> out)
-> Instr (ToTs inp) (ToTs out)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iAnyCode
((inp :-> out) -> Instr (ToTs inp) (ToTs out))
-> ((inp :-> out) -> inp :-> out)
-> (inp :-> out)
-> Instr (ToTs inp) (ToTs out)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> (MText -> MText) -> (inp :-> out) -> inp :-> out)
-> (Bool, MText -> MText) -> (inp :-> out) -> inp :-> out
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> (MText -> MText) -> (inp :-> out) -> inp :-> out
forall (inp :: [*]) (out :: [*]).
Bool -> (MText -> MText) -> (inp :-> out) -> inp :-> out
transformStringsLorentz (Bool, MText -> MText)
coStringTransformer
((inp :-> out) -> inp :-> out)
-> ((inp :-> out) -> inp :-> out) -> (inp :-> out) -> inp :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
-> (ByteString -> ByteString) -> (inp :-> out) -> inp :-> out)
-> (Bool, ByteString -> ByteString) -> (inp :-> out) -> inp :-> out
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> (ByteString -> ByteString) -> (inp :-> out) -> inp :-> out
forall (inp :: [*]) (out :: [*]).
Bool -> (ByteString -> ByteString) -> (inp :-> out) -> inp :-> out
transformBytesLorentz (Bool, ByteString -> ByteString)
coBytesTransformer
defaultContract
:: (NiceParameterFull cp, NiceStorage st)
=> ContractCode cp st -> Contract cp st
defaultContract :: ContractCode cp st -> Contract cp st
defaultContract ContractCode cp st
code =
ContractData cp st -> Contract cp st
forall cp st. ContractData cp st -> Contract cp st
compileLorentzContract (ContractData cp st -> Contract cp st)
-> ContractData cp st -> Contract cp st
forall a b. (a -> b) -> a -> b
$ ContractCode cp st -> CompilationOptions -> ContractData cp st
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
ContractCode cp st -> CompilationOptions -> ContractData cp st
ContractData ContractCode cp st
code CompilationOptions
defaultCompilationOptions
mkContract
:: (NiceParameterFull cp, NiceStorage st)
=> ContractCode cp st -> Contract cp st
mkContract :: ContractCode cp st -> Contract cp st
mkContract = CompilationOptions -> ContractCode cp st -> Contract cp st
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
CompilationOptions -> ContractCode cp st -> Contract cp st
mkContractWith CompilationOptions
defaultCompilationOptions
mkContractWith
:: (NiceParameterFull cp, NiceStorage st)
=> CompilationOptions -> ContractCode cp st -> Contract cp st
mkContractWith :: CompilationOptions -> ContractCode cp st -> Contract cp st
mkContractWith CompilationOptions
opts ContractCode cp st
code =
ContractData cp st -> Contract cp st
forall cp st. ContractData cp st -> Contract cp st
compileLorentzContract (ContractData cp st -> Contract cp st)
-> ContractData cp st -> Contract cp st
forall a b. (a -> b) -> a -> b
$ ContractCode cp st -> CompilationOptions -> ContractData cp st
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
ContractCode cp st -> CompilationOptions -> ContractData cp st
ContractData ContractCode cp st
code CompilationOptions
opts
data ContractData cp st = (NiceParameterFull cp, NiceStorage st) => ContractData
{ ContractData cp st -> ContractCode cp st
cdCode :: ContractCode cp st
, ContractData cp st -> CompilationOptions
cdCompilationOptions :: CompilationOptions
}
defaultContractData
:: forall cp st. (NiceParameterFull cp, NiceStorage st)
=> ContractCode cp st -> ContractData cp st
defaultContractData :: ContractCode cp st -> ContractData cp st
defaultContractData ContractCode cp st
code = ContractData :: forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
ContractCode cp st -> CompilationOptions -> ContractData cp st
ContractData
{ cdCode :: ContractCode cp st
cdCode = ContractCode cp st
code
, cdCompilationOptions :: CompilationOptions
cdCompilationOptions = CompilationOptions
defaultCompilationOptions
}
compileLorentzContract
:: forall cp st. ContractData cp st -> Contract cp st
compileLorentzContract :: ContractData cp st -> Contract cp st
compileLorentzContract ContractData{ContractCode cp st
CompilationOptions
cdCompilationOptions :: CompilationOptions
cdCode :: ContractCode cp st
cdCompilationOptions :: forall cp st. ContractData cp st -> CompilationOptions
cdCode :: forall cp st. ContractData cp st -> ContractCode cp st
..} = Contract :: forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Contract (ToT cp) (ToT st) -> ContractCode cp st -> Contract cp st
Contract{Contract (ToT cp) (ToT st)
ContractCode cp st
cDocumentedCode :: ContractCode cp st
cMichelsonContract :: Contract (ToT cp) (ToT st)
cDocumentedCode :: ContractCode cp st
cMichelsonContract :: Contract (ToT cp) (ToT st)
..}
where
cMichelsonContract :: Contract (ToT cp) (ToT st)
cMichelsonContract = Contract :: forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
ContractCode cp st
-> ParamNotes cp -> Notes st -> EntriesOrder -> Contract cp st
M.Contract
{ cCode :: ContractCode (ToT cp) (ToT st)
cCode = if (ParamNotes (ToT cp)
cpNotes ParamNotes (ToT cp) -> ParamNotes (ToT cp) -> Bool
forall a. Eq a => a -> a -> Bool
== ParamNotes (ToT cp)
forall (t :: T). SingI t => ParamNotes t
starParamNotes Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| CompilationOptions -> Bool
coDisableInitialCast CompilationOptions
cdCompilationOptions)
then
CompilationOptions
-> ContractCode cp st
-> Instr (ToTs '[(cp, st)]) (ToTs (ContractOut st))
forall (inp :: [*]) (out :: [*]).
CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentzWithOptions CompilationOptions
cdCompilationOptions ContractCode cp st
cdCode
else
CompilationOptions
-> ContractCode cp st
-> Instr (ToTs '[(cp, st)]) (ToTs (ContractOut st))
forall (inp :: [*]) (out :: [*]).
CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentzWithOptions CompilationOptions
cdCompilationOptions (Instr (ToTs '[(cp, st)]) (ToTs '[(cp, st)])
-> '[(cp, st)] :-> '[(cp, st)]
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr (ToTs '[(cp, st)]) (ToTs '[(cp, st)])
forall (a :: T) (s :: [T]). SingI a => Instr (a : s) (a : s)
CAST ('[(cp, st)] :-> '[(cp, st)])
-> ContractCode cp st -> ContractCode cp st
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ContractCode cp st
cdCode :: ContractCode cp st)
, cParamNotes :: ParamNotes (ToT cp)
cParamNotes = ParamNotes (ToT cp)
cpNotes
, cStoreNotes :: Notes (ToT st)
cStoreNotes = FollowEntrypointFlag -> Notes (ToT st)
forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @st FollowEntrypointFlag
NotFollowEntrypoint
, cEntriesOrder :: EntriesOrder
cEntriesOrder = EntriesOrder
U.canonicalEntriesOrder
} (ParameterScope (ToT cp) => Contract (ToT cp) (ToT st))
-> (((SingI (ToT cp), FailOnOperationFound (ContainsOp (ToT cp)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))),
KnownValue cp)
:- ParameterScope (ToT cp))
-> Contract (ToT cp) (ToT st)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT cp), FailOnOperationFound (ContainsOp (ToT cp)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))),
KnownValue cp)
:- ParameterScope (ToT cp)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @cp
(StorageScope (ToT st) => Contract (ToT cp) (ToT st))
-> (((SingI (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
HasAnnotation st, KnownValue st)
:- StorageScope (ToT st))
-> Contract (ToT cp) (ToT st)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
HasAnnotation st, KnownValue st)
:- StorageScope (ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st
cDocumentedCode :: ContractCode cp st
cDocumentedCode = Proxy cp -> ContractCode cp st -> ContractCode cp st
forall cp (inp :: [*]) (out :: [*]).
(NiceParameterFull cp, HasCallStack) =>
Proxy cp -> (inp :-> out) -> inp :-> out
finalizeParamCallingDoc' (Proxy cp
forall k (t :: k). Proxy t
Proxy @cp) ContractCode cp st
cdCode
cpNotes :: ParamNotes (ToT cp)
cpNotes = ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp)
forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp)
parameterEntrypointsToNotes @cp
interpretLorentzInstr
:: (IsoValuesStack inp, IsoValuesStack out)
=> ContractEnv
-> inp :-> out
-> Rec Identity inp
-> Either MichelsonFailed (Rec Identity out)
interpretLorentzInstr :: ContractEnv
-> (inp :-> out)
-> Rec Identity inp
-> Either MichelsonFailed (Rec Identity out)
interpretLorentzInstr ContractEnv
env ((inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz -> Instr (ToTs inp) (ToTs out)
instr) Rec Identity inp
inp =
Rec Value (ToTs out) -> Rec Identity out
forall (ts :: [*]).
IsoValuesStack ts =>
Rec Value (ToTs ts) -> Rec Identity ts
fromValStack (Rec Value (ToTs out) -> Rec Identity out)
-> Either MichelsonFailed (Rec Value (ToTs out))
-> Either MichelsonFailed (Rec Identity out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContractEnv
-> Instr (ToTs inp) (ToTs out)
-> Rec Value (ToTs inp)
-> Either MichelsonFailed (Rec Value (ToTs out))
forall (inp :: [T]) (out :: [T]).
ContractEnv
-> Instr inp out
-> Rec Value inp
-> Either MichelsonFailed (Rec Value out)
interpretInstr ContractEnv
env Instr (ToTs inp) (ToTs out)
instr (Rec Identity inp -> Rec Value (ToTs inp)
forall (ts :: [*]).
IsoValuesStack ts =>
Rec Identity ts -> Rec Value (ToTs ts)
toValStack Rec Identity inp
inp)
interpretLorentzLambda
:: (IsoValue inp, IsoValue out)
=> ContractEnv
-> Lambda inp out
-> inp
-> Either MichelsonFailed out
interpretLorentzLambda :: ContractEnv -> Lambda inp out -> inp -> Either MichelsonFailed out
interpretLorentzLambda ContractEnv
env Lambda inp out
instr inp
inp = do
Rec Identity '[out]
res <- ContractEnv
-> Lambda inp out
-> Rec Identity '[inp]
-> Either MichelsonFailed (Rec Identity '[out])
forall (inp :: [*]) (out :: [*]).
(IsoValuesStack inp, IsoValuesStack out) =>
ContractEnv
-> (inp :-> out)
-> Rec Identity inp
-> Either MichelsonFailed (Rec Identity out)
interpretLorentzInstr ContractEnv
env Lambda inp out
instr (inp -> Identity inp
forall a. a -> Identity a
Identity inp
inp Identity inp -> Rec Identity '[] -> Rec Identity '[inp]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec Identity '[]
forall u (a :: u -> *). Rec a '[]
RNil)
let Identity out :& Rec Identity rs
RNil = Rec Identity '[out]
res
out -> Either MichelsonFailed out
forall (m :: * -> *) a. Monad m => a -> m a
return out
out
instance ContainsDoc (ContractData cp st) where
buildDocUnfinalized :: ContractData cp st -> ContractDoc
buildDocUnfinalized =
Contract cp st -> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized (Contract cp st -> ContractDoc)
-> (ContractData cp st -> Contract cp st)
-> ContractData cp st
-> ContractDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractData cp st -> Contract cp st
forall cp st. ContractData cp st -> Contract cp st
compileLorentzContract
instance ContainsUpdateableDoc (ContractData cp st) where
modifyDocEntirely :: (SomeDocItem -> SomeDocItem)
-> ContractData cp st -> ContractData cp st
modifyDocEntirely SomeDocItem -> SomeDocItem
how ContractData cp st
c =
ContractData cp st
c{ cdCode :: ContractCode cp st
cdCode = (SomeDocItem -> SomeDocItem)
-> ContractCode cp st -> ContractCode cp st
forall a.
ContainsUpdateableDoc a =>
(SomeDocItem -> SomeDocItem) -> a -> a
modifyDocEntirely SomeDocItem -> SomeDocItem
how (ContractData cp st -> ContractCode cp st
forall cp st. ContractData cp st -> ContractCode cp st
cdCode ContractData cp st
c) }
analyzeLorentz :: inp :-> out -> AnalyzerRes
analyzeLorentz :: (inp :-> out) -> AnalyzerRes
analyzeLorentz = Instr (ToTs inp) (ToTs out) -> AnalyzerRes
forall (inp :: [T]) (out :: [T]). Instr inp out -> AnalyzerRes
analyze (Instr (ToTs inp) (ToTs out) -> AnalyzerRes)
-> ((inp :-> out) -> Instr (ToTs inp) (ToTs out))
-> (inp :-> out)
-> AnalyzerRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz
makeLensesWith postfixLFields ''CompilationOptions
cdCodeL ::
forall cp st cp1 st1. (NiceParameterFull cp1, NiceStorage st1) =>
Lens.Lens (ContractData cp st) (ContractData cp1 st1) (ContractCode cp st) (ContractCode cp1 st1)
cdCodeL :: Lens
(ContractData cp st)
(ContractData cp1 st1)
(ContractCode cp st)
(ContractCode cp1 st1)
cdCodeL ContractCode cp st -> f (ContractCode cp1 st1)
f (ContractData ContractCode cp st
code CompilationOptions
options)
= (ContractCode cp1 st1 -> ContractData cp1 st1)
-> f (ContractCode cp1 st1) -> f (ContractData cp1 st1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ContractCode cp1 st1 -> CompilationOptions -> ContractData cp1 st1
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
ContractCode cp st -> CompilationOptions -> ContractData cp st
`ContractData` CompilationOptions
options) (ContractCode cp st -> f (ContractCode cp1 st1)
f ContractCode cp st
code)
cdCompilationOptionsL ::
forall cp st.
Lens.Lens' (ContractData cp st) CompilationOptions
cdCompilationOptionsL :: (CompilationOptions -> f CompilationOptions)
-> ContractData cp st -> f (ContractData cp st)
cdCompilationOptionsL CompilationOptions -> f CompilationOptions
f (ContractData ContractCode cp st
code CompilationOptions
options)
= (CompilationOptions -> ContractData cp st)
-> f CompilationOptions -> f (ContractData cp st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ContractCode cp st -> CompilationOptions -> ContractData cp st
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
ContractCode cp st -> CompilationOptions -> ContractData cp st
ContractData ContractCode cp st
code) (CompilationOptions -> f CompilationOptions
f CompilationOptions
options)