{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase          #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Evaluation.Builtins.BLS12_381.TestClasses
where

import Evaluation.Builtins.Common (PlcTerm, bytestring, mkApp1, mkApp2)

import PlutusCore.Crypto.BLS12_381.G1 qualified as G1
import PlutusCore.Crypto.BLS12_381.G2 qualified as G2
import PlutusCore.Default
import PlutusCore.Generators.QuickCheck.Builtin (ArbitraryBuiltin)
import PlutusCore.MkPlc (mkConstant)

import Data.ByteString as BS (ByteString, empty, pack)
import Test.QuickCheck (Arbitrary (..))

---------------- Typeclasses for groups ----------------

{- | The code for the property tests for G1 and G2 is essentially identical, so
 it's worth abstracting over the common features.  The blst Haskell FFI uses a
 phantom type to do this but unfortunately we have to hide that to stop the
 builtin machinery spotting it and then we have to re-abstract here. -}

-- We could re-use the AbelianGroup class here, but that uses <> and `mempty`
-- and that's confusing.
class (Eq a, Show a, Arbitrary a, ArbitraryBuiltin a) => TestableAbelianGroup a
    where
      groupName     :: String
      zeroTerm      :: PlcTerm
      addTerm       :: PlcTerm -> PlcTerm -> PlcTerm
      negTerm       :: PlcTerm -> PlcTerm
      scalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm
      eqTerm        :: PlcTerm -> PlcTerm -> PlcTerm
      toTerm        :: a -> PlcTerm

class TestableAbelianGroup a => HashAndCompress a
    where
      compressedSize  :: Int
      compress        :: a -> ByteString
      compressTerm    :: PlcTerm -> PlcTerm
      uncompressTerm  :: PlcTerm -> PlcTerm
      hashToGroupTerm :: PlcTerm -> PlcTerm -> PlcTerm


{- | Generate an arbitrary element of G1.  It's tricky to construct such an
 element directly without using quite low-level operations on the curve
 because a random point on the curve is highly unlikely to be in the subgroup
 G1, but fortunately `hashToGroup` always produces an element of the subgroup,
 so we can produce random elements of G1 by hasing random bytestrings. -}
instance Arbitrary G1.Element
    where
      arbitrary :: Gen Element
arbitrary =
          ByteString -> ByteString -> Either BLS12_381_Error Element
G1.hashToGroup (ByteString -> ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString
-> Gen (ByteString -> Either BLS12_381_Error Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString -> Gen (Either BLS12_381_Error Element)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Gen ByteString
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BS.empty Gen (Either BLS12_381_Error Element)
-> (Either BLS12_381_Error Element -> Gen Element) -> Gen Element
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left BLS12_381_Error
err -> [Char] -> Gen Element
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen Element) -> [Char] -> Gen Element
forall a b. (a -> b) -> a -> b
$ [Char]
"Arbitrary instance for G1.Element:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BLS12_381_Error -> [Char]
forall a. Show a => a -> [Char]
show BLS12_381_Error
err
            Right Element
p  -> Element -> Gen Element
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
p

instance TestableAbelianGroup G1.Element
    where
      groupName :: [Char]
groupName     = [Char]
"G1"
      zeroTerm :: PlcTerm
zeroTerm      = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G1_uncompress (PlcTerm -> PlcTerm) -> PlcTerm -> PlcTerm
forall a b. (a -> b) -> a -> b
$ ByteString -> PlcTerm
bytestring (ByteString -> PlcTerm) -> ByteString -> PlcTerm
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack (Word8
0xc0 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
47 Word8
0x00)
      addTerm :: PlcTerm -> PlcTerm -> PlcTerm
addTerm       = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G1_add
      negTerm :: PlcTerm -> PlcTerm
negTerm       = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G1_neg
      scalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm
scalarMulTerm = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G1_scalarMul
      eqTerm :: PlcTerm -> PlcTerm -> PlcTerm
eqTerm        = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G1_equal
      toTerm :: Element -> PlcTerm
toTerm        = () -> Element -> PlcTerm
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant ()

instance HashAndCompress G1.Element
    where
      compressedSize :: Int
compressedSize  = Int
48
      compress :: Element -> ByteString
compress        = Element -> ByteString
G1.compress
      compressTerm :: PlcTerm -> PlcTerm
compressTerm    = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G1_compress
      uncompressTerm :: PlcTerm -> PlcTerm
uncompressTerm  = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G1_uncompress
      hashToGroupTerm :: PlcTerm -> PlcTerm -> PlcTerm
hashToGroupTerm = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G1_hashToGroup

-- | See the comment for the Arbitrary instance for G1.
instance Arbitrary G2.Element
    where
      arbitrary :: Gen Element
arbitrary =
        ByteString -> ByteString -> Either BLS12_381_Error Element
G2.hashToGroup (ByteString -> ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString
-> Gen (ByteString -> Either BLS12_381_Error Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString -> Gen (Either BLS12_381_Error Element)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Gen ByteString
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BS.empty Gen (Either BLS12_381_Error Element)
-> (Either BLS12_381_Error Element -> Gen Element) -> Gen Element
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left BLS12_381_Error
err -> [Char] -> Gen Element
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen Element) -> [Char] -> Gen Element
forall a b. (a -> b) -> a -> b
$ [Char]
"Arbitrary instance for G2.Element:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BLS12_381_Error -> [Char]
forall a. Show a => a -> [Char]
show BLS12_381_Error
err
            Right Element
p  -> Element -> Gen Element
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
p

instance TestableAbelianGroup G2.Element
    where
      groupName :: [Char]
groupName     = [Char]
"G2"
      zeroTerm :: PlcTerm
zeroTerm      = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G2_uncompress (PlcTerm -> PlcTerm) -> PlcTerm -> PlcTerm
forall a b. (a -> b) -> a -> b
$ ByteString -> PlcTerm
bytestring (ByteString -> PlcTerm) -> ByteString -> PlcTerm
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack (Word8
0xc0 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
95 Word8
0x00)
      addTerm :: PlcTerm -> PlcTerm -> PlcTerm
addTerm       = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G2_add
      negTerm :: PlcTerm -> PlcTerm
negTerm       = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G2_neg
      scalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm
scalarMulTerm = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G2_scalarMul
      eqTerm :: PlcTerm -> PlcTerm -> PlcTerm
eqTerm        = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G2_equal
      toTerm :: Element -> PlcTerm
toTerm        = () -> Element -> PlcTerm
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant ()

instance HashAndCompress G2.Element
    where
      compressedSize :: Int
compressedSize  = Int
96
      compress :: Element -> ByteString
compress        = Element -> ByteString
G2.compress
      compressTerm :: PlcTerm -> PlcTerm
compressTerm    = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G2_compress
      uncompressTerm :: PlcTerm -> PlcTerm
uncompressTerm  = DefaultFun -> PlcTerm -> PlcTerm
mkApp1 DefaultFun
Bls12_381_G2_uncompress
      hashToGroupTerm :: PlcTerm -> PlcTerm -> PlcTerm
hashToGroupTerm = DefaultFun -> PlcTerm -> PlcTerm -> PlcTerm
mkApp2 DefaultFun
Bls12_381_G2_hashToGroup