Add crypto backend using various reference librariesHEADmaster

2 files changed, 157 insertions, 0 deletions

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