-- |
-- Module      : Crypto.Saltine.Core.Sign
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : MIT
--
-- Maintainer  : me@jspha.com
-- Stability   : experimental
-- Portability : non-portable
--
-- Signatures: "Crypto.Saltine.Core.Sign"
--
-- The 'newKeypair' function randomly generates a secret key and a
-- corresponding public key. The 'sign' function signs a message
-- 'ByteString' using the signer's secret key and returns the
-- resulting signed message. The 'signOpen' function verifies the
-- signature in a signed message using the signer's public key then
-- returns the message without its signature.
--
-- "Crypto.Saltine.Core.Sign" is an EdDSA signature using
-- elliptic-curve Curve25519 (see: <http://ed25519.cr.yp.to/>). See
-- also, \"Daniel J. Bernstein, Niels Duif, Tanja Lange, Peter
-- Schwabe, Bo-Yin Yang. High-speed high-security signatures. Journal
-- of Cryptographic Engineering 2 (2012), 77–89.\"
-- <http://ed25519.cr.yp.to/ed25519-20110926.pdf>.
--
-- This is current information as of 2013 June 6.

module Crypto.Saltine.Core.Sign (
  SecretKey, PublicKey, Keypair(..), Signature,
  newKeypair,
  sign, signOpen,
  signDetached, signVerifyDetached
  ) where

import Crypto.Saltine.Internal.Sign
            ( c_sign_keypair
            , c_sign
            , c_sign_open
            , c_sign_detached
            , c_sign_verify_detached
            , SecretKey(..)
            , PublicKey(..)
            , Keypair(..)
            , Signature(..)
            )
import Crypto.Saltine.Internal.Util as U
import Data.ByteString              (ByteString)
import Foreign.Marshal.Alloc
import Foreign.Storable
import System.IO.Unsafe

import qualified Crypto.Saltine.Internal.Sign as Bytes
import qualified Data.ByteString              as S

-- | Creates a random key of the correct size for 'sign' and
-- 'signOpen' of form @(secretKey, publicKey)@.
newKeypair :: IO Keypair
newKeypair :: IO Keypair
newKeypair = do
  -- This is a little bizarre and a likely source of errors.
  -- _err ought to always be 0.
  ((CInt
_err, ByteString
sk), ByteString
pk) <- Int
-> (Ptr CChar -> IO (CInt, ByteString))
-> IO ((CInt, ByteString), ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' Int
Bytes.sign_publickeybytes ((Ptr CChar -> IO (CInt, ByteString))
 -> IO ((CInt, ByteString), ByteString))
-> (Ptr CChar -> IO (CInt, ByteString))
-> IO ((CInt, ByteString), ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pkbuf ->
    Int -> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' Int
Bytes.sign_secretkeybytes ((Ptr CChar -> IO CInt) -> IO (CInt, ByteString))
-> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
skbuf ->
      Ptr CChar -> Ptr CChar -> IO CInt
c_sign_keypair Ptr CChar
pkbuf Ptr CChar
skbuf
  Keypair -> IO Keypair
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Keypair -> IO Keypair) -> Keypair -> IO Keypair
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> Keypair
Keypair (ByteString -> SecretKey
SK ByteString
sk) (ByteString -> PublicKey
PK ByteString
pk)

-- | Augments a message with a signature forming a \"signed
-- message\".
sign :: SecretKey
     -> ByteString
     -- ^ Message
     -> ByteString
     -- ^ Signed message
sign :: SecretKey -> ByteString -> ByteString
sign (SK ByteString
k) ByteString
m = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  (Ptr CULLong -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULLong -> IO ByteString) -> IO ByteString)
-> (Ptr CULLong -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CULLong
psmlen -> do
    (CInt
_err, ByteString
sm) <- Int -> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
Bytes.sign_bytes) ((Ptr CChar -> IO CInt) -> IO (CInt, ByteString))
-> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
psmbuf ->
      [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
k, ByteString
m] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \[(Ptr CChar
pk, Int
_), (Ptr CChar
pm, Int
_)] ->
        Ptr CChar
-> Ptr CULLong -> Ptr CChar -> CULLong -> Ptr CChar -> IO CInt
c_sign Ptr CChar
psmbuf Ptr CULLong
psmlen Ptr CChar
pm (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr CChar
pk
    CULLong
smlen <- Ptr CULLong -> IO CULLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CULLong
psmlen
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.take (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
smlen) ByteString
sm
  where len :: Int
len = ByteString -> Int
S.length ByteString
m

-- | Checks a \"signed message\" returning 'Just' the original message
-- iff the signature was generated using the 'SecretKey' corresponding
-- to the given 'PublicKey'. Returns 'Nothing' otherwise.
signOpen :: PublicKey
         -> ByteString
         -- ^ Signed message
         -> Maybe ByteString
         -- ^ Maybe the restored message
signOpen :: PublicKey -> ByteString -> Maybe ByteString
signOpen (PK ByteString
k) ByteString
sm = IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
-> IO (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
  (Ptr CULLong -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULLong -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CULLong -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CULLong
pmlen -> do
    (CInt
err, ByteString
m) <- Int -> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' Int
smlen ((Ptr CChar -> IO CInt) -> IO (CInt, ByteString))
-> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pmbuf ->
      [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
k, ByteString
sm] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \[(Ptr CChar
pk, Int
_), (Ptr CChar
psm, Int
_)] ->
        Ptr CChar
-> Ptr CULLong -> Ptr CChar -> CULLong -> Ptr CChar -> IO CInt
c_sign_open Ptr CChar
pmbuf Ptr CULLong
pmlen Ptr CChar
psm (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
smlen) Ptr CChar
pk
    CULLong
mlen <- Ptr CULLong -> IO CULLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CULLong
pmlen
    case CInt
err of
      CInt
0 -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.take (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
mlen) ByteString
m
      CInt
_ -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return   Maybe ByteString
forall a. Maybe a
Nothing
  where smlen :: Int
smlen = ByteString -> Int
S.length ByteString
sm

-- | Returns just the signature for a message using a SecretKey.
signDetached :: SecretKey
             -> ByteString
             -- ^ Message
             -> Signature
             -- ^ Signature
signDetached :: SecretKey -> ByteString -> Signature
signDetached (SK ByteString
k) ByteString
m = IO Signature -> Signature
forall a. IO a -> a
unsafePerformIO (IO Signature -> Signature) -> IO Signature -> Signature
forall a b. (a -> b) -> a -> b
$
    (Ptr CULLong -> IO Signature) -> IO Signature
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULLong -> IO Signature) -> IO Signature)
-> (Ptr CULLong -> IO Signature) -> IO Signature
forall a b. (a -> b) -> a -> b
$ \Ptr CULLong
psmlen -> do
        (CInt
_err, ByteString
sm) <- Int -> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' Int
Bytes.sign_bytes ((Ptr CChar -> IO CInt) -> IO (CInt, ByteString))
-> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sigbuf ->
            [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
k, ByteString
m] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \[(Ptr CChar
pk, Int
_), (Ptr CChar
pm, Int
_)] ->
                Ptr CChar
-> Ptr CULLong -> Ptr CChar -> CULLong -> Ptr CChar -> IO CInt
c_sign_detached Ptr CChar
sigbuf Ptr CULLong
psmlen Ptr CChar
pm (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr CChar
pk
        CULLong
smlen <- Ptr CULLong -> IO CULLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CULLong
psmlen
        Signature -> IO Signature
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signature -> IO Signature) -> Signature -> IO Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> Signature
Signature (ByteString -> Signature) -> ByteString -> Signature
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.take (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
smlen) ByteString
sm
  where len :: Int
len = ByteString -> Int
S.length ByteString
m

-- | Returns @True@ if the signature is valid for the given public key and
-- message.
signVerifyDetached :: PublicKey
                   -> Signature
                   -- ^ Signature
                   -> ByteString
                   -- ^ Message (not signed)
                   -> Bool
signVerifyDetached :: PublicKey -> Signature -> ByteString -> Bool
signVerifyDetached (PK ByteString
k) (Signature ByteString
sig) ByteString
sm = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    [ByteString] -> ([CStringLen] -> IO Bool) -> IO Bool
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
k, ByteString
sig, ByteString
sm] (([CStringLen] -> IO Bool) -> IO Bool)
-> ([CStringLen] -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \[(Ptr CChar
pk, Int
_), (Ptr CChar
psig, Int
_), (Ptr CChar
psm, Int
_)] -> do
        CInt
res <- Ptr CChar -> Ptr CChar -> CULLong -> Ptr CChar -> IO CInt
c_sign_verify_detached Ptr CChar
psig Ptr CChar
psm (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr CChar
pk
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
  where len :: Int
len = ByteString -> Int
S.length ByteString
sm