{-# LINE 1 "src/Sodium/Crypto/Sign.hsc" #-}
{-# LANGUAGE CPP #-}
module Sodium.Crypto.Sign
( PublicKey (..),
SecretKey (..),
Signature (..),
newKeyPair,
sign,
signature,
signatureLength,
verify,
verifyWith,
)
where
import Data.ByteString qualified as B
import Data.ByteString.Base64.URL
import Data.ByteString.Char8 (pack, unpack)
import Data.ByteString.Internal qualified as I
import Data.ByteString.Unsafe qualified as U
import Foreign hiding (void)
import Foreign.C
import Imports
newtype PublicKey = PublicKey {PublicKey -> ByteString
pubBytes :: ByteString} deriving (PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq, Eq PublicKey
Eq PublicKey =>
(PublicKey -> PublicKey -> Ordering)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> PublicKey)
-> (PublicKey -> PublicKey -> PublicKey)
-> Ord PublicKey
PublicKey -> PublicKey -> Bool
PublicKey -> PublicKey -> Ordering
PublicKey -> PublicKey -> PublicKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PublicKey -> PublicKey -> Ordering
compare :: PublicKey -> PublicKey -> Ordering
$c< :: PublicKey -> PublicKey -> Bool
< :: PublicKey -> PublicKey -> Bool
$c<= :: PublicKey -> PublicKey -> Bool
<= :: PublicKey -> PublicKey -> Bool
$c> :: PublicKey -> PublicKey -> Bool
> :: PublicKey -> PublicKey -> Bool
$c>= :: PublicKey -> PublicKey -> Bool
>= :: PublicKey -> PublicKey -> Bool
$cmax :: PublicKey -> PublicKey -> PublicKey
max :: PublicKey -> PublicKey -> PublicKey
$cmin :: PublicKey -> PublicKey -> PublicKey
min :: PublicKey -> PublicKey -> PublicKey
Ord)
newtype SecretKey = SecretKey {SecretKey -> ByteString
secBytes :: ByteString} deriving (SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq, Eq SecretKey
Eq SecretKey =>
(SecretKey -> SecretKey -> Ordering)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> SecretKey)
-> (SecretKey -> SecretKey -> SecretKey)
-> Ord SecretKey
SecretKey -> SecretKey -> Bool
SecretKey -> SecretKey -> Ordering
SecretKey -> SecretKey -> SecretKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SecretKey -> SecretKey -> Ordering
compare :: SecretKey -> SecretKey -> Ordering
$c< :: SecretKey -> SecretKey -> Bool
< :: SecretKey -> SecretKey -> Bool
$c<= :: SecretKey -> SecretKey -> Bool
<= :: SecretKey -> SecretKey -> Bool
$c> :: SecretKey -> SecretKey -> Bool
> :: SecretKey -> SecretKey -> Bool
$c>= :: SecretKey -> SecretKey -> Bool
>= :: SecretKey -> SecretKey -> Bool
$cmax :: SecretKey -> SecretKey -> SecretKey
max :: SecretKey -> SecretKey -> SecretKey
$cmin :: SecretKey -> SecretKey -> SecretKey
min :: SecretKey -> SecretKey -> SecretKey
Ord)
newtype Signature = Signature {Signature -> ByteString
sigBytes :: ByteString} deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Eq Signature
Eq Signature =>
(Signature -> Signature -> Ordering)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Signature)
-> (Signature -> Signature -> Signature)
-> Ord Signature
Signature -> Signature -> Bool
Signature -> Signature -> Ordering
Signature -> Signature -> Signature
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Signature -> Signature -> Ordering
compare :: Signature -> Signature -> Ordering
$c< :: Signature -> Signature -> Bool
< :: Signature -> Signature -> Bool
$c<= :: Signature -> Signature -> Bool
<= :: Signature -> Signature -> Bool
$c> :: Signature -> Signature -> Bool
> :: Signature -> Signature -> Bool
$c>= :: Signature -> Signature -> Bool
>= :: Signature -> Signature -> Bool
$cmax :: Signature -> Signature -> Signature
max :: Signature -> Signature -> Signature
$cmin :: Signature -> Signature -> Signature
min :: Signature -> Signature -> Signature
Ord)
instance Read PublicKey where
readsPrec :: Int -> ReadS PublicKey
readsPrec Int
_ = ReadS PublicKey
-> (ByteString -> [(PublicKey, String)])
-> Either String ByteString
-> [(PublicKey, String)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadS PublicKey
forall a. HasCallStack => String -> a
error (\ByteString
k -> [(ByteString -> PublicKey
PublicKey ByteString
k, String
"")]) (Either String ByteString -> [(PublicKey, String)])
-> (String -> Either String ByteString) -> ReadS PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (String -> ByteString) -> String -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack
instance Read SecretKey where
readsPrec :: Int -> ReadS SecretKey
readsPrec Int
_ = ReadS SecretKey
-> (ByteString -> [(SecretKey, String)])
-> Either String ByteString
-> [(SecretKey, String)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadS SecretKey
forall a. HasCallStack => String -> a
error (\ByteString
k -> [(ByteString -> SecretKey
SecretKey ByteString
k, String
"")]) (Either String ByteString -> [(SecretKey, String)])
-> (String -> Either String ByteString) -> ReadS SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (String -> ByteString) -> String -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack
instance Read Signature where
readsPrec :: Int -> ReadS Signature
readsPrec Int
_ = ReadS Signature
-> (ByteString -> [(Signature, String)])
-> Either String ByteString
-> [(Signature, String)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadS Signature
forall a. HasCallStack => String -> a
error (\ByteString
k -> [(ByteString -> Signature
Signature ByteString
k, String
"")]) (Either String ByteString -> [(Signature, String)])
-> (String -> Either String ByteString) -> ReadS Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (String -> ByteString) -> String -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack
instance Show PublicKey where
show :: PublicKey -> String
show = ByteString -> String
unpack (ByteString -> String)
-> (PublicKey -> ByteString) -> PublicKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
pubBytes
instance Show SecretKey where
show :: SecretKey -> String
show = ByteString -> String
unpack (ByteString -> String)
-> (SecretKey -> ByteString) -> SecretKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode (ByteString -> ByteString)
-> (SecretKey -> ByteString) -> SecretKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> ByteString
secBytes
instance Show Signature where
show :: Signature -> String
show = ByteString -> String
unpack (ByteString -> String)
-> (Signature -> ByteString) -> Signature -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode (ByteString -> ByteString)
-> (Signature -> ByteString) -> Signature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
sigBytes
newKeyPair :: IO (PublicKey, SecretKey)
newKeyPair :: IO (PublicKey, SecretKey)
newKeyPair = do
Int
pl <- Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> IO Word -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word
publicKeyLength
Int
sl <- Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> IO Word -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word
secretKeyLength
ForeignPtr Word8
pk <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
I.mallocByteString Int
pl
ForeignPtr Word8
sk <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
I.mallocByteString Int
sl
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
pk ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ppk ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sk ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psk ->
IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CUChar -> Ptr CUChar -> IO CInt
c_crypto_sign_keypair (Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ppk) (Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
psk)
(PublicKey, SecretKey) -> IO (PublicKey, SecretKey)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
( ByteString -> PublicKey
PublicKey (ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
pk Int
0 Int
pl),
ByteString -> SecretKey
SecretKey (ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
sk Int
0 Int
sl)
)
sign :: SecretKey -> ByteString -> IO ByteString
sign :: SecretKey -> ByteString -> IO ByteString
sign SecretKey
k ByteString
b = do
Int
siglen <- Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> IO Word -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word
signatureLength
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
U.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
m, Int
mlen) ->
ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
U.unsafeUseAsCString (SecretKey -> ByteString
secBytes SecretKey
k) ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sk ->
Int -> (Ptr Word8 -> IO Int) -> IO ByteString
I.createAndTrim (Int
mlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
siglen) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sm ->
(Ptr CULLong -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULLong -> IO Int) -> IO Int)
-> (Ptr CULLong -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr CULLong
smlen -> do
IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CUChar
-> Ptr CULLong -> Ptr CUChar -> CULLong -> Ptr CUChar -> IO CInt
c_crypto_sign (Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
sm) Ptr CULLong
smlen (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
m) (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mlen) (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
sk)
CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Int) -> IO CULLong -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CULLong -> IO CULLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CULLong
smlen
signature :: SecretKey -> ByteString -> IO Signature
signature :: SecretKey -> ByteString -> IO Signature
signature SecretKey
k ByteString
m = do
ByteString
sm <- SecretKey -> ByteString -> IO ByteString
sign SecretKey
k ByteString
m
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 (Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
m) ByteString
sm)
verify :: PublicKey -> ByteString -> IO Bool
verify :: PublicKey -> ByteString -> IO Bool
verify PublicKey
k ByteString
m =
ByteString -> (CStringLen -> IO Bool) -> IO Bool
forall a. ByteString -> (CStringLen -> IO a) -> IO a
U.unsafeUseAsCStringLen ByteString
m ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ms, Int
mslen) ->
ByteString -> (Ptr CChar -> IO Bool) -> IO Bool
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
U.unsafeUseAsCString (PublicKey -> ByteString
pubBytes PublicKey
k) ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pk ->
(Ptr CULLong -> IO Bool) -> IO Bool
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULLong -> IO Bool) -> IO Bool)
-> (Ptr CULLong -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CULLong
pmlen -> do
ForeignPtr Any
out <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
I.mallocByteString Int
mslen
CInt
res <- ForeignPtr Any -> (Ptr Any -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Any
out ((Ptr Any -> IO CInt) -> IO CInt)
-> (Ptr Any -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Any
pout ->
Ptr CUChar
-> Ptr CULLong -> Ptr CUChar -> CULLong -> Ptr CUChar -> IO CInt
c_crypto_sign_open (Ptr Any -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
pout) Ptr CULLong
pmlen (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ms) (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mslen) (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr 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)
verifyWith :: PublicKey -> Signature -> ByteString -> IO Bool
verifyWith :: PublicKey -> Signature -> ByteString -> IO Bool
verifyWith PublicKey
k Signature
s ByteString
m = PublicKey -> ByteString -> IO Bool
verify PublicKey
k (Signature -> ByteString
sigBytes Signature
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
m)
secretKeyLength :: IO Word
secretKeyLength :: IO Word
secretKeyLength = CSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Word) -> IO CSize -> IO Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CSize
c_crypto_sign_secretkeybytes
{-# INLINE secretKeyLength #-}
publicKeyLength :: IO Word
publicKeyLength :: IO Word
publicKeyLength = CSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Word) -> IO CSize -> IO Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CSize
c_crypto_sign_publickeybytes
{-# INLINE publicKeyLength #-}
signatureLength :: IO Word
signatureLength :: IO Word
signatureLength = CSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Word) -> IO CSize -> IO Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CSize
c_crypto_sign_bytes
{-# INLINE signatureLength #-}
foreign import ccall unsafe "crypto_sign.h crypto_sign_bytes"
c_crypto_sign_bytes :: IO CSize
foreign import ccall unsafe "crypto_sign.h crypto_sign_publickeybytes"
c_crypto_sign_publickeybytes :: IO CSize
foreign import ccall unsafe "crypto_sign.h crypto_sign_secretkeybytes"
c_crypto_sign_secretkeybytes :: IO CSize
foreign import ccall unsafe "crypto_sign.h crypto_sign_keypair"
c_crypto_sign_keypair :: Ptr CUChar -> Ptr CUChar -> IO CInt
foreign import ccall unsafe "crypto_sign.h crypto_sign"
c_crypto_sign ::
Ptr CUChar ->
Ptr CULLong ->
Ptr CUChar ->
CULLong ->
Ptr CUChar ->
IO CInt
foreign import ccall unsafe "crypto_sign.h crypto_sign_open"
c_crypto_sign_open ::
Ptr CUChar ->
Ptr CULLong ->
Ptr CUChar ->
CULLong ->
Ptr CUChar ->
IO CInt