diff options
Diffstat (limited to 'src/Crypto')
-rw-r--r-- | src/Crypto/Tox.hs | 49 |
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 | |||
105 | import Crypto.ECC | 106 | import Crypto.ECC |
106 | import Crypto.Error | 107 | import Crypto.Error |
107 | #endif | 108 | #endif |
109 | import Crypto.Random | ||
108 | import Network.Socket (SockAddr) | 110 | import Network.Socket (SockAddr) |
109 | import GHC.Exts (Word(..),inline) | 111 | import GHC.Exts (Word(..),inline) |
110 | import GHC.Generics (Generic) | 112 | import GHC.Generics (Generic) |
@@ -118,6 +120,8 @@ import System.IO.Unsafe (unsafeDupablePerformIO) | |||
118 | import Data.Functor.Compose | 120 | import Data.Functor.Compose |
119 | import qualified Rank2 | 121 | import qualified Rank2 |
120 | import Data.Functor.Identity | 122 | import Data.Functor.Identity |
123 | import DPut | ||
124 | import 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. |
123 | newtype Encrypted a = Encrypted ByteString | 127 | newtype 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 | |||
666 | showHex :: BA.ByteArrayAccess ba => ba -> String | ||
667 | showHex bs = C8.unpack $ Base16.encode $ BA.convert bs | ||
668 | |||
669 | newCrypto :: IO TransportCrypto | ||
670 | newCrypto = 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 | |||