haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Avoid repeated point encoding

Browse Source
This commit is contained in:
Olivier Chéron 2020-02-04 21:23:29 +01:00
parent 6075b698e1
commit 633879f801
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Crypto/PubKey/EdDSA.hs
View File

@ -148,9 +148,10 @@ sign prx priv pub msg =
digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg
r = decodeScalarNoErr prx digR r = decodeScalarNoErr prx digR
pR = pointBaseSmul prx r pR = pointBaseSmul prx r
sK = getK prx pub pR msg bsR = encodePoint prx pR
sK = getK prx pub bsR msg
sS = scalarAdd prx r (scalarMul prx sK s) sS = scalarAdd prx r (scalarMul prx sK s)
in encodeSignature prx (pR, sS) in encodeSignature prx (bsR, pR, sS)
-- | Verify a message -- | Verify a message
verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg)
@ -161,37 +162,36 @@ verify prx pub msg sig =
CryptoFailed _ -> False CryptoFailed _ -> False
where where
doVerify = do doVerify = do
(pR, sS) <- decodeSignature prx sig (bsR, pR, sS) <- decodeSignature prx sig
nPub <- pointNegate prx `fmap` publicPoint prx pub nPub <- pointNegate prx `fmap` publicPoint prx pub
let sK = getK prx pub pR msg let sK = getK prx pub bsR msg
pR' = pointsSmulVarTime prx sS sK nPub pR' = pointsSmulVarTime prx sS sK nPub
return (pR == pR') return (pR == pR')
getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg)
=> proxy curve -> PublicKey curve -> Point curve -> msg -> Scalar curve => proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve
getK prx pub pR msg = getK prx pub bsR msg =
let bsR = encodePoint prx pR :: Bytes let digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg
digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg
in decodeScalarNoErr prx digK in decodeScalarNoErr prx digK
encodeSignature :: EllipticCurveEdDSA curve encodeSignature :: EllipticCurveEdDSA curve
=> proxy curve => proxy curve
-> (Point curve, Scalar curve) -> (Bytes, Point curve, Scalar curve)
-> Signature curve -> Signature curve
encodeSignature prx (pR, sS) = encodeSignature prx (bsR, _, sS) =
let bsS = encodeScalarLE prx sS :: Bytes let bsS = encodeScalarLE prx sS :: Bytes
len0 = signatureSize prx - publicKeySize prx - B.length bsS len0 = signatureSize prx - B.length bsR - B.length bsS
in Signature $ B.concat [ encodePoint prx pR, bsS, B.zero len0 ] in Signature $ B.concat [ bsR, bsS, B.zero len0 ]
decodeSignature :: EllipticCurveEdDSA curve decodeSignature :: EllipticCurveEdDSA curve
=> proxy curve => proxy curve
-> Signature curve -> Signature curve
-> CryptoFailable (Point curve, Scalar curve) -> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature prx (Signature bs) = do decodeSignature prx (Signature bs) = do
let (bsR, bsS) = B.splitAt (publicKeySize prx) bs let (bsR, bsS) = B.splitAt (publicKeySize prx) bs
pR <- decodePoint prx bsR pR <- decodePoint prx bsR
sS <- decodeScalarLE prx bsS sS <- decodeScalarLE prx bsS
return (pR, sS) return (bsR, pR, sS)
-- implementations are supposed to decode any scalar up to the size of the digest -- implementations are supposed to decode any scalar up to the size of the digest
decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs) decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs)