summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erebos.cabal28
-rw-r--r--src/Erebos/Invite.hs3
-rw-r--r--src/Erebos/Network/Channel.hs18
-rw-r--r--src/Erebos/Network/Protocol.hs41
-rw-r--r--src/Erebos/Object/Internal.hs3
-rw-r--r--src/Erebos/Pairing.hs3
-rw-r--r--src/Erebos/PubKey.hs50
-rw-r--r--src/Erebos/Storage/Internal.hs3
-rw-r--r--src/Erebos/UUID.hs4
-rw-r--r--src/crypto/crypton/Crypto.hs118
10 files changed, 193 insertions, 78 deletions
diff --git a/erebos.cabal b/erebos.cabal
index e9b8488..ba2b5d2 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -31,11 +31,15 @@ Extra-Source-Files:
src/Erebos/ICE/pjproject.h
src/Erebos/Network/ifaddrs.h
-Flag ice
+flag ice
Description: Enable peer discovery with ICE support using pjproject
-Flag cryptonite
- description: Use deprecated 'cryptonite' package
+flag crypton
+ description: Use 'crypton' package as crypto backend
+ default: True
+
+flag cryptonite
+ description: Use deprecated 'cryptonite' package as crypto backed
default: False
source-repository head
@@ -119,6 +123,7 @@ library
Erebos.TextFormat.Ansi
other-modules:
+ Crypto
Erebos.Conversation.Class
Erebos.Flow
Erebos.Network.Address
@@ -177,12 +182,20 @@ library
uuid-types ^>= { 1.0.4 },
zlib >=0.6 && <0.8
- if !flag(cryptonite)
+ if flag(crypton)
build-depends:
crypton ^>= { 0.34, 1.0 },
- else
+ hs-source-dirs:
+ src/crypto/crypton
+
+ elif flag(cryptonite)
build-depends:
cryptonite >=0.25 && <0.31,
+ hs-source-dirs:
+ src/crypto/crypton
+
+ else
+ build-depends: base < 0
if os(windows)
hs-source-dirs: src/windows
@@ -229,9 +242,10 @@ executable erebos
uuid-types,
websockets ^>= { 0.12.7, 0.13 },
- if !flag(cryptonite)
+ if flag(crypton)
build-depends:
crypton,
- else
+
+ elif flag(cryptonite)
build-depends:
cryptonite,
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
generated by cgit v1.2.3 (git 2.25.1) at 2026-10-30 03:34:11 +0000