summaryrefslogtreecommitdiff
path: root/src/Crypto
diff options
context:
space:
mode:
Diffstat (limited to 'src/Crypto')
-rw-r--r--src/Crypto/Tox.hs49
1 files changed, 49 insertions, 0 deletions
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index d418f504..a7f1ae83 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -24,6 +24,7 @@ module Crypto.Tox
24 , toPublic 24 , toPublic
25 , SymmetricKey(..) 25 , SymmetricKey(..)
26 , TransportCrypto(..) 26 , TransportCrypto(..)
27 , newCrypto
27 , SecretsCache 28 , SecretsCache
28 , newSecretsCache 29 , newSecretsCache
29 , Encrypted 30 , Encrypted
@@ -105,6 +106,7 @@ import Crypto.Error.Types (CryptoFailable (..), throwCryptoE
105import Crypto.ECC 106import Crypto.ECC
106import Crypto.Error 107import Crypto.Error
107#endif 108#endif
109import Crypto.Random
108import Network.Socket (SockAddr) 110import Network.Socket (SockAddr)
109import GHC.Exts (Word(..),inline) 111import GHC.Exts (Word(..),inline)
110import GHC.Generics (Generic) 112import GHC.Generics (Generic)
@@ -118,6 +120,8 @@ import System.IO.Unsafe (unsafeDupablePerformIO)
118import Data.Functor.Compose 120import Data.Functor.Compose
119import qualified Rank2 121import qualified Rank2
120import Data.Functor.Identity 122import Data.Functor.Identity
123import DPut
124import DebugTag
121 125
122-- | A 16-byte mac and an arbitrary-length encrypted stream. 126-- | A 16-byte mac and an arbitrary-length encrypted stream.
123newtype Encrypted a = Encrypted ByteString 127newtype Encrypted a = Encrypted ByteString
@@ -658,3 +662,48 @@ xorsum bs = unsafeDupablePerformIO $ BA.withByteArray bs $ \ptr16 -> do
658 loop (wcnt - 1) $ case r of 662 loop (wcnt - 1) $ case r of
659 0 -> 0 663 0 -> 0
660 _ -> 256 * fromIntegral (BA.index bs (BA.length bs - 1)) 664 _ -> 256 * fromIntegral (BA.index bs (BA.length bs - 1))
665
666showHex :: BA.ByteArrayAccess ba => ba -> String
667showHex bs = C8.unpack $ Base16.encode $ BA.convert bs
668
669newCrypto :: IO TransportCrypto
670newCrypto = do
671 secret <- generateSecretKey
672 alias <- generateSecretKey
673 ralias <- generateSecretKey
674 let pubkey = toPublic secret
675 aliaspub = toPublic alias
676 raliaspub = toPublic ralias
677 ukeys <- atomically $ newTVar []
678 (symkey, drg) <- do
679 drg0 <- getSystemDRG
680 return $ randomBytesGenerate 32 drg0 :: IO (ByteString, SystemDRG)
681 noncevar <- atomically $ newTVar $ fst $ withDRG drg drgNew
682 cookieKeys <- atomically $ newTVar []
683 cache <- newSecretsCache
684 dput XNetCrypto $ "secret(tox) = " ++ showHex secret
685 dput XNetCrypto $ "public(tox) = " ++ showHex pubkey
686 dput XNetCrypto $ "symmetric(tox) = " ++ showHex symkey
687 return TransportCrypto
688 { transportSecret = secret
689 , transportPublic = pubkey
690 , onionAliasSecret = alias
691 , onionAliasPublic = aliaspub
692 , rendezvousSecret = ralias
693 , rendezvousPublic = raliaspub
694 , transportSymmetric = return $ SymmetricKey symkey
695 , transportNewNonce = do
696 drg1 <- readTVar noncevar
697 let (nonce, drg2) = withDRG drg1 (Nonce24 <$> getRandomBytes 24)
698 writeTVar noncevar drg2
699 return nonce
700 , transportNewKey = do
701 drg1 <- readTVar noncevar
702 let (k, drg2) = withDRG drg1 generateSecretKey
703 writeTVar noncevar drg2
704 return k
705 , userKeys = return []
706 , pendingCookies = cookieKeys
707 , secretsCache = cache
708 }
709