Unsafe interface conversion primitives (#13391)

* Add unsafeFromInterface method to HasFromInterface class * Use unsafeFromInterface instead of fromInterface + experimental primitive * Drop THROW_WRONGLY_TYPED_CONTRACT experimental primitive * Add UnsafeFrom{,Required}Interface LF primitives * Add convertPrim cases for UnsafeFrom{,Required}Interface * Add InterfaceGuarded tests for WronglyTypedContract cases changelog_begin changelog_end Co-authored-by: Sofia Faro <sofia.faro@digitalasset.com>
2024-09-19 16:57:40 +03:00 · 2022-03-25 11:07:14 +01:00 · 2022-03-25 11:07:14 +01:00 · f9f1611d46
commit f9f1611d46
parent 3fac74f9e2
32 changed files with 344 additions and 52 deletions
--- a/bazel-haskell-deps.bzl
+++ b/bazel-haskell-deps.bzl
@ -17,11 +17,11 @@ load("@os_info//:os_info.bzl", "is_linux", "is_windows")
 load("@dadew//:dadew.bzl", "dadew_tool_home")
 load("@rules_haskell//haskell:cabal.bzl", "stack_snapshot")

-GHC_LIB_REV = "33fa5bfa6aed2b55a8bafb7c9f1fd619"
-GHC_LIB_SHA256 = "96f08118e42f3155d958a79bf0f8fba91d95be454c91ee92fac09cd0d841ccbe"
+GHC_LIB_REV = "60a14c87f2fa4b204eed881425e86a50"
+GHC_LIB_SHA256 = "c0e359e43b7d2209208eb8dbd22c2071b462c954b1f413d1ac784bcd4be056bf"
 GHC_LIB_VERSION = "8.8.1"
-GHC_LIB_PARSER_REV = "33fa5bfa6aed2b55a8bafb7c9f1fd619"
-GHC_LIB_PARSER_SHA256 = "26bbe32742b78df965ce82a00d30d886bc3499cdc595de4b329383ed19fe0ae4"
+GHC_LIB_PARSER_REV = "60a14c87f2fa4b204eed881425e86a50"
+GHC_LIB_PARSER_SHA256 = "5765c67c24cb1a140918ae51c8d45a61fe5268ccace303b7275997970b660273"
 GHC_LIB_PARSER_VERSION = "8.8.1"
 GHCIDE_REV = "0572146d4b792c6c67affe461e0bd07d49d9df72"
 GHCIDE_SHA256 = "7de56b15d08eab19d325a93c4f43d0ca3d634bb1a1fdc0d18fe4ab4a021cc697"
--- a/ci/da-ghc-lib/compile.yml
+++ b/ci/da-ghc-lib/compile.yml
@ -12,7 +12,7 @@ jobs:
  variables:
    ghc-lib-sha: '905f51296d979d79da511bed9ab2da7cb9429c9f'
    base-sha: '9c787d4d24f2b515934c8503ee2bbd7cfac4da20'
-    patches: '3b52915616984a41dfba3c89fad0b8f9c3cb4ed3 833ca63be2ab14871874ccb6974921e8952802e9'
+    patches: '30e015efef3ec8d3fcf43ac5675bba8c13f16a7e 833ca63be2ab14871874ccb6974921e8952802e9'
    flavor: 'da-ghc-8.8.1'
  steps:
  - checkout: self
--- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Alpha.hs
+++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Alpha.hs
@ -228,6 +228,13 @@ alphaExpr' env = \case
            && alphaTypeCon t1b t2b
            && alphaExpr' env e1 e2
        _ -> False
+    EUnsafeFromInterface t1a t1b e1a e1b -> \case
+        EUnsafeFromInterface t2a t2b e2a e2b
+            -> alphaTypeCon t1a t2a
+            && alphaTypeCon t1b t2b
+            && alphaExpr' env e1a e2a
+            && alphaExpr' env e1b e2b
+        _ -> False
    ECallInterface t1 m1 e1 -> \case
        ECallInterface t2 m2 e2
            -> alphaTypeCon t1 t2
@ -246,6 +253,13 @@ alphaExpr' env = \case
            && alphaTypeCon t1b t2b
            && alphaExpr' env e1 e2
        _ -> False
+    EUnsafeFromRequiredInterface t1a t1b e1a e1b -> \case
+        EUnsafeFromRequiredInterface t2a t2b e2a e2b
+            -> alphaTypeCon t1a t2a
+            && alphaTypeCon t1b t2b
+            && alphaExpr' env e1a e2a
+            && alphaExpr' env e1b e2b
+        _ -> False
    EInterfaceTemplateTypeRep ty1 expr1 -> \case
        EInterfaceTemplateTypeRep ty2 expr2
            -> alphaTypeCon ty1 ty2
--- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs
+++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs
@ -547,6 +547,13 @@ data Expr
    , fromInterfaceTemplate :: !(Qualified TypeConName)
    , fromInterfaceExpr :: !Expr
    }
+  -- | Convert interface type to template payload or raise WronglyTypedContract error if not possible.
+  | EUnsafeFromInterface
+    { unsafeFromInterfaceInterface :: !(Qualified TypeConName)
+    , unsafeFromInterfaceTemplate :: !(Qualified TypeConName)
+    , unsafeFromInterfaceContractId :: !Expr
+    , unsafeFromInterfaceExpr :: !Expr
+    }
  -- | Invoke an interface method
  | ECallInterface
    { callInterfaceType :: !(Qualified TypeConName)
@ -565,6 +572,13 @@ data Expr
    , friRequiringInterface :: !(Qualified TypeConName)
    , friExpr :: !Expr
    }
+  -- | Downcast interface or raise WronglyTypedContract error if not possible.
+  | EUnsafeFromRequiredInterface
+    { unsafeFromRequiredInterfaceInterface :: !(Qualified TypeConName)
+    , unsafeFromRequiredInterfaceTemplate :: !(Qualified TypeConName)
+    , unsafeFromRequiredInterfaceContractId :: !Expr
+    , unsafeFromRequiredInterfaceExpr :: !Expr
+    }
  -- | Obtain type representation of contract's template through an interface
  | EInterfaceTemplateTypeRep
    { ttrInterface :: !(Qualified TypeConName)
--- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/FreeVars.hs
+++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/FreeVars.hs
@ -106,9 +106,11 @@ freeVarsStep = \case
    EThrowF t1 t2 e -> freeVarsInType t1 <> freeVarsInType t2 <> e
    EToInterfaceF _ _ e -> e
    EFromInterfaceF _ _ e -> e
+    EUnsafeFromInterfaceF _ _ e1 e2 -> e1 <> e2
    ECallInterfaceF _ _ e -> e
    EToRequiredInterfaceF _ _ e -> e
    EFromRequiredInterfaceF _ _ e -> e
+    EUnsafeFromRequiredInterfaceF _ _ e1 e2 -> e1 <> e2
    EInterfaceTemplateTypeRepF _ e -> e
    ESignatoryInterfaceF _ e -> e
    EObserverInterfaceF _ e -> e
--- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs
+++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs
@ -536,12 +536,16 @@ instance Pretty Expr where
        [interfaceArg ty1, tplArg ty2, TmArg expr]
    EFromInterface ty1 ty2 expr -> pPrintAppKeyword lvl prec "from_interface"
        [interfaceArg ty1, tplArg ty2, TmArg expr]
+    EUnsafeFromInterface ty1 ty2 expr1 expr2 -> pPrintAppKeyword lvl prec "unsafe_from_interface"
+        [interfaceArg ty1, tplArg ty2, TmArg expr1, TmArg expr2]
    ECallInterface ty mth expr -> pPrintAppKeyword lvl prec "call_interface"
        [interfaceArg ty, methodArg mth, TmArg expr]
    EToRequiredInterface ty1 ty2 expr -> pPrintAppKeyword lvl prec "to_required_interface"
        [interfaceArg ty1, interfaceArg ty2, TmArg expr]
    EFromRequiredInterface ty1 ty2 expr -> pPrintAppKeyword lvl prec "from_required_interface"
        [interfaceArg ty1, interfaceArg ty2, TmArg expr]
+    EUnsafeFromRequiredInterface ty1 ty2 expr1 expr2 -> pPrintAppKeyword lvl prec "unsafe_from_required_interface"
+        [interfaceArg ty1, interfaceArg ty2, TmArg expr1, TmArg expr2]
    EInterfaceTemplateTypeRep ty expr -> pPrintAppKeyword lvl prec "interface_template_type_rep"
        [interfaceArg ty, TmArg expr]
    ESignatoryInterface ty expr -> pPrintAppKeyword lvl prec "signatory_interface"
--- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Recursive.hs
+++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Recursive.hs
@ -52,9 +52,11 @@ data ExprF expr
  | EThrowF !Type !Type !expr
  | EToInterfaceF !(Qualified TypeConName) !(Qualified TypeConName) !expr
  | EFromInterfaceF !(Qualified TypeConName) !(Qualified TypeConName) !expr
+  | EUnsafeFromInterfaceF !(Qualified TypeConName) !(Qualified TypeConName) !expr !expr
  | ECallInterfaceF !(Qualified TypeConName) !MethodName !expr
  | EToRequiredInterfaceF !(Qualified TypeConName) !(Qualified TypeConName) !expr
  | EFromRequiredInterfaceF !(Qualified TypeConName) !(Qualified TypeConName) !expr
+  | EUnsafeFromRequiredInterfaceF !(Qualified TypeConName) !(Qualified TypeConName) !expr !expr
  | EInterfaceTemplateTypeRepF !(Qualified TypeConName) !expr
  | ESignatoryInterfaceF !(Qualified TypeConName) !expr
  | EObserverInterfaceF !(Qualified TypeConName) !expr
@ -211,9 +213,11 @@ instance Recursive Expr where
    EThrow a b c -> EThrowF a b c
    EToInterface a b c -> EToInterfaceF a b c
    EFromInterface a b c -> EFromInterfaceF a b c
+    EUnsafeFromInterface a b c d -> EUnsafeFromInterfaceF a b c d
    ECallInterface a b c -> ECallInterfaceF a b c
    EToRequiredInterface a b c -> EToRequiredInterfaceF a b c
    EFromRequiredInterface a b c -> EFromRequiredInterfaceF a b c
+    EUnsafeFromRequiredInterface a b c d -> EUnsafeFromRequiredInterfaceF a b c d
    EInterfaceTemplateTypeRep a b -> EInterfaceTemplateTypeRepF a b
    ESignatoryInterface a b -> ESignatoryInterfaceF a b
    EObserverInterface a b -> EObserverInterfaceF a b
@ -253,9 +257,11 @@ instance Corecursive Expr where
    EThrowF a b c -> EThrow a b c
    EToInterfaceF a b c -> EToInterface a b c
    EFromInterfaceF a b c -> EFromInterface a b c
+    EUnsafeFromInterfaceF a b c d -> EUnsafeFromInterface a b c d
    ECallInterfaceF a b c -> ECallInterface a b c
    EToRequiredInterfaceF a b c -> EToRequiredInterface a b c
    EFromRequiredInterfaceF a b c -> EFromRequiredInterface a b c
+    EUnsafeFromRequiredInterfaceF a b c d -> EUnsafeFromRequiredInterface a b c d
    EInterfaceTemplateTypeRepF a b -> EInterfaceTemplateTypeRep a b
    ESignatoryInterfaceF a b -> ESignatoryInterface a b
    EObserverInterfaceF a b -> EObserverInterface a b
--- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Subst.hs
+++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Subst.hs
@ -196,12 +196,18 @@ applySubstInExpr subst@Subst{..} = \case
        (applySubstInExpr subst e)
    EFromInterface t1 t2 e -> EFromInterface t1 t2
        (applySubstInExpr subst e)
+    EUnsafeFromInterface t1 t2 e1 e2 -> EUnsafeFromInterface t1 t2
+        (applySubstInExpr subst e1)
+        (applySubstInExpr subst e2)
    ECallInterface t m e -> ECallInterface t m
        (applySubstInExpr subst e)
    EToRequiredInterface t1 t2 e -> EToRequiredInterface t1 t2
        (applySubstInExpr subst e)
    EFromRequiredInterface t1 t2 e -> EFromRequiredInterface t1 t2
        (applySubstInExpr subst e)
+    EUnsafeFromRequiredInterface t1 t2 e1 e2 -> EUnsafeFromRequiredInterface t1 t2
+        (applySubstInExpr subst e1)
+        (applySubstInExpr subst e2)
    EInterfaceTemplateTypeRep ty e -> EInterfaceTemplateTypeRep ty
        (applySubstInExpr subst e)
    ESignatoryInterface ty e -> ESignatoryInterface ty
--- a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs
+++ b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs
@ -663,6 +663,11 @@ decodeExprSum exprSum = mayDecode "exprSum" exprSum $ \case
    <$> mayDecode "expr_FromInterfaceInterfaceType" expr_FromInterfaceInterfaceType decodeTypeConName
    <*> mayDecode "expr_FromInterfaceTemplateType" expr_FromInterfaceTemplateType decodeTypeConName
    <*> mayDecode "expr_FromInterfaceInterfaceExpr" expr_FromInterfaceInterfaceExpr decodeExpr
+  LF1.ExprSumUnsafeFromInterface LF1.Expr_UnsafeFromInterface {..} -> EUnsafeFromInterface
+    <$> mayDecode "expr_UnsafeFromInterfaceInterfaceType" expr_UnsafeFromInterfaceInterfaceType decodeTypeConName
+    <*> mayDecode "expr_UnsafeFromInterfaceTemplateType" expr_UnsafeFromInterfaceTemplateType decodeTypeConName
+    <*> mayDecode "expr_UnsafeFromInterfaceContractIdExpr" expr_UnsafeFromInterfaceContractIdExpr decodeExpr
+    <*> mayDecode "expr_UnsafeFromInterfaceInterfaceExpr" expr_UnsafeFromInterfaceInterfaceExpr decodeExpr
  LF1.ExprSumCallInterface LF1.Expr_CallInterface {..} -> ECallInterface
    <$> mayDecode "expr_CallInterfaceInterfaceType" expr_CallInterfaceInterfaceType decodeTypeConName
    <*> decodeMethodName expr_CallInterfaceMethodInternedName
@ -675,6 +680,11 @@ decodeExprSum exprSum = mayDecode "exprSum" exprSum $ \case
    <$> mayDecode "expr_FromRequiredInterfaceRequiredInterface" expr_FromRequiredInterfaceRequiredInterface decodeTypeConName
    <*> mayDecode "expr_FromRequiredInterfaceRequiringInterface" expr_FromRequiredInterfaceRequiringInterface decodeTypeConName
    <*> mayDecode "expr_FromRequiredInterfaceExpr" expr_FromRequiredInterfaceExpr decodeExpr
+  LF1.ExprSumUnsafeFromRequiredInterface LF1.Expr_UnsafeFromRequiredInterface {..} -> EUnsafeFromRequiredInterface
+    <$> mayDecode "expr_UnsafeFromRequiredInterfaceRequiredInterface" expr_UnsafeFromRequiredInterfaceRequiredInterface decodeTypeConName
+    <*> mayDecode "expr_UnsafeFromRequiredInterfaceRequiringInterface" expr_UnsafeFromRequiredInterfaceRequiringInterface decodeTypeConName
+    <*> mayDecode "expr_UnsafeFromRequiredInterfaceContractIdExpr" expr_UnsafeFromRequiredInterfaceContractIdExpr decodeExpr
+    <*> mayDecode "expr_UnsafeFromRequiredInterfaceInterfaceExpr" expr_UnsafeFromRequiredInterfaceInterfaceExpr decodeExpr
  LF1.ExprSumInterfaceTemplateTypeRep LF1.Expr_InterfaceTemplateTypeRep {..} -> EInterfaceTemplateTypeRep
    <$> mayDecode "expr_InterfaceTemplateTypeRepInterface" expr_InterfaceTemplateTypeRepInterface decodeTypeConName
    <*> mayDecode "expr_InterfaceTemplateTypeRepExpr" expr_InterfaceTemplateTypeRepExpr decodeExpr
--- a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs
+++ b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs
@ -695,6 +695,12 @@ encodeExpr' = \case
        expr_FromInterfaceTemplateType <- encodeQualTypeConName ty2
        expr_FromInterfaceInterfaceExpr <- encodeExpr val
        pureExpr $ P.ExprSumFromInterface P.Expr_FromInterface{..}
+    EUnsafeFromInterface ty1 ty2 cid val -> do
+        expr_UnsafeFromInterfaceInterfaceType <- encodeQualTypeConName ty1
+        expr_UnsafeFromInterfaceTemplateType <- encodeQualTypeConName ty2
+        expr_UnsafeFromInterfaceContractIdExpr <- encodeExpr cid
+        expr_UnsafeFromInterfaceInterfaceExpr <- encodeExpr val
+        pureExpr $ P.ExprSumUnsafeFromInterface P.Expr_UnsafeFromInterface{..}
    ECallInterface ty mth val -> do
        expr_CallInterfaceInterfaceType <- encodeQualTypeConName ty
        expr_CallInterfaceMethodInternedName <- encodeMethodName mth
@ -710,6 +716,12 @@ encodeExpr' = \case
        expr_FromRequiredInterfaceRequiringInterface <- encodeQualTypeConName ty2
        expr_FromRequiredInterfaceExpr <- encodeExpr val
        pureExpr $ P.ExprSumFromRequiredInterface P.Expr_FromRequiredInterface{..}
+    EUnsafeFromRequiredInterface ty1 ty2 cid val -> do
+        expr_UnsafeFromRequiredInterfaceRequiredInterface <- encodeQualTypeConName ty1
+        expr_UnsafeFromRequiredInterfaceRequiringInterface <- encodeQualTypeConName ty2
+        expr_UnsafeFromRequiredInterfaceContractIdExpr <- encodeExpr cid
+        expr_UnsafeFromRequiredInterfaceInterfaceExpr <- encodeExpr val
+        pureExpr $ P.ExprSumUnsafeFromRequiredInterface P.Expr_UnsafeFromRequiredInterface{..}
    EInterfaceTemplateTypeRep ty val -> do
        expr_InterfaceTemplateTypeRepInterface <- encodeQualTypeConName ty
        expr_InterfaceTemplateTypeRepExpr <- encodeExpr val
--- a/compiler/daml-lf-tools/src/DA/Daml/LF/Simplifier.hs
+++ b/compiler/daml-lf-tools/src/DA/Daml/LF/Simplifier.hs
@ -208,9 +208,11 @@ safetyStep = \case
  EThrowF _ _ _ -> Unsafe
  EToInterfaceF _ _ s -> s <> Safe 0
  EFromInterfaceF _ _ s -> s <> Safe 0
+  EUnsafeFromInterfaceF _ _ _ _ -> Unsafe
  ECallInterfaceF _ _ _ -> Unsafe
  EToRequiredInterfaceF _ _ s -> s <> Safe 0
  EFromRequiredInterfaceF _ _ s -> s <> Safe 0
+  EUnsafeFromRequiredInterfaceF _ _ _ _ -> Unsafe
  EInterfaceTemplateTypeRepF _ s -> s <> Safe 0
  ESignatoryInterfaceF _ s -> s <> Safe 0
  EObserverInterfaceF _ s -> s <> Safe 0
--- a/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs
+++ b/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs
@ -748,6 +748,11 @@ typeOf' = \case
    checkImplements tpl iface
    checkExpr val (TCon iface)
    pure (TOptional (TCon tpl))
+  EUnsafeFromInterface iface tpl cid val -> do
+    checkImplements tpl iface
+    checkExpr cid (TContractId (TCon iface))
+    checkExpr val (TCon iface)
+    pure (TCon tpl)
  ECallInterface iface method val -> do
    method <- inWorld (lookupInterfaceMethod (iface, method))
    checkExpr val (TCon iface)
@ -764,6 +769,13 @@ typeOf' = \case
      throwWithContext (EWrongInterfaceRequirement requiringIface requiredIface)
    checkExpr expr (TCon requiredIface)
    pure (TOptional (TCon requiringIface))
+  EUnsafeFromRequiredInterface requiredIface requiringIface cid expr -> do
+    allRequiredIfaces <- intRequires <$> inWorld (lookupInterface requiringIface)
+    unless (S.member requiredIface allRequiredIfaces) $ do
+      throwWithContext (EWrongInterfaceRequirement requiringIface requiredIface)
+    checkExpr cid (TContractId (TCon requiredIface))
+    checkExpr expr (TCon requiredIface)
+    pure (TCon requiringIface)
  EInterfaceTemplateTypeRep iface expr -> do
    void $ inWorld (lookupInterface iface)
    checkExpr expr (TCon iface)
@ -787,8 +799,6 @@ typeOf' = \case
 checkExperimentalType :: MonadGamma m => T.Text -> Type -> m ()
 checkExperimentalType "ANSWER" (TUnit :-> TInt64) = pure ()
 checkExperimentalType "TYPEREP_TYCON_NAME" (TTypeRep :-> TOptional TText) = pure ()
-checkExperimentalType "THROW_WRONGLY_TYPED_CONTRACT"
-  (TContractId _ :-> TTypeRep :-> TTypeRep :-> _) = pure ()
 checkExperimentalType name ty =
  throwWithContext (EUnknownExperimental name ty)

--- a/compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion/Primitives.hs
+++ b/compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion/Primitives.hs
@ -396,6 +396,12 @@ convertPrim _ "EFromInterface" (TCon iface :-> TOptional (TCon tpid)) =
    ETmLam (mkVar "i", TCon iface) $
        EFromInterface iface tpid (EVar $ mkVar "i")

+convertPrim _ "EUnsafeFromInterface" (TContractId (TCon iface) :-> TCon iface1 :-> TCon tpid)
+    | iface == iface1
+        = ETmLam (mkVar "cid", TContractId (TCon iface))
+        $ ETmLam (mkVar "i", TCon iface)
+        $ EUnsafeFromInterface iface tpid (EVar $ mkVar "cid") (EVar $ mkVar "i")
+
 convertPrim _ "EToRequiredInterface" (TCon subIface :-> TCon superIface) =
    ETmLam (mkVar "i", TCon subIface) $
        EToRequiredInterface superIface subIface (EVar $ mkVar "i")
@ -404,6 +410,12 @@ convertPrim _ "EFromRequiredInterface" (TCon superIface :-> TOptional (TCon subI
    ETmLam (mkVar "i", TCon superIface) $
        EFromRequiredInterface superIface subIface (EVar $ mkVar "i")

+convertPrim _ "EUnsafeFromRequiredInterface" (TContractId (TCon superIface) :-> TCon superIface1 :-> TCon subIface)
+    | superIface == superIface1
+        = ETmLam (mkVar "cid", TContractId (TCon superIface))
+        $ ETmLam (mkVar "i", TCon superIface)
+        $ EUnsafeFromRequiredInterface superIface subIface (EVar $ mkVar "cid") (EVar $ mkVar "i")
+
 convertPrim (V1 PointDev) (L.stripPrefix "$" -> Just builtin) typ =
    EExperimental (T.pack builtin) typ

--- a/compiler/damlc/daml-stdlib-src/DA/Internal/Interface.daml
+++ b/compiler/damlc/daml-stdlib-src/DA/Internal/Interface.daml
@ -3,7 +3,6 @@

 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE CPP #-}

 -- | MOVE Prelude interface functionality
 module DA.Internal.Interface (
@ -24,10 +23,6 @@ import DA.Internal.Template.Functions
 import DA.Internal.LF
 import DA.Internal.Any

-#ifdef DAML_EXPERIMENTAL
-import qualified GHC.Types
-#endif
-
 -- | (1.dev only) Exposes the `interfaceTypeRep` function. Available only for interfaces.
 class HasInterfaceTypeRep i where
  -- | HIDE
@ -78,6 +73,11 @@ class HasFromInterface t i where
  -- the interface value `value` into the template type `MyTemplate`.
  fromInterface : i -> Optional t

+  -- | HIDE
+  -- Like 'fromInterface', but raises a fatal error (`WronglyTypedContract`) if the
+  -- underlying template type of the interface value doesn't match the desired type.
+  unsafeFromInterface : ContractId i -> i -> t
+
 -- | (1.dev only) Constraint that indicates that a template implements an interface.
 type Implements t i =
  ( HasInterfaceTypeRep i
@ -114,7 +114,7 @@ _exerciseDefault : HasExerciseGuarded t c r => ContractId t -> c -> Update r
 _exerciseDefault = exerciseGuarded (const True)

 -- | HIDE The guard used for UExerciseInterface, during interface
-- desugaring. This funciton converts a guard on type t into a
+-- desugaring. This function converts a guard on type t into a
 -- guard on the type i, raising a WronglyTypedContract error if
 -- there is a type mismatch. It has to work uniformly in these
 -- three cases:
@ -123,17 +123,10 @@ _exerciseDefault = exerciseGuarded (const True)
 --  2. when t is an interface type and i is an interface it requires
 --  3. when t and i are the same interface type
 --
-- It supports these three cases uniformly because `fromInterface`
+-- It supports these three cases uniformly because `unsafeFromInterface`
 -- handles each of them separately.
 _exerciseInterfaceGuard : forall i t.
  (HasFromInterface t i, HasInterfaceTypeRep i, HasTemplateTypeRep t) =>
  ContractId t -> (t -> Bool) -> i -> Bool
 _exerciseInterfaceGuard cid tpred ivalue =
-  case fromInterface @t ivalue of
-    Some tvalue -> tpred tvalue
-  #ifdef DAML_EXPERIMENTAL
-    None -> GHC.Types.primitive @"$THROW_WRONGLY_TYPED_CONTRACT" cid
-      (_templateTypeRep cid) (_interfaceTypeRep ivalue)
-  #else
-    None -> False
-  #endif
+  tpred (unsafeFromInterface (coerceContractId cid) ivalue)
--- a/compiler/damlc/tests/daml-test-files/InterfaceDesugared.daml
+++ b/compiler/damlc/tests/daml-test-files/InterfaceDesugared.daml
@ -22,6 +22,7 @@ instance DA.Internal.Desugar.HasToInterface Token Token where
  _toInterface this = this
 instance DA.Internal.Desugar.HasFromInterface Token Token where
  fromInterface this = Some this
+  unsafeFromInterface _ this = this
 instance DA.Internal.Desugar.HasFetch Token where
  fetch = GHC.Types.primitive @"UFetchInterface"
 instance DA.Internal.Desugar.HasMethod Token "noopImpl" (()
@ -330,6 +331,7 @@ instance DA.Internal.Desugar.HasToInterface Asset Token where
  _toInterface = GHC.Types.primitive @"EToInterface"
 instance DA.Internal.Desugar.HasFromInterface Asset Token where
  fromInterface = GHC.Types.primitive @"EFromInterface"
+  unsafeFromInterface = GHC.Types.primitive @"EUnsafeFromInterface"
 _method_Asset_Token_getOwner
  = DA.Internal.Desugar.mkMethod
      @Asset
--- a/compiler/damlc/tests/daml-test-files/InterfaceGuarded.daml
+++ b/compiler/damlc/tests/daml-test-files/InterfaceGuarded.daml
@ -22,6 +22,8 @@ interface Token where
        assert (byHowMuch > 0)
        create $ setAmount this (getAmount this + byHowMuch)

+interface SubToken requires Token
+
 template Asset
  with
    issuer : Party
@ -35,6 +37,18 @@ template Asset
      getAmount = amount
      setAmount x = toInterface @Token (this with amount = x)

+template AnotherAsset
+  with
+    owner: Party
+    amount: Int
+  where
+    signatory owner
+    implements Token where
+      getOwner = owner
+      getAmount = amount
+      setAmount x = toInterface @Token (this with amount = x)
+    implements SubToken
+
 exception GuardException
    with
        m : Text
@ -88,6 +102,16 @@ main = scenario do
      GuardException {} ->
        pure $ toInterfaceContractId @Token asset

+  p `submitMustFail` do
+    -- Fail if predicate doesn't match underlying template type
+    anotherAsset <- coerceContractId @_ @AnotherAsset <$> create assetTpl
+    exerciseGuarded (const True) anotherAsset getRich
+
+  p `submitMustFail` do
+    -- Fail if predicate doesn't match underlying template's interfaces
+    subToken <- coerceContractId @_ @SubToken <$> create assetTpl
+    exerciseGuarded (const True) subToken getRich
+
  pure ()

 -- @ENABLE-SCENARIOS
--- a/compiler/damlc/tests/daml-test-files/MkMethodTypeError.daml
+++ b/compiler/damlc/tests/daml-test-files/MkMethodTypeError.daml
@ -11,7 +11,10 @@ data T = T

 instance HasInterfaceTypeRep T where _interfaceTypeRep = undefined
 instance HasToInterface T T where _toInterface x = x
-instance HasFromInterface T T where fromInterface = Some
+instance HasFromInterface T T where
+    fromInterface = Some
+    unsafeFromInterface _ this = this
+
 instance DA.Internal.Desugar.HasMethod T "foo" T where

 main : Int
--- a/daml-lf/archive/src/main/protobuf/com/daml/daml_lf_dev/daml_lf_1.proto
+++ b/daml-lf/archive/src/main/protobuf/com/daml/daml_lf_dev/daml_lf_1.proto
@ -927,6 +927,15 @@ message Expr {
    Expr interface_expr = 3;
  }

+  // Convert an interface back to a template payload, or raises WronglyTypedContract if not possible.
+  // *Available in versions >= 1.dev*
+  message UnsafeFromInterface {
+    TypeConName interface_type = 1;
+    TypeConName template_type = 2;
+    Expr contract_id_expr = 3;
+    Expr interface_expr = 4;
+  }
+
  // Upcast from an interface payload to an interface it requires.
  // *Available in versions >= 1.dev*
  message ToRequiredInterface {
@ -943,6 +952,15 @@ message Expr {
    Expr expr = 3;
  }

+  // Downcast from an interface payload to an interface that requires it, or raises WronglyTypedContract if not possible.
+  // *Available in versions >= 1.dev*
+  message UnsafeFromRequiredInterface {
+    TypeConName required_interface = 1;
+    TypeConName requiring_interface = 2;
+    Expr contract_id_expr = 3;
+    Expr interface_expr = 4;
+  }
+
  // Invoke an interface method.
  // *Available in versions >= 1.dev*
  message CallInterface {
@ -1112,6 +1130,11 @@ message Expr {
    SignatoryInterface signatory_interface = 42;
    ObserverInterface observer_interface = 43;

+    // Unsafe conversion to/from interface payloads.
+    UnsafeFromInterface unsafe_from_interface = 44;
+    // Unsafe downcast interface payloads.
+    UnsafeFromRequiredInterface unsafe_from_required_interface = 45;
+
    Experimental experimental = 9999; // *Available only in 1.dev*
  }

--- a/daml-lf/archive/src/main/scala/com/digitalasset/daml/lf/archive/DecodeV1.scala
+++ b/daml-lf/archive/src/main/scala/com/digitalasset/daml/lf/archive/DecodeV1.scala
@ -1132,6 +1132,16 @@ private[archive] class DecodeV1(minor: LV.Minor) {
            value = decodeExpr(fromInterface.getInterfaceExpr, definition),
          )

+        case PLF.Expr.SumCase.UNSAFE_FROM_INTERFACE =>
+          assertSince(LV.Features.interfaces, "Expr.unsafe_from_interface")
+          val unsafeFromInterface = lfExpr.getUnsafeFromInterface
+          EUnsafeFromInterface(
+            interfaceId = decodeTypeConName(unsafeFromInterface.getInterfaceType),
+            templateId = decodeTypeConName(unsafeFromInterface.getTemplateType),
+            contractIdExpr = decodeExpr(unsafeFromInterface.getContractIdExpr, definition),
+            ifaceExpr = decodeExpr(unsafeFromInterface.getInterfaceExpr, definition),
+          )
+
        case PLF.Expr.SumCase.CALL_INTERFACE =>
          assertSince(LV.Features.interfaces, "Expr.call_interface")
          val callInterface = lfExpr.getCallInterface
@ -1160,6 +1170,16 @@ private[archive] class DecodeV1(minor: LV.Minor) {
            body = decodeExpr(fromRequiredInterface.getExpr, definition),
          )

+        case PLF.Expr.SumCase.UNSAFE_FROM_REQUIRED_INTERFACE =>
+          assertSince(LV.Features.interfaces, "Expr.from_required_interface")
+          val unsafeFromRequiredInterface = lfExpr.getUnsafeFromRequiredInterface
+          EUnsafeFromRequiredInterface(
+            requiredIfaceId = decodeTypeConName(unsafeFromRequiredInterface.getRequiredInterface),
+            requiringIfaceId = decodeTypeConName(unsafeFromRequiredInterface.getRequiringInterface),
+            contractIdExpr = decodeExpr(unsafeFromRequiredInterface.getContractIdExpr, definition),
+            ifaceExpr = decodeExpr(unsafeFromRequiredInterface.getInterfaceExpr, definition),
+          )
+
        case PLF.Expr.SumCase.INTERFACE_TEMPLATE_TYPE_REP =>
          assertSince(LV.Features.interfaces, "Expr.interface_template_type_rep")
          val interfaceTemplateTypeRep = lfExpr.getInterfaceTemplateTypeRep
--- a/daml-lf/encoder/src/main/scala/com/digitalasset/daml/lf/archive/testing/EncodeV1.scala
+++ b/daml-lf/encoder/src/main/scala/com/digitalasset/daml/lf/archive/testing/EncodeV1.scala
@ -676,6 +676,44 @@ private[daml] class EncodeV1(minor: LV.Minor) {
              .setTemplateType(tpl)
              .setInterfaceExpr(value)
          )
+        case EUnsafeFromInterface(iface, tpl, cid, value) =>
+          assertSince(LV.Features.interfaces, "Expr.UnsafeFromInterface")
+          builder.setUnsafeFromInterface(
+            PLF.Expr.UnsafeFromInterface
+              .newBuilder()
+              .setInterfaceType(iface)
+              .setTemplateType(tpl)
+              .setContractIdExpr(cid)
+              .setInterfaceExpr(value)
+          )
+        case EToRequiredInterface(superIface, iface, value) =>
+          assertSince(LV.Features.interfaces, "Expr.ToRequiredInterface")
+          builder.setToRequiredInterface(
+            PLF.Expr.ToRequiredInterface
+              .newBuilder()
+              .setRequiredInterface(superIface)
+              .setRequiringInterface(iface)
+              .setExpr(value)
+          )
+        case EFromRequiredInterface(superIface, iface, value) =>
+          assertSince(LV.Features.interfaces, "Expr.FromRequiredInterface")
+          builder.setFromRequiredInterface(
+            PLF.Expr.FromRequiredInterface
+              .newBuilder()
+              .setRequiredInterface(superIface)
+              .setRequiringInterface(iface)
+              .setExpr(value)
+          )
+        case EUnsafeFromRequiredInterface(superIface, iface, cid, value) =>
+          assertSince(LV.Features.interfaces, "Expr.UnsafeFromRequiredInterface")
+          builder.setUnsafeFromRequiredInterface(
+            PLF.Expr.UnsafeFromRequiredInterface
+              .newBuilder()
+              .setRequiredInterface(superIface)
+              .setRequiringInterface(iface)
+              .setContractIdExpr(cid)
+              .setInterfaceExpr(value)
+          )
        case EExperimental(name, ty) =>
          assertSince(LV.v1_dev, "Expr.experimental")
          builder.setExperimental(PLF.Expr.Experimental.newBuilder().setName(name).setType(ty))
--- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/PhaseOne.scala
+++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/PhaseOne.scala
@ -333,6 +333,12 @@ private[lf] final class PhaseOne(
        compileExp(env, exp) { exp =>
          Return(SBFromInterface(tpl)(exp))
        }
+      case EUnsafeFromInterface(iface @ _, tpl, cidExp, ifaceExp) =>
+        compileExp(env, cidExp) { cidExp =>
+          compileExp(env, ifaceExp) { ifaceExp =>
+            Return(SBUnsafeFromInterface(tpl)(cidExp, ifaceExp))
+          }
+        }
      case ECallInterface(iface, methodName, exp) =>
        compileExp(env, exp) { exp =>
          Return(SBCallInterface(iface, methodName)(exp))
@ -343,6 +349,12 @@ private[lf] final class PhaseOne(
        compileExp(env, exp) { exp =>
          Return(SBFromRequiredInterface(requiringIfaceId)(exp))
        }
+      case EUnsafeFromRequiredInterface(requiredIfaceId @ _, requiringIfaceId, cidExp, ifaceExp) =>
+        compileExp(env, cidExp) { cidExp =>
+          compileExp(env, ifaceExp) { ifaceExp =>
+            Return(SBUnsafeFromRequiredInterface(requiringIfaceId)(cidExp, ifaceExp))
+          }
+        }
      case EInterfaceTemplateTypeRep(ifaceId, exp) =>
        compileExp(env, exp) { exp =>
          Return(SBInterfaceTemplateTypeRep(ifaceId)(exp))
--- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SBuiltin.scala
+++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SBuiltin.scala
@ -1098,29 +1098,6 @@ private[lf] object SBuiltin {
    }
  }

-  final case object SBThrowWronglyTypedContract extends SBuiltinPure(3) {
-    override private[speedy] def executePure(args: util.ArrayList[SValue]): SValue = {
-      val contractId = getSContractId(args, 0)
-      val expectedTemplateId = getSTypeRep(args, 1) match {
-        case Ast.TTyCon(templateId) => templateId
-        case _ =>
-          throw SErrorDamlException(
-            IE.UserError("unexpected typerep when throwing WronglyTypedContract error")
-          )
-      }
-      val actualTemplateId = getSTypeRep(args, 2) match {
-        case Ast.TTyCon(templateId) => templateId
-        case _ =>
-          throw SErrorDamlException(
-            IE.UserError("unexpected typerep when throwing WronglyTypedContract error")
-          )
-      }
-      throw SErrorDamlException(
-        IE.WronglyTypedContract(contractId, expectedTemplateId, actualTemplateId)
-      )
-    }
-  }
-
  final case class SBApplyChoiceGuard(
      choiceName: ChoiceName,
      byInterface: Option[TypeConName],
@ -1217,6 +1194,23 @@ private[lf] object SBuiltin {
    }
  }

+  // Convert an interface to a given template type if possible. Since interfaces are represented
+  // by an SAny wrapping the underlying template, we need to check that the SAny type constructor
+  // matches the template type, and then return the SAny internal value.
+  final case class SBUnsafeFromInterface(
+      tplId: TypeConName
+  ) extends SBuiltinPure(2) {
+    override private[speedy] def executePure(args: util.ArrayList[SValue]): SRecord = {
+      val coid = getSContractId(args, 0)
+      val (tyCon, record) = getSAnyContract(args, 1)
+      if (tplId == tyCon) {
+        record
+      } else {
+        throw SErrorDamlException(IE.WronglyTypedContract(coid, tplId, tyCon))
+      }
+    }
+  }
+
  // Convert an interface `requiredIface` to another interface `requiringIface`, if
  // the `requiringIface` implements `requiredIface`.
  final case class SBFromRequiredInterface(
@ -1240,6 +1234,30 @@ private[lf] object SBuiltin {
    }
  }

+  // Convert an interface `requiredIface` to another interface `requiringIface`, if
+  // the `requiringIface` implements `requiredIface`.
+  final case class SBUnsafeFromRequiredInterface(
+      requiringIface: TypeConName
+  ) extends SBuiltin(2) {
+
+    override private[speedy] def execute(
+        args: util.ArrayList[SValue],
+        machine: Machine,
+    ) = {
+      val coid = getSContractId(args, 0)
+      val (tyCon, record) = getSAnyContract(args, 1)
+      // TODO https://github.com/digital-asset/daml/issues/12051
+      // TODO https://github.com/digital-asset/daml/issues/11345
+      //  The lookup is probably slow. We may want to investigate way to make the feature faster.
+      machine.returnValue = machine.compiledPackages.interface.lookupTemplate(tyCon) match {
+        case Right(ifaceSignature) if ifaceSignature.implements.contains(requiringIface) =>
+          SAnyContract(tyCon, record)
+        case _ =>
+          throw SErrorDamlException(IE.WronglyTypedContract(coid, requiringIface, tyCon))
+      }
+    }
+  }
+
  final case class SBCallInterface(
      ifaceId: TypeConName,
      methodName: MethodName,
@ -1851,7 +1869,6 @@ private[lf] object SBuiltin {
      List(
        "ANSWER" -> SBExperimentalAnswer,
        "TYPEREP_TYCON_NAME" -> SBExperimentalTypeRepTyConName,
-        "THROW_WRONGLY_TYPED_CONTRACT" -> SBThrowWronglyTypedContract,
      ).view.map { case (name, builtin) => name -> compileTime.SEBuiltin(builtin) }.toMap

    def apply(name: String): compileTime.SExpr =
--- a/daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/Ast.scala
+++ b/daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/Ast.scala
@ -158,6 +158,16 @@ object Ast {
  final case class EFromInterface(interfaceId: TypeConName, templateId: TypeConName, value: Expr)
      extends Expr

+  /** Convert interface back to template payload,
+    * or raise a WronglyTypedContracg error if not possible
+    */
+  final case class EUnsafeFromInterface(
+      interfaceId: TypeConName,
+      templateId: TypeConName,
+      contractIdExpr: Expr,
+      ifaceExpr: Expr,
+  ) extends Expr
+
  /** Upcast from an interface payload to an interface it requires. */
  final case class EToRequiredInterface(
      requiredIfaceId: TypeConName,
@ -172,6 +182,16 @@ object Ast {
      body: Expr,
  ) extends Expr

+  /** Downcast from an interface payload to an interface that requires it,
+    * or raise a WronglyTypedContract error if not possible.
+    */
+  final case class EUnsafeFromRequiredInterface(
+      requiredIfaceId: TypeConName,
+      requiringIfaceId: TypeConName,
+      contractIdExpr: Expr,
+      ifaceExpr: Expr,
+  ) extends Expr
+
  /** Invoke an interface method */
  final case class ECallInterface(interfaceId: TypeConName, methodName: MethodName, value: Expr)
      extends Expr
--- a/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/AstRewriter.scala
+++ b/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/AstRewriter.scala
@ -129,12 +129,21 @@ private[daml] class AstRewriter(
          EToInterface(apply(iface), apply(tpl), apply(value))
        case EFromInterface(iface, tpl, value) =>
          EFromInterface(apply(iface), apply(tpl), apply(value))
+        case EUnsafeFromInterface(iface, tpl, cid, value) =>
+          EUnsafeFromInterface(apply(iface), apply(tpl), apply(cid), apply(value))
        case ECallInterface(iface, method, value) =>
          ECallInterface(apply(iface), method, apply(value))
        case EToRequiredInterface(requiredIfaceId, requiringIfaceId, body) =>
          EToRequiredInterface(apply(requiredIfaceId), apply(requiringIfaceId), apply(body))
        case EFromRequiredInterface(requiredIfaceId, requiringIfaceId, body) =>
          EFromRequiredInterface(apply(requiredIfaceId), apply(requiringIfaceId), apply(body))
+        case EUnsafeFromRequiredInterface(requiredIfaceId, requiringIfaceId, cid, body) =>
+          EUnsafeFromRequiredInterface(
+            apply(requiredIfaceId),
+            apply(requiringIfaceId),
+            apply(cid),
+            apply(body),
+          )
        case EInterfaceTemplateTypeRep(ifaceId, body) =>
          EInterfaceTemplateTypeRep(apply(ifaceId), apply(body))
        case ESignatoryInterface(ifaceId, body) =>
--- a/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/ExprParser.scala
+++ b/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/ExprParser.scala
@ -43,10 +43,12 @@ private[parser] class ExprParser[P](parserParameters: ParserParameters[P]) {
      eToTextTypeConName |
      eThrow |
      eCallInterface |
-      eToRequiredInterface |
      eToInterface |
-      eFromRequiredInterface |
      eFromInterface |
+      eUnsafeFromInterface |
+      eToRequiredInterface |
+      eFromRequiredInterface |
+      eUnsafeFromRequiredInterface |
      eInterfaceTemplateTypeRep |
      eSignatoryInterface |
      eObserverInterface |
@ -233,6 +235,12 @@ private[parser] class ExprParser[P](parserParameters: ParserParameters[P]) {
        EFromInterface(ifaceId, tmplId, e)
    }

+  private lazy val eUnsafeFromInterface: Parser[Expr] =
+    `unsafe_from_interface` ~! `@` ~> fullIdentifier ~ `@` ~ fullIdentifier ~ expr0 ~ expr0 ^^ {
+      case ifaceId ~ _ ~ tmplId ~ cid ~ expr =>
+        EUnsafeFromInterface(ifaceId, tmplId, cid, expr)
+    }
+
  private lazy val eToRequiredInterface: Parser[Expr] =
    `to_required_interface` ~! `@` ~> fullIdentifier ~ `@` ~ fullIdentifier ~ expr0 ^^ {
      case ifaceId1 ~ _ ~ ifaceId2 ~ e =>
@ -245,6 +253,12 @@ private[parser] class ExprParser[P](parserParameters: ParserParameters[P]) {
        EFromRequiredInterface(ifaceId1, ifaceId2, e)
    }

+  private lazy val eUnsafeFromRequiredInterface: Parser[Expr] =
+    `unsafe_from_required_interface` ~! `@` ~> fullIdentifier ~ `@` ~ fullIdentifier ~ expr0 ~ expr0 ^^ {
+      case ifaceId1 ~ _ ~ ifaceId2 ~ cid ~ expr =>
+        EUnsafeFromRequiredInterface(ifaceId1, ifaceId2, cid, expr)
+    }
+
  private lazy val eInterfaceTemplateTypeRep: Parser[Expr] =
    `interface_template_type_rep` ~! `@` ~> fullIdentifier ~ expr0 ^^ { case ifaceId ~ e =>
      EInterfaceTemplateTypeRep(ifaceId, e)
--- a/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/Lexer.scala
+++ b/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/Lexer.scala
@ -47,6 +47,8 @@ private[parser] object Lexer extends RegexParsers {
    "to_required_interface" -> `to_required_interface`,
    "from_interface" -> `from_interface`,
    "from_required_interface" -> `from_required_interface`,
+    "unsafe_from_interface" -> `unsafe_from_interface`,
+    "unsafe_from_required_interface" -> `unsafe_from_required_interface`,
    "call_method" -> `call_method`,
    "interface_template_type_rep" -> `interface_template_type_rep`,
    "signatory_interface" -> `signatory_interface`,
--- a/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/Token.scala
+++ b/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/Token.scala
@ -53,8 +53,10 @@ private[parser] object Token {
  case object `catch` extends Token
  case object `to_interface` extends Token
  case object `from_interface` extends Token
+  case object `unsafe_from_interface` extends Token
  case object `to_required_interface` extends Token
  case object `from_required_interface` extends Token
+  case object `unsafe_from_required_interface` extends Token
  case object `call_method` extends Token
  case object `interface_template_type_rep` extends Token
  case object `signatory_interface` extends Token
--- a/daml-lf/tests/scenario/stable/many-fields/EXPECTED.ledger
+++ b/daml-lf/tests/scenario/stable/many-fields/EXPECTED.ledger
@ -3,7 +3,7 @@ TX #0 1970-01-01T00:00:00Z [Test:42] version: 14
 #0:0 version: 14
 │   known to (since): Alice (#0)
 └─> create Test:BigTemplate@XXXXXXXX
-    with: { p = 'Alice', x000 = 0, x001 = 1, x002 = 2, x003 = 3, x004 = 4, x005 = 5, x006 = 6, x007 = 7, x008 = 8, x009 = 9, x010 = 10, x011 = 11, x012 = 12, x013 = 13, x014 = 14, x015 = 15, x016 = 16, x017 = 17, x018 = 18, x019 = 19, x020 = 20, x021 = 21, x022 = 22, x023 = 23, x024 = 24, x025 = 25, x026 = 26, x027 = 27, x028 = 28, x029 = 29, x030 = 30, x031 = 31, x032 = 32, x033 = 33, x034 = 34, x035 = 35, x036 = 36, x037 = 37, x038 = 38, x039 = 39, x040 = 40, x041 = 41, x042 = 42, x043 = 43, x044 = 44, x045 = 45, x046 = 46, x047 = 47, x048 = 48, x049 = 49, x050 = 50, x051 = 51, x052 = 52, x053 = 53, x054 = 54, x055 = 55, x056 = 56, x057 = 57, x058 = 58, x059 = 59, x060 = 60, x061 = 61, x062 = 62, x063 = 63, x064 = 64, x065 = 65, x066 = 66, x067 = 67, x068 = 68, x069 = 69, x070 = 70, x071 = 71, x072 = 72, x073 = 73, x074 = 74, x075 = 75, x076 = 76, x077 = 77, x078 = 78, x079 = 79, x080 = 80, x081 = 81, x082 = 82, x083 = 83, x084 = 84, x085 = 85, x086 = 86, x087 = 87, x088 = 88, x089 = 89, x090 = 90, x091 = 91, x092 = 92, x093 = 93, x094 = 94, x095 = 95, x096 = 96, x097 = 97, x098 = 98, x099 = 99, x100 = 100, x101 = 101, x102 = 102, x103 = 103, x104 = 104, x105 = 105, x106 = 106, x107 = 107, x108 = 108, x109 = 109, x110 = 110, x111 = 111, x112 = 112, x113 = 113, x114 = 114, x115 = 115, x116 = 116, x117 = 117, x118 = 118, x119 = 119, x120 = 120, x121 = 121, x122 = 122, x123 = 123, x124 = 124 }
+    with: { p = 'Alice', x000 = 0, x001 = 1, x002 = 2, x003 = 3, x004 = 4, x005 = 5, x006 = 6, x007 = 7, x008 = 8, x009 = 9, x010 = 10, x011 = 11, x012 = 12, x013 = 13, x014 = 14, x015 = 15, x016 = 16, x017 = 17, x018 = 18, x019 = 19, x020 = 20, x021 = 21, x022 = 22, x023 = 23, x024 = 24, x025 = 25, x026 = 26, x027 = 27, x028 = 28, x029 = 29, x030 = 30, x031 = 31, x032 = 32, x033 = 33, x034 = 34, x035 = 35, x036 = 36, x037 = 37, x038 = 38, x039 = 39, x040 = 40, x041 = 41, x042 = 42, x043 = 43, x044 = 44, x045 = 45, x046 = 46, x047 = 47, x048 = 48, x049 = 49, x050 = 50, x051 = 51, x052 = 52, x053 = 53, x054 = 54, x055 = 55, x056 = 56, x057 = 57, x058 = 58, x059 = 59, x060 = 60, x061 = 61, x062 = 62, x063 = 63, x064 = 64, x065 = 65, x066 = 66, x067 = 67, x068 = 68, x069 = 69, x070 = 70, x071 = 71, x072 = 72, x073 = 73, x074 = 74, x075 = 75, x076 = 76, x077 = 77, x078 = 78, x079 = 79, x080 = 80, x081 = 81, x082 = 82, x083 = 83, x084 = 84, x085 = 85, x086 = 86, x087 = 87, x088 = 88, x089 = 89, x090 = 90, x091 = 91, x092 = 92, x093 = 93, x094 = 94, x095 = 95, x096 = 96, x097 = 97, x098 = 98, x099 = 99, x100 = 100, x101 = 101, x102 = 102, x103 = 103, x104 = 104, x105 = 105, x106 = 106, x107 = 107, x108 = 108, x109 = 109, x110 = 110, x111 = 111, x112 = 112, x113 = 113, x114 = 114, x115 = 115, x116 = 116, x117 = 117, x118 = 118, x119 = 119 }

 active contracts:
   00fc4114f9e0408a3b8587e01e9bc7daaceffd8f1a42e7e17f0ccbd44d5427b8c5
--- a/daml-lf/tests/scenario/stable/many-fields/Test.daml
+++ b/daml-lf/tests/scenario/stable/many-fields/Test.daml
@ -26,7 +26,7 @@ template BigTemplate
    x090: Int, x091: Int, x092: Int, x093: Int, x094: Int, x095: Int, x096: Int, x097: Int, x098: Int, x099: Int
    x100: Int, x101: Int, x102: Int, x103: Int, x104: Int, x105: Int, x106: Int, x107: Int, x108: Int, x109: Int
    x110: Int, x111: Int, x112: Int, x113: Int, x114: Int, x115: Int, x116: Int, x117: Int, x118: Int, x119: Int
-    x120: Int, x121: Int, x122: Int, x123: Int, x124: Int--, x125: Int, x126: Int, x127: Int, x128: Int, x129: Int
+--    x120: Int, x121: Int, x122: Int, x123: Int, x124: Int, x125: Int, x126: Int, x127: Int, x128: Int, x129: Int
 --    x130: Int, x131: Int, x132: Int, x133: Int, x134: Int, x135: Int, x136: Int, x137: Int, x138: Int, x139: Int
 --    x140: Int, x141: Int, x142: Int, x143: Int, x144: Int, x145: Int, x146: Int, x147: Int, x148: Int, x149: Int
 --    x150: Int, x151: Int, x152: Int, x153: Int, x154: Int, x155: Int, x156: Int, x157: Int, x158: Int, x159: Int
@ -54,7 +54,7 @@ run = do
                      090 091 092 093 094 095 096 097 098 099
                      100 101 102 103 104 105 106 107 108 109
                      110 111 112 113 114 115 116 117 118 119
-                      120 121 122 123 124-- 125 126 127 128 129
+--                      120 121 122 123 124 125 126 127 128 129
 --                      130 131 132 133 134 135 136 137 138 139
 --                      140 141 142 143 144 145 146 147 148 149
 --                      150 151 152 153 154 155 156 157 158 159
--- a/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Typing.scala
+++ b/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Typing.scala
@ -1163,6 +1163,11 @@ private[validation] object Typing {
        checkImplements(tpl, iface)
        checkExpr(value, TTyCon(iface))
        TOptional(TTyCon(tpl))
+      case EUnsafeFromInterface(iface, tpl, cid, value) =>
+        checkImplements(tpl, iface)
+        checkExpr(cid, TContractId(TTyCon(iface)))
+        checkExpr(value, TTyCon(iface))
+        TTyCon(tpl)
      case EToRequiredInterface(requiredIfaceId, requiringIfaceId, body) =>
        val requiringIface = handleLookup(ctx, interface.lookupInterface(requiringIfaceId))
        if (!requiringIface.requires.contains(requiredIfaceId))
@ -1175,6 +1180,13 @@ private[validation] object Typing {
          throw EWrongInterfaceRequirement(ctx, requiringIfaceId, requiredIfaceId)
        checkExpr(body, TTyCon(requiredIfaceId))
        TOptional(TTyCon(requiringIfaceId))
+      case EUnsafeFromRequiredInterface(requiredIfaceId, requiringIfaceId, cid, body) =>
+        val requiringIface = handleLookup(ctx, interface.lookupInterface(requiringIfaceId))
+        if (!requiringIface.requires.contains(requiredIfaceId))
+          throw EWrongInterfaceRequirement(ctx, requiringIfaceId, requiredIfaceId)
+        checkExpr(cid, TContractId(TTyCon(requiredIfaceId)))
+        checkExpr(body, TTyCon(requiredIfaceId))
+        TTyCon(requiringIfaceId)
      case ECallInterface(iface, methodName, value) =>
        val method = handleLookup(ctx, interface.lookupInterfaceMethod(iface, methodName))
        checkExpr(value, TTyCon(iface))
--- a/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/iterable/ExprIterable.scala
+++ b/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/iterable/ExprIterable.scala
@ -68,12 +68,16 @@ private[validation] object ExprIterable {
        Iterator(value)
      case EFromInterface(iface @ _, tpl @ _, value) =>
        Iterator(value)
+      case EUnsafeFromInterface(iface @ _, tpl @ _, cid, value) =>
+        Iterator(cid, value)
      case ECallInterface(iface @ _, method @ _, value) =>
        Iterator(value)
      case EToRequiredInterface(requiredIface @ _, requiringIface @ _, body) =>
        iterator(body)
      case EFromRequiredInterface(requiredIface @ _, requiringIface @ _, body) =>
        iterator(body)
+      case EUnsafeFromRequiredInterface(requiredIface @ _, requiringIface @ _, cid, body) =>
+        Iterator(cid, body)
      case EInterfaceTemplateTypeRep(iface @ _, body) =>
        iterator(body)
      case ESignatoryInterface(iface @ _, body) =>
--- a/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/iterable/TypeIterable.scala
+++ b/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/iterable/TypeIterable.scala
@ -82,12 +82,17 @@ private[validation] object TypeIterable {
        Iterator(TTyCon(iface), TTyCon(tpl)) ++ iterator(value)
      case EFromInterface(iface, tpl, value) =>
        Iterator(TTyCon(iface), TTyCon(tpl)) ++ iterator(value)
+      case EUnsafeFromInterface(iface, tpl, cid, value) =>
+        Iterator(TTyCon(iface), TTyCon(tpl)) ++ iterator(cid) ++ iterator(value)
      case ECallInterface(iface, _, value) =>
        Iterator(TTyCon(iface)) ++ iterator(value)
      case EToRequiredInterface(requiredIfaceId, requiringIfaceId, body) =>
        Iterator(TTyCon(requiredIfaceId), TTyCon(requiringIfaceId)) ++ iterator(body)
      case EFromRequiredInterface(requiredIfaceId, requiringIfaceId, body) =>
        Iterator(TTyCon(requiredIfaceId), TTyCon(requiringIfaceId)) ++ iterator(body)
+      case EUnsafeFromRequiredInterface(requiredIfaceId, requiringIfaceId, cid, body) =>
+        Iterator(TTyCon(requiredIfaceId), TTyCon(requiringIfaceId)) ++
+          iterator(cid) ++ iterator(body)
      case EInterfaceTemplateTypeRep(ifaceId @ _, body) =>
        Iterator(TTyCon(ifaceId)) ++ iterator(body)
      case ESignatoryInterface(ifaceId, body) =>