missing Network.Tox.Crypto.Handlers

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 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TupleSections #-}
+module Network.Tox.Crypto.Handlers where
+
+import Network.Tox.Crypto.Transport
+import Network.Tox.DHT.Transport (Cookie(..),CookieData(..))
+import Crypto.Tox
+import Control.Concurrent.STM
+import Network.Address
+import qualified Data.Map.Strict as Map
+import Crypto.Hash
+import Control.Applicative
+import Control.Monad
+import Data.Time.Clock.POSIX
+
+data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed
+    deriving (Eq,Ord,Show,Enum)
+
+
+data NetCryptoSession = NCrypto { ncState         :: TVar NetCryptoSessionStatus
+                                , ncTheirPacketNonce:: TVar Nonce24 -- base nonce + packet number
+                                , ncMyPacketNonce   :: TVar Nonce24 -- base nonce + packet number
+                                , ncHandShake     :: TVar (Maybe (Handshake Encrypted))
+                                , ncCookie        :: TVar (Maybe Cookie)
+                                , ncTheirSessionPublic :: Maybe PublicKey
+                                , ncSessionSecret :: SecretKey
+                                , ncSockAddr      :: SockAddr
+                                }
+
+data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
+                                    , transportCrypto :: TransportCrypto
+                                    }
+
+newSessionsState :: TransportCrypto -> IO NetCryptoSessions
+newSessionsState crypto = error "todo"
+
+data HandshakeParams 
+        = HParam
+            { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own
+            , hpOtherCookie :: Maybe Cookie
+            , hpTheirSessionKeyPublic :: PublicKey
+            , hpMySecretKey :: SecretKey
+            , hpCookieRemotePubkey :: PublicKey
+            , hpCookieRemoteDhtkey :: PublicKey
+            }
+newHandShakeData :: TransportCrypto -> HandshakeParams -> HandshakeData
+newHandShakeData = error "todo"
+
+cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do
+    let crypto = transportCrypto sessions
+        allsessions = netCryptoSessions sessions
+        anyRight xs f = foldr1 (<|>) $ map f xs
+    seckeys <- map fst <$> atomically (readTVar (userKeys crypto))
+    symkey <- atomically $ transportSymmetric crypto
+    now <- getPOSIXTime
+    let lr = do -- Either Monad
+            (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie)
+            (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie })
+                <- anyRight seckeys $ \key -> (key,) <$> (decodePlain =<< decrypt (computeSharedSecret key remotePubkey nonce24) encrypted)
+            -- check cookie time < 15 seconds ago
+            guard (now - fromIntegral cookieTime < 15)
+            -- cookie hash is valid? sha512 of ecookie
+            let hinit = hashInit
+                hctx = hashUpdate hinit n24
+                hctx' = hashUpdate hctx ecookie
+                digest = hashFinalize hctx'
+            guard (cookieHash == digest)
+            -- known friend?
+            -- todo
+            return 
+             HParam
+                { hpTheirBaseNonce = Just baseNonce
+                , hpOtherCookie    = Just otherCookie
+                , hpTheirSessionKeyPublic =  sessionKey
+                , hpMySecretKey        = key
+                , hpCookieRemotePubkey = remotePubkey
+                , hpCookieRemoteDhtkey = remoteDhtkey
+                }
+    case lr of
+        Left _ -> return ()
+        Right hp@(HParam
+                      { hpTheirBaseNonce = Just theirBaseNonce
+                      , hpOtherCookie    = Just otherCookie             
+                      , hpTheirSessionKeyPublic = theirSessionKey
+                      , hpMySecretKey        = key
+                      , hpCookieRemotePubkey = remotePublicKey
+                      , hpCookieRemoteDhtkey = remoteDhtPublicKey
+                      }) -> do
+            sessionsmap <- atomically $ readTVar allsessions
+            case Map.lookup addr sessionsmap of
+                Nothing -> do -- create new session
+                    ncState0 <- atomically $ newTVar Accepted
+                    ncTheirPacketNonce0 <- atomically $ newTVar theirBaseNonce
+                    n24 <- atomically $ transportNewNonce crypto
+                    let myhandshakeData = newHandShakeData crypto hp
+                        plain = encodePlain myhandshakeData
+                        state = computeSharedSecret key remoteDhtPublicKey n24
+                        encrypted = encrypt state plain
+                        myhandshake = Handshake { handshakeCookie = otherCookie
+                                                , handshakeNonce = n24
+                                                , handshakeData = encrypted
+                                                }
+                    ncMyPacketNonce0 <- atomically $ newTVar (baseNonce myhandshakeData)
+                    ncHandShake0 <- atomically $ newTVar (Just myhandshake)
+                    cookie0 <- atomically $ newTVar (Just otherCookie)
+                    newsession <- generateSecretKey
+                    let netCryptoSession = 
+                            NCrypto { ncState         = ncState0
+                                    , ncTheirPacketNonce= ncTheirPacketNonce0
+                                    , ncMyPacketNonce   = ncMyPacketNonce0
+                                    , ncHandShake     = ncHandShake0
+                                    , ncCookie        = cookie0
+                                    , ncTheirSessionPublic = Just theirSessionKey
+                                    , ncSessionSecret = newsession
+                                    , ncSockAddr      = addr
+                                    }
+                    atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession)
+                Just netCryptoSession -> return () -- TODO: UPdate existing session
+    return Nothing 
+cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
+    let crypto = transportCrypto sessions
+    -- Handle Encrypted Message
+    -- TODO
+    return Nothing
+cryptoNetHandlerr _ _ _ = return id