{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Crypto.PubKey.EdDSA
( SecretKey
, PublicKey
, Signature
, EllipticCurveEdDSA(CurveDigestSize)
, publicKeySize
, secretKeySize
, signatureSize
, signature
, publicKey
, secretKey
, toPublic
, sign
, signCtx
, signPh
, verify
, verifyCtx
, verifyPh
, generateSecretKey
) where
import Data.Bits
import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View)
import qualified Data.ByteArray as B
import Data.ByteString (ByteString)
import Data.Proxy
import Crypto.ECC
import qualified Crypto.ECC.Edwards25519 as Edwards25519
import Crypto.Error
import Crypto.Hash (Digest)
import Crypto.Hash.IO
import Crypto.Random
import GHC.TypeLits (KnownNat, Nat)
import Crypto.Internal.Builder
import Crypto.Internal.Compat
import Crypto.Internal.Imports
import Crypto.Internal.Nat (integralNatVal)
import Foreign.Storable
newtype SecretKey curve = SecretKey ScrubbedBytes
deriving (Int -> SecretKey curve -> ShowS
[SecretKey curve] -> ShowS
SecretKey curve -> String
(Int -> SecretKey curve -> ShowS)
-> (SecretKey curve -> String)
-> ([SecretKey curve] -> ShowS)
-> Show (SecretKey curve)
forall curve. Int -> SecretKey curve -> ShowS
forall curve. [SecretKey curve] -> ShowS
forall curve. SecretKey curve -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKey curve] -> ShowS
$cshowList :: forall curve. [SecretKey curve] -> ShowS
show :: SecretKey curve -> String
$cshow :: forall curve. SecretKey curve -> String
showsPrec :: Int -> SecretKey curve -> ShowS
$cshowsPrec :: forall curve. Int -> SecretKey curve -> ShowS
Show,SecretKey curve -> SecretKey curve -> Bool
(SecretKey curve -> SecretKey curve -> Bool)
-> (SecretKey curve -> SecretKey curve -> Bool)
-> Eq (SecretKey curve)
forall curve. SecretKey curve -> SecretKey curve -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKey curve -> SecretKey curve -> Bool
$c/= :: forall curve. SecretKey curve -> SecretKey curve -> Bool
== :: SecretKey curve -> SecretKey curve -> Bool
$c== :: forall curve. SecretKey curve -> SecretKey curve -> Bool
Eq,SecretKey curve -> Int
SecretKey curve -> Ptr p -> IO ()
SecretKey curve -> (Ptr p -> IO a) -> IO a
(SecretKey curve -> Int)
-> (forall p a. SecretKey curve -> (Ptr p -> IO a) -> IO a)
-> (forall p. SecretKey curve -> Ptr p -> IO ())
-> ByteArrayAccess (SecretKey curve)
forall curve. SecretKey curve -> Int
forall p. SecretKey curve -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall curve p. SecretKey curve -> Ptr p -> IO ()
forall p a. SecretKey curve -> (Ptr p -> IO a) -> IO a
forall curve p a. SecretKey curve -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: SecretKey curve -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall curve p. SecretKey curve -> Ptr p -> IO ()
withByteArray :: SecretKey curve -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall curve p a. SecretKey curve -> (Ptr p -> IO a) -> IO a
length :: SecretKey curve -> Int
$clength :: forall curve. SecretKey curve -> Int
ByteArrayAccess,SecretKey curve -> ()
(SecretKey curve -> ()) -> NFData (SecretKey curve)
forall curve. SecretKey curve -> ()
forall a. (a -> ()) -> NFData a
rnf :: SecretKey curve -> ()
$crnf :: forall curve. SecretKey curve -> ()
NFData)
newtype PublicKey curve hash = PublicKey Bytes
deriving (Int -> PublicKey curve hash -> ShowS
[PublicKey curve hash] -> ShowS
PublicKey curve hash -> String
(Int -> PublicKey curve hash -> ShowS)
-> (PublicKey curve hash -> String)
-> ([PublicKey curve hash] -> ShowS)
-> Show (PublicKey curve hash)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall curve hash. Int -> PublicKey curve hash -> ShowS
forall curve hash. [PublicKey curve hash] -> ShowS
forall curve hash. PublicKey curve hash -> String
showList :: [PublicKey curve hash] -> ShowS
$cshowList :: forall curve hash. [PublicKey curve hash] -> ShowS
show :: PublicKey curve hash -> String
$cshow :: forall curve hash. PublicKey curve hash -> String
showsPrec :: Int -> PublicKey curve hash -> ShowS
$cshowsPrec :: forall curve hash. Int -> PublicKey curve hash -> ShowS
Show,PublicKey curve hash -> PublicKey curve hash -> Bool
(PublicKey curve hash -> PublicKey curve hash -> Bool)
-> (PublicKey curve hash -> PublicKey curve hash -> Bool)
-> Eq (PublicKey curve hash)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall curve hash.
PublicKey curve hash -> PublicKey curve hash -> Bool
/= :: PublicKey curve hash -> PublicKey curve hash -> Bool
$c/= :: forall curve hash.
PublicKey curve hash -> PublicKey curve hash -> Bool
== :: PublicKey curve hash -> PublicKey curve hash -> Bool
$c== :: forall curve hash.
PublicKey curve hash -> PublicKey curve hash -> Bool
Eq,PublicKey curve hash -> Int
PublicKey curve hash -> Ptr p -> IO ()
PublicKey curve hash -> (Ptr p -> IO a) -> IO a
(PublicKey curve hash -> Int)
-> (forall p a. PublicKey curve hash -> (Ptr p -> IO a) -> IO a)
-> (forall p. PublicKey curve hash -> Ptr p -> IO ())
-> ByteArrayAccess (PublicKey curve hash)
forall p. PublicKey curve hash -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall curve hash. PublicKey curve hash -> Int
forall p a. PublicKey curve hash -> (Ptr p -> IO a) -> IO a
forall curve hash p. PublicKey curve hash -> Ptr p -> IO ()
forall curve hash p a.
PublicKey curve hash -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: PublicKey curve hash -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall curve hash p. PublicKey curve hash -> Ptr p -> IO ()
withByteArray :: PublicKey curve hash -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall curve hash p a.
PublicKey curve hash -> (Ptr p -> IO a) -> IO a
length :: PublicKey curve hash -> Int
$clength :: forall curve hash. PublicKey curve hash -> Int
ByteArrayAccess,PublicKey curve hash -> ()
(PublicKey curve hash -> ()) -> NFData (PublicKey curve hash)
forall a. (a -> ()) -> NFData a
forall curve hash. PublicKey curve hash -> ()
rnf :: PublicKey curve hash -> ()
$crnf :: forall curve hash. PublicKey curve hash -> ()
NFData)
newtype Signature curve hash = Signature Bytes
deriving (Int -> Signature curve hash -> ShowS
[Signature curve hash] -> ShowS
Signature curve hash -> String
(Int -> Signature curve hash -> ShowS)
-> (Signature curve hash -> String)
-> ([Signature curve hash] -> ShowS)
-> Show (Signature curve hash)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall curve hash. Int -> Signature curve hash -> ShowS
forall curve hash. [Signature curve hash] -> ShowS
forall curve hash. Signature curve hash -> String
showList :: [Signature curve hash] -> ShowS
$cshowList :: forall curve hash. [Signature curve hash] -> ShowS
show :: Signature curve hash -> String
$cshow :: forall curve hash. Signature curve hash -> String
showsPrec :: Int -> Signature curve hash -> ShowS
$cshowsPrec :: forall curve hash. Int -> Signature curve hash -> ShowS
Show,Signature curve hash -> Signature curve hash -> Bool
(Signature curve hash -> Signature curve hash -> Bool)
-> (Signature curve hash -> Signature curve hash -> Bool)
-> Eq (Signature curve hash)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall curve hash.
Signature curve hash -> Signature curve hash -> Bool
/= :: Signature curve hash -> Signature curve hash -> Bool
$c/= :: forall curve hash.
Signature curve hash -> Signature curve hash -> Bool
== :: Signature curve hash -> Signature curve hash -> Bool
$c== :: forall curve hash.
Signature curve hash -> Signature curve hash -> Bool
Eq,Signature curve hash -> Int
Signature curve hash -> Ptr p -> IO ()
Signature curve hash -> (Ptr p -> IO a) -> IO a
(Signature curve hash -> Int)
-> (forall p a. Signature curve hash -> (Ptr p -> IO a) -> IO a)
-> (forall p. Signature curve hash -> Ptr p -> IO ())
-> ByteArrayAccess (Signature curve hash)
forall p. Signature curve hash -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall curve hash. Signature curve hash -> Int
forall p a. Signature curve hash -> (Ptr p -> IO a) -> IO a
forall curve hash p. Signature curve hash -> Ptr p -> IO ()
forall curve hash p a.
Signature curve hash -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: Signature curve hash -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall curve hash p. Signature curve hash -> Ptr p -> IO ()
withByteArray :: Signature curve hash -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall curve hash p a.
Signature curve hash -> (Ptr p -> IO a) -> IO a
length :: Signature curve hash -> Int
$clength :: forall curve hash. Signature curve hash -> Int
ByteArrayAccess,Signature curve hash -> ()
(Signature curve hash -> ()) -> NFData (Signature curve hash)
forall a. (a -> ()) -> NFData a
forall curve hash. Signature curve hash -> ()
rnf :: Signature curve hash -> ()
$crnf :: forall curve hash. Signature curve hash -> ()
NFData)
class ( EllipticCurveBasepointArith curve
, KnownNat (CurveDigestSize curve)
) => EllipticCurveEdDSA curve where
type CurveDigestSize curve :: Nat
secretKeySize :: proxy curve -> Int
hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg)
=> proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
pointPublic :: proxy curve -> Point curve -> PublicKey curve hash
publicPoint :: proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs
decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve)
scheduleSecret :: ( HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve
-> hash
-> SecretKey curve
-> (Scalar curve, View Bytes)
publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int
publicKeySize :: proxy curve -> Int
publicKeySize proxy curve
prx = proxy curve -> Int
forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
signatureSize :: forall proxy curve . EllipticCurveEdDSA curve
=> proxy curve -> Int
signatureSize :: proxy curve -> Int
signatureSize proxy curve
_ = Proxy (CurveDigestSize curve) -> Int
forall (bitlen :: Nat) a (proxy :: Nat -> *).
(KnownNat bitlen, Num a) =>
proxy bitlen -> a
integralNatVal (Proxy (CurveDigestSize curve)
forall k (t :: k). Proxy t
Proxy :: Proxy (CurveDigestSize curve))
publicKey :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ba
)
=> proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
publicKey :: proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
publicKey proxy curve
prx hash
_ ba
bs
| ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx =
PublicKey curve hash -> CryptoFailable (PublicKey curve hash)
forall a. a -> CryptoFailable a
CryptoPassed (Bytes -> PublicKey curve hash
forall curve hash. Bytes -> PublicKey curve hash
PublicKey (Bytes -> PublicKey curve hash) -> Bytes -> PublicKey curve hash
forall a b. (a -> b) -> a -> b
$ ba -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
| Bool
otherwise =
CryptoError -> CryptoFailable (PublicKey curve hash)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_PublicKeySizeInvalid
secretKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba)
=> proxy curve -> ba -> CryptoFailable (SecretKey curve)
secretKey :: proxy curve -> ba -> CryptoFailable (SecretKey curve)
secretKey proxy curve
prx ba
bs
| ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
secretKeySize proxy curve
prx =
SecretKey curve -> CryptoFailable (SecretKey curve)
forall a. a -> CryptoFailable a
CryptoPassed (ScrubbedBytes -> SecretKey curve
forall curve. ScrubbedBytes -> SecretKey curve
SecretKey (ScrubbedBytes -> SecretKey curve)
-> ScrubbedBytes -> SecretKey curve
forall a b. (a -> b) -> a -> b
$ ba -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
| Bool
otherwise =
CryptoError -> CryptoFailable (SecretKey curve)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid
signature :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ba
)
=> proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
signature :: proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
signature proxy curve
prx hash
_ ba
bs
| ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== proxy curve -> Int
forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx =
Signature curve hash -> CryptoFailable (Signature curve hash)
forall a. a -> CryptoFailable a
CryptoPassed (Bytes -> Signature curve hash
forall curve hash. Bytes -> Signature curve hash
Signature (Bytes -> Signature curve hash) -> Bytes -> Signature curve hash
forall a b. (a -> b) -> a -> b
$ ba -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
| Bool
otherwise =
CryptoError -> CryptoFailable (Signature curve hash)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid
generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m)
=> proxy curve -> m (SecretKey curve)
generateSecretKey :: proxy curve -> m (SecretKey curve)
generateSecretKey proxy curve
prx = ScrubbedBytes -> SecretKey curve
forall curve. ScrubbedBytes -> SecretKey curve
SecretKey (ScrubbedBytes -> SecretKey curve)
-> m ScrubbedBytes -> m (SecretKey curve)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ScrubbedBytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
secretKeySize proxy curve
prx)
toPublic :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
toPublic :: proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
toPublic proxy curve
prx hash
alg SecretKey curve
priv =
let p :: Point curve
p = proxy curve -> Scalar curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx (proxy curve -> hash -> SecretKey curve -> Scalar curve
forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar proxy curve
prx hash
alg SecretKey curve
priv)
in proxy curve -> Point curve -> PublicKey curve hash
forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> Point curve -> PublicKey curve hash
pointPublic proxy curve
prx Point curve
p
secretScalar :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar :: proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar proxy curve
prx hash
alg SecretKey curve
priv = (Scalar curve, View Bytes) -> Scalar curve
forall a b. (a, b) -> a
fst (proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
scheduleSecret proxy curve
prx hash
alg SecretKey curve
priv)
sign :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess msg
)
=> proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
sign :: proxy curve
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
sign proxy curve
prx = proxy curve
-> Bytes
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signCtx proxy curve
prx Bytes
emptyCtx
verify :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess msg
)
=> proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verify :: proxy curve
-> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verify proxy curve
prx = proxy curve
-> Bytes
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyCtx proxy curve
prx Bytes
emptyCtx
signCtx :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
signCtx :: proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signCtx proxy curve
prx = proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
False
verifyCtx :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verifyCtx :: proxy curve
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyCtx proxy curve
prx = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
False
signPh :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
)
=> proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> Digest prehash -> Signature curve hash
signPh :: proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
signPh proxy curve
prx = proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
True
verifyPh :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
)
=> proxy curve -> ctx -> PublicKey curve hash -> Digest prehash -> Signature curve hash -> Bool
verifyPh :: proxy curve
-> ctx
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
-> Bool
verifyPh proxy curve
prx = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
-> Bool
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
True
signPhCtx :: forall proxy curve hash ctx msg .
( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> Bool -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
signPhCtx :: proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
ph ctx
ctx SecretKey curve
priv PublicKey curve hash
pub msg
msg =
let alg :: hash
alg = hash
forall a. HasCallStack => a
undefined :: hash
(Scalar curve
s, View Bytes
prefix) = proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
scheduleSecret proxy curve
prx hash
alg SecretKey curve
priv
digR :: Bytes
digR = proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (View Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes View Bytes
prefix) msg
msg
r :: Scalar curve
r = proxy curve -> Bytes -> Scalar curve
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx Bytes
digR
pR :: Point curve
pR = proxy curve -> Scalar curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx Scalar curve
r
bsR :: Bytes
bsR = proxy curve -> Point curve -> Bytes
forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint proxy curve
prx Point curve
pR
sK :: Scalar curve
sK = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub Bytes
bsR msg
msg
sS :: Scalar curve
sS = proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarAdd proxy curve
prx Scalar curve
r (proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
sK Scalar curve
s)
in proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
encodeSignature proxy curve
prx (Bytes
bsR, Point curve
pR, Scalar curve
sS)
verifyPhCtx :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> Bool -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verifyPhCtx :: proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub msg
msg Signature curve hash
sig =
case CryptoFailable Bool
doVerify of
CryptoPassed Bool
verified -> Bool
verified
CryptoFailed CryptoError
_ -> Bool
False
where
doVerify :: CryptoFailable Bool
doVerify = do
(Bytes
bsR, Point curve
pR, Scalar curve
sS) <- proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature proxy curve
prx Signature curve hash
sig
Point curve
nPub <- proxy curve -> Point curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveArith curve =>
proxy curve -> Point curve -> Point curve
pointNegate proxy curve
prx (Point curve -> Point curve)
-> CryptoFailable (Point curve) -> CryptoFailable (Point curve)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
publicPoint proxy curve
prx PublicKey curve hash
pub
let sK :: Scalar curve
sK = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub Bytes
bsR msg
msg
pR' :: Point curve
pR' = proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
pointsSmulVarTime proxy curve
prx Scalar curve
sS Scalar curve
sK Point curve
nPub
Bool -> CryptoFailable Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Point curve
pR Point curve -> Point curve -> Bool
forall a. Eq a => a -> a -> Bool
== Point curve
pR')
emptyCtx :: Bytes
emptyCtx :: Bytes
emptyCtx = Bytes
forall a. ByteArray a => a
B.empty
getK :: forall proxy curve hash ctx msg .
( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve
getK :: proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx (PublicKey Bytes
pub) Bytes
bsR msg
msg =
let alg :: hash
alg = hash
forall a. HasCallStack => a
undefined :: hash
digK :: Bytes
digK = proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
pub) msg
msg
in proxy curve -> Bytes -> Scalar curve
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx Bytes
digK
encodeSignature :: EllipticCurveEdDSA curve
=> proxy curve
-> (Bytes, Point curve, Scalar curve)
-> Signature curve hash
encodeSignature :: proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
encodeSignature proxy curve
prx (Bytes
bsR, Point curve
_, Scalar curve
sS) = Bytes -> Signature curve hash
forall curve hash. Bytes -> Signature curve hash
Signature (Bytes -> Signature curve hash) -> Bytes -> Signature curve hash
forall a b. (a -> b) -> a -> b
$ Builder -> Bytes
forall ba. ByteArray ba => Builder -> ba
buildAndFreeze (Builder -> Bytes) -> Builder -> Bytes
forall a b. (a -> b) -> a -> b
$
Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsS Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
zero Int
len0
where
bsS :: Bytes
bsS = proxy curve -> Scalar curve -> Bytes
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArray bs) =>
proxy curve -> Scalar curve -> bs
encodeScalarLE proxy curve
prx Scalar curve
sS :: Bytes
len0 :: Int
len0 = proxy curve -> Int
forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
bsR Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
bsS
decodeSignature :: ( EllipticCurveEdDSA curve
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature :: proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature proxy curve
prx (Signature Bytes
bs) = do
let (Bytes
bsR, Bytes
bsS) = Int -> Bytes -> (Bytes, Bytes)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx) Bytes
bs
Point curve
pR <- proxy curve -> Bytes -> CryptoFailable (Point curve)
forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint proxy curve
prx Bytes
bsR
Scalar curve
sS <- proxy curve -> Bytes -> CryptoFailable (Scalar curve)
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalarLE proxy curve
prx Bytes
bsS
(Bytes, Point curve, Scalar curve)
-> CryptoFailable (Bytes, Point curve, Scalar curve)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
bsR, Point curve
pR, Scalar curve
sS)
decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs)
=> proxy curve -> bs -> Scalar curve
decodeScalarNoErr :: proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx = String -> CryptoFailable (Scalar curve) -> Scalar curve
forall a. String -> CryptoFailable a -> a
unwrap String
"decodeScalarNoErr" (CryptoFailable (Scalar curve) -> Scalar curve)
-> (bs -> CryptoFailable (Scalar curve)) -> bs -> Scalar curve
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy curve -> bs -> CryptoFailable (Scalar curve)
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalarLE proxy curve
prx
unwrap :: String -> CryptoFailable a -> a
unwrap :: String -> CryptoFailable a -> a
unwrap String
name (CryptoFailed CryptoError
_) = String -> a
forall a. HasCallStack => String -> a
error (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": assumption failed")
unwrap String
_ (CryptoPassed a
x) = a
x
instance EllipticCurveEdDSA Curve_Edwards25519 where
type CurveDigestSize Curve_Edwards25519 = 64
secretKeySize :: proxy Curve_Edwards25519 -> Int
secretKeySize proxy Curve_Edwards25519
_ = Int
32
hashWithDom :: proxy Curve_Edwards25519
-> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy Curve_Edwards25519
_ hash
alg Bool
ph ctx
ctx Builder
bss
| Bool -> Bool
not Bool
ph Bool -> Bool -> Bool
&& ctx -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null ctx
ctx = hash -> Builder -> msg -> Bytes
forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg Builder
bss
| Bool
otherwise = hash -> Builder -> msg -> Bytes
forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg (Builder
dom Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bss)
where dom :: Builder
dom = ByteString -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes (ByteString
"SigEd25519 no Ed25519 collisions" :: ByteString) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word8 -> Builder
byte (if Bool
ph then Word8
1 else Word8
0) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word8 -> Builder
byte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ctx -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ctx
ctx) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
ctx -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes ctx
ctx
pointPublic :: proxy Curve_Edwards25519
-> Point Curve_Edwards25519 -> PublicKey Curve_Edwards25519 hash
pointPublic proxy Curve_Edwards25519
_ = Bytes -> PublicKey Curve_Edwards25519 hash
forall curve hash. Bytes -> PublicKey curve hash
PublicKey (Bytes -> PublicKey Curve_Edwards25519 hash)
-> (Point -> Bytes) -> Point -> PublicKey Curve_Edwards25519 hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Bytes
forall bs. ByteArray bs => Point -> bs
Edwards25519.pointEncode
publicPoint :: proxy Curve_Edwards25519
-> PublicKey Curve_Edwards25519 hash
-> CryptoFailable (Point Curve_Edwards25519)
publicPoint proxy Curve_Edwards25519
_ = PublicKey Curve_Edwards25519 hash
-> CryptoFailable (Point Curve_Edwards25519)
forall bs. ByteArrayAccess bs => bs -> CryptoFailable Point
Edwards25519.pointDecode
encodeScalarLE :: proxy Curve_Edwards25519 -> Scalar Curve_Edwards25519 -> bs
encodeScalarLE proxy Curve_Edwards25519
_ = Scalar Curve_Edwards25519 -> bs
forall bs. ByteArray bs => Scalar -> bs
Edwards25519.scalarEncode
decodeScalarLE :: proxy Curve_Edwards25519
-> bs -> CryptoFailable (Scalar Curve_Edwards25519)
decodeScalarLE proxy Curve_Edwards25519
_ = bs -> CryptoFailable (Scalar Curve_Edwards25519)
forall bs. ByteArrayAccess bs => bs -> CryptoFailable Scalar
Edwards25519.scalarDecodeLong
scheduleSecret :: proxy Curve_Edwards25519
-> hash
-> SecretKey Curve_Edwards25519
-> (Scalar Curve_Edwards25519, View Bytes)
scheduleSecret proxy Curve_Edwards25519
prx hash
alg SecretKey Curve_Edwards25519
priv =
(proxy Curve_Edwards25519 -> Bytes -> Scalar Curve_Edwards25519
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy Curve_Edwards25519
prx Bytes
clamped, Bytes -> Int -> View Bytes
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView Bytes
hashed Int
32)
where
hashed :: Bytes
hashed = hash
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest hash
alg (((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes)
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update -> SecretKey Curve_Edwards25519 -> IO ()
forall bs. ByteArrayAccess bs => bs -> IO ()
update SecretKey Curve_Edwards25519
priv
clamped :: Bytes
clamped :: Bytes
clamped = View Bytes -> (Ptr Word8 -> IO ()) -> Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze (Bytes -> Int -> View Bytes
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.takeView Bytes
hashed Int
32) ((Ptr Word8 -> IO ()) -> Bytes) -> (Ptr Word8 -> IO ()) -> Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Word8
b0 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
0 :: IO Word8
Word8
b31 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
31 :: IO Word8
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
31 ((Word8
b31 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x40)
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
0 (Word8
b0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF8)
digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg)
=> alg -> Builder -> msg -> Bytes
digestDomMsg :: alg -> Builder -> msg -> Bytes
digestDomMsg alg
alg Builder
bss msg
bs = alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest alg
alg (((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes)
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update ->
Bytes -> IO ()
forall bs. ByteArrayAccess bs => bs -> IO ()
update (Builder -> Bytes
forall ba. ByteArray ba => Builder -> ba
buildAndFreeze Builder
bss :: Bytes) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> msg -> IO ()
forall bs. ByteArrayAccess bs => bs -> IO ()
update msg
bs
digest :: HashAlgorithm alg
=> alg
-> ((forall bs . ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest :: alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest alg
alg (forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ()
fn = Digest alg -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest alg -> Bytes) -> Digest alg -> Bytes
forall a b. (a -> b) -> a -> b
$ IO (Digest alg) -> Digest alg
forall a. IO a -> a
unsafeDoIO (IO (Digest alg) -> Digest alg) -> IO (Digest alg) -> Digest alg
forall a b. (a -> b) -> a -> b
$ do
MutableContext alg
mc <- alg -> IO (MutableContext alg)
forall alg. HashAlgorithm alg => alg -> IO (MutableContext alg)
hashMutableInitWith alg
alg
(forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ()
fn (MutableContext alg -> bs -> IO ()
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
MutableContext a -> ba -> IO ()
hashMutableUpdate MutableContext alg
mc)
MutableContext alg -> IO (Digest alg)
forall a. HashAlgorithm a => MutableContext a -> IO (Digest a)
hashMutableFinalize MutableContext alg
mc