summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs125
1 files changed, 125 insertions, 0 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
new file mode 100644
index 00000000..f2c792cd
--- /dev/null
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -0,0 +1,125 @@
1{-# LANGUAGE NamedFieldPuns #-}
2{-# LANGUAGE TupleSections #-}
3module Network.Tox.Crypto.Handlers where
4
5import Network.Tox.Crypto.Transport
6import Network.Tox.DHT.Transport (Cookie(..),CookieData(..))
7import Crypto.Tox
8import Control.Concurrent.STM
9import Network.Address
10import qualified Data.Map.Strict as Map
11import Crypto.Hash
12import Control.Applicative
13import Control.Monad
14import Data.Time.Clock.POSIX
15
16data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed
17 deriving (Eq,Ord,Show,Enum)
18
19
20data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus
21 , ncTheirPacketNonce:: TVar Nonce24 -- base nonce + packet number
22 , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number
23 , ncHandShake :: TVar (Maybe (Handshake Encrypted))
24 , ncCookie :: TVar (Maybe Cookie)
25 , ncTheirSessionPublic :: Maybe PublicKey
26 , ncSessionSecret :: SecretKey
27 , ncSockAddr :: SockAddr
28 }
29
30data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
31 , transportCrypto :: TransportCrypto
32 }
33
34newSessionsState :: TransportCrypto -> IO NetCryptoSessions
35newSessionsState crypto = error "todo"
36
37data HandshakeParams
38 = HParam
39 { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own
40 , hpOtherCookie :: Maybe Cookie
41 , hpTheirSessionKeyPublic :: PublicKey
42 , hpMySecretKey :: SecretKey
43 , hpCookieRemotePubkey :: PublicKey
44 , hpCookieRemoteDhtkey :: PublicKey
45 }
46newHandShakeData :: TransportCrypto -> HandshakeParams -> HandshakeData
47newHandShakeData = error "todo"
48
49cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do
50 let crypto = transportCrypto sessions
51 allsessions = netCryptoSessions sessions
52 anyRight xs f = foldr1 (<|>) $ map f xs
53 seckeys <- map fst <$> atomically (readTVar (userKeys crypto))
54 symkey <- atomically $ transportSymmetric crypto
55 now <- getPOSIXTime
56 let lr = do -- Either Monad
57 (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie)
58 (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie })
59 <- anyRight seckeys $ \key -> (key,) <$> (decodePlain =<< decrypt (computeSharedSecret key remotePubkey nonce24) encrypted)
60 -- check cookie time < 15 seconds ago
61 guard (now - fromIntegral cookieTime < 15)
62 -- cookie hash is valid? sha512 of ecookie
63 let hinit = hashInit
64 hctx = hashUpdate hinit n24
65 hctx' = hashUpdate hctx ecookie
66 digest = hashFinalize hctx'
67 guard (cookieHash == digest)
68 -- known friend?
69 -- todo
70 return
71 HParam
72 { hpTheirBaseNonce = Just baseNonce
73 , hpOtherCookie = Just otherCookie
74 , hpTheirSessionKeyPublic = sessionKey
75 , hpMySecretKey = key
76 , hpCookieRemotePubkey = remotePubkey
77 , hpCookieRemoteDhtkey = remoteDhtkey
78 }
79 case lr of
80 Left _ -> return ()
81 Right hp@(HParam
82 { hpTheirBaseNonce = Just theirBaseNonce
83 , hpOtherCookie = Just otherCookie
84 , hpTheirSessionKeyPublic = theirSessionKey
85 , hpMySecretKey = key
86 , hpCookieRemotePubkey = remotePublicKey
87 , hpCookieRemoteDhtkey = remoteDhtPublicKey
88 }) -> do
89 sessionsmap <- atomically $ readTVar allsessions
90 case Map.lookup addr sessionsmap of
91 Nothing -> do -- create new session
92 ncState0 <- atomically $ newTVar Accepted
93 ncTheirPacketNonce0 <- atomically $ newTVar theirBaseNonce
94 n24 <- atomically $ transportNewNonce crypto
95 let myhandshakeData = newHandShakeData crypto hp
96 plain = encodePlain myhandshakeData
97 state = computeSharedSecret key remoteDhtPublicKey n24
98 encrypted = encrypt state plain
99 myhandshake = Handshake { handshakeCookie = otherCookie
100 , handshakeNonce = n24
101 , handshakeData = encrypted
102 }
103 ncMyPacketNonce0 <- atomically $ newTVar (baseNonce myhandshakeData)
104 ncHandShake0 <- atomically $ newTVar (Just myhandshake)
105 cookie0 <- atomically $ newTVar (Just otherCookie)
106 newsession <- generateSecretKey
107 let netCryptoSession =
108 NCrypto { ncState = ncState0
109 , ncTheirPacketNonce= ncTheirPacketNonce0
110 , ncMyPacketNonce = ncMyPacketNonce0
111 , ncHandShake = ncHandShake0
112 , ncCookie = cookie0
113 , ncTheirSessionPublic = Just theirSessionKey
114 , ncSessionSecret = newsession
115 , ncSockAddr = addr
116 }
117 atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession)
118 Just netCryptoSession -> return () -- TODO: UPdate existing session
119 return Nothing
120cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
121 let crypto = transportCrypto sessions
122 -- Handle Encrypted Message
123 -- TODO
124 return Nothing
125cryptoNetHandlerr _ _ _ = return id