From e45b366ca8b9caa4fe0087e5c4fb1720472d9c23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 18 Oct 2026 10:13:30 +0200 Subject: Refactor code to support multiple crypto backends --- src/Erebos/Invite.hs | 3 +- src/Erebos/Network/Channel.hs | 18 +++---- src/Erebos/Network/Protocol.hs | 41 ++++++-------- src/Erebos/Object/Internal.hs | 3 +- src/Erebos/Pairing.hs | 3 +- src/Erebos/PubKey.hs | 50 ++++++++--------- src/Erebos/Storage/Internal.hs | 3 +- src/Erebos/UUID.hs | 4 +- src/crypto/crypton/Crypto.hs | 118 +++++++++++++++++++++++++++++++++++++++++ 9 files changed, 172 insertions(+), 71 deletions(-) create mode 100644 src/crypto/crypton/Crypto.hs (limited to 'src') diff --git a/src/Erebos/Invite.hs b/src/Erebos/Invite.hs index 65adaa7..69a6977 100644 --- a/src/Erebos/Invite.hs +++ b/src/Erebos/Invite.hs @@ -20,8 +20,6 @@ import Control.Monad.Except import Control.Monad.IO.Class import Control.Monad.Reader -import Crypto.Random - import Data.ByteArray (ByteArray, ByteArrayAccess) import Data.ByteString (ByteString) import Data.ByteString.Char8 qualified as BC @@ -33,6 +31,7 @@ import Data.Text qualified as T import Data.Text.Encoding import Data.Time.LocalTime +import Crypto import Erebos.Contact import Erebos.Discovery import Erebos.Identity diff --git a/src/Erebos/Network/Channel.hs b/src/Erebos/Network/Channel.hs index d9679bd..e53f8b3 100644 --- a/src/Erebos/Network/Channel.hs +++ b/src/Erebos/Network/Channel.hs @@ -16,15 +16,13 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Class -import Crypto.Cipher.ChaChaPoly1305 -import Crypto.Error - import Data.Binary import Data.ByteArray (ByteArray, Bytes, ScrubbedBytes, convert) import Data.ByteArray qualified as BA import Data.ByteString.Lazy qualified as BL import Data.List +import Crypto import Erebos.Identity import Erebos.PubKey import Erebos.Storable @@ -142,12 +140,12 @@ channelEncrypt Channel {..} plain = do count <- liftIO $ modifyMVar chCounterNextOut $ \c -> return (c + 1, c) let cbytes = convert $ BL.toStrict $ encode count nonce = nonce8 chNonceFixedOur cbytes - state <- case initialize chKey =<< nonce of + state <- case aeadInitialize chKey =<< nonce of CryptoPassed state -> return state CryptoFailed err -> throwOtherError $ "failed to init chacha-poly1305 cipher: " <> show err let (ctext, state') = encrypt plain state - tag = finalize state' + tag = aeadFinalize state' return (BA.concat [ convert $ BA.drop 7 cbytes, ctext, convert tag ], count) channelDecrypt :: (ByteArray ba, MonadIO m, MonadError e m, FromErebosError e) => Channel -> ba -> m (ba, Word64) @@ -163,13 +161,15 @@ channelDecrypt Channel {..} body = do blen = BA.length body' - 16 ctext = BA.takeView body' blen tag = BA.dropView body' blen - state <- case initialize chKey =<< nonce of + state <- case aeadInitialize chKey =<< nonce of CryptoPassed state -> return state CryptoFailed err -> throwOtherError $ "failed to init chacha-poly1305 cipher: " <> show err - let (plain, state') = decrypt (convert ctext) state - when (not $ tag `BA.constEq` finalize state') $ do - throwOtherError $ "tag validation falied" + auth <- case authTag tag of + CryptoPassed auth -> return auth + CryptoFailed err -> throwOtherError $ "failed to decode auth tag: " <> show err + plain <- maybe (throwOtherError "tag validation failed") return $ + decrypt ( convert ctext, auth ) state liftIO $ modifyMVar_ chCounterNextIn $ return . max (guessedCount + 1) return (plain, guessedCount) diff --git a/src/Erebos/Network/Protocol.hs b/src/Erebos/Network/Protocol.hs index 6654b27..87272a2 100644 --- a/src/Erebos/Network/Protocol.hs +++ b/src/Erebos/Network/Protocol.hs @@ -45,11 +45,6 @@ import Control.Monad import Control.Monad.Except import Control.Monad.Trans -import Crypto.Cipher.ChaChaPoly1305 qualified as C -import Crypto.MAC.Poly1305 qualified as C (Auth(..), authTag) -import Crypto.Error -import Crypto.Random - import Data.Binary import Data.Binary.Get import Data.Binary.Put @@ -69,6 +64,7 @@ import Data.Void import System.Clock +import Crypto as C import Erebos.Flow import Erebos.Identity import Erebos.Network.Channel @@ -149,7 +145,7 @@ instance Binary ParsedCookie where putByteString cookieContent get = do - Just cookieNonce <- maybeCryptoError . C.nonce12 <$> getByteString 12 + Just cookieNonce <- maybeCryptoError . C.nonce12 . BA.convert <$> getByteString 12 cookieValidity <- getWord32be Just cookieMac <- maybeCryptoError . C.authTag <$> getByteString 16 cookieContent <- BL.toStrict <$> getRemainingLazyByteString @@ -810,11 +806,11 @@ createCookie GlobalState {..} addr = do cookieValidity = validSecondsFromStart - gCookieStartTime plainContent = BC.pack (show addr) throwCryptoErrorIO $ do - cookieNonce <- C.nonce12 nonceBytes - st1 <- C.initialize gCookieKey cookieNonce - let st2 = C.finalizeAAD $ C.appendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1 - (cookieContent, st3) = C.encrypt plainContent st2 - cookieMac = C.finalize st3 + cookieNonce <- nonce12 nonceBytes + st1 <- aeadInitialize gCookieKey cookieNonce + let st2 = aeadFinalizeAAD $ aeadAppendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1 + ( cookieContent, st3 ) = encrypt plainContent st2 + cookieMac = aeadFinalize st3 return $ Cookie $ BL.toStrict $ encode $ ParsedCookie {..} verifyCookie :: GlobalState addr -> addr -> Cookie -> IO Bool @@ -822,19 +818,16 @@ verifyCookie GlobalState {..} addr (Cookie cookie) = do ctime <- getTime Monotonic return $ fromMaybe False $ do ( _, _, ParsedCookie {..} ) <- either (const Nothing) Just $ decodeOrFail $ BL.fromStrict cookie - maybeCryptoError $ do - st1 <- C.initialize gCookieKey cookieNonce - let st2 = C.finalizeAAD $ C.appendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1 - (plainContent, st3) = C.decrypt cookieContent st2 - mac = C.finalize st3 - - validSecondsFromStart = fromIntegral $ cookieValidity + gCookieStartTime - validUntil = gStartTime + fromNanoSecs (validSecondsFromStart * (10^(9 :: Int))) - return $ and - [ mac == cookieMac - , ctime <= validUntil - , show addr == BC.unpack plainContent - ] + st1 <- maybeCryptoError $ do + aeadInitialize gCookieKey cookieNonce + let st2 = aeadFinalizeAAD $ aeadAppendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1 + plainContent <- decrypt ( cookieContent, cookieMac ) st2 + let validSecondsFromStart = fromIntegral $ cookieValidity + gCookieStartTime + validUntil = gStartTime + fromNanoSecs (validSecondsFromStart * (10^(9 :: Int))) + return $ and + [ ctime <= validUntil + , show addr == BC.unpack plainContent + ] reservePacket :: Connection addr -> STM ReservedToSend reservePacket conn@Connection {..} = do diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs index 778f80a..4a33dba 100644 --- a/src/Erebos/Object/Internal.hs +++ b/src/Erebos/Object/Internal.hs @@ -49,8 +49,6 @@ import Control.Monad.Except import Control.Monad.Reader import Control.Monad.Writer -import Crypto.Hash - import Data.Bifunctor import Data.ByteArray qualified as BA import Data.ByteString (ByteString) @@ -75,6 +73,7 @@ import Data.Word import System.IO.Unsafe +import Crypto import Erebos.Error import Erebos.Storage.Internal import Erebos.UUID (UUID) diff --git a/src/Erebos/Pairing.hs b/src/Erebos/Pairing.hs index d1fdc79..602aea8 100644 --- a/src/Erebos/Pairing.hs +++ b/src/Erebos/Pairing.hs @@ -14,8 +14,6 @@ import Control.Monad import Control.Monad.Except import Control.Monad.Reader -import Crypto.Random - import Data.Bits import Data.ByteArray qualified as BA import Data.ByteString (ByteString) @@ -26,6 +24,7 @@ import Data.Maybe import Data.Typeable import Data.Word +import Crypto import Erebos.Identity import Erebos.Network import Erebos.Object diff --git a/src/Erebos/PubKey.hs b/src/Erebos/PubKey.hs index a2ee519..ef56d41 100644 --- a/src/Erebos/PubKey.hs +++ b/src/Erebos/PubKey.hs @@ -12,25 +12,21 @@ module Erebos.PubKey ( import Control.Monad -import Crypto.Error -import qualified Crypto.PubKey.Ed25519 as ED -import qualified Crypto.PubKey.Curve25519 as CX - import Data.ByteArray -import Data.ByteString (ByteString) -import qualified Data.Text as T +import Data.Text qualified as T +import Crypto import Erebos.Storable import Erebos.Storage.Key -data PublicKey = PublicKey ED.PublicKey +data PublicKey = PublicKey EdPublicKey deriving (Show) -data SecretKey = SecretKey ED.SecretKey (Stored PublicKey) +data SecretKey = SecretKey EdSecretKey (Stored PublicKey) data Signature = Signature { sigKey :: Stored PublicKey - , sigSignature :: ED.Signature + , sigSignature :: EdSignature } deriving (Show) @@ -50,13 +46,13 @@ instance KeyPair SecretKey PublicKey where keyGetPublic (SecretKey _ pub) = pub keyGetData (SecretKey sec _) = convert sec keyFromData kdata spub = do - skey <- maybeCryptoError $ ED.secretKey kdata + skey <- maybeCryptoError $ edSecretKey kdata let PublicKey pkey = fromStored spub - guard $ ED.toPublic skey == pkey + guard $ edToPublic skey == pkey return $ SecretKey skey spub generateKeys st = do - secret <- ED.generateSecretKey - public <- wrappedStore st $ PublicKey $ ED.toPublic secret + secret <- edGenerateSecretKey + public <- wrappedStore st $ PublicKey $ edToPublic secret let pair = SecretKey secret public storeKey pair return (pair, public) @@ -70,8 +66,7 @@ instance Storable PublicKey where ktype <- loadText "type" guard $ ktype == "ed25519" maybe (throwOtherError "public key decoding failed") (return . PublicKey) . - maybeCryptoError . (ED.publicKey :: ByteString -> CryptoFailable ED.PublicKey) =<< - loadBinary "pubkey" + maybeCryptoError . edPublicKey =<< loadBinary "pubkey" instance Storable Signature where store' sig = storeRec $ do @@ -82,7 +77,7 @@ instance Storable Signature where <$> loadRef "key" <*> loadSignature "sig" where loadSignature = maybe (throwOtherError "signature decoding failed") return . - maybeCryptoError . (ED.signature :: ByteString -> CryptoFailable ED.Signature) <=< loadBinary + maybeCryptoError . edSignature <=< loadBinary instance Storable a => Storable (Signed a) where store' sig = storeRec $ do @@ -94,7 +89,7 @@ instance Storable a => Storable (Signed a) where sigs <- loadRefs "sig" forM_ sigs $ \sig -> do let PublicKey pubkey = fromStored $ sigKey $ fromStored sig - when (not $ ED.verify pubkey (storedRef sdata) $ sigSignature $ fromStored sig) $ + when (not $ edVerify pubkey (storedRef sdata) $ sigSignature $ fromStored sig) $ throwOtherError "signature verification failed" return $ Signed sdata sigs @@ -104,12 +99,12 @@ sign secret val = signAdd secret $ Signed val [] signAdd :: MonadStorage m => SecretKey -> Signed a -> m (Signed a) signAdd (SecretKey secret spublic) (Signed val sigs) = do let PublicKey public = fromStored spublic - sig = ED.sign secret public $ storedRef val + sig = edSign secret public $ storedRef val ssig <- mstore $ Signature spublic sig return $ Signed val (ssig : sigs) isSignedBy :: Signed a -> Stored PublicKey -> Bool -isSignedBy sig key = key `elem` map (sigKey . fromStored) (signedSignature sig) +isSignedBy sig key = key `elem` Prelude.map (sigKey . fromStored) (signedSignature sig) fromSigned :: Stored (Signed a) -> a fromSigned = fromStored . signedData . fromStored @@ -119,22 +114,22 @@ unsafeMapSigned :: (a -> b) -> Signed a -> Signed b unsafeMapSigned f signed = signed { signedData_ = unsafeMapStored f (signedData_ signed) } -data PublicKexKey = PublicKexKey CX.PublicKey +data PublicKexKey = PublicKexKey CxPublicKey deriving (Show) -data SecretKexKey = SecretKexKey CX.SecretKey (Stored PublicKexKey) +data SecretKexKey = SecretKexKey CxSecretKey (Stored PublicKexKey) instance KeyPair SecretKexKey PublicKexKey where keyGetPublic (SecretKexKey _ pub) = pub keyGetData (SecretKexKey sec _) = convert sec keyFromData kdata spub = do - skey <- maybeCryptoError $ CX.secretKey kdata + skey <- maybeCryptoError $ cxSecretKey kdata let PublicKexKey pkey = fromStored spub - guard $ CX.toPublic skey == pkey + guard $ cxToPublic skey == pkey return $ SecretKexKey skey spub generateKeys st = do - secret <- CX.generateSecretKey - public <- wrappedStore st $ PublicKexKey $ CX.toPublic secret + secret <- cxGenerateSecretKey + public <- wrappedStore st $ PublicKexKey $ cxToPublic secret let pair = SecretKexKey secret public storeKey pair return (pair, public) @@ -148,8 +143,7 @@ instance Storable PublicKexKey where ktype <- loadText "type" guard $ ktype == "x25519" maybe (throwOtherError "public key decoding failed") (return . PublicKexKey) . - maybeCryptoError . (CX.publicKey :: ScrubbedBytes -> CryptoFailable CX.PublicKey) =<< - loadBinary "pubkey" + maybeCryptoError . cxPublicKey =<< loadBinary "pubkey" dhSecret :: SecretKexKey -> PublicKexKey -> ScrubbedBytes -dhSecret (SecretKexKey secret _) (PublicKexKey public) = convert $ CX.dh public secret +dhSecret (SecretKexKey secret _) (PublicKexKey public) = convert $ diffieHellman public secret diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs index e6fafe4..49a2b27 100644 --- a/src/Erebos/Storage/Internal.hs +++ b/src/Erebos/Storage/Internal.hs @@ -24,8 +24,6 @@ import Control.Concurrent import Control.DeepSeq import Control.Monad.Identity -import Crypto.Hash - import Data.Bits import Data.ByteArray (ByteArrayAccess, ScrubbedBytes) import Data.ByteArray qualified as BA @@ -41,6 +39,7 @@ import Foreign.Storable (peek) import System.IO.Unsafe (unsafePerformIO) +import Crypto import Erebos.UUID (UUID) import Erebos.Util diff --git a/src/Erebos/UUID.hs b/src/Erebos/UUID.hs index 128d450..582bab2 100644 --- a/src/Erebos/UUID.hs +++ b/src/Erebos/UUID.hs @@ -6,14 +6,14 @@ module Erebos.UUID ( nextRandom, ) where -import Crypto.Random.Entropy - import Data.Bits import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BSL import Data.Maybe import Data.UUID.Types +import Crypto + nextRandom :: IO UUID nextRandom = do [ b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf ] diff --git a/src/crypto/crypton/Crypto.hs b/src/crypto/crypton/Crypto.hs new file mode 100644 index 0000000..7c98088 --- /dev/null +++ b/src/crypto/crypton/Crypto.hs @@ -0,0 +1,118 @@ +module Crypto ( + getEntropy, + getRandomBytes, + + Digest, Blake2b_256, + hashInit, hashUpdates, hashFinalize, + hashDigestSize, + digestFromByteString, + + AeadState, + Nonce, nonce8, nonce12, + Auth(..), authTag, + aeadInitialize, aeadAppendAAD, + aeadFinalize, aeadFinalizeAAD, + encrypt, decrypt, + + EdPublicKey, EdSecretKey, EdSignature, + edPublicKey, edSecretKey, edGenerateSecretKey, edToPublic, + edSignature, edSign, edVerify, + CxPublicKey, CxSecretKey, DhSecret, + cxPublicKey, cxSecretKey, cxGenerateSecretKey, cxToPublic, + diffieHellman, + + CryptoFailable(..), + maybeCryptoError, + throwCryptoErrorIO, +) where + +import Control.Monad + +import Crypto.Cipher.ChaChaPoly1305 qualified as C +import Crypto.Error +import Crypto.Hash +import Crypto.MAC.Poly1305 (Auth(..), authTag) +import Crypto.PubKey.Curve25519 qualified as Cx +import Crypto.PubKey.Ed25519 qualified as Ed +import Crypto.Random +import Crypto.Random.Entropy + +import Data.ByteArray +import Data.ByteString (ByteString) + + +type AeadState = C.State + +type Nonce = C.Nonce + +nonce8 :: Bytes -> Bytes -> CryptoFailable Nonce +nonce8 = C.nonce8 + +nonce12 :: Bytes -> CryptoFailable Nonce +nonce12 = C.nonce12 + +aeadInitialize :: ScrubbedBytes -> Nonce -> CryptoFailable AeadState +aeadInitialize = C.initialize + +aeadAppendAAD :: ByteString -> AeadState -> AeadState +aeadAppendAAD = C.appendAAD + +aeadFinalizeAAD :: AeadState -> AeadState +aeadFinalizeAAD = C.finalizeAAD + +encrypt :: ByteArray ba => ba -> AeadState -> ( ba, AeadState ) +encrypt = C.encrypt + +decrypt :: ByteArray ba => ( ba, Auth ) -> AeadState -> Maybe ba +decrypt ( ctext, auth ) st = do + let ( plain, st' ) = C.decrypt ctext st + guard (C.finalize st' `constEq` auth) + return plain + +aeadFinalize :: AeadState -> Auth +aeadFinalize = C.finalize + + +type EdPublicKey = Ed.PublicKey +type EdSecretKey = Ed.SecretKey +type EdSignature = Ed.Signature + +edPublicKey :: ByteString -> CryptoFailable EdPublicKey +edPublicKey = Ed.publicKey + +edSecretKey :: ByteArrayAccess ba => ba -> CryptoFailable EdSecretKey +edSecretKey = Ed.secretKey + +edGenerateSecretKey :: IO EdSecretKey +edGenerateSecretKey = Ed.generateSecretKey + +edToPublic :: EdSecretKey -> EdPublicKey +edToPublic = Ed.toPublic + +edSignature :: ByteString -> CryptoFailable EdSignature +edSignature = Ed.signature + +edSign :: ByteArrayAccess ba => EdSecretKey -> EdPublicKey -> ba -> EdSignature +edSign = Ed.sign + +edVerify :: ByteArrayAccess ba => EdPublicKey -> ba -> EdSignature -> Bool +edVerify = Ed.verify + +type CxPublicKey = Cx.PublicKey +type CxSecretKey = Cx.SecretKey +type DhSecret = Cx.DhSecret + +cxPublicKey :: ByteString -> CryptoFailable CxPublicKey +cxPublicKey = Cx.publicKey + +cxSecretKey :: ByteArrayAccess ba => ba -> CryptoFailable CxSecretKey +cxSecretKey = Cx.secretKey + +cxGenerateSecretKey :: IO CxSecretKey +cxGenerateSecretKey = Cx.generateSecretKey + +cxToPublic :: CxSecretKey -> CxPublicKey +cxToPublic = Cx.toPublic + +diffieHellman :: CxPublicKey -> CxSecretKey -> DhSecret +diffieHellman = Cx.dh -- cgit v1.2.3