-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- TODO: Replace 'Empty' with 'Never' from morley
{-# OPTIONS_GHC -Wno-deprecations #-}

module Lorentz.Contracts.Upgradeable.Common.Base
  ( Version (..)
  , VersionKind
  , KnownContractVersion (..)
  , VerParam
  , VerUStore
  , EmptyContractVersion
  , SomeContractVersion
  , UStore_
  , MigrationScript (..)
  , MigrationScriptFrom
  , MigrationScriptTo
  , UContractRouter (..)
  , SomeUContractRouter
  , UpgradeableEntrypointsKind
  , PermanentImpl (..)
  , SomePermanentImpl
  , PermanentEntrypointsKind
  , mkUContractRouter
  , coerceUContractRouter
  , emptyPermanentImpl
  , mkSmallPermanentImpl

    -- * Re-exports
  , Nat
  , Empty
  , absurd_
  ) where

import Prelude (KnownNat, Num, Typeable, natVal)

import qualified Data.Kind as Kind
import Fmt (Buildable(..))
import GHC.TypeNats (Nat)
import Util.TypeTuple

import Lorentz
import Lorentz.Contracts.Upgradeable.Common.Doc (UpgradeableEntrypointsKind)
import Lorentz.UStore
import Lorentz.UStore.Migration
import Michelson.Typed.Arith

-- Versioning
----------------------------------------------------------------------------

-- | Version of a contract.
--
-- Our current versioning suggests that this type is a term-level reflection
-- of types which have 'KnownContractVersion' instance, so this version item
-- should uniquely identify storage structure and entrypoints set for a given
-- contract for all of its instances.
--
-- The old semantics of this type was that it counts number of given contract
-- instance upgrades, so different contract instances, being upgraded to the
-- recent version, could have different 'Version's. For old contracts we have
-- to follow this behaviour.
newtype Version = Version { Version -> Natural
unVersion :: Natural }
  deriving stock (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)
  deriving newtype (Integer -> Version
Version -> Version
Version -> Version -> Version
(Version -> Version -> Version)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> (Version -> Version)
-> (Version -> Version)
-> (Version -> Version)
-> (Integer -> Version)
-> Num Version
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Version
$cfromInteger :: Integer -> Version
signum :: Version -> Version
$csignum :: Version -> Version
abs :: Version -> Version
$cabs :: Version -> Version
negate :: Version -> Version
$cnegate :: Version -> Version
* :: Version -> Version -> Version
$c* :: Version -> Version -> Version
- :: Version -> Version -> Version
$c- :: Version -> Version -> Version
+ :: Version -> Version -> Version
$c+ :: Version -> Version -> Version
Num, WellTypedToT Version
WellTypedToT Version
-> (Version -> Value (ToT Version))
-> (Value (ToT Version) -> Version)
-> IsoValue Version
Value (ToT Version) -> Version
Version -> Value (ToT Version)
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
fromVal :: Value (ToT Version) -> Version
$cfromVal :: Value (ToT Version) -> Version
toVal :: Version -> Value (ToT Version)
$ctoVal :: Version -> Value (ToT Version)
$cp1IsoValue :: WellTypedToT Version
IsoValue)
  deriving anyclass AnnOptions
FollowEntrypointFlag -> Notes (ToT Version)
(FollowEntrypointFlag -> Notes (ToT Version))
-> AnnOptions -> HasAnnotation Version
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> AnnOptions -> HasAnnotation a
annOptions :: AnnOptions
$cannOptions :: AnnOptions
getAnnotation :: FollowEntrypointFlag -> Notes (ToT Version)
$cgetAnnotation :: FollowEntrypointFlag -> Notes (ToT Version)
HasAnnotation

instance ArithOpHs Add Natural Version where
  type ArithResHs Add Natural Version = Version

instance Buildable Version where
  build :: Version -> Builder
build (Version Natural
v) = Builder
"v" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
forall p. Buildable p => p -> Builder
build Natural
v

instance TypeHasDoc Version where
  typeDocMdDescription :: Builder
typeDocMdDescription = Builder
"Contract version."

instance ParameterHasEntrypoints Version where
  type ParameterEntrypointsDerivation Version = EpdNone

-- | Kind of type-level contract version.
type VersionKind =
  -- Defining it like this as it is the simplest way to have a custom open kind
  ContractVersionTag -> Kind.Type
data ContractVersionTag

-- | Declare given type as contract version identifier.
--
-- Instances of this typeclass (versions) uniquely identify contract storage
-- scheme and code. Normally the opposite should also hold, i.e.
-- @contract version <-> (contract storage scheme, code)@ relation is a bijection.
--
-- If as part of migration you need to update contract storage without modifying
-- its structure, then contract version should not change, and you should
-- perform an upgrade to the same version as the current one.
--
-- We allow upgrades between arbitrary two versions, so one can not only upgrade
-- to the next adjacent version, but also upgrade a new contract from V0 to the
-- recent version immediately, or leave version the same (as a versatile way
-- to change storage).
class KnownContractVersion (v :: VersionKind) where
  -- | List of entrypoints of given contract version.
  type VerInterface v :: [EntrypointKind]
  -- | Storage template of given contract version.
  type VerUStoreTemplate v :: Kind.Type

  -- | Set of permanent entrypoints (as a sum type).
  --
  -- We tie this type to contract version for convenience, in order not to carry
  -- one more type argument everywhere.
  -- We do not ensure right here that all versions of a contract have the same
  -- permanent entrypoints, but if this does not hold, then (ideally) it will
  -- not be possible to construct migration between such contract versions.
  type VerPermanent v :: Kind.Type
  type VerPermanent _ = Empty

  -- | Get term-level contract version.
  -- Returned value will be stored within the contract designating the current
  -- contract version.
  contractVersion :: Proxy v -> Version
  default contractVersion :: (v ~ cid ver, KnownNat ver) => Proxy v -> Version
  contractVersion (_ :: Proxy (cid ver)) = Natural -> Version
Version (Natural -> Version) -> Natural -> Version
forall a b. (a -> b) -> a -> b
$ Proxy ver -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy ver
forall k (t :: k). Proxy t
Proxy @ver)

type VerParam v = UParam (VerInterface v)
type VerUStore v = UStore (VerUStoreTemplate v)

-- | Contract with empty interface and storage.
data EmptyContractVersion (perm :: Kind.Type) :: VersionKind
instance KnownContractVersion (EmptyContractVersion perm) where
  type VerInterface (EmptyContractVersion perm) = '[]
  type VerUStoreTemplate (EmptyContractVersion perm) = ()
  type VerPermanent (EmptyContractVersion perm) = perm
  contractVersion :: Proxy (EmptyContractVersion perm) -> Version
contractVersion Proxy (EmptyContractVersion perm)
_ = Version
0

-- | Version which forgets about particular interface/storage.
data SomeContractVersion (perm :: Kind.Type) :: VersionKind
instance KnownContractVersion (SomeContractVersion perm) where
  type VerInterface (SomeContractVersion perm) = SomeInterface
  type VerUStoreTemplate (SomeContractVersion perm) = SomeUTemplate
  type VerPermanent (SomeContractVersion perm) = perm
  contractVersion :: Proxy (SomeContractVersion perm) -> Version
contractVersion Proxy (SomeContractVersion perm)
_ = Text -> Version
forall a. HasCallStack => Text -> a
error Text
"Requested version of SomeContractVersion"

-- UParam dispatching
----------------------------------------------------------------------------

-- | Keeps parameter dispatching logic.
newtype UContractRouter (ver :: VersionKind) =
  UContractRouter
    { UContractRouter ver
-> Lambda
     (VerParam ver, VerUStore ver) ([Operation], VerUStore ver)
unUContractRouter
       :: Lambda (VerParam ver, VerUStore ver)
                 ([Operation], VerUStore ver)
    }
  deriving stock ((forall x. UContractRouter ver -> Rep (UContractRouter ver) x)
-> (forall x. Rep (UContractRouter ver) x -> UContractRouter ver)
-> Generic (UContractRouter ver)
forall x. Rep (UContractRouter ver) x -> UContractRouter ver
forall x. UContractRouter ver -> Rep (UContractRouter ver) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (ver :: VersionKind) x.
Rep (UContractRouter ver) x -> UContractRouter ver
forall (ver :: VersionKind) x.
UContractRouter ver -> Rep (UContractRouter ver) x
$cto :: forall (ver :: VersionKind) x.
Rep (UContractRouter ver) x -> UContractRouter ver
$cfrom :: forall (ver :: VersionKind) x.
UContractRouter ver -> Rep (UContractRouter ver) x
Generic, Int -> UContractRouter ver -> ShowS
[UContractRouter ver] -> ShowS
UContractRouter ver -> String
(Int -> UContractRouter ver -> ShowS)
-> (UContractRouter ver -> String)
-> ([UContractRouter ver] -> ShowS)
-> Show (UContractRouter ver)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (ver :: VersionKind). Int -> UContractRouter ver -> ShowS
forall (ver :: VersionKind). [UContractRouter ver] -> ShowS
forall (ver :: VersionKind). UContractRouter ver -> String
showList :: [UContractRouter ver] -> ShowS
$cshowList :: forall (ver :: VersionKind). [UContractRouter ver] -> ShowS
show :: UContractRouter ver -> String
$cshow :: forall (ver :: VersionKind). UContractRouter ver -> String
showsPrec :: Int -> UContractRouter ver -> ShowS
$cshowsPrec :: forall (ver :: VersionKind). Int -> UContractRouter ver -> ShowS
Show)
  deriving anyclass (WellTypedToT (UContractRouter ver)
WellTypedToT (UContractRouter ver)
-> (UContractRouter ver -> Value (ToT (UContractRouter ver)))
-> (Value (ToT (UContractRouter ver)) -> UContractRouter ver)
-> IsoValue (UContractRouter ver)
Value (ToT (UContractRouter ver)) -> UContractRouter ver
UContractRouter ver -> Value (ToT (UContractRouter ver))
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall (ver :: VersionKind). WellTypedToT (UContractRouter ver)
forall (ver :: VersionKind).
Value (ToT (UContractRouter ver)) -> UContractRouter ver
forall (ver :: VersionKind).
UContractRouter ver -> Value (ToT (UContractRouter ver))
fromVal :: Value (ToT (UContractRouter ver)) -> UContractRouter ver
$cfromVal :: forall (ver :: VersionKind).
Value (ToT (UContractRouter ver)) -> UContractRouter ver
toVal :: UContractRouter ver -> Value (ToT (UContractRouter ver))
$ctoVal :: forall (ver :: VersionKind).
UContractRouter ver -> Value (ToT (UContractRouter ver))
$cp1IsoValue :: forall (ver :: VersionKind). WellTypedToT (UContractRouter ver)
IsoValue, AnnOptions
FollowEntrypointFlag -> Notes (ToT (UContractRouter ver))
(FollowEntrypointFlag -> Notes (ToT (UContractRouter ver)))
-> AnnOptions -> HasAnnotation (UContractRouter ver)
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> AnnOptions -> HasAnnotation a
forall (ver :: VersionKind). AnnOptions
forall (ver :: VersionKind).
FollowEntrypointFlag -> Notes (ToT (UContractRouter ver))
annOptions :: AnnOptions
$cannOptions :: forall (ver :: VersionKind). AnnOptions
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (UContractRouter ver))
$cgetAnnotation :: forall (ver :: VersionKind).
FollowEntrypointFlag -> Notes (ToT (UContractRouter ver))
HasAnnotation, ToT (UContractRouter ver) ~ ToT (Unwrappable (UContractRouter ver))
(ToT (UContractRouter ver)
 ~ ToT (Unwrappable (UContractRouter ver)))
-> Wrappable (UContractRouter ver)
forall s. (ToT s ~ ToT (Unwrappable s)) -> Wrappable s
forall (ver :: VersionKind).
ToT (UContractRouter ver) ~ ToT (Unwrappable (UContractRouter ver))
Wrappable)
  deriving newtype (((forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
 -> UContractRouter ver -> UContractRouter ver)
-> MapLorentzInstr (UContractRouter ver)
(forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> UContractRouter ver -> UContractRouter ver
forall instr.
((forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
 -> instr -> instr)
-> MapLorentzInstr instr
forall (ver :: VersionKind).
(forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> UContractRouter ver -> UContractRouter ver
mapLorentzInstr :: (forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> UContractRouter ver -> UContractRouter ver
$cmapLorentzInstr :: forall (ver :: VersionKind).
(forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> UContractRouter ver -> UContractRouter ver
MapLorentzInstr)

instance ( Typeable ver
         , Typeable (VerInterface ver), Typeable (VerUStoreTemplate ver)
         , TypeHasDoc (VerUStore ver)
         ) =>
         TypeHasDoc (UContractRouter ver) where
  typeDocMdDescription :: Builder
typeDocMdDescription =
    Builder
"Parameter dispatching logic, main purpose of this code is to pass control \
    \to an entrypoint carrying the main logic of the contract."
  typeDocMdReference :: Proxy (UContractRouter ver) -> WithinParens -> Builder
typeDocMdReference Proxy (UContractRouter ver)
tp = (Text, DType) -> [DType] -> WithinParens -> Builder
customTypeDocMdReference (Text
"UContractRouter", Proxy (UContractRouter ver) -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy (UContractRouter ver)
tp) []
  typeDocHaskellRep :: TypeDocHaskellRep (UContractRouter ver)
typeDocHaskellRep = TypeDocHaskellRep (UContractRouter ver)
forall a. (Generic a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep a
homomorphicTypeDocHaskellRep
  typeDocMichelsonRep :: TypeDocMichelsonRep (UContractRouter ver)
typeDocMichelsonRep = TypeDocMichelsonRep (UContractRouter ver)
forall a. SingI (ToT a) => TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep

type SomeUContractRouter = UContractRouter (SomeContractVersion ())

mkUContractRouter
  :: ([VerParam ver, VerUStore ver] :-> '[([Operation], VerUStore ver)])
  -> UContractRouter ver
mkUContractRouter :: ('[VerParam ver, VerUStore ver]
 :-> '[([Operation], VerUStore ver)])
-> UContractRouter ver
mkUContractRouter '[VerParam ver, VerUStore ver] :-> '[([Operation], VerUStore ver)]
code = Lambda (VerParam ver, VerUStore ver) ([Operation], VerUStore ver)
-> UContractRouter ver
forall (ver :: VersionKind).
Lambda (VerParam ver, VerUStore ver) ([Operation], VerUStore ver)
-> UContractRouter ver
UContractRouter (Lambda (VerParam ver, VerUStore ver) ([Operation], VerUStore ver)
 -> UContractRouter ver)
-> Lambda
     (VerParam ver, VerUStore ver) ([Operation], VerUStore ver)
-> UContractRouter ver
forall a b. (a -> b) -> a -> b
$ do
  '[(VerParam ver, VerUStore ver)] :-> '[VerParam ver, VerUStore ver]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair
  '[VerParam ver, VerUStore ver] :-> '[([Operation], VerUStore ver)]
code

instance ( VerParam ver1 `CanCastTo` VerParam ver2
         , VerUStore ver1 `CanCastTo` VerUStore ver2
         ) =>
         UContractRouter ver1 `CanCastTo` UContractRouter ver2 where
  castDummy :: Proxy (UContractRouter ver1) -> Proxy (UContractRouter ver2) -> ()
castDummy = Proxy (UContractRouter ver1) -> Proxy (UContractRouter ver2) -> ()
forall a b.
(Generic a, Generic b, GCanCastTo (Rep a) (Rep b)) =>
Proxy a -> Proxy b -> ()
castDummyG

coerceUContractRouter
  :: ( Coercible_ (VerParam s1) (VerParam s2)
     , Coercible_ (VerUStore s1) (VerUStore s2)
     )
  => UContractRouter s1 -> UContractRouter s2
coerceUContractRouter :: UContractRouter s1 -> UContractRouter s2
coerceUContractRouter (UContractRouter Lambda (VerParam s1, VerUStore s1) ([Operation], VerUStore s1)
code) =
  Lambda (VerParam s2, VerUStore s2) ([Operation], VerUStore s2)
-> UContractRouter s2
forall (ver :: VersionKind).
Lambda (VerParam ver, VerUStore ver) ([Operation], VerUStore ver)
-> UContractRouter ver
UContractRouter (Lambda (VerParam s2, VerUStore s2) ([Operation], VerUStore s2)
 -> UContractRouter s2)
-> Lambda (VerParam s2, VerUStore s2) ([Operation], VerUStore s2)
-> UContractRouter s2
forall a b. (a -> b) -> a -> b
$ '[(VerParam s2, VerUStore s2)] :-> '[(VerParam s1, VerUStore s1)]
forall a b (s :: [*]). Castable_ a b => (a : s) :-> (b : s)
checkedCoerce_ ('[(VerParam s2, VerUStore s2)] :-> '[(VerParam s1, VerUStore s1)])
-> Lambda (VerParam s1, VerUStore s1) ([Operation], VerUStore s1)
-> '[(VerParam s2, VerUStore s2)]
   :-> '[([Operation], VerUStore s1)]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Lambda (VerParam s1, VerUStore s1) ([Operation], VerUStore s1)
code ('[(VerParam s2, VerUStore s2)] :-> '[([Operation], VerUStore s1)])
-> ('[([Operation], VerUStore s1)]
    :-> '[([Operation], VerUStore s2)])
-> Lambda (VerParam s2, VerUStore s2) ([Operation], VerUStore s2)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[([Operation], VerUStore s1)] :-> '[([Operation], VerUStore s2)]
forall a b (s :: [*]). Castable_ a b => (a : s) :-> (b : s)
checkedCoerce_

-- Permanent entrypoints parameter dispatching
----------------------------------------------------------------------------

-- | Implementation of permanent entrypoints.
--
-- This will be injected into contract storage as one of fields, so make sure
-- that code within does not exceed several instructions; an actual entrypoint
-- logic can be put into 'UStore' and called from within @PermanentImpl@ only
-- when necessary.
--
-- Regarding documentation - this have to provide code pieces wrapped into
-- 'DEntrypoint' with 'PermanentEntrypointsKind', so always use 'entryCase' as
-- implementation of this type /or/ inject documentation of code which does so
-- unless you know what you are doing.
newtype PermanentImpl ver = PermanentImpl
  { PermanentImpl ver -> Entrypoint (VerPermanent ver) (VerUStore ver)
unPermanentImpl :: Entrypoint (VerPermanent ver) (VerUStore ver)
  }
  deriving stock ((forall x. PermanentImpl ver -> Rep (PermanentImpl ver) x)
-> (forall x. Rep (PermanentImpl ver) x -> PermanentImpl ver)
-> Generic (PermanentImpl ver)
forall x. Rep (PermanentImpl ver) x -> PermanentImpl ver
forall x. PermanentImpl ver -> Rep (PermanentImpl ver) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (ver :: VersionKind) x.
Rep (PermanentImpl ver) x -> PermanentImpl ver
forall (ver :: VersionKind) x.
PermanentImpl ver -> Rep (PermanentImpl ver) x
$cto :: forall (ver :: VersionKind) x.
Rep (PermanentImpl ver) x -> PermanentImpl ver
$cfrom :: forall (ver :: VersionKind) x.
PermanentImpl ver -> Rep (PermanentImpl ver) x
Generic, Int -> PermanentImpl ver -> ShowS
[PermanentImpl ver] -> ShowS
PermanentImpl ver -> String
(Int -> PermanentImpl ver -> ShowS)
-> (PermanentImpl ver -> String)
-> ([PermanentImpl ver] -> ShowS)
-> Show (PermanentImpl ver)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (ver :: VersionKind). Int -> PermanentImpl ver -> ShowS
forall (ver :: VersionKind). [PermanentImpl ver] -> ShowS
forall (ver :: VersionKind). PermanentImpl ver -> String
showList :: [PermanentImpl ver] -> ShowS
$cshowList :: forall (ver :: VersionKind). [PermanentImpl ver] -> ShowS
show :: PermanentImpl ver -> String
$cshow :: forall (ver :: VersionKind). PermanentImpl ver -> String
showsPrec :: Int -> PermanentImpl ver -> ShowS
$cshowsPrec :: forall (ver :: VersionKind). Int -> PermanentImpl ver -> ShowS
Show)
  deriving newtype (((forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
 -> PermanentImpl ver -> PermanentImpl ver)
-> MapLorentzInstr (PermanentImpl ver)
(forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> PermanentImpl ver -> PermanentImpl ver
forall instr.
((forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
 -> instr -> instr)
-> MapLorentzInstr instr
forall (ver :: VersionKind).
(forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> PermanentImpl ver -> PermanentImpl ver
mapLorentzInstr :: (forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> PermanentImpl ver -> PermanentImpl ver
$cmapLorentzInstr :: forall (ver :: VersionKind).
(forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> PermanentImpl ver -> PermanentImpl ver
MapLorentzInstr)
  deriving anyclass (ToT (PermanentImpl ver) ~ ToT (Unwrappable (PermanentImpl ver))
(ToT (PermanentImpl ver) ~ ToT (Unwrappable (PermanentImpl ver)))
-> Wrappable (PermanentImpl ver)
forall s. (ToT s ~ ToT (Unwrappable s)) -> Wrappable s
forall (ver :: VersionKind).
ToT (PermanentImpl ver) ~ ToT (Unwrappable (PermanentImpl ver))
Wrappable)

deriving anyclass instance (WellTypedIsoValue (VerPermanent ver)) => IsoValue (PermanentImpl ver)

instance HasAnnotation (VerPermanent ver) => HasAnnotation (PermanentImpl ver)

instance ( Typeable ver, Typeable (VerUStoreTemplate ver)
         , TypeHasDoc (VerUStore ver)
         , TypeHasDoc (VerPermanent ver), KnownValue (VerPermanent ver)
         ) =>
         TypeHasDoc (PermanentImpl ver) where
  typeDocMdDescription :: Builder
typeDocMdDescription =
    Builder
"Implementation of permanent entrypoints."
  typeDocMdReference :: Proxy (PermanentImpl ver) -> WithinParens -> Builder
typeDocMdReference Proxy (PermanentImpl ver)
tp = (Text, DType) -> [DType] -> WithinParens -> Builder
customTypeDocMdReference (Text
"PermanentImpl", Proxy (PermanentImpl ver) -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy (PermanentImpl ver)
tp) []
  typeDocHaskellRep :: TypeDocHaskellRep (PermanentImpl ver)
typeDocHaskellRep = TypeDocHaskellRep (PermanentImpl ver)
forall a. (Generic a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep a
homomorphicTypeDocHaskellRep
  typeDocMichelsonRep :: TypeDocMichelsonRep (PermanentImpl ver)
typeDocMichelsonRep = TypeDocMichelsonRep (PermanentImpl ver)
forall a. SingI (ToT a) => TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep

type SomePermanentImpl perm = PermanentImpl (SomeContractVersion perm)

instance ( VerPermanent ver1 `CanCastTo` VerPermanent ver2
         , VerUStore ver1 `CanCastTo` VerUStore ver2
         ) =>
         PermanentImpl ver1 `CanCastTo` PermanentImpl ver2 where
  castDummy :: Proxy (PermanentImpl ver1) -> Proxy (PermanentImpl ver2) -> ()
castDummy = Proxy (PermanentImpl ver1) -> Proxy (PermanentImpl ver2) -> ()
forall a b.
(Generic a, Generic b, GCanCastTo (Rep a) (Rep b)) =>
Proxy a -> Proxy b -> ()
castDummyG

-- | Common implementation of permanent part in case contract has no such.
emptyPermanentImpl :: (VerPermanent ver ~ Empty) => PermanentImpl ver
emptyPermanentImpl :: PermanentImpl ver
emptyPermanentImpl = Entrypoint (VerPermanent ver) (VerUStore ver) -> PermanentImpl ver
forall (ver :: VersionKind).
Entrypoint (VerPermanent ver) (VerUStore ver) -> PermanentImpl ver
PermanentImpl (Entrypoint (VerPermanent ver) (VerUStore ver)
 -> PermanentImpl ver)
-> Entrypoint (VerPermanent ver) (VerUStore ver)
-> PermanentImpl ver
forall a b. (a -> b) -> a -> b
$
  (SubDoc -> DEntrypoint PermanentEntrypointsKind)
-> ('[Empty, VerUStore ver] :-> ContractOut (VerUStore ver))
-> '[Empty, VerUStore ver] :-> ContractOut (VerUStore ver)
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (Text -> SubDoc -> DEntrypoint PermanentEntrypointsKind
forall kind. Text -> SubDoc -> DEntrypoint kind
DEntrypoint @PermanentEntrypointsKind Text
"<No entrypoints>")
    '[Empty, VerUStore ver] :-> ContractOut (VerUStore ver)
forall (s :: [*]) (s' :: [*]). (Empty : s) :-> s'
absurd_

-- | Construct implementation of permanent part in a common case;
-- this works similarly to 'entryCase'.
--
-- Use this function only for very small implementations.
mkSmallPermanentImpl
  :: forall ver dt out inp clauses.
     ( CaseTC dt out inp clauses
     , DocumentEntrypoints PermanentEntrypointsKind dt
     , dt ~ VerPermanent ver, inp ~ '[VerUStore ver]
     , out ~ ContractOut (VerUStore ver)
     )
  => IsoRecTuple clauses -> PermanentImpl ver
mkSmallPermanentImpl :: IsoRecTuple clauses -> PermanentImpl ver
mkSmallPermanentImpl = ('[dt, UStore (VerUStoreTemplate ver)]
 :-> '[([Operation], UStore (VerUStoreTemplate ver))])
-> PermanentImpl ver
forall (ver :: VersionKind).
Entrypoint (VerPermanent ver) (VerUStore ver) -> PermanentImpl ver
PermanentImpl (('[dt, UStore (VerUStoreTemplate ver)]
  :-> '[([Operation], UStore (VerUStoreTemplate ver))])
 -> PermanentImpl ver)
-> (IsoRecTuple
      (Rec
         (CaseClauseL
            '[UStore (VerUStoreTemplate ver)]
            '[([Operation], UStore (VerUStoreTemplate ver))])
         (GCaseClauses (Rep dt)))
    -> '[dt, UStore (VerUStoreTemplate ver)]
       :-> '[([Operation], UStore (VerUStoreTemplate ver))])
-> IsoRecTuple
     (Rec
        (CaseClauseL
           '[UStore (VerUStoreTemplate ver)]
           '[([Operation], UStore (VerUStoreTemplate ver))])
        (GCaseClauses (Rep dt)))
-> PermanentImpl ver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy PermanentEntrypointsKind
-> IsoRecTuple
     (Rec
        (CaseClauseL
           '[UStore (VerUStoreTemplate ver)]
           '[([Operation], UStore (VerUStoreTemplate ver))])
        (GCaseClauses (Rep dt)))
-> '[dt, UStore (VerUStoreTemplate ver)]
   :-> '[([Operation], UStore (VerUStoreTemplate ver))]
forall dt entrypointKind (out :: [*]) (inp :: [*]) clauses.
(CaseTC dt out inp clauses,
 DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind -> IsoRecTuple clauses -> (dt : inp) :-> out
entryCase (Proxy PermanentEntrypointsKind
forall k (t :: k). Proxy t
Proxy @PermanentEntrypointsKind)

-- | Common marker for permanent entrypoints.
-- Can be used when parameter for permanent entrypoints is flat, i.e. does not
-- have nested subparameters with multiple entrypoints.
data PermanentEntrypointsKind
instance EntrypointKindHasDoc PermanentEntrypointsKind where
  entrypointKindPos :: Natural
entrypointKindPos = Natural
1050
  entrypointKindSectionName :: Text
entrypointKindSectionName = Text
"Permanent entrypoints"