1 files changed, 0 insertions, 125 deletions
diff --git a/src/Network/Tox/Handshake.hs b/src/Network/Tox/Handshake.hs
deleted file mode 100644
index c48b7415..00000000
--- a/src/Network/Tox/Handshake.hs
+++ /dev/null
@@ -1,125 +0,0 @@
-{-# LANGUAGE CPP             #-}
-{-# LANGUAGE DeriveFunctor   #-}
-{-# LANGUAGE NamedFieldPuns  #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TupleSections   #-}
-{-# LANGUAGE TypeOperators   #-}
-module Network.Tox.Handshake where
-import Control.Arrow
-import Control.Concurrent.STM
-import Control.Monad
-import Crypto.Hash
-import Crypto.Tox
-import Data.Functor.Identity
-import Data.Time.Clock.POSIX
-import Network.Tox.Crypto.Transport
-import Network.Tox.DHT.Handlers     (createCookieSTM)
-import Network.Tox.DHT.Transport    (Cookie (..), CookieData (..))
-import Network.Tox.NodeId
-#ifdef THREAD_DEBUG
-#else
-import Control.Concurrent
-import GHC.Conc           (labelThread)
-#endif
-import DPut
-import DebugTag
-anyRight :: Monad m => a -> [t] -> (t -> m (Either b b1)) -> m (Either a b1)
-anyRight e []     f = return $ Left e
-anyRight e (x:xs) f = f x >>= either (const $ anyRight e xs f) (return . Right)
-decryptHandshake :: TransportCrypto -> Handshake Encrypted -> IO (Either String (SecretKey,Handshake Identity))
-decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
-    (ukeys,symkey) <- atomically $ (,) <$> userKeys crypto
-                                       <*> transportSymmetric crypto
-    let seckeys = map fst ukeys
-    now <- getPOSIXTime
-    -- dput XNetCrypto "decryptHandshake: trying the following keys:"
-    -- forM_ seckeys $ \k -> dput XNetCrypto $ "  " ++ show (key2id . toPublic $ k)
-    fmap join . sequence $ do -- Either Monad
-            cd@(CookieData cookieTime remotePubkey remoteDhtkey) <- decodePlain =<< decryptSymmetric symkey n24 ecookie
-            Right $ do -- IO Monad
-            decrypted <- anyRight "missing key" seckeys $ \key -> do
-                            -- dput XNetCrypto $ "(NetCrypto)handshakeH: remotePubkey =  " ++ show (key2id $ remotePubkey)
-                            -- dput XNetCrypto $ "(NetCrypto)handshakeH: nonce24 =  " ++ show nonce24
-                            secret <- lookupSharedSecret crypto key remotePubkey nonce24
-                            let step1 = decrypt secret encrypted
-                            case step1 of
-                                Left s -> do
-                                    -- dput XNetCrypto $ "(NetCrypto)handshakeH: (decrypt) " ++ s
-                                    return (Left s)
-                                Right pln -> do
-                                    case decodePlain pln of
-                                        Left s -> do
-                                            -- dput XNetCrypto $ "(NetCrypto)handshakeH: (decodePlain) " ++ s
-                                            return (Left s)
-                                        Right x -> return (Right (key,x))
-            return $ do -- Either Monad
-            (key,hsdata@HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) <- decrypted
-            left (asTypeOf "cookie too old") $ guard (now - fromIntegral cookieTime < 15)
-            let hinit = hashInit
-                hctx = hashUpdate hinit n24
-                hctx' = hashUpdate hctx ecookie
-                digest = hashFinalize hctx'
-            left (asTypeOf "cookie digest mismatch") $ guard (cookieHash == digest)
-            return ( key
-                   , hshake { handshakeCookie = Cookie n24 (pure cd)
-                            , handshakeData   = pure hsdata
-                            } )
-data HandshakeParams
-        = HParam
-            { hpTheirBaseNonce        :: Maybe Nonce24 -- ignore and generate your own
-            , hpOtherCookie           :: Cookie Encrypted
-            , hpTheirSessionKeyPublic :: Maybe PublicKey
-            , hpMySecretKey           :: SecretKey
-            , hpCookieRemotePubkey    :: PublicKey
-            , hpCookieRemoteDhtkey    :: PublicKey
-            }
-newHandShakeData :: POSIXTime -> TransportCrypto -> Nonce24 -> HandshakeParams -> NodeInfo -> PublicKey -> STM HandshakeData
-newHandShakeData timestamp crypto basenonce hp nodeinfo mySessionPublic = do
-    let HParam {hpOtherCookie,hpMySecretKey,hpCookieRemotePubkey,hpCookieRemoteDhtkey} = hp
-        hinit                = hashInit
-        Cookie n24 encrypted = hpOtherCookie
-        hctx                 = hashUpdate hinit n24
-        hctx'                = hashUpdate hctx encrypted
-        digest               = hashFinalize hctx'
-    freshCookie <- createCookieSTM timestamp crypto nodeinfo hpCookieRemotePubkey
-    return HandshakeData
-                { baseNonce   = basenonce
-                , sessionKey  = mySessionPublic
-                , cookieHash  = digest
-                , otherCookie = freshCookie
-                }
-toHandshakeParams :: (SecretKey, Handshake Identity) -> HandshakeParams
-toHandshakeParams (key,hs)
-    = let hd = runIdentity $ handshakeData hs
-          Cookie _ cd0 = handshakeCookie hs
-          CookieData _ remotePublicKey remoteDhtPublicKey = runIdentity cd0
-      in HParam { hpTheirBaseNonce        = Just $ baseNonce hd
-                , hpOtherCookie           = otherCookie hd
-                , hpTheirSessionKeyPublic = Just $ sessionKey hd
-                , hpMySecretKey           = key
-                , hpCookieRemotePubkey    = remotePublicKey
-                , hpCookieRemoteDhtkey    = remoteDhtPublicKey
-                }
-encodeHandshake :: POSIXTime
-                   -> TransportCrypto
-                   -> SecretKey
-                   -> PublicKey
-                   -> Cookie Encrypted
-                   -> HandshakeData
-                   -> STM (Handshake Encrypted)
-encodeHandshake timestamp crypto me them otherCookie myhandshakeData = do
-    n24 <- transportNewNonce crypto
-    state <- ($ n24) <$> lookupNonceFunctionSTM timestamp crypto me them
-    return Handshake { handshakeCookie = otherCookie
-                     , handshakeNonce  = n24
-                     , handshakeData   = encrypt state $ encodePlain myhandshakeData
-                     }

diff --git a/src/Network/Tox/Handshake.hs b/src/Network/Tox/Handshake.hs deleted file mode 100644 index c48b7415..00000000 --- a/src/Network/Tox/Handshake.hs +++ /dev/null
@@ -1,125 +0,0 @@
1	{-# LANGUAGE CPP #-}
2	{-# LANGUAGE DeriveFunctor #-}
3	{-# LANGUAGE NamedFieldPuns #-}
4	{-# LANGUAGE PatternSynonyms #-}
5	{-# LANGUAGE TupleSections #-}
6	{-# LANGUAGE TypeOperators #-}
7	module Network.Tox.Handshake where
8
9	import Control.Arrow
10	import Control.Concurrent.STM
11	import Control.Monad
12	import Crypto.Hash
13	import Crypto.Tox
14	import Data.Functor.Identity
15	import Data.Time.Clock.POSIX
16	import Network.Tox.Crypto.Transport
17	import Network.Tox.DHT.Handlers (createCookieSTM)
18	import Network.Tox.DHT.Transport (Cookie (..), CookieData (..))
19	import Network.Tox.NodeId
20	#ifdef THREAD_DEBUG
21	#else
22	import Control.Concurrent
23	import GHC.Conc (labelThread)
24	#endif
25	import DPut
26	import DebugTag
27
28
29	anyRight :: Monad m => a -> [t] -> (t -> m (Either b b1)) -> m (Either a b1)
30	anyRight e [] f = return $ Left e
31	anyRight e (x:xs) f = f x >>= either (const $ anyRight e xs f) (return . Right)
32
33	decryptHandshake :: TransportCrypto -> Handshake Encrypted -> IO (Either String (SecretKey,Handshake Identity))
34	decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
35	(ukeys,symkey) <- atomically $ (,) <$> userKeys crypto
36	<*> transportSymmetric crypto
37	let seckeys = map fst ukeys
38	now <- getPOSIXTime
39	-- dput XNetCrypto "decryptHandshake: trying the following keys:"
40	-- forM_ seckeys $ \k -> dput XNetCrypto $ " " ++ show (key2id . toPublic $ k)
41	fmap join . sequence $ do -- Either Monad
42	cd@(CookieData cookieTime remotePubkey remoteDhtkey) <- decodePlain =<< decryptSymmetric symkey n24 ecookie
43	Right $ do -- IO Monad
44	decrypted <- anyRight "missing key" seckeys $ \key -> do
45	-- dput XNetCrypto $ "(NetCrypto)handshakeH: remotePubkey = " ++ show (key2id $ remotePubkey)
46	-- dput XNetCrypto $ "(NetCrypto)handshakeH: nonce24 = " ++ show nonce24
47	secret <- lookupSharedSecret crypto key remotePubkey nonce24
48	let step1 = decrypt secret encrypted
49	case step1 of
50	Left s -> do
51	-- dput XNetCrypto $ "(NetCrypto)handshakeH: (decrypt) " ++ s
52	return (Left s)
53	Right pln -> do
54	case decodePlain pln of
55	Left s -> do
56	-- dput XNetCrypto $ "(NetCrypto)handshakeH: (decodePlain) " ++ s
57	return (Left s)
58	Right x -> return (Right (key,x))
59	return $ do -- Either Monad
60	(key,hsdata@HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) <- decrypted
61	left (asTypeOf "cookie too old") $ guard (now - fromIntegral cookieTime < 15)
62	let hinit = hashInit
63	hctx = hashUpdate hinit n24
64	hctx' = hashUpdate hctx ecookie
65	digest = hashFinalize hctx'
66	left (asTypeOf "cookie digest mismatch") $ guard (cookieHash == digest)
67	return ( key
68	, hshake { handshakeCookie = Cookie n24 (pure cd)
69	, handshakeData = pure hsdata
70	} )
71
72
73	data HandshakeParams
74	= HParam
75	{ hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own
76	, hpOtherCookie :: Cookie Encrypted
77	, hpTheirSessionKeyPublic :: Maybe PublicKey
78	, hpMySecretKey :: SecretKey
79	, hpCookieRemotePubkey :: PublicKey
80	, hpCookieRemoteDhtkey :: PublicKey
81	}
82
83	newHandShakeData :: POSIXTime -> TransportCrypto -> Nonce24 -> HandshakeParams -> NodeInfo -> PublicKey -> STM HandshakeData
84	newHandShakeData timestamp crypto basenonce hp nodeinfo mySessionPublic = do
85	let HParam {hpOtherCookie,hpMySecretKey,hpCookieRemotePubkey,hpCookieRemoteDhtkey} = hp
86	hinit = hashInit
87	Cookie n24 encrypted = hpOtherCookie
88	hctx = hashUpdate hinit n24
89	hctx' = hashUpdate hctx encrypted
90	digest = hashFinalize hctx'
91	freshCookie <- createCookieSTM timestamp crypto nodeinfo hpCookieRemotePubkey
92	return HandshakeData
93	{ baseNonce = basenonce
94	, sessionKey = mySessionPublic
95	, cookieHash = digest
96	, otherCookie = freshCookie
97	}
98
99	toHandshakeParams :: (SecretKey, Handshake Identity) -> HandshakeParams
100	toHandshakeParams (key,hs)
101	= let hd = runIdentity $ handshakeData hs
102	Cookie _ cd0 = handshakeCookie hs
103	CookieData _ remotePublicKey remoteDhtPublicKey = runIdentity cd0
104	in HParam { hpTheirBaseNonce = Just $ baseNonce hd
105	, hpOtherCookie = otherCookie hd
106	, hpTheirSessionKeyPublic = Just $ sessionKey hd
107	, hpMySecretKey = key
108	, hpCookieRemotePubkey = remotePublicKey
109	, hpCookieRemoteDhtkey = remoteDhtPublicKey
110	}
111
112	encodeHandshake :: POSIXTime
113	-> TransportCrypto
114	-> SecretKey
115	-> PublicKey
116	-> Cookie Encrypted
117	-> HandshakeData
118	-> STM (Handshake Encrypted)
119	encodeHandshake timestamp crypto me them otherCookie myhandshakeData = do
120	n24 <- transportNewNonce crypto
121	state <- ($ n24) <$> lookupNonceFunctionSTM timestamp crypto me them
122	return Handshake { handshakeCookie = otherCookie
123	, handshakeNonce = n24
124	, handshakeData = encrypt state $ encodePlain myhandshakeData
125	}