[Builtins] Make 'BuiltinFailure' the last constructor

IntersectMBO · Apr 8, 2024 · b1ee0ff · b1ee0ff
1 parent 1911032
commit b1ee0ff
Show file tree

Hide file tree

Showing 6 changed files with 22 additions and 22 deletions.
diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/KnownType.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/KnownType.hs
@@ -328,9 +328,9 @@ type ReadKnown val = ReadKnownIn (UniOf val) val
 -- | Same as 'makeKnown', but allows for neither emitting nor storing the cause of a failure.
 makeKnownOrFail :: MakeKnownIn uni val a => a -> EvaluationResult val
 makeKnownOrFail x = case makeKnown x of
-    BuiltinFailure _ _           -> EvaluationFailure
     BuiltinSuccess val           -> EvaluationSuccess val
     BuiltinSuccessWithLogs _ val -> EvaluationSuccess val
+    BuiltinFailure _ _           -> EvaluationFailure
 {-# INLINE makeKnownOrFail #-}
 
 -- | Same as 'readKnown', but the cause of a potential failure is the provided term itself.

diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs
@@ -58,9 +58,9 @@ data BuiltinError
 -- logging, since there's no logging on the chain and builtins don't emit much anyway. Otherwise
 -- we'd have to use @text-builder@ or @text-builder-linear@ or something of this sort.
 data BuiltinResult a
-    = BuiltinFailure (DList Text) BuiltinError
-    | BuiltinSuccess a
+    = BuiltinSuccess a
     | BuiltinSuccessWithLogs (DList Text) a
+    | BuiltinFailure (DList Text) BuiltinError
     deriving stock (Show, Foldable)
 
 mtraverse makeClassyPrisms
@@ -113,43 +113,43 @@ throwNotAConstant = throwError $ BuiltinUnliftingError "Not a constant"
 -- | Prepend logs to a 'BuiltinResult' computation.
 withLogs :: DList Text -> BuiltinResult a -> BuiltinResult a
 withLogs logs1 = \case
-    BuiltinFailure logs2 err       -> BuiltinFailure (logs1 <> logs2) err
     BuiltinSuccess x               -> BuiltinSuccessWithLogs logs1 x
     BuiltinSuccessWithLogs logs2 x -> BuiltinSuccessWithLogs (logs1 <> logs2) x
+    BuiltinFailure logs2 err       -> BuiltinFailure (logs1 <> logs2) err
 {-# INLINE withLogs #-}
 
 instance Functor BuiltinResult where
-    fmap _ (BuiltinFailure logs err)       = BuiltinFailure logs err
     fmap f (BuiltinSuccess x)              = BuiltinSuccess (f x)
     fmap f (BuiltinSuccessWithLogs logs x) = BuiltinSuccessWithLogs logs (f x)
+    fmap _ (BuiltinFailure logs err)       = BuiltinFailure logs err
     {-# INLINE fmap #-}
 
     -- Written out explicitly just in case.
-    _ <$ BuiltinFailure logs err       = BuiltinFailure logs err
     x <$ BuiltinSuccess _              = BuiltinSuccess x
     x <$ BuiltinSuccessWithLogs logs _ = BuiltinSuccessWithLogs logs x
+    _ <$ BuiltinFailure logs err       = BuiltinFailure logs err
     {-# INLINE (<$) #-}
 
 instance Applicative BuiltinResult where
     pure = BuiltinSuccess
     {-# INLINE pure #-}
 
-    BuiltinFailure logs err       <*> _ = BuiltinFailure logs err
     BuiltinSuccess f              <*> a = fmap f a
     BuiltinSuccessWithLogs logs f <*> a = withLogs logs $ fmap f a
+    BuiltinFailure logs err       <*> _ = BuiltinFailure logs err
     {-# INLINE (<*>) #-}
 
     -- Better than the default implementation, because the value in the 'BuiltinSuccess' case
     -- doesn't need to be retained.
-    BuiltinFailure logs err       *> _ = BuiltinFailure logs err
     BuiltinSuccess _              *> b = b
     BuiltinSuccessWithLogs logs _ *> b = withLogs logs b
+    BuiltinFailure logs err       *> _ = BuiltinFailure logs err
     {-# INLINE (*>) #-}
 
 instance Monad BuiltinResult where
-    BuiltinFailure logs err       >>= _ = BuiltinFailure logs err
     BuiltinSuccess x              >>= f = f x
     BuiltinSuccessWithLogs logs x >>= f = withLogs logs $ f x
+    BuiltinFailure logs err       >>= _ = BuiltinFailure logs err
     {-# INLINE (>>=) #-}
 
     (>>) = (*>)

diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs
@@ -75,9 +75,9 @@ evalBuiltinApp
     -> CkM uni fun s (CkValue uni fun)
 evalBuiltinApp term runtime = case runtime of
     BuiltinCostedResult _ getX -> case getX of
-        BuiltinFailure logs err       -> emitCkM logs *> throwBuiltinErrorWithCause term err
         BuiltinSuccess x              -> pure x
         BuiltinSuccessWithLogs logs x -> emitCkM logs $> x
+        BuiltinFailure logs err       -> emitCkM logs *> throwBuiltinErrorWithCause term err
     _ -> pure $ VBuiltin term runtime
 
 ckValueToTerm :: CkValue uni fun -> Term TyName Name uni fun ()

diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs
@@ -655,11 +655,11 @@ evalBuiltinApp fun term runtime = case runtime of
     BuiltinCostedResult budgets getX -> do
         spendBudgetStreamCek (BBuiltinApp fun) budgets
         case getX of
+            BuiltinSuccess x              -> pure x
+            BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
             BuiltinFailure logs err       -> do
                 ?cekEmitter logs
                 throwBuiltinErrorWithCause term err
-            BuiltinSuccess x              -> pure x
-            BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
     _ -> pure $ VBuiltin fun term runtime
 {-# INLINE evalBuiltinApp #-}
 

diff --git a/...ore/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/...ore/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs
@@ -439,11 +439,11 @@ evalBuiltinApp fun term runtime = case runtime of
     BuiltinCostedResult budgets getX -> do
         spendBudgetStreamCek (BBuiltinApp fun) budgets
         case getX of
+            BuiltinSuccess x              -> pure x
+            BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
             BuiltinFailure logs err       -> do
                 ?cekEmitter logs
                 throwBuiltinErrorWithCause term err
-            BuiltinSuccess x              -> pure x
-            BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
     _ -> pure $ VBuiltin fun term runtime
 {-# INLINE evalBuiltinApp #-}
 

diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs
@@ -259,10 +259,10 @@ keccak_256 (BuiltinByteString b) = BuiltinByteString $ Hash.keccak_256 b
 verifyEd25519Signature :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString -> BuiltinBool
 verifyEd25519Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) =
   case PlutusCore.Crypto.Ed25519.verifyEd25519Signature_V1 vk msg sig of
-    BuiltinFailure logs err       -> traceAll (logs <> pure (display err)) $
-        mustBeReplaced "Ed25519 signature verification errored."
     BuiltinSuccess b              -> BuiltinBool b
     BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b
+    BuiltinFailure logs err       -> traceAll (logs <> pure (display err)) $
+        mustBeReplaced "Ed25519 signature verification errored."
 
 {-# NOINLINE verifyEcdsaSecp256k1Signature #-}
 verifyEcdsaSecp256k1Signature ::
@@ -272,10 +272,10 @@ verifyEcdsaSecp256k1Signature ::
   BuiltinBool
 verifyEcdsaSecp256k1Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) =
   case PlutusCore.Crypto.Secp256k1.verifyEcdsaSecp256k1Signature vk msg sig of
-    BuiltinFailure logs err       -> traceAll (logs <> pure (display err)) $
-        mustBeReplaced "ECDSA SECP256k1 signature verification errored."
     BuiltinSuccess b              -> BuiltinBool b
     BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b
+    BuiltinFailure logs err       -> traceAll (logs <> pure (display err)) $
+        mustBeReplaced "ECDSA SECP256k1 signature verification errored."
 
 {-# NOINLINE verifySchnorrSecp256k1Signature #-}
 verifySchnorrSecp256k1Signature ::
@@ -285,10 +285,10 @@ verifySchnorrSecp256k1Signature ::
   BuiltinBool
 verifySchnorrSecp256k1Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) =
   case PlutusCore.Crypto.Secp256k1.verifySchnorrSecp256k1Signature vk msg sig of
-    BuiltinFailure logs err       -> traceAll (logs <> pure (display err)) $
-        mustBeReplaced "Schnorr SECP256k1 signature verification errored."
     BuiltinSuccess b              -> BuiltinBool b
     BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b
+    BuiltinFailure logs err       -> traceAll (logs <> pure (display err)) $
+        mustBeReplaced "Schnorr SECP256k1 signature verification errored."
 
 traceAll :: forall (a :: Type) (f :: Type -> Type) .
   (Foldable f) => f Text -> a -> a
@@ -695,10 +695,10 @@ integerToByteString
     -> BuiltinByteString
 integerToByteString (BuiltinBool endiannessArg) paddingArg input =
   case Convert.integerToByteStringWrapper endiannessArg paddingArg input of
-    BuiltinFailure logs err        -> traceAll (logs <> pure (display err)) $
-        mustBeReplaced "Integer to ByteString conversion errored."
     BuiltinSuccess bs              -> BuiltinByteString bs
     BuiltinSuccessWithLogs logs bs -> traceAll logs $ BuiltinByteString bs
+    BuiltinFailure logs err        -> traceAll (logs <> pure (display err)) $
+        mustBeReplaced "Integer to ByteString conversion errored."
 
 {-# NOINLINE byteStringToInteger #-}
 byteStringToInteger