-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
-- SPDX-License-Identifier: MPL-2.0

{-# LANGUAGE TypeFamilyDependencies #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Bindings with class.
module Crypto.BLST.Internal.Classy
  ( module Crypto.BLST.Internal.Classy
  ) where

import Data.ByteArray (ByteArrayAccess(..), Bytes)
import Data.ByteArray.Sized (SizedByteArray)
import Data.Kind (Constraint)
import GHC.TypeNats (KnownNat, Nat)

import Crypto.BLST.Internal.Bindings
import Crypto.BLST.Internal.Demote

-- | Curve data kind.
data Curve = G1 | G2

instance Demote 'G1 where demote :: Curve
demote = Curve
G1
instance Demote 'G2 where demote :: Curve
demote = Curve
G2

-- | Public key point type depending on the curve.
type CurveToPkPoint :: Curve -> PointKind
type family CurveToPkPoint c = r | r -> c where
  CurveToPkPoint 'G1 = 'P1
  CurveToPkPoint 'G2 = 'P2

-- | Message/signature point depending on the curve.
type CurveToMsgPoint :: Curve -> PointKind
type family CurveToMsgPoint c = r | r -> c where
  CurveToMsgPoint 'G1 = 'P2
  CurveToMsgPoint 'G2 = 'P1

-- | Size of serialized point.
type SerializedSize :: PointKind -> Nat
type family SerializedSize p = r | r -> p where
  SerializedSize 'P1 = P1SerializeSize
  SerializedSize 'P2 = P2SerializeSize

-- | Size of compressed serialized point.
type CompressedSize :: PointKind -> Nat
type family CompressedSize p = r | r -> p where
  CompressedSize 'P1 = P1CompressSize
  CompressedSize 'P2 = P2CompressSize

-- | Class for operations on curves.
type IsCurve :: Curve -> Constraint
class (IsPoint (CurveToMsgPoint c), IsPoint (CurveToPkPoint c)) => IsCurve c where
  skToPkPoint :: Scalar -> IO (Point (CurveToPkPoint c))
  signPk :: Point (CurveToMsgPoint c) -> Scalar -> IO (Point (CurveToMsgPoint c))
  coreVerifyPk
    :: (ByteArrayAccess ba, ByteArrayAccess ba2)
    => Affine (CurveToPkPoint c)
    -> Affine (CurveToMsgPoint c)
    -> EncodeMethod
    -> ba
    -> Maybe ba2
    -> IO BlstError
  pairingChkNAggrPk
    :: ByteArrayAccess ba
    => PairingCtx
    -> Affine (CurveToPkPoint c)
    -> Bool
    -> Maybe (Affine (CurveToMsgPoint c))
    -> Bool
    -> ba
    -> IO BlstError

instance IsCurve 'G1 where
  skToPkPoint :: Scalar -> IO (Point (CurveToPkPoint 'G1))
skToPkPoint = Scalar -> IO (Point 'P1)
Scalar -> IO (Point (CurveToPkPoint 'G1))
skToPkInG1
  signPk :: Point (CurveToMsgPoint 'G1)
-> Scalar -> IO (Point (CurveToMsgPoint 'G1))
signPk = Point 'P2 -> Scalar -> IO (Point 'P2)
Point (CurveToMsgPoint 'G1)
-> Scalar -> IO (Point (CurveToMsgPoint 'G1))
signPkInG1
  coreVerifyPk :: forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
Affine (CurveToPkPoint 'G1)
-> Affine (CurveToMsgPoint 'G1)
-> EncodeMethod
-> ba
-> Maybe ba2
-> IO BlstError
coreVerifyPk = Affine 'P1
-> Affine 'P2 -> EncodeMethod -> ba -> Maybe ba2 -> IO BlstError
Affine (CurveToPkPoint 'G1)
-> Affine (CurveToMsgPoint 'G1)
-> EncodeMethod
-> ba
-> Maybe ba2
-> IO BlstError
forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
Affine 'P1
-> Affine 'P2 -> EncodeMethod -> ba -> Maybe ba2 -> IO BlstError
coreVerifyPkInG1
  pairingChkNAggrPk :: forall ba.
ByteArrayAccess ba =>
PairingCtx
-> Affine (CurveToPkPoint 'G1)
-> Bool
-> Maybe (Affine (CurveToMsgPoint 'G1))
-> Bool
-> ba
-> IO BlstError
pairingChkNAggrPk = PairingCtx
-> Affine 'P1
-> Bool
-> Maybe (Affine 'P2)
-> Bool
-> ba
-> IO BlstError
PairingCtx
-> Affine (CurveToPkPoint 'G1)
-> Bool
-> Maybe (Affine (CurveToMsgPoint 'G1))
-> Bool
-> ba
-> IO BlstError
forall ba.
ByteArrayAccess ba =>
PairingCtx
-> Affine 'P1
-> Bool
-> Maybe (Affine 'P2)
-> Bool
-> ba
-> IO BlstError
pairingChkNAggrPkInG1

instance IsCurve 'G2 where
  skToPkPoint :: Scalar -> IO (Point (CurveToPkPoint 'G2))
skToPkPoint = Scalar -> IO (Point 'P2)
Scalar -> IO (Point (CurveToPkPoint 'G2))
skToPkInG2
  signPk :: Point (CurveToMsgPoint 'G2)
-> Scalar -> IO (Point (CurveToMsgPoint 'G2))
signPk = Point 'P1 -> Scalar -> IO (Point 'P1)
Point (CurveToMsgPoint 'G2)
-> Scalar -> IO (Point (CurveToMsgPoint 'G2))
signPkInG2
  coreVerifyPk :: forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
Affine (CurveToPkPoint 'G2)
-> Affine (CurveToMsgPoint 'G2)
-> EncodeMethod
-> ba
-> Maybe ba2
-> IO BlstError
coreVerifyPk = Affine 'P2
-> Affine 'P1 -> EncodeMethod -> ba -> Maybe ba2 -> IO BlstError
Affine (CurveToPkPoint 'G2)
-> Affine (CurveToMsgPoint 'G2)
-> EncodeMethod
-> ba
-> Maybe ba2
-> IO BlstError
forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
Affine 'P2
-> Affine 'P1 -> EncodeMethod -> ba -> Maybe ba2 -> IO BlstError
coreVerifyPkInG2
  pairingChkNAggrPk :: forall ba.
ByteArrayAccess ba =>
PairingCtx
-> Affine (CurveToPkPoint 'G2)
-> Bool
-> Maybe (Affine (CurveToMsgPoint 'G2))
-> Bool
-> ba
-> IO BlstError
pairingChkNAggrPk = PairingCtx
-> Affine 'P2
-> Bool
-> Maybe (Affine 'P1)
-> Bool
-> ba
-> IO BlstError
PairingCtx
-> Affine (CurveToPkPoint 'G2)
-> Bool
-> Maybe (Affine (CurveToMsgPoint 'G2))
-> Bool
-> ba
-> IO BlstError
forall ba.
ByteArrayAccess ba =>
PairingCtx
-> Affine 'P2
-> Bool
-> Maybe (Affine 'P1)
-> Bool
-> ba
-> IO BlstError
pairingChkNAggrPkInG2

-- | Class for operations on points.
type IsPoint :: PointKind -> Constraint
class (KnownNat (SerializedSize p), KnownNat (CompressedSize p)) => IsPoint p where
  toAffine :: Point p -> IO (Affine p)
  fromAffine :: Affine p -> IO (Point p)
  affSerialize :: Affine p -> IO (SizedByteArray (SerializedSize p) Bytes)
  affCompress :: Affine p -> IO (SizedByteArray (CompressedSize p) Bytes)
  uncompress
    :: ByteArrayAccess ba
    => SizedByteArray (CompressedSize p) ba
    -> IO (Either BlstError (Affine p))
  addOrDoubleAffine :: Point p -> Affine p -> IO (Point p)
  deserialize
    :: ByteArrayAccess ba
    => SizedByteArray (SerializedSize p) ba
    -> IO (Either BlstError (Affine p))

instance IsPoint 'P1 where
  toAffine :: Point 'P1 -> IO (Affine 'P1)
toAffine = Point 'P1 -> IO (Affine 'P1)
p1ToAffine
  fromAffine :: Affine 'P1 -> IO (Point 'P1)
fromAffine = Affine 'P1 -> IO (Point 'P1)
p1FromAffine
  affSerialize :: Affine 'P1 -> IO (SizedByteArray (SerializedSize 'P1) Bytes)
affSerialize = Affine 'P1 -> IO (SizedByteArray P1SerializeSize Bytes)
Affine 'P1 -> IO (SizedByteArray (SerializedSize 'P1) Bytes)
p1AffSerialize
  affCompress :: Affine 'P1 -> IO (SizedByteArray (CompressedSize 'P1) Bytes)
affCompress = Affine 'P1 -> IO (SizedByteArray P1CompressSize Bytes)
Affine 'P1 -> IO (SizedByteArray (CompressedSize 'P1) Bytes)
p1AffCompress
  uncompress :: forall ba.
ByteArrayAccess ba =>
SizedByteArray (CompressedSize 'P1) ba
-> IO (Either BlstError (Affine 'P1))
uncompress = SizedByteArray P1CompressSize ba
-> IO (Either BlstError (Affine 'P1))
SizedByteArray (CompressedSize 'P1) ba
-> IO (Either BlstError (Affine 'P1))
forall ba.
ByteArrayAccess ba =>
SizedByteArray P1CompressSize ba
-> IO (Either BlstError (Affine 'P1))
p1Uncompress
  addOrDoubleAffine :: Point 'P1 -> Affine 'P1 -> IO (Point 'P1)
addOrDoubleAffine = Point 'P1 -> Affine 'P1 -> IO (Point 'P1)
p1AddOrDoubleAffine
  deserialize :: forall ba.
ByteArrayAccess ba =>
SizedByteArray (SerializedSize 'P1) ba
-> IO (Either BlstError (Affine 'P1))
deserialize = SizedByteArray P1SerializeSize ba
-> IO (Either BlstError (Affine 'P1))
SizedByteArray (SerializedSize 'P1) ba
-> IO (Either BlstError (Affine 'P1))
forall ba.
ByteArrayAccess ba =>
SizedByteArray P1SerializeSize ba
-> IO (Either BlstError (Affine 'P1))
p1Deserialize

instance IsPoint 'P2 where
  toAffine :: Point 'P2 -> IO (Affine 'P2)
toAffine = Point 'P2 -> IO (Affine 'P2)
p2ToAffine
  fromAffine :: Affine 'P2 -> IO (Point 'P2)
fromAffine = Affine 'P2 -> IO (Point 'P2)
p2FromAffine
  affSerialize :: Affine 'P2 -> IO (SizedByteArray (SerializedSize 'P2) Bytes)
affSerialize = Affine 'P2 -> IO (SizedByteArray P2SerializeSize Bytes)
Affine 'P2 -> IO (SizedByteArray (SerializedSize 'P2) Bytes)
p2AffSerialize
  affCompress :: Affine 'P2 -> IO (SizedByteArray (CompressedSize 'P2) Bytes)
affCompress = Affine 'P2 -> IO (SizedByteArray P1SerializeSize Bytes)
Affine 'P2 -> IO (SizedByteArray (CompressedSize 'P2) Bytes)
p2AffCompress
  uncompress :: forall ba.
ByteArrayAccess ba =>
SizedByteArray (CompressedSize 'P2) ba
-> IO (Either BlstError (Affine 'P2))
uncompress = SizedByteArray P1SerializeSize ba
-> IO (Either BlstError (Affine 'P2))
SizedByteArray (CompressedSize 'P2) ba
-> IO (Either BlstError (Affine 'P2))
forall ba.
ByteArrayAccess ba =>
SizedByteArray P1SerializeSize ba
-> IO (Either BlstError (Affine 'P2))
p2Uncompress
  addOrDoubleAffine :: Point 'P2 -> Affine 'P2 -> IO (Point 'P2)
addOrDoubleAffine = Point 'P2 -> Affine 'P2 -> IO (Point 'P2)
p2AddOrDoubleAffine
  deserialize :: forall ba.
ByteArrayAccess ba =>
SizedByteArray (SerializedSize 'P2) ba
-> IO (Either BlstError (Affine 'P2))
deserialize = SizedByteArray P2SerializeSize ba
-> IO (Either BlstError (Affine 'P2))
SizedByteArray (SerializedSize 'P2) ba
-> IO (Either BlstError (Affine 'P2))
forall ba.
ByteArrayAccess ba =>
SizedByteArray P2SerializeSize ba
-> IO (Either BlstError (Affine 'P2))
p2Deserialize

-- | Class for encoding/hashing to curve.
type ToCurve :: EncodeMethod -> Curve -> Constraint
class (IsCurve c, Demote meth) => ToCurve meth c where
  toCurve
    :: (ByteArrayAccess ba, ByteArrayAccess ba2)
    => ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint c))

-- Note: it might seem this is backwards, but it's not.
instance ToCurve 'Encode 'G1 where toCurve :: forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G1))
toCurve = ba -> Maybe ba2 -> IO (Point 'P2)
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G1))
forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point 'P2)
encodeToG2
instance ToCurve 'Encode 'G2 where toCurve :: forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G2))
toCurve = ba -> Maybe ba2 -> IO (Point 'P1)
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G2))
forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point 'P1)
encodeToG1
instance ToCurve 'Hash 'G1 where toCurve :: forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G1))
toCurve = ba -> Maybe ba2 -> IO (Point 'P2)
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G1))
forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point 'P2)
hashToG2
instance ToCurve 'Hash 'G2 where toCurve :: forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G2))
toCurve = ba -> Maybe ba2 -> IO (Point 'P1)
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint 'G2))
forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point 'P1)
hashToG1