{-# LANGUAGE CPP #-}
#ifndef mingw32_HOST_OS
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Crypto.ECC.Ed25519.Sign ( genkeys
, publickey
, dsign
, sign
, dverify
, verify
, Message
, PubKey
, SecKey
, Signature
, SignedMessage
, SigOK(..)
, VerifyResult
)
where
import safe Crypto.ECC.Ed25519.Internal.Ed25519
import safe Prelude ((==),($),(<),IO,return,pure,Either(Left,Right),String,(&&))
import safe qualified Crypto.Fi as FP
import safe qualified Data.ByteString as BS
#ifndef mingw32_HOST_OS
import safe qualified Data.ByteString.Lazy.Char8 as BS8
#else
import qualified Crypto.Random as R
import safe Prelude (show)
#endif
genkeys :: IO (Either String (SecKey,PubKey))
genkeys = do
#ifndef mingw32_HOST_OS
bytes <- BS8.readFile "/dev/urandom"
let sk = SecKeyBytes $ BS8.toStrict $ BS8.take 32 bytes
derived = publickey sk
return $ case derived of
Left e -> Left e
Right pk -> Right (sk,pk)
#else
g <- (R.newGenIO :: IO R.SystemRandom)
let prngresult = R.genBytes 32 g
case prngresult of
Left e -> return $ Left $ show e
Right (bytes,_) -> let sk = SecKeyBytes bytes
derived = publickey sk
in return $ case derived of
Left e -> Left e
Right pk -> Right (sk,pk)
#endif
publickey :: SecKey -> Either String PubKey
publickey (SecKeyBytes sk) = let mysk = BS.take 32 sk
secret = clamp $ BS.take 32 $ h mysk
in case secret of
Left e -> Left e
Right sec -> let aB = pmul bPoint sec
in if ison aB
then Right (pointtobs aB)
else Left "public key is not on curve"
sign :: SecKey -> Message -> Either String SignedMessage
sign sk m = case dsign sk m of
Left e -> Left e
Right sig -> Right (BS.append sig m)
verify :: PubKey -> SignedMessage -> VerifyResult
verify a_ sigm = let sig = BS.take 64 sigm
m = BS.drop 64 sigm
in dverify a_ sig m
dsign :: SecKey -> Message -> Either String Signature
dsign (SecKeyBytes sk) m = do
let mysk = BS.take 32 sk
hsk = h mysk
ahsk = BS.take 32 hsk
rhsk = BS.drop 32 hsk
r <- getFPrime64 $ h $ rhsk `BS.append ` m
let rB_ = pointtobs $ pmul bPoint (FP.redc l r)
a' <- clamp ahsk
let aB_ = pointtobs $ pmul bPoint a'
t' <- getFPrime64 (h $ rB_ `BS.append` aB_ `BS.append` ph m)
let s = FP.addr l r (FP.mulr l t' a')
let s_ = putFPrime s
pure $ BS.append rB_ s_
dverify :: PubKey -> Signature -> Message -> VerifyResult
dverify a_ sig m = do
let r_ = BS.take 32 sig
r <- bstopoint r_
a' <- bstopoint a_
s' <- getFPrime32 $ BS.drop 32 sig
t <- getFPrime64 $ h $ r_ `BS.append` a_ `BS.append` m
if (FP.toInteger s' < FP.toInteger l) && (scale $ pmul bPoint (FP.redc l s')) == (scale $ padd r $ pmul a' (FP.redc l t))
then Right SigOK
else Left "bad Signature"