Add Typeable and IsData instances for BLS12-381 types (PLT-6512) (#5413)

* Add Typeable instances for BLS12-381 types

* Add IsData instances for BLS12-381 types

* Oops

plutus-tx/src/PlutusTx/IsData/Class.hs

@@ -9,8 +9,10 @@
 {-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
 module PlutusTx.IsData.Class where
 
-import Prelude qualified as Haskell (Int, error)
+import Prelude qualified as Haskell (Either (..), Int, error)
 
+import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1
+import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2
 import PlutusCore.Data qualified as PLC
 import PlutusTx.Base
 import PlutusTx.Builtins as Builtins
@@ -139,6 +141,61 @@ instance UnsafeFromData Void where
     {-# INLINABLE unsafeFromBuiltinData #-}
     unsafeFromBuiltinData _ = traceError voidIsNotSupportedError
 
+{- | For the BLS12-381 G1 and G2 types we use the `compress` functions to convert
+   to a ByteString and then encode that as Data as usual.  We have to be more
+   careful going the other way because we decode a Data object to (possibly) get
+   a BuiltinByteString and then uncompress the underlying ByteString to get a
+   group element.  However uncompression can fail so we have to check what
+   happens: we don't use bls12_381_G?_uncompress because that invokes `error` if
+   something goes wrong (but we do use it for unsafeFromData).
+-}
+instance ToData Builtins.BuiltinBLS12_381_G1_Element where
+    {-# INLINABLE toBuiltinData #-}
+    toBuiltinData = toBuiltinData . Builtins.bls12_381_G1_compress
+instance FromData Builtins.BuiltinBLS12_381_G1_Element where
+    {-# INLINABLE fromBuiltinData #-}
+    fromBuiltinData d =
+        case fromBuiltinData d of
+          Nothing -> Nothing
+          Just (BI.BuiltinByteString bs) ->
+              case BLS12_381.G1.uncompress bs of
+                Haskell.Left _  -> Nothing
+                Haskell.Right g -> Just $ toBuiltin g
+instance UnsafeFromData Builtins.BuiltinBLS12_381_G1_Element where
+    {-# INLINABLE unsafeFromBuiltinData #-}
+    unsafeFromBuiltinData = Builtins.bls12_381_G1_uncompress . unsafeFromBuiltinData
+
+instance ToData Builtins.BuiltinBLS12_381_G2_Element where
+    {-# INLINABLE toBuiltinData #-}
+    toBuiltinData = toBuiltinData . Builtins.bls12_381_G2_compress
+instance FromData Builtins.BuiltinBLS12_381_G2_Element where
+    {-# INLINABLE fromBuiltinData #-}
+    fromBuiltinData d =
+        case fromBuiltinData d of
+          Nothing -> Nothing
+          Just (BI.BuiltinByteString bs) ->
+              case BLS12_381.G2.uncompress bs of
+                Haskell.Left _  -> Nothing
+                Haskell.Right g -> Just $ toBuiltin g
+instance UnsafeFromData Builtins.BuiltinBLS12_381_G2_Element where
+    {-# INLINABLE unsafeFromBuiltinData #-}
+    unsafeFromBuiltinData = Builtins.bls12_381_G2_uncompress . unsafeFromBuiltinData
+
+{- | We do not provide instances of any of these classes for
+   BuiltinBLS12_381_MlResult since there is no serialisation format: we expect
+   that values of that type will only occur as the result of on-chain
+   computations.
+-}
+instance (TypeError ('Text "toBuiltinData is not supported for BuiltinBLS12_381_MlResult"))
+    => ToData Builtins.BuiltinBLS12_381_MlResult where
+    toBuiltinData = Haskell.error "unsupported"
+instance (TypeError ('Text "fromBuiltinData is not supported for BuiltinBLS12_381_MlResult"))
+    => FromData Builtins.BuiltinBLS12_381_MlResult where
+    fromBuiltinData = Haskell.error "unsupported"
+instance (TypeError ('Text "unsafeFromBuiltinData is not supported for BuiltinBLS12_381_MlResult"))
+    => UnsafeFromData Builtins.BuiltinBLS12_381_MlResult where
+    unsafeFromBuiltinData = Haskell.error "unsupported"
+
 -- | Convert a value to 'PLC.Data'.
 toData :: (ToData a) => a -> PLC.Data
 toData a = builtinDataToData (toBuiltinData a)

plutus-tx/src/PlutusTx/Lift/Class.hs

@@ -148,28 +148,37 @@ instance uni `PLC.Includes` Data => Typeable uni BuiltinData where
     typeRep _ = typeRepBuiltin (Proxy @Data)
 
 instance uni `PLC.Includes` Data => Lift uni BuiltinData where
-    lift d = liftBuiltin (builtinDataToData d)
+    lift = liftBuiltin . builtinDataToData
 
 instance uni `PLC.Includes` BS.ByteString => Typeable uni BuiltinByteString where
     typeRep _proxyPByteString = typeRepBuiltin (Proxy @BS.ByteString)
 
 instance uni `PLC.Includes` BS.ByteString => Lift uni BuiltinByteString where
-    lift b = liftBuiltin $ fromBuiltin b
+    lift = liftBuiltin . fromBuiltin
 
 instance uni `PLC.Includes` T.Text => Typeable uni BuiltinString where
     typeRep _proxyPByteString = typeRepBuiltin (Proxy @T.Text)
 
 instance uni `PLC.Includes` T.Text => Lift uni BuiltinString where
-    lift b = liftBuiltin $ fromBuiltin b
+    lift = liftBuiltin . fromBuiltin
 
 instance (FromBuiltin arep a, uni `PLC.Includes` [a]) => Lift uni (BuiltinList arep) where
-    lift b = liftBuiltin $ fromBuiltin b
+    lift = liftBuiltin . fromBuiltin
+
+instance uni `PLC.Includes` PlutusCore.Crypto.BLS12_381.G1.Element => Typeable uni BuiltinBLS12_381_G1_Element where
+    typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G1.Element)
 
 instance uni `PLC.Includes` PlutusCore.Crypto.BLS12_381.G1.Element => Lift uni BuiltinBLS12_381_G1_Element where
-    lift a = liftBuiltin $ fromBuiltin a
+    lift = liftBuiltin . fromBuiltin
+
+instance uni `PLC.Includes` PlutusCore.Crypto.BLS12_381.G2.Element => Typeable uni BuiltinBLS12_381_G2_Element where
+    typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G2.Element)
 
 instance uni `PLC.Includes` PlutusCore.Crypto.BLS12_381.G2.Element => Lift uni BuiltinBLS12_381_G2_Element where
-    lift a = liftBuiltin $ fromBuiltin a
+    lift = liftBuiltin . fromBuiltin
+
+instance uni `PLC.Includes` PlutusCore.Crypto.BLS12_381.Pairing.MlResult => Typeable uni BuiltinBLS12_381_MlResult where
+    typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.Pairing.MlResult)
 
 instance uni `PLC.Includes` PlutusCore.Crypto.BLS12_381.Pairing.MlResult => Lift uni BuiltinBLS12_381_MlResult where
-    lift a = liftBuiltin $ fromBuiltin a
+    lift = liftBuiltin . fromBuiltin