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 --- erebos.cabal | 32 +++++++++ src/crypto/reflibs/Crypto.hs | 23 ++++++ src/crypto/reflibs/Crypto/Cipher/ChaChaPoly1305.hs | 72 +++++++++++++++++++ src/crypto/reflibs/Crypto/Error.hs | 41 +++++++++++ src/crypto/reflibs/Crypto/Hash.hs | 80 +++++++++++++++++++++ src/crypto/reflibs/Crypto/MAC/Poly1305.hs | 20 ++++++ src/crypto/reflibs/Crypto/PubKey/Curve25519.hs | 84 ++++++++++++++++++++++ src/crypto/reflibs/Crypto/PubKey/Ed25519.hs | 73 +++++++++++++++++++ src/crypto/reflibs/Crypto/Random.hs | 13 ++++ src/crypto/reflibs/Crypto/Random/Entropy.hs | 19 +++++ 10 files changed, 457 insertions(+) create mode 100644 src/crypto/reflibs/Crypto.hs create mode 100644 src/crypto/reflibs/Crypto/Cipher/ChaChaPoly1305.hs create mode 100644 src/crypto/reflibs/Crypto/Error.hs create mode 100644 src/crypto/reflibs/Crypto/Hash.hs create mode 100644 src/crypto/reflibs/Crypto/MAC/Poly1305.hs create mode 100644 src/crypto/reflibs/Crypto/PubKey/Curve25519.hs create mode 100644 src/crypto/reflibs/Crypto/PubKey/Ed25519.hs create mode 100644 src/crypto/reflibs/Crypto/Random.hs create mode 100644 src/crypto/reflibs/Crypto/Random/Entropy.hs diff --git a/erebos.cabal b/erebos.cabal index ba2b5d2..d9180f7 100644 --- a/erebos.cabal +++ b/erebos.cabal @@ -42,6 +42,10 @@ flag cryptonite description: Use deprecated 'cryptonite' package as crypto backed default: False +flag crypto-reflibs + description: Use various (reference) libraries as crypto backed + default: False + source-repository head type: git location: https://code.erebosprotocol.net/erebos @@ -194,6 +198,25 @@ library hs-source-dirs: src/crypto/crypton + elif flag(crypto-reflibs) + other-modules: + Crypto.Cipher.ChaChaPoly1305 + Crypto.Error + Crypto.Hash + Crypto.MAC.Poly1305 + Crypto.PubKey.Curve25519 + Crypto.PubKey.Ed25519 + Crypto.Random + Crypto.Random.Entropy + build-depends: + ed25519 ^>= { 0.0.6 }, + ppad-aead ^>= { 0.1 }, + hs-source-dirs: + src/crypto/reflibs + extra-libraries: + blake2b-ref + curve25519-donna + else build-depends: base < 0 @@ -249,3 +272,12 @@ executable erebos elif flag(cryptonite) build-depends: cryptonite, + + elif flag(crypto-reflibs) + other-modules: + Crypto.Random + Crypto.Random.Entropy + hs-source-dirs: + src/crypto/reflibs + build-depends: + memory, diff --git a/src/crypto/reflibs/Crypto.hs b/src/crypto/reflibs/Crypto.hs new file mode 100644 index 0000000..0b98b82 --- /dev/null +++ b/src/crypto/reflibs/Crypto.hs @@ -0,0 +1,23 @@ +module Crypto ( + module Crypto.Random.Entropy, + module Crypto.Random, + + module Crypto.Hash, + + module Crypto.Cipher.ChaChaPoly1305, + + module Crypto.PubKey.Ed25519, + module Crypto.PubKey.Curve25519, + + CryptoFailable(..), + maybeCryptoError, + throwCryptoErrorIO, +) where + +import Crypto.Cipher.ChaChaPoly1305 +import Crypto.Error +import Crypto.Hash +import Crypto.PubKey.Curve25519 +import Crypto.PubKey.Ed25519 +import Crypto.Random +import Crypto.Random.Entropy diff --git a/src/crypto/reflibs/Crypto/Cipher/ChaChaPoly1305.hs b/src/crypto/reflibs/Crypto/Cipher/ChaChaPoly1305.hs new file mode 100644 index 0000000..c849c0b --- /dev/null +++ b/src/crypto/reflibs/Crypto/Cipher/ChaChaPoly1305.hs @@ -0,0 +1,72 @@ +module Crypto.Cipher.ChaChaPoly1305 ( + AeadState, Nonce, Auth(..), + authTag, + nonce8, nonce12, + aeadInitialize, + aeadAppendAAD, aeadFinalizeAAD, + encrypt, decrypt, + aeadFinalize, +) where + +import Crypto.AEAD.ChaCha20Poly1305 qualified as P +import Crypto.Error +import Crypto.MAC.Poly1305 + +import Data.ByteArray as BA +import Data.ByteString (ByteString) +import Data.ByteString qualified as B + + +data AeadState = AeadState + { stKey :: ByteString + , stNonce :: Nonce + , stAAD :: [ ByteString ] + , stAuth :: Maybe Auth + } + +newtype Nonce = Nonce ByteString + deriving (Eq, ByteArrayAccess) + +nonce8 :: Bytes -> Bytes -> CryptoFailable Nonce +nonce8 c iv + | BA.length c /= 4 = CryptoFailed CryptoError + | BA.length iv /= 8 = CryptoFailed CryptoError + | otherwise = CryptoPassed $ Nonce $ B.concat $ [ BA.convert c, BA.convert iv ] + +nonce12 :: Bytes -> CryptoFailable Nonce +nonce12 iv + | BA.length iv /= 12 = CryptoFailed CryptoError + | otherwise = CryptoPassed $ Nonce $ BA.convert iv + +aeadInitialize :: ScrubbedBytes -> Nonce -> CryptoFailable AeadState +aeadInitialize key nonce + | BA.length key /= 32 = CryptoFailed CryptoError + | otherwise = CryptoPassed AeadState + { stKey = BA.convert key + , stNonce = nonce + , stAAD = [] + , stAuth = Nothing + } + +aeadAppendAAD :: ByteString -> AeadState -> AeadState +aeadAppendAAD aad st = st { stAAD = stAAD st ++ [ aad ] } + +aeadFinalizeAAD :: AeadState -> AeadState +aeadFinalizeAAD = id + +encrypt :: ByteArray ba => ba -> AeadState -> ( ba, AeadState ) +encrypt ptext st = + let Nonce nonce = stNonce st + ( ctext, mac ) = P.encrypt (B.concat $ stAAD st) (stKey st) nonce (convert ptext) + in ( convert ctext, st { stAuth = Just $ Auth mac } ) + +decrypt :: ByteArray ba => ( ba, Auth ) -> AeadState -> Maybe ba +decrypt ( ctext, auth ) st = do + let Nonce nonce = stNonce st + Auth mac = auth + fmap convert $ P.decrypt (B.concat $ stAAD st) (stKey st) nonce ( convert ctext, mac ) + +aeadFinalize :: AeadState -> Auth +aeadFinalize st = case stAuth st of + Just auth -> auth + Nothing -> aeadFinalize $ snd $ encrypt B.empty st diff --git a/src/crypto/reflibs/Crypto/Error.hs b/src/crypto/reflibs/Crypto/Error.hs new file mode 100644 index 0000000..8f03db7 --- /dev/null +++ b/src/crypto/reflibs/Crypto/Error.hs @@ -0,0 +1,41 @@ +module Crypto.Error ( + CryptoError(..), + CryptoFailable(..), + + throwCryptoErrorIO, + maybeCryptoError, +) where + +import Control.Exception +import Control.Monad + + +data CryptoError = CryptoError + deriving (Show) + +instance Exception CryptoError + +data CryptoFailable a + = CryptoPassed a + | CryptoFailed CryptoError + deriving (Show) + +instance Functor CryptoFailable where + fmap f (CryptoPassed x) = CryptoPassed (f x) + fmap _ (CryptoFailed e) = CryptoFailed e + +instance Applicative CryptoFailable where + pure = CryptoPassed + (<*>) = ap + +instance Monad CryptoFailable where + CryptoPassed x >>= f = f x + CryptoFailed e >>= _ = CryptoFailed e + +throwCryptoErrorIO :: CryptoFailable a -> IO a +throwCryptoErrorIO (CryptoPassed r) = return r +throwCryptoErrorIO (CryptoFailed e) = throwIO e + +maybeCryptoError :: CryptoFailable a -> Maybe a +maybeCryptoError (CryptoPassed x) = Just x +maybeCryptoError (CryptoFailed _) = Nothing diff --git a/src/crypto/reflibs/Crypto/Hash.hs b/src/crypto/reflibs/Crypto/Hash.hs new file mode 100644 index 0000000..36308f9 --- /dev/null +++ b/src/crypto/reflibs/Crypto/Hash.hs @@ -0,0 +1,80 @@ +module Crypto.Hash ( + Digest, + Blake2b_256, + + digestFromByteString, + hashInit, + hashUpdates, + hashFinalize, + hashDigestSize, +) where + +import Control.DeepSeq +import Control.Monad + +import Data.ByteArray +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Unsafe + +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.Storable + +import System.IO.Unsafe + + +newtype Digest a = Digest ByteString + deriving (Eq, Ord, NFData, ByteArrayAccess) + +data Context a = Context (ForeignPtr Blake2bContext) + +data Blake2bContext + +data Blake2b_256 + + +digestFromByteString :: ByteString -> Maybe (Digest Blake2b_256) +digestFromByteString bs + | BS.length bs == digestSize = Just (Digest bs) + | otherwise = Nothing + +hashInit :: Context Blake2b_256 +hashInit = unsafePerformIO $ do + fctx <- mallocForeignPtrBytes stateSize + withForeignPtr fctx $ \ctx -> void $ cInit ctx (fromIntegral digestSize) + return $ Context fctx + +hashUpdates :: Context Blake2b_256 -> [ ByteString ] -> Context Blake2b_256 +hashUpdates (Context fbefore) updates = unsafePerformIO $ do + fafter <- mallocForeignPtrBytes stateSize + withForeignPtr fbefore $ \before -> + withForeignPtr fafter $ \after -> do + copyBytes after before stateSize + forM_ updates $ \update -> unsafeUseAsCStringLen update $ \( ptr, len ) -> do + void $ cUpdate after ptr (fromIntegral len) + return $ Context fafter + +hashFinalize :: Context Blake2b_256 -> Digest Blake2b_256 +hashFinalize (Context fctx) = unsafePerformIO $ do + bytes <- mallocBytes digestSize + withForeignPtr fctx $ \ctx -> + void $ cFinal ctx bytes (fromIntegral digestSize) + Digest <$> unsafePackMallocCStringLen ( bytes, digestSize ) + +hashDigestSize :: Blake2b_256 -> Int +hashDigestSize _ = fromIntegral digestSize + +digestSize :: Int +digestSize = 32 + +stateSize :: Int +stateSize = fromIntegral $ unsafeDupablePerformIO $ peek cStateSize + +foreign import ccall unsafe "&blake2b_state_size" cStateSize :: Ptr CSize +foreign import ccall unsafe "blake2b_init" cInit :: Ptr Blake2bContext -> CSize -> IO CInt +foreign import ccall unsafe "blake2b_update" cUpdate :: Ptr Blake2bContext -> Ptr CChar -> CSize -> IO CInt +foreign import ccall unsafe "blake2b_final" cFinal :: Ptr Blake2bContext -> Ptr CChar -> CSize -> IO CInt diff --git a/src/crypto/reflibs/Crypto/MAC/Poly1305.hs b/src/crypto/reflibs/Crypto/MAC/Poly1305.hs new file mode 100644 index 0000000..5e8938f --- /dev/null +++ b/src/crypto/reflibs/Crypto/MAC/Poly1305.hs @@ -0,0 +1,20 @@ +module Crypto.MAC.Poly1305 ( + Auth(..), + authTag, +) where + +import Crypto.Error + +import Data.ByteArray as BA +import Data.ByteString (ByteString) + + +newtype Auth = Auth ByteString + deriving (Eq, ByteArrayAccess) + +authTag :: ByteArrayAccess b => b -> CryptoFailable Auth +authTag ba + | BA.length bs /= 16 = CryptoFailed CryptoError + | otherwise = CryptoPassed (Auth bs) + where + bs = convert ba 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 diff --git a/src/crypto/reflibs/Crypto/Random.hs b/src/crypto/reflibs/Crypto/Random.hs new file mode 100644 index 0000000..6297155 --- /dev/null +++ b/src/crypto/reflibs/Crypto/Random.hs @@ -0,0 +1,13 @@ +module Crypto.Random ( + MonadRandom(..), +) where + +import Crypto.Random.Entropy + +import Data.ByteArray + +class Monad m => MonadRandom m where + getRandomBytes :: ByteArray byteArray => Int -> m byteArray + +instance MonadRandom IO where + getRandomBytes = fmap convert . getEntropy diff --git a/src/crypto/reflibs/Crypto/Random/Entropy.hs b/src/crypto/reflibs/Crypto/Random/Entropy.hs new file mode 100644 index 0000000..d0685e4 --- /dev/null +++ b/src/crypto/reflibs/Crypto/Random/Entropy.hs @@ -0,0 +1,19 @@ +module Crypto.Random.Entropy ( + getEntropy, +) where + +import Foreign.C.Error +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import Data.ByteString (ByteString) +import Data.ByteString.Unsafe + +getEntropy :: Int -> IO ByteString +getEntropy n = do + bytes <- mallocBytes n + throwErrnoIfMinus1_ "getentropy" $ c_getentropy bytes (fromIntegral n) + unsafePackMallocCStringLen ( bytes, n ) + +foreign import ccall "unistd.h getentropy" c_getentropy :: Ptr CChar -> CSize -> IO CInt -- cgit v1.2.3