-----------------------------------------------------------------------------
-- |
-- Module      :  Crypto.ECC.Ed25519.Sign
-- Copyright   :  (c) Marcel Fourné 20[14..]
-- License     :  BSD3
-- Maintainer  :  Marcel Fourné (haskell@marcelfourne.de)
-- Stability   :  alpha
-- Portability :  Bad
--
-- Short-time plan: custom field arithmetic
-- TODO: optimal const time inversion in 25519, see eccss-20130911b.pdf
-- TODO: convert code to portable implementation and get rid of Integer
-----------------------------------------------------------------------------

{-# 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 -- only type export, not constructors
                               , 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

-- | generate a new key pair (secret and derived public key) using some external entropy
-- | This may be insecure, depending on your environment, so for your usage case you may need to implement some better key generator!
genkeys :: IO (Either String (SecKey,PubKey))
genkeys :: IO (Either String (SecKey, PubKey))
genkeys = do
#ifndef mingw32_HOST_OS
  ByteString
bytes <- String -> IO ByteString
BS8.readFile String
"/dev/urandom"
  let sk :: SecKey
sk = PubKey -> SecKey
SecKeyBytes forall a b. (a -> b) -> a -> b
$ ByteString -> PubKey
BS8.toStrict forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BS8.take Int64
32 ByteString
bytes
      derived :: Either String PubKey
derived = SecKey -> Either String PubKey
publickey SecKey
sk
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either String PubKey
derived of
    Left String
e -> forall a b. a -> Either a b
Left String
e
    Right PubKey
pk -> forall a b. b -> Either a b
Right (SecKey
sk,PubKey
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

-- | derive public key from secret key
publickey :: SecKey -> Either String PubKey
publickey :: SecKey -> Either String PubKey
publickey (SecKeyBytes PubKey
sk) = let mysk :: PubKey
mysk = Int -> PubKey -> PubKey
BS.take Int
32 PubKey
sk -- ensure sk is b bit
                                 secret :: Either String Integer
secret = PubKey -> Either String Integer
clamp forall a b. (a -> b) -> a -> b
$ Int -> PubKey -> PubKey
BS.take Int
32 forall a b. (a -> b) -> a -> b
$ PubKey -> PubKey
h PubKey
mysk
                             in case Either String Integer
secret of
                                  Left String
e -> forall a b. a -> Either a b
Left String
e
                                  Right Integer
sec -> let aB :: Point
aB = Point -> Integer -> Point
pmul Point
bPoint Integer
sec
                                    in if Point -> Bool
ison Point
aB
                                       then forall a b. b -> Either a b
Right (Point -> PubKey
pointtobs Point
aB)
                                       else forall a b. a -> Either a b
Left String
"public key is not on curve"

-- | sign with secret key the message, resulting in message appended to the signature
sign :: SecKey -> Message -> Either String SignedMessage
sign :: SecKey -> PubKey -> Either String PubKey
sign SecKey
sk PubKey
m = case SecKey -> PubKey -> Either String PubKey
dsign SecKey
sk PubKey
m of
  Left String
e    -> forall a b. a -> Either a b
Left String
e
  Right PubKey
sig -> forall a b. b -> Either a b
Right (PubKey -> PubKey -> PubKey
BS.append PubKey
sig PubKey
m)

-- | wrapper around dverify, in case we work with a signed message, i.e. the signature with appended message
verify :: PubKey -> SignedMessage -> VerifyResult
verify :: PubKey -> PubKey -> VerifyResult
verify PubKey
a_ PubKey
sigm = let sig :: PubKey
sig = Int -> PubKey -> PubKey
BS.take Int
64 PubKey
sigm
                     m :: PubKey
m = Int -> PubKey -> PubKey
BS.drop Int
64 PubKey
sigm
                 in PubKey -> PubKey -> PubKey -> VerifyResult
dverify PubKey
a_ PubKey
sig PubKey
m

-- | sign the message m with secret key sk, resulting in a detached signature
dsign :: SecKey -> Message -> Either String Signature
dsign :: SecKey -> PubKey -> Either String PubKey
dsign (SecKeyBytes PubKey
sk) PubKey
m = do
  let mysk :: PubKey
mysk = Int -> PubKey -> PubKey
BS.take Int
32 PubKey
sk
      hsk :: PubKey
hsk = PubKey -> PubKey
h PubKey
mysk
      ahsk :: PubKey
ahsk = Int -> PubKey -> PubKey
BS.take Int
32 PubKey
hsk
      rhsk :: PubKey
rhsk = Int -> PubKey -> PubKey
BS.drop Int
32 PubKey
hsk
  Integer
r <- PubKey -> Either String Integer
getFPrime64 forall a b. (a -> b) -> a -> b
$ PubKey -> PubKey
h forall a b. (a -> b) -> a -> b
$ PubKey
rhsk `BS.append ` PubKey
m
  let rB_ :: PubKey
rB_ = Point -> PubKey
pointtobs forall a b. (a -> b) -> a -> b
$ Point -> Integer -> Point
pmul Point
bPoint (Integer -> Integer -> Integer
FP.redc Integer
l Integer
r)
  Integer
a' <- PubKey -> Either String Integer
clamp PubKey
ahsk
  let aB_ :: PubKey
aB_ = Point -> PubKey
pointtobs forall a b. (a -> b) -> a -> b
$ Point -> Integer -> Point
pmul Point
bPoint Integer
a'
  Integer
t' <- PubKey -> Either String Integer
getFPrime64 (PubKey -> PubKey
h forall a b. (a -> b) -> a -> b
$ PubKey
rB_ PubKey -> PubKey -> PubKey
`BS.append` PubKey
aB_ PubKey -> PubKey -> PubKey
`BS.append` PubKey -> PubKey
ph PubKey
m)
  let s :: Integer
s = Integer -> Integer -> Integer -> Integer
FP.addr Integer
l Integer
r (Integer -> Integer -> Integer -> Integer
FP.mulr Integer
l Integer
t' Integer
a')
  let s_ :: PubKey
s_ = Integer -> PubKey
putFPrime Integer
s
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PubKey -> PubKey -> PubKey
BS.append PubKey
rB_ PubKey
s_

-- | in: public key, message and signature, out: is the signature valid for public key and message?
dverify :: PubKey -> Signature -> Message -> VerifyResult
dverify :: PubKey -> PubKey -> PubKey -> VerifyResult
dverify PubKey
a_ PubKey
sig PubKey
m = do
  let r_ :: PubKey
r_ = Int -> PubKey -> PubKey
BS.take Int
32 PubKey
sig
  Point
r <- PubKey -> Either String Point
bstopoint PubKey
r_
  Point
a' <- PubKey -> Either String Point
bstopoint PubKey
a_
  Integer
s' <- PubKey -> Either String Integer
getFPrime32 forall a b. (a -> b) -> a -> b
$ Int -> PubKey -> PubKey
BS.drop Int
32 PubKey
sig
  Integer
t <- PubKey -> Either String Integer
getFPrime64 forall a b. (a -> b) -> a -> b
$ PubKey -> PubKey
h forall a b. (a -> b) -> a -> b
$ PubKey
r_ PubKey -> PubKey -> PubKey
`BS.append` PubKey
a_ PubKey -> PubKey -> PubKey
`BS.append` PubKey
m
  if (Integer -> Integer
FP.toInteger Integer
s' forall a. Ord a => a -> a -> Bool
< Integer -> Integer
FP.toInteger Integer
l) Bool -> Bool -> Bool
&& (Point -> Point
scale forall a b. (a -> b) -> a -> b
$ Point -> Integer -> Point
pmul Point
bPoint (Integer -> Integer -> Integer
FP.redc Integer
l Integer
s')) forall a. Eq a => a -> a -> Bool
== (Point -> Point
scale forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
padd Point
r forall a b. (a -> b) -> a -> b
$ Point -> Integer -> Point
pmul Point
a' (Integer -> Integer -> Integer
FP.redc Integer
l Integer
t))
    then forall a b. b -> Either a b
Right SigOK
SigOK
    else forall a b. a -> Either a b
Left String
"bad Signature"