{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RecordWildCards            #-}
{- HLINT ignore "Reduce duplication" -}
{-|
  Module      : Auth.Biscuit.Sel
  Copyright   : © Clément Delafargue, 2021
  License     : MIT
  Maintainer  : clement@delafargue.name
  Cryptographic primitives necessary to sign and verify biscuit tokens
-}
module Auth.Biscuit.Sel
  ( Keypair (..)
  , PrivateKey
  , PublicKey
  , Signature (..)
  , parsePrivateKey
  , parsePublicKey
  , serializePrivateKey
  , serializePublicKey
  , newKeypair
  , fromPrivateKey
  , signBlock
  , aggregate
  , verifySignature
  , hashBytes
  ) where

import           Control.Monad.Cont     (ContT (..), runContT)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.ByteString        (ByteString, packCStringLen,
                                         useAsCStringLen)
import qualified Data.ByteString        as BS
import           Data.ByteString.Base16 as Hex
import           Data.Foldable          (for_)
import           Data.Functor           (void)
import           Data.List.NonEmpty     (NonEmpty)
import           Data.Primitive.Ptr     (copyPtr)
import           Foreign.C.Types
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Libsodium

-- | A private key used to generate a biscuit
newtype PrivateKey = PrivateKey ByteString
  deriving newtype (PrivateKey -> PrivateKey -> Bool
(PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool) -> Eq PrivateKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivateKey -> PrivateKey -> Bool
$c/= :: PrivateKey -> PrivateKey -> Bool
== :: PrivateKey -> PrivateKey -> Bool
$c== :: PrivateKey -> PrivateKey -> Bool
Eq, Eq PrivateKey
Eq PrivateKey
-> (PrivateKey -> PrivateKey -> Ordering)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> PrivateKey)
-> (PrivateKey -> PrivateKey -> PrivateKey)
-> Ord PrivateKey
PrivateKey -> PrivateKey -> Bool
PrivateKey -> PrivateKey -> Ordering
PrivateKey -> PrivateKey -> PrivateKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrivateKey -> PrivateKey -> PrivateKey
$cmin :: PrivateKey -> PrivateKey -> PrivateKey
max :: PrivateKey -> PrivateKey -> PrivateKey
$cmax :: PrivateKey -> PrivateKey -> PrivateKey
>= :: PrivateKey -> PrivateKey -> Bool
$c>= :: PrivateKey -> PrivateKey -> Bool
> :: PrivateKey -> PrivateKey -> Bool
$c> :: PrivateKey -> PrivateKey -> Bool
<= :: PrivateKey -> PrivateKey -> Bool
$c<= :: PrivateKey -> PrivateKey -> Bool
< :: PrivateKey -> PrivateKey -> Bool
$c< :: PrivateKey -> PrivateKey -> Bool
compare :: PrivateKey -> PrivateKey -> Ordering
$ccompare :: PrivateKey -> PrivateKey -> Ordering
$cp1Ord :: Eq PrivateKey
Ord)

instance Show PrivateKey where
  show :: PrivateKey -> String
show (PrivateKey ByteString
bs) = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Hex.encode ByteString
bs

-- | Parse a private key from raw bytes.
-- This returns `Nothing` if the raw bytes don't have the expected length
parsePrivateKey :: ByteString -> Maybe PrivateKey
parsePrivateKey :: ByteString -> Maybe PrivateKey
parsePrivateKey ByteString
bs = if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CSize -> Int
cs2int CSize
crypto_core_ristretto255_scalarbytes
                     then PrivateKey -> Maybe PrivateKey
forall a. a -> Maybe a
Just (ByteString -> PrivateKey
PrivateKey ByteString
bs)
                     else Maybe PrivateKey
forall a. Maybe a
Nothing

-- | Serialize a private key to raw bytes
serializePrivateKey :: PrivateKey -> ByteString
serializePrivateKey :: PrivateKey -> ByteString
serializePrivateKey (PrivateKey ByteString
bs) = ByteString
bs

-- | A public key used to generate a biscuit
newtype PublicKey = PublicKey ByteString
  deriving newtype (PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c== :: PublicKey -> PublicKey -> Bool
Eq, Eq PublicKey
Eq PublicKey
-> (PublicKey -> PublicKey -> Ordering)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> PublicKey)
-> (PublicKey -> PublicKey -> PublicKey)
-> Ord PublicKey
PublicKey -> PublicKey -> Bool
PublicKey -> PublicKey -> Ordering
PublicKey -> PublicKey -> PublicKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PublicKey -> PublicKey -> PublicKey
$cmin :: PublicKey -> PublicKey -> PublicKey
max :: PublicKey -> PublicKey -> PublicKey
$cmax :: PublicKey -> PublicKey -> PublicKey
>= :: PublicKey -> PublicKey -> Bool
$c>= :: PublicKey -> PublicKey -> Bool
> :: PublicKey -> PublicKey -> Bool
$c> :: PublicKey -> PublicKey -> Bool
<= :: PublicKey -> PublicKey -> Bool
$c<= :: PublicKey -> PublicKey -> Bool
< :: PublicKey -> PublicKey -> Bool
$c< :: PublicKey -> PublicKey -> Bool
compare :: PublicKey -> PublicKey -> Ordering
$ccompare :: PublicKey -> PublicKey -> Ordering
$cp1Ord :: Eq PublicKey
Ord)

-- | Parse a public key from raw bytes.
-- This returns `Nothing` if the raw bytes don't have the expected length
parsePublicKey :: ByteString -> Maybe PublicKey
parsePublicKey :: ByteString -> Maybe PublicKey
parsePublicKey ByteString
bs = if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CSize -> Int
cs2int CSize
crypto_core_ristretto255_bytes
                     then PublicKey -> Maybe PublicKey
forall a. a -> Maybe a
Just (ByteString -> PublicKey
PublicKey ByteString
bs)
                     else Maybe PublicKey
forall a. Maybe a
Nothing

-- | Serialize a public key to raw bytes
serializePublicKey :: PublicKey -> ByteString
serializePublicKey :: PublicKey -> ByteString
serializePublicKey (PublicKey ByteString
bs) = ByteString
bs

instance Show PublicKey where
  show :: PublicKey -> String
show (PublicKey ByteString
bs) = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Hex.encode ByteString
bs

-- | A keypair containing both a private key and a public key
data Keypair
  = Keypair
  { Keypair -> PrivateKey
privateKey :: PrivateKey
  -- ^ the private key
  , Keypair -> PublicKey
publicKey  :: PublicKey
  -- ^ the public key
  } deriving (Keypair -> Keypair -> Bool
(Keypair -> Keypair -> Bool)
-> (Keypair -> Keypair -> Bool) -> Eq Keypair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Keypair -> Keypair -> Bool
$c/= :: Keypair -> Keypair -> Bool
== :: Keypair -> Keypair -> Bool
$c== :: Keypair -> Keypair -> Bool
Eq, Eq Keypair
Eq Keypair
-> (Keypair -> Keypair -> Ordering)
-> (Keypair -> Keypair -> Bool)
-> (Keypair -> Keypair -> Bool)
-> (Keypair -> Keypair -> Bool)
-> (Keypair -> Keypair -> Bool)
-> (Keypair -> Keypair -> Keypair)
-> (Keypair -> Keypair -> Keypair)
-> Ord Keypair
Keypair -> Keypair -> Bool
Keypair -> Keypair -> Ordering
Keypair -> Keypair -> Keypair
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Keypair -> Keypair -> Keypair
$cmin :: Keypair -> Keypair -> Keypair
max :: Keypair -> Keypair -> Keypair
$cmax :: Keypair -> Keypair -> Keypair
>= :: Keypair -> Keypair -> Bool
$c>= :: Keypair -> Keypair -> Bool
> :: Keypair -> Keypair -> Bool
$c> :: Keypair -> Keypair -> Bool
<= :: Keypair -> Keypair -> Bool
$c<= :: Keypair -> Keypair -> Bool
< :: Keypair -> Keypair -> Bool
$c< :: Keypair -> Keypair -> Bool
compare :: Keypair -> Keypair -> Ordering
$ccompare :: Keypair -> Keypair -> Ordering
$cp1Ord :: Eq Keypair
Ord)

instance Show Keypair where
  show :: Keypair -> String
show Keypair{PrivateKey
privateKey :: PrivateKey
privateKey :: Keypair -> PrivateKey
privateKey, PublicKey
publicKey :: PublicKey
publicKey :: Keypair -> PublicKey
publicKey} =
    PrivateKey -> String
forall a. Show a => a -> String
show PrivateKey
privateKey String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKey -> String
forall a. Show a => a -> String
show PublicKey
publicKey

keypairFromScalar :: Scalar -> CIO a Keypair
keypairFromScalar :: Scalar -> CIO a Keypair
keypairFromScalar Scalar
scalarBuf = do
  Scalar
pointBuf <- Scalar -> CIO a Scalar
forall a. Scalar -> CIO a Scalar
scalarToPoint Scalar
scalarBuf
  PrivateKey
privateKey <- ByteString -> PrivateKey
PrivateKey (ByteString -> PrivateKey)
-> ContT a IO ByteString -> ContT a IO PrivateKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scalar -> ContT a IO ByteString
forall (m :: * -> *). MonadIO m => Scalar -> m ByteString
scalarToByteString Scalar
scalarBuf
  PublicKey
publicKey <-  ByteString -> PublicKey
PublicKey (ByteString -> PublicKey)
-> ContT a IO ByteString -> ContT a IO PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scalar -> ContT a IO ByteString
forall (m :: * -> *). MonadIO m => Scalar -> m ByteString
pointToByteString Scalar
pointBuf
  Keypair -> CIO a Keypair
forall (f :: * -> *) a. Applicative f => a -> f a
pure Keypair :: PrivateKey -> PublicKey -> Keypair
Keypair{PublicKey
PrivateKey
publicKey :: PublicKey
privateKey :: PrivateKey
publicKey :: PublicKey
privateKey :: PrivateKey
..}

-- | Generate a random keypair
newKeypair :: IO Keypair
newKeypair :: IO Keypair
newKeypair = ContT Keypair IO Keypair -> IO Keypair
forall a. ContT a IO a -> IO a
runCIO (ContT Keypair IO Keypair -> IO Keypair)
-> ContT Keypair IO Keypair -> IO Keypair
forall a b. (a -> b) -> a -> b
$ do
  Scalar
scalar <- CIO Keypair Scalar
forall a. CIO a Scalar
randomScalar
  Scalar -> ContT Keypair IO Keypair
forall a. Scalar -> CIO a Keypair
keypairFromScalar Scalar
scalar

-- | Construct a keypair from a private key
fromPrivateKey :: PrivateKey -> IO Keypair
fromPrivateKey :: PrivateKey -> IO Keypair
fromPrivateKey (PrivateKey ByteString
privBs) = ContT Keypair IO Keypair -> IO Keypair
forall a. ContT a IO a -> IO a
runCIO (ContT Keypair IO Keypair -> IO Keypair)
-> ContT Keypair IO Keypair -> IO Keypair
forall a b. (a -> b) -> a -> b
$ do
  (Scalar
privBuf, CULLong
_) <- ByteString -> ContT Keypair IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
privBs
  Scalar -> ContT Keypair IO Keypair
forall a. Scalar -> CIO a Keypair
keypairFromScalar Scalar
privBuf

-- | The signature of a series of blocks (raw bytestrings)
data Signature
  = Signature
  { Signature -> [ByteString]
parameters :: [ByteString]
  -- ^ the list of parameters used to sign each block
  , Signature -> ByteString
z          :: ByteString
  -- ^ the aggregated signature
  } deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show)

type Scalar = Ptr CUChar
type Point = Ptr CUChar

-- | Pointer allocations are written in a continuation passing style,
-- this type alias allows to use monadic notation instead of nesting
-- callbacks
type CIO a = ContT a IO

-- | Run a continuation to get back an IO value.
runCIO :: ContT a IO a -> IO a
runCIO :: ContT a IO a -> IO a
runCIO = (ContT a IO a -> (a -> IO a) -> IO a
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
`runContT` a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

voidIO :: IO a -> CIO b ()
voidIO :: IO a -> CIO b ()
voidIO = ContT b IO a -> CIO b ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ContT b IO a -> CIO b ())
-> (IO a -> ContT b IO a) -> IO a -> CIO b ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ContT b IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

scalarToByteString :: MonadIO m => Ptr CUChar -> m ByteString
scalarToByteString :: Scalar -> m ByteString
scalarToByteString Scalar
ptr =
  let scalarIntSize :: Int
scalarIntSize = CSize -> Int
cs2int CSize
crypto_core_ristretto255_scalarbytes
   in IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
packCStringLen (Scalar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Scalar
ptr, Int
scalarIntSize)

pointToByteString :: MonadIO m => Ptr CUChar -> m ByteString
pointToByteString :: Scalar -> m ByteString
pointToByteString Scalar
ptr =
  let pointIntSize :: Int
pointIntSize = CSize -> Int
cs2int CSize
crypto_core_ristretto255_bytes
   in IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
packCStringLen (Scalar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Scalar
ptr, Int
pointIntSize)

randomScalar :: CIO a Scalar
randomScalar :: CIO a Scalar
randomScalar = do
  Scalar
scalarBuf <- CIO a Scalar
forall a. CIO a Scalar
withScalar
  IO () -> ContT a IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT a IO ()) -> IO () -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ Scalar -> IO ()
forall k (r :: k). Scalar -> IO ()
crypto_core_ristretto255_scalar_random Scalar
scalarBuf
  Scalar -> CIO a Scalar
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
scalarBuf

withScalar :: CIO a Scalar
withScalar :: CIO a Scalar
withScalar =
  let intScalarSize :: Int
intScalarSize = CSize -> Int
cs2int CSize
crypto_core_ristretto255_scalarbytes
   in ((Scalar -> IO a) -> IO a) -> CIO a Scalar
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Scalar -> IO a) -> IO a) -> CIO a Scalar)
-> ((Scalar -> IO a) -> IO a) -> CIO a Scalar
forall a b. (a -> b) -> a -> b
$ Int -> (Scalar -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
intScalarSize

withPoint :: CIO a Point
withPoint :: CIO a Scalar
withPoint =
  let intPointSize :: Int
intPointSize = CSize -> Int
cs2int CSize
crypto_core_ristretto255_bytes
   in ((Scalar -> IO a) -> IO a) -> CIO a Scalar
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Scalar -> IO a) -> IO a) -> CIO a Scalar)
-> ((Scalar -> IO a) -> IO a) -> CIO a Scalar
forall a b. (a -> b) -> a -> b
$ Int -> (Scalar -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
intPointSize

scalarToPoint :: Scalar
              -> CIO a Point
scalarToPoint :: Scalar -> CIO a Scalar
scalarToPoint Scalar
scalar = do
  Scalar
pointBuf <- CIO a Scalar
forall a. CIO a Scalar
withPoint
  IO CInt -> CIO a ()
forall a b. IO a -> CIO b ()
voidIO (IO CInt -> CIO a ()) -> IO CInt -> CIO a ()
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> IO CInt
forall k1 k2 (q :: k1) (n :: k2). Scalar -> Scalar -> IO CInt
crypto_scalarmult_ristretto255_base Scalar
pointBuf Scalar
scalar
  Scalar -> CIO a Scalar
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
pointBuf

withBSLen :: ByteString
          -> ContT a IO (Ptr CUChar, CULLong)
withBSLen :: ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
bs = do
  (Ptr CChar
buf, Int
int) <- ((CStringLen -> IO a) -> IO a) -> ContT a IO CStringLen
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CStringLen -> IO a) -> IO a) -> ContT a IO CStringLen)
-> ((CStringLen -> IO a) -> IO a) -> ContT a IO CStringLen
forall a b. (a -> b) -> a -> b
$ ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen ByteString
bs
  (Scalar, CULLong) -> ContT a IO (Scalar, CULLong)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr CChar -> Scalar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
buf, Int -> CULLong
forall a. Enum a => Int -> a
toEnum Int
int)

scalarAdd :: Scalar -> Scalar -> CIO a Scalar
scalarAdd :: Scalar -> Scalar -> CIO a Scalar
scalarAdd Scalar
x Scalar
y = do
  Scalar
z <- CIO a Scalar
forall a. CIO a Scalar
withScalar
  IO () -> ContT a IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT a IO ()) -> IO () -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> Scalar -> IO ()
forall k1 k2 k3 (z :: k1) (x :: k2) (y :: k3).
Scalar -> Scalar -> Scalar -> IO ()
crypto_core_ristretto255_scalar_add Scalar
z Scalar
x Scalar
y
  Scalar -> CIO a Scalar
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
z

scalarAddBs :: ByteString -> ByteString -> CIO a ByteString
scalarAddBs :: ByteString -> ByteString -> CIO a ByteString
scalarAddBs ByteString
xBs ByteString
yBs = do
  (Scalar
x, CULLong
_) <- ByteString -> ContT a IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
xBs
  (Scalar
y, CULLong
_) <- ByteString -> ContT a IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
yBs
  Scalar
z <- Scalar -> Scalar -> CIO a Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
scalarAdd Scalar
x Scalar
y
  Scalar -> CIO a ByteString
forall (m :: * -> *). MonadIO m => Scalar -> m ByteString
scalarToByteString Scalar
z

scalarMul :: Scalar -> Scalar -> CIO a Scalar
scalarMul :: Scalar -> Scalar -> CIO a Scalar
scalarMul Scalar
x Scalar
y = do
  Scalar
z <- CIO a Scalar
forall a. CIO a Scalar
withScalar
  Scalar
z Scalar -> ContT a IO () -> CIO a Scalar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> ContT a IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Scalar -> Scalar -> Scalar -> IO ()
forall k1 k2 k3 (z :: k1) (x :: k2) (y :: k3).
Scalar -> Scalar -> Scalar -> IO ()
crypto_core_ristretto255_scalar_mul Scalar
z Scalar
x Scalar
y)

scalarSub :: Scalar -> Scalar -> CIO a Scalar
scalarSub :: Scalar -> Scalar -> CIO a Scalar
scalarSub Scalar
x Scalar
y = do
  Scalar
z <- CIO a Scalar
forall a. CIO a Scalar
withScalar
  Scalar
z Scalar -> ContT a IO () -> CIO a Scalar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> ContT a IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Scalar -> Scalar -> Scalar -> IO ()
forall k1 k2 k3 (z :: k1) (x :: k2) (y :: k3).
Scalar -> Scalar -> Scalar -> IO ()
crypto_core_ristretto255_scalar_sub Scalar
z Scalar
x Scalar
y)

scalarReduce :: Ptr CUChar -> CIO a Scalar
scalarReduce :: Scalar -> CIO a Scalar
scalarReduce Scalar
bytes = do
  Scalar
z <- CIO a Scalar
forall a. CIO a Scalar
withScalar
  Scalar
z Scalar -> ContT a IO () -> CIO a Scalar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> ContT a IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Scalar -> Scalar -> IO ()
forall k1 k2 (r :: k1) (s :: k2). Scalar -> Scalar -> IO ()
crypto_core_ristretto255_scalar_reduce Scalar
z Scalar
bytes)

scalarMulPoint :: Scalar -> Point -> CIO a Point
scalarMulPoint :: Scalar -> Scalar -> CIO a Scalar
scalarMulPoint Scalar
p Scalar
q = do
  Scalar
n <- CIO a Scalar
forall a. CIO a Scalar
withScalar
  Scalar
n Scalar -> ContT a IO CInt -> CIO a Scalar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO CInt -> ContT a IO CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Scalar -> Scalar -> Scalar -> IO CInt
forall k1 k2 k3 (q :: k1) (n :: k2) (p :: k3).
Scalar -> Scalar -> Scalar -> IO CInt
crypto_scalarmult_ristretto255 Scalar
n Scalar
p Scalar
q)

pointAdd :: Point -> Point -> CIO a Point
pointAdd :: Scalar -> Scalar -> CIO a Scalar
pointAdd Scalar
p Scalar
q = do
  Scalar
r <- CIO a Scalar
forall a. CIO a Scalar
withPoint
  Scalar
r Scalar -> ContT a IO CInt -> CIO a Scalar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO CInt -> ContT a IO CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Scalar -> Scalar -> Scalar -> IO CInt
forall k1 k2 k3 (q :: k1) (n :: k2) (p :: k3).
Scalar -> Scalar -> Scalar -> IO CInt
crypto_core_ristretto255_add Scalar
r Scalar
p Scalar
q)

pointSub :: Point -> Point -> CIO a Point
pointSub :: Scalar -> Scalar -> CIO a Scalar
pointSub Scalar
p Scalar
q = do
  Scalar
r <- CIO a Scalar
forall a. CIO a Scalar
withPoint
  Scalar
r Scalar -> ContT a IO CInt -> CIO a Scalar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO CInt -> ContT a IO CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Scalar -> Scalar -> Scalar -> IO CInt
forall k1 k2 k3 (q :: k1) (n :: k2) (p :: k3).
Scalar -> Scalar -> Scalar -> IO CInt
crypto_core_ristretto255_sub Scalar
r Scalar
p Scalar
q)

zeroPoint :: CIO a Point
zeroPoint :: CIO a Scalar
zeroPoint = do
  Scalar
p <- CIO a Scalar
forall a. CIO a Scalar
withPoint
  Scalar
p Scalar -> ContT a IO () -> CIO a Scalar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scalar -> ContT a IO ()
forall (m :: * -> *). MonadIO m => Scalar -> m ()
zeroizePoint Scalar
p

zeroizePoint :: MonadIO m => Point -> m ()
zeroizePoint :: Scalar -> m ()
zeroizePoint Scalar
p = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Scalar -> CSize -> IO ()
forall k1 k2 (pnt :: k1) x (len :: k2).
(pnt ::: Ptr x) -> CSize -> IO ()
sodium_memzero Scalar
p CSize
crypto_core_ristretto255_bytes

isZeroPoint :: MonadIO m => Point -> m Bool
isZeroPoint :: Scalar -> m Bool
isZeroPoint Scalar
p = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
  (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1) (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scalar -> CSize -> IO CInt
forall k1 k2 (n :: k1) (nlen :: k2). Scalar -> CSize -> IO CInt
sodium_is_zero Scalar
p CSize
crypto_core_ristretto255_scalarbytes

-- | Hash a bytestring with SHA256
hashBytes :: ByteString
          -> IO ByteString
hashBytes :: ByteString -> IO ByteString
hashBytes ByteString
message = ContT ByteString IO ByteString -> IO ByteString
forall a. ContT a IO a -> IO a
runCIO (ContT ByteString IO ByteString -> IO ByteString)
-> ContT ByteString IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
  Scalar
out <- ((Scalar -> IO ByteString) -> IO ByteString)
-> ContT ByteString IO Scalar
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Scalar -> IO ByteString) -> IO ByteString)
 -> ContT ByteString IO Scalar)
-> ((Scalar -> IO ByteString) -> IO ByteString)
-> ContT ByteString IO Scalar
forall a b. (a -> b) -> a -> b
$ Int -> (Scalar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int -> (Scalar -> IO ByteString) -> IO ByteString)
-> Int -> (Scalar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ CSize -> Int
cs2int CSize
crypto_hash_sha256_bytes
  (Scalar
buf, CULLong
len) <- ByteString -> ContT ByteString IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
message
  IO CInt -> CIO ByteString ()
forall a b. IO a -> CIO b ()
voidIO (IO CInt -> CIO ByteString ()) -> IO CInt -> CIO ByteString ()
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> CULLong -> IO CInt
forall k1 k2 k3 (out :: k1) (in_ :: k2) (inlen :: k3).
Scalar -> Scalar -> CULLong -> IO CInt
crypto_hash_sha256 Scalar
out Scalar
buf CULLong
len
  IO ByteString -> ContT ByteString IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ContT ByteString IO ByteString)
-> IO ByteString -> ContT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
packCStringLen (Scalar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Scalar
out, CSize -> Int
cs2int CSize
crypto_hash_sha256_bytes)

hashPoint :: Point
           -> ContT a IO Scalar
hashPoint :: Scalar -> ContT a IO Scalar
hashPoint Scalar
point = do
  Scalar
hash   <- ((Scalar -> IO a) -> IO a) -> ContT a IO Scalar
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Scalar -> IO a) -> IO a) -> ContT a IO Scalar)
-> ((Scalar -> IO a) -> IO a) -> ContT a IO Scalar
forall a b. (a -> b) -> a -> b
$ Int -> (Scalar -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
cs2int CSize
crypto_hash_sha512_bytes)
  IO CInt -> CIO a ()
forall a b. IO a -> CIO b ()
voidIO (IO CInt -> CIO a ()) -> IO CInt -> CIO a ()
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> CULLong -> IO CInt
forall k1 k2 k3 (out :: k1) (in_ :: k2) (inlen :: k3).
Scalar -> Scalar -> CULLong -> IO CInt
crypto_hash_sha512 Scalar
hash Scalar
point (Integer -> CULLong
forall a. Num a => Integer -> a
fromInteger (Integer -> CULLong) -> Integer -> CULLong
forall a b. (a -> b) -> a -> b
$ CSize -> Integer
forall a. Integral a => a -> Integer
toInteger CSize
crypto_core_ristretto255_bytes)
  Scalar -> ContT a IO Scalar
forall a. Scalar -> CIO a Scalar
scalarReduce Scalar
hash

copyPointFrom :: Point -> Point -> IO ()
copyPointFrom :: Scalar -> Scalar -> IO ()
copyPointFrom Scalar
to Scalar
from = Scalar -> Scalar -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> Ptr a -> Int -> m ()
copyPtr Scalar
to Scalar
from (CSize -> Int
cs2int CSize
crypto_core_ristretto255_bytes)

hashMessage :: ByteString
            -> ByteString
            -> CIO a Scalar
hashMessage :: ByteString -> ByteString -> CIO a Scalar
hashMessage ByteString
publicKey ByteString
message = do
  (Scalar
kpBuf, CULLong
kpLen) <- ByteString -> ContT a IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
publicKey
  (Scalar
msgBuf, CULLong
msgLen) <- ByteString -> ContT a IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
message
  Crypto_hash_sha512_state
state <- IO Crypto_hash_sha512_state -> ContT a IO Crypto_hash_sha512_state
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Crypto_hash_sha512_state
crypto_hash_sha512_state'malloc
  Ptr Crypto_hash_sha512_state
statePtr <- ((Ptr Crypto_hash_sha512_state -> IO a) -> IO a)
-> ContT a IO (Ptr Crypto_hash_sha512_state)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Crypto_hash_sha512_state -> IO a) -> IO a)
 -> ContT a IO (Ptr Crypto_hash_sha512_state))
-> ((Ptr Crypto_hash_sha512_state -> IO a) -> IO a)
-> ContT a IO (Ptr Crypto_hash_sha512_state)
forall a b. (a -> b) -> a -> b
$ Crypto_hash_sha512_state
-> (Ptr Crypto_hash_sha512_state -> IO a) -> IO a
forall x.
Crypto_hash_sha512_state
-> (Ptr Crypto_hash_sha512_state -> IO x) -> IO x
crypto_hash_sha512_state'ptr Crypto_hash_sha512_state
state
  IO CInt -> CIO a ()
forall a b. IO a -> CIO b ()
voidIO (IO CInt -> CIO a ()) -> IO CInt -> CIO a ()
forall a b. (a -> b) -> a -> b
$ Ptr Crypto_hash_sha512_state -> IO CInt
forall k (state :: k). Ptr Crypto_hash_sha512_state -> IO CInt
crypto_hash_sha512_init Ptr Crypto_hash_sha512_state
statePtr
  IO CInt -> CIO a ()
forall a b. IO a -> CIO b ()
voidIO (IO CInt -> CIO a ()) -> IO CInt -> CIO a ()
forall a b. (a -> b) -> a -> b
$ Ptr Crypto_hash_sha512_state -> Scalar -> CULLong -> IO CInt
forall k1 k2 k3 (state :: k1) (in_ :: k2) (inlen :: k3).
Ptr Crypto_hash_sha512_state -> Scalar -> CULLong -> IO CInt
crypto_hash_sha512_update Ptr Crypto_hash_sha512_state
statePtr Scalar
kpBuf CULLong
kpLen
  IO CInt -> CIO a ()
forall a b. IO a -> CIO b ()
voidIO (IO CInt -> CIO a ()) -> IO CInt -> CIO a ()
forall a b. (a -> b) -> a -> b
$ Ptr Crypto_hash_sha512_state -> Scalar -> CULLong -> IO CInt
forall k1 k2 k3 (state :: k1) (in_ :: k2) (inlen :: k3).
Ptr Crypto_hash_sha512_state -> Scalar -> CULLong -> IO CInt
crypto_hash_sha512_update Ptr Crypto_hash_sha512_state
statePtr Scalar
msgBuf CULLong
msgLen
  Scalar
hash <- ((Scalar -> IO a) -> IO a) -> CIO a Scalar
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Scalar -> IO a) -> IO a) -> CIO a Scalar)
-> ((Scalar -> IO a) -> IO a) -> CIO a Scalar
forall a b. (a -> b) -> a -> b
$ Int -> (Scalar -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
cs2int CSize
crypto_hash_sha512_bytes)
  IO CInt -> CIO a ()
forall a b. IO a -> CIO b ()
voidIO (IO CInt -> CIO a ()) -> IO CInt -> CIO a ()
forall a b. (a -> b) -> a -> b
$ Ptr Crypto_hash_sha512_state -> Scalar -> IO CInt
forall k1 k2 (state :: k1) (out :: k2).
Ptr Crypto_hash_sha512_state -> Scalar -> IO CInt
crypto_hash_sha512_final Ptr Crypto_hash_sha512_state
statePtr Scalar
hash
  Scalar
scalar <- CIO a Scalar
forall a. CIO a Scalar
withScalar
  IO () -> CIO a ()
forall a b. IO a -> CIO b ()
voidIO (IO () -> CIO a ()) -> IO () -> CIO a ()
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> IO ()
forall k1 k2 (r :: k1) (s :: k2). Scalar -> Scalar -> IO ()
crypto_core_ristretto255_scalar_reduce Scalar
scalar Scalar
hash
  Scalar -> CIO a Scalar
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
scalar

-- | Sign a single block with the given keypair
signBlock :: Keypair -> ByteString -> IO Signature
signBlock :: Keypair -> ByteString -> IO Signature
signBlock Keypair{PublicKey
publicKey :: PublicKey
publicKey :: Keypair -> PublicKey
publicKey,PrivateKey
privateKey :: PrivateKey
privateKey :: Keypair -> PrivateKey
privateKey} ByteString
message = do
  let PublicKey ByteString
pubBs = PublicKey
publicKey
      PrivateKey ByteString
prvBs = PrivateKey
privateKey
  (ContT Signature IO Signature
-> (Signature -> IO Signature) -> IO Signature
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
`runContT` Signature -> IO Signature
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ContT Signature IO Signature -> IO Signature)
-> ContT Signature IO Signature -> IO Signature
forall a b. (a -> b) -> a -> b
$ do
     (Scalar
pk, CULLong
_) <- ByteString -> ContT Signature IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
prvBs

     Scalar
r   <- CIO Signature Scalar
forall a. CIO a Scalar
randomScalar
     Scalar
aa  <- Scalar -> CIO Signature Scalar
forall a. Scalar -> CIO a Scalar
scalarToPoint Scalar
r
     Scalar
d   <- Scalar -> CIO Signature Scalar
forall a. Scalar -> CIO a Scalar
hashPoint Scalar
aa
     Scalar
e   <- ByteString -> ByteString -> CIO Signature Scalar
forall a. ByteString -> ByteString -> CIO a Scalar
hashMessage ByteString
pubBs ByteString
message
     Scalar
rd  <- Scalar -> Scalar -> CIO Signature Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
scalarMul Scalar
r Scalar
d
     Scalar
epk <- Scalar -> Scalar -> CIO Signature Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
scalarMul Scalar
e Scalar
pk
     Scalar
z   <- Scalar -> Scalar -> CIO Signature Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
scalarSub Scalar
rd Scalar
epk
     ByteString
aaBs <- Scalar -> ContT Signature IO ByteString
forall (m :: * -> *). MonadIO m => Scalar -> m ByteString
pointToByteString Scalar
aa
     ByteString
zBs  <- Scalar -> ContT Signature IO ByteString
forall (m :: * -> *). MonadIO m => Scalar -> m ByteString
scalarToByteString Scalar
z
     Signature -> ContT Signature IO Signature
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature :: [ByteString] -> ByteString -> Signature
Signature { parameters :: [ByteString]
parameters = [ByteString
aaBs]
                    , z :: ByteString
z = ByteString
zBs
                    }

-- | Aggregate two signatures into a single one
aggregate :: Signature -> Signature -> IO Signature
aggregate :: Signature -> Signature -> IO Signature
aggregate Signature
first Signature
second = ContT Signature IO Signature -> IO Signature
forall a. ContT a IO a -> IO a
runCIO (ContT Signature IO Signature -> IO Signature)
-> ContT Signature IO Signature -> IO Signature
forall a b. (a -> b) -> a -> b
$ do
  ByteString
z <- ByteString -> ByteString -> ContT Signature IO ByteString
forall a. ByteString -> ByteString -> CIO a ByteString
scalarAddBs (Signature -> ByteString
z Signature
first) (Signature -> ByteString
z Signature
second)
  Signature -> ContT Signature IO Signature
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature :: [ByteString] -> ByteString -> Signature
Signature
    { parameters :: [ByteString]
parameters = Signature -> [ByteString]
parameters Signature
first [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> Signature -> [ByteString]
parameters Signature
second
    , ByteString
z :: ByteString
z :: ByteString
z
    }

-- | Verify a signature, given a list of messages and associated
-- public keys
verifySignature :: NonEmpty (PublicKey, ByteString)
                -> Signature
                -> IO Bool
verifySignature :: NonEmpty (PublicKey, ByteString) -> Signature -> IO Bool
verifySignature NonEmpty (PublicKey, ByteString)
messagesAndPks Signature{[ByteString]
parameters :: [ByteString]
parameters :: Signature -> [ByteString]
parameters,ByteString
z :: ByteString
z :: Signature -> ByteString
z} = ContT Bool IO Bool -> IO Bool
forall a. ContT a IO a -> IO a
runCIO (ContT Bool IO Bool -> IO Bool) -> ContT Bool IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
  Scalar
zP      <- Scalar -> CIO Bool Scalar
forall a. Scalar -> CIO a Scalar
scalarToPoint (Scalar -> CIO Bool Scalar)
-> ((Scalar, CULLong) -> Scalar)
-> (Scalar, CULLong)
-> CIO Bool Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scalar, CULLong) -> Scalar
forall a b. (a, b) -> a
fst  ((Scalar, CULLong) -> CIO Bool Scalar)
-> ContT Bool IO (Scalar, CULLong) -> CIO Bool Scalar
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ContT Bool IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
z
  Scalar
eiXiRes <- NonEmpty (PublicKey, ByteString) -> CIO Bool Scalar
forall a. NonEmpty (PublicKey, ByteString) -> ContT a IO Scalar
computeHashMSums NonEmpty (PublicKey, ByteString)
messagesAndPks
  Scalar
diAiRes <- [ByteString] -> CIO Bool Scalar
forall a. [ByteString] -> ContT a IO Scalar
computeHashPSums [ByteString]
parameters
  Scalar
resTmp  <- Scalar -> Scalar -> CIO Bool Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
pointAdd Scalar
zP Scalar
eiXiRes
  Scalar
res     <- Scalar -> Scalar -> CIO Bool Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
pointSub Scalar
resTmp Scalar
diAiRes
  Scalar -> ContT Bool IO Bool
forall (m :: * -> *). MonadIO m => Scalar -> m Bool
isZeroPoint Scalar
res

computeHashMSums :: NonEmpty (PublicKey, ByteString)
                 -> ContT a IO Point
computeHashMSums :: NonEmpty (PublicKey, ByteString) -> ContT a IO Scalar
computeHashMSums NonEmpty (PublicKey, ByteString)
messagesAndPks = do
  Scalar
eiXiRes <- ContT a IO Scalar
forall a. CIO a Scalar
zeroPoint
  NonEmpty (PublicKey, ByteString)
-> ((PublicKey, ByteString) -> ContT a IO ()) -> ContT a IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty (PublicKey, ByteString)
messagesAndPks (((PublicKey, ByteString) -> ContT a IO ()) -> ContT a IO ())
-> ((PublicKey, ByteString) -> ContT a IO ()) -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ \(PublicKey ByteString
publicKey, ByteString
message) -> do
    Scalar
ei         <- ByteString -> ByteString -> ContT a IO Scalar
forall a. ByteString -> ByteString -> CIO a Scalar
hashMessage ByteString
publicKey ByteString
message
    Scalar
eiXi       <- Scalar -> Scalar -> ContT a IO Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
scalarMulPoint Scalar
ei (Scalar -> ContT a IO Scalar)
-> ((Scalar, CULLong) -> Scalar)
-> (Scalar, CULLong)
-> ContT a IO Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scalar, CULLong) -> Scalar
forall a b. (a, b) -> a
fst ((Scalar, CULLong) -> ContT a IO Scalar)
-> ContT a IO (Scalar, CULLong) -> ContT a IO Scalar
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ContT a IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
publicKey
    Scalar
eiXiResTmp <- Scalar -> Scalar -> ContT a IO Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
pointAdd Scalar
eiXiRes Scalar
eiXi
    IO () -> ContT a IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT a IO ()) -> IO () -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> IO ()
copyPointFrom Scalar
eiXiRes Scalar
eiXiResTmp
  Scalar -> ContT a IO Scalar
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
eiXiRes

computeHashPSums :: [ByteString] -- parameters
                 -> ContT a IO Point
computeHashPSums :: [ByteString] -> ContT a IO Scalar
computeHashPSums [ByteString]
parameters = do
  Scalar
diAiRes <- ContT a IO Scalar
forall a. CIO a Scalar
zeroPoint
  [ByteString] -> (ByteString -> ContT a IO ()) -> ContT a IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ByteString]
parameters ((ByteString -> ContT a IO ()) -> ContT a IO ())
-> (ByteString -> ContT a IO ()) -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ \ByteString
aa -> do
    (Scalar
aaBuf, CULLong
_) <- ByteString -> ContT a IO (Scalar, CULLong)
forall a. ByteString -> ContT a IO (Scalar, CULLong)
withBSLen ByteString
aa
    Scalar
di         <- Scalar -> ContT a IO Scalar
forall a. Scalar -> CIO a Scalar
hashPoint Scalar
aaBuf
    Scalar
diAi       <- Scalar -> Scalar -> ContT a IO Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
scalarMulPoint Scalar
di Scalar
aaBuf
    Scalar
diAiResTmp <- Scalar -> Scalar -> ContT a IO Scalar
forall a. Scalar -> Scalar -> CIO a Scalar
pointAdd Scalar
diAiRes Scalar
diAi
    IO () -> ContT a IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT a IO ()) -> IO () -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> IO ()
copyPointFrom Scalar
diAiRes Scalar
diAiResTmp
  Scalar -> ContT a IO Scalar
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
diAiRes

cs2int :: CSize -> Int
cs2int :: CSize -> Int
cs2int = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (CSize -> Integer) -> CSize -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Integer
forall a. Integral a => a -> Integer
toInteger