Get BSL sizes from blst

nix/cells/plutus/library/make-plutus-project.nix

@@ -154,8 +154,9 @@ let
             [ pkgs.libsodium-vrf ]
           ];
           cardano-crypto-class.components.library.pkgconfig = lib.mkForce [
-            [ pkgs.libsodium-vrf pkgs.secp256k1 pkgs.blst ]
+            [ pkgs.libsodium-vrf pkgs.secp256k1 ]
           ];
+          cardano-crypto-class.components.library.libs = lib.mkForce [ pkgs.blst ];
         };
       })
 

plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs

@@ -8,6 +8,9 @@
 
 module CreateBuiltinCostModel where
 
+import Crypto.BLS12_381.G1 qualified as G1
+import Crypto.BLS12_381.G2 qualified as G2
+import Crypto.BLS12_381.Pairing qualified as Pairing
 import PlutusCore.Evaluation.Machine.BuiltinCostModel
 import PlutusCore.Evaluation.Machine.ExMemory
 
@@ -766,6 +769,9 @@ mkNilPairData cpuModelR = do
 
 ---------------- BLS12_381 operations ----------------
 
+toMemSize :: Int -> CostingInteger
+toMemSize n = fromIntegral $ n `div` 8
+
 -- Group order is 255 bits -> 32 bytes (4 words).
 -- Field size is 381 bits  -> 48 bytes (6 words)
 -- (with three spare bits used for encoding purposes).
@@ -776,23 +782,23 @@ mkNilPairData cpuModelR = do
 -- In-memory G1 points take up 144 bytes (18 words).
 -- These are projective points, so we have *three* 48-byte coordinates.
 g1MemSize :: CostingInteger
-g1MemSize = 18
+g1MemSize = toMemSize G1.memSizeBytes
 
 -- Compressed serialised G1 points take up 48 bytes (6 words)
 g1CompressedSize :: CostingInteger
-g1CompressedSize = 6
+g1CompressedSize = toMemSize G1.compressedSizeBytes
 
 -- In-memory G2 points take up 288 bytes (36 words)
 g2MemSize :: CostingInteger
-g2MemSize = 36
+g2MemSize = toMemSize G2.memSizeBytes
 
 -- Compressed serialised G2 points take up 96 bytes (12 words)
 g2CompressedSize :: CostingInteger
-g2CompressedSize = 12
+g2CompressedSize = toMemSize G2.compressedSizeBytes
 
 -- In-memory G2 points take up 576 bytes (72 words)
-gtMemSize :: CostingInteger
-gtMemSize = 72
+mlResultMemSize :: CostingInteger
+mlResultMemSize = toMemSize Pairing.mlResultMemSizeBytes
 
 bls12_381_G1_add :: MonadR m => (SomeSEXP (Region m)) -> m (CostingFun ModelTwoArguments)
 bls12_381_G1_add cpuModelR = do
@@ -881,13 +887,13 @@ bls12_381_G2_uncompress cpuModelR = do
 bls12_381_pairing :: MonadR m => (SomeSEXP (Region m)) -> m (CostingFun ModelTwoArguments)
 bls12_381_pairing cpuModelR = do
     cpuModel <- ModelTwoArgumentsConstantCost <$> readModelConstantCost cpuModelR
-    let memModel = ModelTwoArgumentsConstantCost gtMemSize
+    let memModel = ModelTwoArgumentsConstantCost mlResultMemSize
     pure $ CostingFun cpuModel memModel
 
 bls12_381_mulMlResult :: MonadR m => (SomeSEXP (Region m)) -> m (CostingFun ModelTwoArguments)
 bls12_381_mulMlResult cpuModelR = do
     cpuModel <- ModelTwoArgumentsConstantCost <$> readModelConstantCost cpuModelR
-    let memModel = ModelTwoArgumentsConstantCost gtMemSize
+    let memModel = ModelTwoArgumentsConstantCost mlResultMemSize
     pure $ CostingFun cpuModel memModel
 
 bls12_381_finalVerify :: MonadR m => (SomeSEXP (Region m)) -> m (CostingFun ModelTwoArguments)

plutus-core/plutus-core/src/Crypto/BLS12_381/G1.hs

@@ -12,13 +12,12 @@ module Crypto.BLS12_381.G1
     , compress
     , uncompress
     , zero
+    , memSizeBytes
+    , compressedSizeBytes
     ) where
 
--- FIXME: perhaps export the in-memory and (compressed) serialised sizes of
--- elements.  We need these in ExMemory.hs and CreateBuiltinCostModel.hs.  Can
--- we get these numbers from the library easily?
-
 import Crypto.External.EllipticCurve.BLS12_381 qualified as BlstBindings
+import Crypto.External.EllipticCurve.BLS12_381.Internal qualified as BlstBindings.Internal
 
 import Crypto.Utils (byteStringAsHex)
 import PlutusCore.Pretty.PrettyConst (ConstConfig)
@@ -27,12 +26,29 @@ import Text.PrettyBy (PrettyBy, prettyBy)
 import Control.DeepSeq (NFData, rnf)
 import Data.Bifunctor (second)
 import Data.ByteString (ByteString, pack)
+import Data.Proxy (Proxy (..))
 import Flat
 import Prettyprinter
 
--- We have to wrap the BLS points in a newtype because otherwise
--- the builtin machinery seems to spot that they're applications,
--- and we don't want to expose that to users.
+
+{- | Note [Wrapping the BLS12-381 types].  In the Haskell bidings to the `blst`
+library, points in G1 and G2 are represented as ForeignPtrs pointing to C
+objects, with a phantom type deterimining which group is involved. We have to
+wrap these in a newtype here because otherwise the builtin machinery spots that
+they're applications and can't find the relevant type parameters.  In theory I
+think we could add a couple of phantom types to the default universe, but it
+seemed simpler and safer to use monomorphic types instead, even though it
+requires a bit of code duplication between G1 and G2.
+
+The newtype wrappers suffice for Plutus Core, but there's a further complication
+in PlutusTx: if you try to use the newtypes directly then the plugin sees
+through the newtypes to the foreign pointers and fails because it doesn't know
+how to handle them.  To avoid this we further wrap the newtypes in datatypes.
+We could do this here (just write `data` instead of `newtype`), but then the
+code dealing with BLS types and builtins in PlutusTx doesn't look like the code
+for the other builtins.  Because of this it seemed safer and more uniform to add
+the datatype wrapper in PlutusTx rather than here.
+-}
 newtype Element = Element { unElement :: BlstBindings.Point1 }
     deriving newtype (Eq)
 instance Show Element where
@@ -52,31 +68,58 @@ instance Flat Element where
 instance NFData Element where
     rnf _ = ()
 
+-- | Add two G1 group elements
 add :: Element -> Element -> Element
 add (Element a) (Element b) = Element $ BlstBindings.blsAddOrDouble @BlstBindings.Curve1 a b
 
+-- | Negate a G1 group element
 neg :: Element -> Element
 neg (Element a) = Element $ BlstBindings.blsNeg @BlstBindings.Curve1 a
 
-scalarMul :: Integer -> Element -> Element -- Other way round from implementation
+-- | Multiplication of group elements by scalars. In the blst library the
+-- arguments are the other way round, but scalars acting on the left is more
+-- consistent with standard mathematical practice.
+scalarMul :: Integer -> Element -> Element
 scalarMul k (Element a) = Element $ BlstBindings.blsMult @BlstBindings.Curve1 a k
 
-compress :: Element -> ByteString  -- 48 bytes
+-- | Compress a G1 element to a bytestring. This serialises a curve point to its
+-- x coordinate only, using an extra bit to determine which of two possible y
+-- coordinates the point has. The compressed bytestring is 48 bytes long. See
+-- https://github.com/supranational/blst#serialization-format
+compress :: Element -> ByteString
 compress (Element a) = BlstBindings.blsCompress @BlstBindings.Curve1 a
 
+{- | Uncompress a bytestring to get a G1 point.  This can fail if
+     * The bytestring is not exactly 48 bytes long
+     * The most significant three bits are used incorrectly
+     * The bytestring encodes a field element which is not the
+       x coordinate of a point on the E1 curve
+     * The bytestring does represent a point on the E1 curve, but the
+       point is not in the G1 subgroup
+-}
 uncompress :: ByteString -> Either BlstBindings.BLSTError Element
 uncompress = second Element . BlstBindings.blsUncompress @BlstBindings.Curve1
 
--- Take an arbitrary bytestring and hash it to a get point on the curve;
+-- | Take an arbitrary bytestring and hash it to a get point in G1
 hashToGroup :: ByteString -> Element
 hashToGroup s = Element $ BlstBindings.blsHash @BlstBindings.Curve1 s Nothing Nothing
 
--- This is only here for the QuickCheck shrinker in the PlutusIR tests.  I'm not
--- sure if it even makes sense for that.
+
+-- Utilities (not exposed as builtins)
+
+-- | The zero element of G1
 zero :: Element
 zero =
     let b = pack (0xc0 : replicate 47 0x00) -- Compressed serialised G1 points are bytestrings of length 48: see CIP-0381.
     in case BlstBindings.blsUncompress @BlstBindings.Curve1 b of
          Left err       -> error $ "Unexpected failure deserialising point at infinity on BLS12_381.G1:  " ++ show err
          Right infinity -> Element infinity  -- The zero point on this curve is chosen to be the point at infinity.
 
+-- | Memory usage of a G1 point (144 bytes)
+memSizeBytes :: Int
+memSizeBytes = BlstBindings.Internal.sizePoint (Proxy @BlstBindings.Curve1)
+
+-- | Compressed size of a G1 point (48 bytes)
+compressedSizeBytes :: Int
+compressedSizeBytes = BlstBindings.Internal.compressedSizePoint (Proxy @BlstBindings.Curve1)
+

plutus-core/plutus-core/src/Crypto/BLS12_381/G2.hs

@@ -12,9 +12,12 @@ module Crypto.BLS12_381.G2
     , compress
     , uncompress
     , zero
+    , memSizeBytes
+    , compressedSizeBytes
     ) where
 
 import Crypto.External.EllipticCurve.BLS12_381 qualified as BlstBindings
+import Crypto.External.EllipticCurve.BLS12_381.Internal qualified as BlstBindings.Internal
 
 import Crypto.Utils (byteStringAsHex)
 import PlutusCore.Pretty.PrettyConst (ConstConfig)
@@ -23,12 +26,11 @@ import Text.PrettyBy (PrettyBy, prettyBy)
 import Control.DeepSeq (NFData, rnf)
 import Data.Bifunctor (second)
 import Data.ByteString (ByteString, pack)
+import Data.Proxy (Proxy (..))
 import Flat
 import Prettyprinter
 
--- We have to wrap the BLS points in a newtype because otherwise
--- the builtin machinery seems to spot that they're applications,
--- and we don't want to expose that to users.
+{- | See Note [Wrapping the BLS12-381 types]. -}
 newtype Element = Element { unElement :: BlstBindings.Point2 }
     deriving newtype (Eq)
 instance Show Element where
@@ -48,33 +50,55 @@ instance Flat Element where
 instance NFData Element where
     rnf _ = ()
 
+-- | Add two G2 group elements
 add :: Element -> Element -> Element
 add (Element a) (Element b) = Element $ BlstBindings.blsAddOrDouble @BlstBindings.Curve2 a b
 
+-- | Negate a G2group element
 neg :: Element -> Element
 neg (Element a) = Element $ BlstBindings.blsNeg @BlstBindings.Curve2 a
 
 scalarMul :: Integer -> Element -> Element -- Other way round from library function
 scalarMul k (Element a) = Element $ BlstBindings.blsMult @BlstBindings.Curve2 a k
 
-compress :: Element -> ByteString  -- 96 bytes
+-- | Compress a G2 element to a bytestring. This serialises a curve point to its
+-- x coordinate only, using an extra bit to determine which of two possible y
+-- coordinates the point has. The compressed bytestring is 96 bytes long. See
+-- https://github.com/supranational/blst#serialization-format
+compress :: Element -> ByteString
 compress (Element a) = BlstBindings.blsCompress @BlstBindings.Curve2 a
 
+{- | Uncompress a bytestring to get a G2 point.  This can fail if
+     * The bytestring is not exactly 96 bytes long
+     * The most significant three bits are used incorrectly
+     * The bytestring encodes a field element which is not the
+       x coordinate of a point on the E2 curve
+     * The bytestring does represent a point on the E2 curve, but the
+       point is not in the G2 subgroup
+-}
 uncompress :: ByteString -> Either BlstBindings.BLSTError Element
 uncompress = second Element . BlstBindings.blsUncompress @BlstBindings.Curve2
 
 -- Take an arbitrary bytestring and hash it to a get point on the curve;
 hashToGroup :: ByteString -> Element
 hashToGroup s = Element $ BlstBindings.blsHash @BlstBindings.Curve2 s Nothing Nothing
 
--- This is only here for the QuickCheck shrinker in the PlutusIR tests.  I'm not
--- sure if it even makes sense for that.
+
+-- Utilities (not exposed as builtins)
+
+-- | The zero element of G2
 zero :: Element
 zero =
     let b = pack (0xc0 : replicate 95 0x00) -- Compressed serialised G2 points are bytestrings of length 96: see CIP-0381.
     in case BlstBindings.blsUncompress @BlstBindings.Curve2 b of
          Left err       -> error $ "Unexpected failure deserialising point at infinity on BLS12_381.G2:  " ++ show err
          Right infinity -> Element infinity   -- The zero point on this curve is chosen to be the point at infinity.
 
+-- | Memory usage of a G2 point (288 bytes)
+memSizeBytes :: Int
+memSizeBytes = BlstBindings.Internal.sizePoint (Proxy @BlstBindings.Curve2)
 
+-- | Compressed size of a G2 point (96 bytes)
+compressedSizeBytes :: Int
+compressedSizeBytes = BlstBindings.Internal.compressedSizePoint (Proxy @BlstBindings.Curve2)
 

plutus-core/plutus-core/src/Crypto/BLS12_381/Pairing.hs

@@ -6,10 +6,12 @@ module Crypto.BLS12_381.Pairing
      MlResult (..),
      mulMlResult,
      pairing,
-     finalVerify
+     finalVerify,
+     mlResultMemSizeBytes
     ) where
 
 import Crypto.External.EllipticCurve.BLS12_381 qualified as BlstBindings
+import Crypto.External.EllipticCurve.BLS12_381.Internal qualified as BlstBindings.Internal
 
 import Crypto.BLS12_381.G1 qualified as G1
 import Crypto.BLS12_381.G2 qualified as G2
@@ -30,9 +32,9 @@ instance Pretty MlResult where
     pretty = pretty . show
 instance PrettyBy ConstConfig MlResult where
     prettyBy _ = pretty
--- !! FIXME. We need a Flat instance to get everything to build properly, but
--- we'll never want GT values in serialised scripts.  Is the instance below OK?
--- Also, do we need a tag for GT in Universe.hs?
+-- We need a Flat instance to get everything to build properly, but we'll never
+-- want GT values in serialised scripts, so the decoding and encoding functions
+-- just raise errors.
 instance Flat MlResult where
     decode = fail "BLS12_381.Pairing.MlResult: flat decoding disallowed"
     encode = error "BLS12_381.Pairing.MlResult: flat encoding disallowed"
@@ -49,3 +51,11 @@ pairing (G1.Element e1) (G2.Element e2) = second MlResult $ BlstBindings.millerL
 
 finalVerify :: MlResult -> MlResult -> Bool
 finalVerify (MlResult a) (MlResult b) = BlstBindings.ptFinalVerify a b
+
+
+-- Not exposed as a builtin
+
+-- | Memory usage of an MlResult point (576 bytes)
+mlResultMemSizeBytes :: Int
+mlResultMemSizeBytes = BlstBindings.Internal.sizePT
+

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemory.hs

@@ -282,10 +282,13 @@ instance ExMemoryUsage Data where
               sizeDataPairs ((d1,d2):ps) = sizeData d1 + sizeData d2 + sizeDataPairs ps
 
 instance ExMemoryUsage Crypto.BLS12_381.G1.Element where
-    memoryUsage _ = 12
+    memoryUsage _ = fromIntegral $ Crypto.BLS12_381.G1.memSizeBytes `div` 8
+    -- Should be 12
 
 instance ExMemoryUsage Crypto.BLS12_381.G2.Element where
-    memoryUsage _ = 24
+    memoryUsage _ = fromIntegral $ Crypto.BLS12_381.G2.memSizeBytes `div` 8
+    -- Should be
 
 instance ExMemoryUsage Crypto.BLS12_381.Pairing.MlResult where
-    memoryUsage _ = 144
+    memoryUsage _ = fromIntegral $ Crypto.BLS12_381.Pairing.mlResultMemSizeBytes `div` 8
+    -- Soulh be 144