{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
-- |Message signing using asymmetric cipher and message digest
-- algorithm. This is an opposite of "OpenSSL.EVP.Verify".
module OpenSSL.EVP.Sign
    ( sign
    , signBS
    , signLBS
    )
    where
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Internal as B8
import qualified Data.ByteString.Lazy.Char8 as L8
#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative ((<$>))
#endif
import           Foreign
import           Foreign.C
import           OpenSSL.EVP.Digest
import           OpenSSL.EVP.PKey
import           OpenSSL.EVP.Internal
import           OpenSSL.Utils

foreign import capi unsafe "openssl/evp.h EVP_SignFinal"
  _SignFinal :: Ptr EVP_MD_CTX -> Ptr Word8 -> Ptr CUInt
             -> Ptr EVP_PKEY -> IO CInt

signFinal :: KeyPair k => DigestCtx -> k -> IO B8.ByteString
signFinal :: forall k. KeyPair k => DigestCtx -> k -> IO ByteString
signFinal DigestCtx
ctx k
k = do
  let maxLen :: Int
maxLen = k -> Int
forall k. PKey k => k -> Int
pkeySize k
k
  DigestCtx -> (Ptr EVP_MD_CTX -> IO ByteString) -> IO ByteString
forall a. DigestCtx -> (Ptr EVP_MD_CTX -> IO a) -> IO a
withDigestCtxPtr DigestCtx
ctx ((Ptr EVP_MD_CTX -> IO ByteString) -> IO ByteString)
-> (Ptr EVP_MD_CTX -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_MD_CTX
ctxPtr ->
    k -> (Ptr EVP_PKEY -> IO ByteString) -> IO ByteString
forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' k
k ((Ptr EVP_PKEY -> IO ByteString) -> IO ByteString)
-> (Ptr EVP_PKEY -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_PKEY
pkeyPtr ->
      Int -> (Ptr Word8 -> IO Int) -> IO ByteString
B8.createAndTrim Int
maxLen ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bufPtr ->
        (Ptr CUInt -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO Int) -> IO Int)
-> (Ptr CUInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr CUInt
bufLenPtr -> do
          (CInt -> Bool) -> CInt -> IO ()
forall a. (a -> Bool) -> a -> IO ()
failIf_ (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1) (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr EVP_MD_CTX -> Ptr Word8 -> Ptr CUInt -> Ptr EVP_PKEY -> IO CInt
_SignFinal Ptr EVP_MD_CTX
ctxPtr Ptr Word8
bufPtr Ptr CUInt
bufLenPtr Ptr EVP_PKEY
pkeyPtr
          CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
bufLenPtr

-- |@'sign'@ generates a signature from a stream of data. The string
-- must not contain any letters which aren't in the range of U+0000 -
-- U+00FF.
sign :: KeyPair key =>
        Digest    -- ^ message digest algorithm to use
     -> key       -- ^ private key to sign the message digest
     -> String    -- ^ input string
     -> IO String -- ^ the result signature
{-# DEPRECATED sign "Use signBS or signLBS instead." #-}
sign :: forall key. KeyPair key => Digest -> key -> String -> IO String
sign Digest
md key
pkey String
input
    = (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
L8.unpack (IO ByteString -> IO String) -> IO ByteString -> IO String
forall a b. (a -> b) -> a -> b
$ Digest -> key -> ByteString -> IO ByteString
forall key.
KeyPair key =>
Digest -> key -> ByteString -> IO ByteString
signLBS Digest
md key
pkey (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
L8.pack String
input

-- |@'signBS'@ generates a signature from a chunk of data.
signBS :: KeyPair key =>
          Digest        -- ^ message digest algorithm to use
       -> key           -- ^ private key to sign the message digest
       -> B8.ByteString -- ^ input string
       -> IO B8.ByteString -- ^ the result signature
signBS :: forall key.
KeyPair key =>
Digest -> key -> ByteString -> IO ByteString
signBS Digest
md key
pkey ByteString
input
    = do DigestCtx
ctx <- Digest -> ByteString -> IO DigestCtx
digestStrictly Digest
md ByteString
input
         DigestCtx -> key -> IO ByteString
forall k. KeyPair k => DigestCtx -> k -> IO ByteString
signFinal DigestCtx
ctx key
pkey

-- |@'signLBS'@ generates a signature from a stream of data.
signLBS :: KeyPair key =>
           Digest        -- ^ message digest algorithm to use
        -> key           -- ^ private key to sign the message digest
        -> L8.ByteString -- ^ input string
        -> IO L8.ByteString -- ^ the result signature
signLBS :: forall key.
KeyPair key =>
Digest -> key -> ByteString -> IO ByteString
signLBS Digest
md key
pkey ByteString
input
    = do DigestCtx
ctx <- Digest -> ByteString -> IO DigestCtx
digestLazily Digest
md ByteString
input
         ByteString
sig <- DigestCtx -> key -> IO ByteString
forall k. KeyPair k => DigestCtx -> k -> IO ByteString
signFinal DigestCtx
ctx key
pkey
         ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L8.fromChunks [ByteString
sig]