From 0bb8daa7da52240a971a4ce83d97cfb62971ea78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 18 Oct 2026 16:52:41 +0200 Subject: Add crypto backend using various reference libraries --- src/crypto/reflibs/Crypto/PubKey/Curve25519.hs | 84 ++++++++++++++++++++++++++ src/crypto/reflibs/Crypto/PubKey/Ed25519.hs | 73 ++++++++++++++++++++++ 2 files changed, 157 insertions(+) create mode 100644 src/crypto/reflibs/Crypto/PubKey/Curve25519.hs create mode 100644 src/crypto/reflibs/Crypto/PubKey/Ed25519.hs (limited to 'src/crypto/reflibs/Crypto/PubKey') diff --git a/src/crypto/reflibs/Crypto/PubKey/Curve25519.hs b/src/crypto/reflibs/Crypto/PubKey/Curve25519.hs new file mode 100644 index 0000000..ea8e035 --- /dev/null +++ b/src/crypto/reflibs/Crypto/PubKey/Curve25519.hs @@ -0,0 +1,84 @@ +module Crypto.PubKey.Curve25519 ( + CxSecretKey, + CxPublicKey, + DhSecret, + + cxSecretKey, + cxPublicKey, + + cxGenerateSecretKey, + cxToPublic, + diffieHellman, +) where + +import Control.Monad + +import Crypto.Error +import Crypto.Random + +import Data.Bits +import Data.ByteArray +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Unsafe qualified as BS +import Data.Word + +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.Storable + +import System.IO.Unsafe + + +newtype CxSecretKey = CxSecretKey ByteString + deriving (Eq, ByteArrayAccess) + +newtype CxPublicKey = CxPublicKey ByteString + deriving (Eq, Show, ByteArrayAccess) + +newtype DhSecret = DhSecret ByteString + deriving (Eq, Show, ByteArrayAccess) + +cxSecretKey :: ByteArrayAccess bs => bs -> CryptoFailable CxSecretKey +cxSecretKey ba + | BS.length bs == 32 = CryptoPassed $ CxSecretKey bs + | otherwise = CryptoFailed CryptoError + where + bs = convert ba + +cxPublicKey :: ByteString -> CryptoFailable CxPublicKey +cxPublicKey bs + | BS.length bs == 32 = CryptoPassed $ CxPublicKey bs + | otherwise = CryptoFailed CryptoError + +cxGenerateSecretKey :: IO CxSecretKey +cxGenerateSecretKey = do + bs <- getRandomBytes 32 + BS.unsafeUseAsCString bs $ \ptr -> do + pokeElemOff ptr 0 . (.&. 248) =<< peekElemOff ptr 0 + pokeElemOff ptr 31 . (.|. 64) . (.&. 127) =<< peekElemOff ptr 31 + return $ CxSecretKey bs + +cxToPublic :: CxSecretKey -> CxPublicKey +cxToPublic (CxSecretKey bs) = unsafePerformIO $ do + let len = 32 + ptr <- mallocBytes len + BS.unsafeUseAsCString bs $ \secret -> do + allocaBytes 32 $ \basepoint -> do + fillBytes basepoint 0 len + pokeElemOff basepoint 0 9 + void $ curve25519_donna ptr (castPtr secret) basepoint + CxPublicKey <$> BS.unsafePackCStringFinalizer ptr len (free ptr) + +diffieHellman :: CxPublicKey -> CxSecretKey -> DhSecret +diffieHellman (CxPublicKey bpub) (CxSecretKey bsec) = unsafePerformIO $ do + let len = 32 + ptr <- mallocBytes len + BS.unsafeUseAsCString bpub $ \pub -> do + BS.unsafeUseAsCString bsec $ \sec -> do + void $ curve25519_donna ptr (castPtr sec) (castPtr pub) + DhSecret <$> BS.unsafePackCStringFinalizer ptr len (free ptr) + +foreign import ccall unsafe "curve25519_donna" curve25519_donna :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt diff --git a/src/crypto/reflibs/Crypto/PubKey/Ed25519.hs b/src/crypto/reflibs/Crypto/PubKey/Ed25519.hs new file mode 100644 index 0000000..88c7302 --- /dev/null +++ b/src/crypto/reflibs/Crypto/PubKey/Ed25519.hs @@ -0,0 +1,73 @@ +module Crypto.PubKey.Ed25519 ( + EdSecretKey, + EdPublicKey, + EdSignature, + + edSecretKey, + edPublicKey, + edSignature, + edToPublic, + edGenerateSecretKey, + edSign, + edVerify, +) where + +import Crypto.Error +import Crypto.Random +import Crypto.Sign.Ed25519 qualified as Ed + +import Data.ByteArray as BA +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS + + +newtype EdSecretKey = EdSecretKey { fromSecretKey :: Ed.SecretKey } + deriving (Eq) + +newtype EdPublicKey = EdPublicKey { fromPublicKey :: Ed.PublicKey } + deriving (Eq) + +newtype EdSignature = EdSignature { fromSignature :: Ed.Signature } + deriving (Eq) + +instance Show EdSecretKey where show = show . fromSecretKey +instance Show EdPublicKey where show = show . fromPublicKey +instance Show EdSignature where show = show . fromSignature + +instance ByteArrayAccess EdSecretKey where + length = BS.length . Ed.openSecretKey . fromSecretKey + withByteArray = withByteArray . Ed.openSecretKey . fromSecretKey + +instance ByteArrayAccess EdPublicKey where + length = BS.length . Ed.openPublicKey . fromPublicKey + withByteArray = withByteArray . Ed.openPublicKey . fromPublicKey + +instance ByteArrayAccess EdSignature where + length = BS.length . Ed.unSignature . fromSignature + withByteArray = withByteArray . Ed.unSignature . fromSignature + +signatureSize :: Int +signatureSize = 64 + +edSignature :: ByteString -> CryptoFailable EdSignature +edSignature bs + | BS.length bs == signatureSize = CryptoPassed (EdSignature (Ed.Signature bs)) + | otherwise = CryptoFailed CryptoError + +edPublicKey :: ByteString -> CryptoFailable EdPublicKey +edPublicKey = maybe (CryptoFailed CryptoError) (CryptoPassed . EdPublicKey) . Ed.makePublicKey . convert + +edSecretKey :: ByteArrayAccess ba => ba -> CryptoFailable EdSecretKey +edSecretKey = maybe (CryptoFailed CryptoError) (CryptoPassed . EdSecretKey) . Ed.makeSecretKey . convert + +edToPublic :: EdSecretKey -> EdPublicKey +edToPublic = EdPublicKey . Ed.secretToPublicKey . fromSecretKey + +edSign :: ByteArrayAccess ba => EdSecretKey -> EdPublicKey -> ba -> EdSignature +edSign (EdSecretKey key) _ = EdSignature . Ed.dsign key . convert + +edVerify :: ByteArrayAccess ba => EdPublicKey -> ba -> EdSignature -> Bool +edVerify (EdPublicKey pub) msg (EdSignature sig) = Ed.dverify pub (convert msg) sig + +edGenerateSecretKey :: IO EdSecretKey +edGenerateSecretKey = maybe (error "createKeypairFromSeed_ failed") (return . EdSecretKey . snd) . Ed.createKeypairFromSeed_ =<< getRandomBytes 32 -- cgit v1.2.3