module Data.Pairing.Hash
  ( module Data.Pairing
  -- * Shallue-van de Woestijne encoding to BLS12 curves
  , swEncBLS12
  -- * Shallue-van de Woestijne encoding to BN curves
  , swEncBN
  ) where

import Protolude

import Control.Error (hoistMaybe, runMaybeT)
import Control.Monad.Random (MonadRandom)
import qualified Data.ByteString as B (foldl')
import Data.Curve.Weierstrass
import Data.Field.Galois as F
import Data.List ((!!))

import Data.Pairing

-------------------------------------------------------------------------------
-- Shallue-van de Woestijne encoding
-------------------------------------------------------------------------------

-- | Encodes a given byte string to a point on the BLS12 curve.
--
-- The implementation uses the Shallue-van de Woestijne encoding to BLS12 curves
-- as specified in Section 3 of [Fast and simple constant-time hashing to the
-- BLS12-381 elliptic curve](https://eprint.iacr.org/2019/403.pdf).
--
-- This function is not implemented yet.
swEncBLS12 :: forall e m q r u v w . (MonadRandom m, ECPairing e q r u v w)
  => ByteString -> m (Maybe (G1 e))
swEncBLS12 = panic "swEncBLS12: not implemented."
{-# INLINABLE swEncBLS12 #-}

-- | Encodes a given byte string to a point on the BN curve.
--
-- The implementation uses the Shallue-van de Woestijne encoding to BN curves
-- as specified in Section 6 of [Indifferentiable Hashing to Barreto-Naehrig Curves]
-- (https://www.di.ens.fr/~fouque/pub/latincrypt12.pdf).
--
-- This function evaluates an empty bytestring or one that contains \NUL
-- to zero and is sent to an arbitrary point on the curve.
swEncBN :: forall e m q r u v w . (MonadRandom m, ECPairing e q r u v w)
  => ByteString -> m (Maybe (G1 e))
swEncBN bs = runMaybeT $ do
  sqrt3 <- hoistMaybe $ sr $ -3
  let t  = fromInteger $ fromBytes bs
      s1 = (sqrt3 - 1) / 2
      b1 = 1 + b_ (witness :: G1 e)
  guard (b1 + t * t /= 0)
  if t == 0 then                  -- arbitrary point on the curve
    if b1 == 3 then
      return $ A (-1) 1           -- 1^2 = (-1)^3 + 2
    else if b1 == 4 then
      return $ A 1 2              -- 2^2 = 1^3 + 3
    else if b1 == 6 then
      return $ A (-1) 2           -- 2^2 = (-1)^3 + 5
    else
      A s1 <$> hoistMaybe (sr b1) -- definition 2 assuming 1 + b is a quadratic residue
  else do
    let w  = sqrt3 * t / (b1 + t * t)
        x1 = s1 - t * w
        x2 = -1 - x1
        x3 = 1 + 1 / (w * w)
    r1 <- F.rnd
    r2 <- F.rnd
    r3 <- F.rnd
    let a = ch $ r1 * r1 * (x1 * x1 * x1 + b_ (witness :: G1 e))
        b = ch $ r2 * r2 * (x2 * x2 * x2 + b_ (witness :: G1 e))
        c = ch $ r3 * r3 * t
        i = mod ((a - 1) * b) 3
        x = [x1, x2, x3] !! i
        y = sr $ x * x * x + b_ (witness :: G1 e)
    A x . (fromIntegral c *) <$> hoistMaybe y
  where
    ch x = if x == 0 then 0 else if qr x then 1 else -1 :: Int
{-# INLINABLE swEncBN #-}

-------------------------------------------------------------------------------
-- Auxiliary functions
-------------------------------------------------------------------------------

-- Conversion from bytestring to field.
fromBytes :: ByteString -> Integer
fromBytes = B.foldl' f 0
  where
    f a b = shiftL a 8 .|. fromIntegral b
{-# INLINABLE fromBytes #-}