1 files changed, 123 insertions, 111 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index e6669c3e..6e1623de 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -53,6 +53,7 @@ type NetCryptoHook = IOHook NetCryptoSession CryptoData
 type MsgTypeArray = A.UArray Word8 Word16
 type MsgOutMap = W64.Word64Map Word8
 -- type MsgOutMap = A.UArray Word64 Word8 -- if above is too slow, switch to this, but use reasonable bounds
 msgOutMapLookup :: Word64 -> MsgOutMap -> Maybe Word8
 msgOutMapLookup = W64.lookup
@@ -60,65 +61,75 @@ msgOutMapLookup = W64.lookup
 -- as displayed in some way to the user via mutiple views.
 --
 data SessionView = SessionView
-        { svNick :: TVar ByteString
+        { svNick        :: TVar ByteString
-        , svStatus :: TVar UserStatus
+        , svStatus      :: TVar UserStatus
-        , svStatusMsg :: TVar ByteString
+        , svStatusMsg   :: TVar ByteString
-        , svNoSpam :: TVar (Maybe NoSpam)
+        , svNoSpam      :: TVar (Maybe NoSpam)
-        , svGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr))
+        , svGroups      :: TVar (Map.Map GroupChatId (Set.Set SockAddr))
        -- allthough these directories are not visible to others on the net
        -- they are included in this type, because it facilitates organizing
        -- the disk according to your public image.
-        , svCacheDir :: FilePath -- ^ directory path used if the session has to use the disk for cache
-                                 --   clean up only if space is needed
+        , svCacheDir    :: FilePath -- ^ directory path used if the session has
-        , svTmpDir :: FilePath -- ^ Once off storage goes here, should clean up quickly
+                                    -- to use the disk for cache clean up only
-        , svConfigDir :: FilePath -- ^ profile related storage, etc, never clean up
+                                    -- if space is needed
+        , svTmpDir      :: FilePath -- ^ Once off storage goes here, should
+                                    -- clean up quickly
+        , svConfigDir   :: FilePath      -- ^ profile related storage, etc, never clean up
        , svDownloadDir :: TVar FilePath -- ^ where to put files the user downloads
        }
 type SessionID = Word64
-data NetCryptoSession = NCrypto { ncState          :: TVar NetCryptoSessionStatus
+data NetCryptoSession = NCrypto
-                                , ncSessionId      :: SessionID
+    { ncState              :: TVar NetCryptoSessionStatus
-                                , ncTheirPublicKey :: PublicKey -- Tox id w/o nospam
+    , ncSessionId          :: SessionID
-                                , ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number
+    , ncTheirPublicKey     :: PublicKey -- Tox id w/o nospam
-                                , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number
+    , ncTheirBaseNonce     :: TVar Nonce24 -- base nonce + packet number
-                                , ncHandShake     :: TVar (Maybe (Handshake Encrypted))
+    , ncMyPacketNonce      :: TVar Nonce24 -- base nonce + packet number
-                                , ncCookie        :: TVar (Maybe Cookie) -- ^ Cookie issued by remote peer
+    , ncHandShake          :: TVar (Maybe (Handshake Encrypted))
-                                , ncTheirDHTKey   :: PublicKey
+    , ncCookie             :: TVar (Maybe Cookie) -- ^ Cookie issued by remote peer
-                                , ncTheirSessionPublic :: Maybe PublicKey
+    , ncTheirDHTKey        :: PublicKey
-                                , ncSessionSecret :: SecretKey
+    , ncTheirSessionPublic :: Maybe PublicKey
-                                , ncSockAddr      :: SockAddr
+    , ncSessionSecret      :: SecretKey
-                                , ncHooks         :: TVar (Map.Map MessageType [NetCryptoHook])
+    , ncSockAddr           :: SockAddr
-                                , ncUnrecognizedHook :: TVar (MessageType -> NetCryptoHook)
+    , ncHooks              :: TVar (Map.Map MessageType [NetCryptoHook])
-                                , ncIncomingTypeArray :: TVar MsgTypeArray
+    , ncUnrecognizedHook   :: TVar (MessageType -> NetCryptoHook)
-                                                                      -- ^ supported messages, 0 for unsupported,
+    , ncIncomingTypeArray  :: TVar MsgTypeArray -- ^ supported messages, 0 for unsupported,
-                                                                      --   otherwise the messageType, some message types
+                                                -- otherwise the messageType, some message types
-                                                                      --   may not be in ncHooks yet, but they should appear
+                                                -- may not be in ncHooks yet, but they should appear
-                                                                      --   here if ncUnrecognizedHook will add them to ncHooks
+                                                -- here if ncUnrecognizedHook will add them to ncHooks
-                                                                      --   on an as-need basis.
+                                                -- on an as-need basis.
-                                , ncOutgoingIdMap :: TVar MsgOutMap
+    , ncOutgoingIdMap      :: TVar MsgOutMap
-                                , ncAllSessions :: NetCryptoSessions -- ^ may be needed if one net-crypto session
+    , ncAllSessions        :: NetCryptoSessions -- ^ may be needed if one net-crypto session
-                                                                     --   needs to possibly start another, as is
+                                                -- needs to possibly start another, as is
-                                                                     --   the case in group chats
+                                                -- the case in group chats
-                                , ncView :: TVar SessionView
+    , ncView               :: TVar SessionView
-                                , ncPacketQueue :: PacketQueue CryptoData
+    , ncPacketQueue        :: PacketQueue CryptoData
-                                , ncBufferStart :: TVar Word32
+    , ncBufferStart        :: TVar Word32
-                                , ncPingMachine :: Maybe PingMachine
+    , ncPingMachine        :: Maybe PingMachine
-                                , ncOutgoingQueue :: PQ.PacketOutQueue (State,Nonce24,TVar MsgOutMap) CryptoMessage (CryptoPacket Encrypted) CryptoData
+    , ncOutgoingQueue      :: PQ.PacketOutQueue (State,Nonce24,TVar MsgOutMap)
-                                }
+                                                CryptoMessage
+                                                (CryptoPacket Encrypted)
-data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
+                                                CryptoData
-                                    , netCryptoSessionsByKey :: TVar (Map.Map PublicKey [NetCryptoSession])
+    }
-                                    , transportCrypto :: TransportCrypto
-                                    , defaultHooks :: Map.Map MessageType [NetCryptoHook]
+data NetCryptoSessions = NCSessions
-                                    , defaultUnrecognizedHook :: MessageType -> NetCryptoHook
+    { netCryptoSessions       :: TVar (Map.Map SockAddr NetCryptoSession)
-                                    , sessionView :: SessionView
+    , netCryptoSessionsByKey  :: TVar (Map.Map PublicKey [NetCryptoSession])
-                                    , msgTypeArray :: MsgTypeArray
+    , transportCrypto         :: TransportCrypto
-                                    , inboundQueueCapacity :: Word32
+    , defaultHooks            :: Map.Map MessageType [NetCryptoHook]
-                                    , outboundQueueCapacity :: Word32
+    , defaultUnrecognizedHook :: MessageType -> NetCryptoHook
-                                    , nextSessionId :: TVar SessionID
+    , sessionView             :: SessionView
-                                    , announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession]
+    , msgTypeArray            :: MsgTypeArray
-                                    }
+    , inboundQueueCapacity    :: Word32
+    , outboundQueueCapacity   :: Word32
+    , nextSessionId           :: TVar SessionID
+    , announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession]
+    }
 type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession
@@ -141,7 +152,7 @@ forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) sess
                                                                    ys -> Just ys) sPubKey)
 newSessionsState :: TransportCrypto
-                 -> (MessageType -> NetCryptoHook) -- ^ default hook
+                 -> (MessageType -> NetCryptoHook)      -- ^ default hook
                 -> Map.Map MessageType [NetCryptoHook] -- ^ all hooks, can be empty to start
                 -> IO NetCryptoSessions
 newSessionsState crypto unrechook hooks = do
@@ -160,37 +171,39 @@ newSessionsState crypto unrechook hooks = do
    svDownloadDir0 <- atomically $ newTVar (homedir </> "Downloads")
    nextSessionId0 <- atomically $ newTVar 0
    announceNewSessionHooks0 <- atomically $ newTVar []
-    return NCSessions { netCryptoSessions = x
+    return NCSessions { netCryptoSessions       = x
-                      , netCryptoSessionsByKey = x2
+                      , netCryptoSessionsByKey  = x2
-                      , transportCrypto = crypto
+                      , transportCrypto         = crypto
-                      , defaultHooks = hooks
+                      , defaultHooks            = hooks
                      , defaultUnrecognizedHook = unrechook
-                      , sessionView = SessionView { svNick = nick
+                      , sessionView             = SessionView
-                                                  , svStatus = status
+                            { svNick        = nick
-                                                  , svStatusMsg = statusmsg
+                            , svStatus      = status
-                                                  , svNoSpam = nospam
+                            , svStatusMsg   = statusmsg
-                                                  , svGroups = grps
+                            , svNoSpam      = nospam
-                                                  , svCacheDir = cachedir
+                            , svGroups      = grps
-                                                  , svTmpDir = tmpdir
+                            , svCacheDir    = cachedir
-                                                  , svConfigDir = configdir
+                            , svTmpDir      = tmpdir
-                                                  , svDownloadDir = svDownloadDir0
+                            , svConfigDir   = configdir
-                                                  }
+                            , svDownloadDir = svDownloadDir0
-                      , msgTypeArray = allMsgTypes -- todo make this a parameter
+                            }
-                      , inboundQueueCapacity = 200
+                      , msgTypeArray            = allMsgTypes -- todo make this a parameter
-                      , outboundQueueCapacity = 400
+                      , inboundQueueCapacity    = 200
-                      , nextSessionId = nextSessionId0
+                      , outboundQueueCapacity   = 400
+                      , nextSessionId           = nextSessionId0
                      , announceNewSessionHooks = announceNewSessionHooks0
                      }
 data HandshakeParams
        = HParam
-            { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own
+            { hpTheirBaseNonce        :: Maybe Nonce24 -- ignore and generate your own
-            , hpOtherCookie :: Cookie
+            , hpOtherCookie           :: Cookie
            , hpTheirSessionKeyPublic :: PublicKey
-            , hpMySecretKey :: SecretKey
+            , hpMySecretKey           :: SecretKey
-            , hpCookieRemotePubkey :: PublicKey
+            , hpCookieRemotePubkey    :: PublicKey
-            , hpCookieRemoteDhtkey :: PublicKey
+            , hpCookieRemoteDhtkey    :: PublicKey
            }
 newHandShakeData :: TransportCrypto -> Nonce24 -> HandshakeParams -> SockAddr -> IO (Maybe HandshakeData)
 newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieRemotePubkey,hpCookieRemoteDhtkey}) addr
    = do
@@ -198,11 +211,11 @@ newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieR
      <- case  nodeInfo (key2id hpCookieRemoteDhtkey) addr  of
            Right nodeinfo -> Just <$> cookieRequestH crypto nodeinfo (CookieRequest hpCookieRemotePubkey)
            Left er        -> return Nothing
-    let hinit = hashInit
+    let hinit                = hashInit
        Cookie n24 encrypted = hpOtherCookie
-        hctx = hashUpdate hinit n24
+        hctx                 = hashUpdate hinit n24
-        hctx' = hashUpdate hctx encrypted
+        hctx'                = hashUpdate hctx encrypted
-        digest = hashFinalize hctx'
+        digest               = hashFinalize hctx'
 -- parameters addr {--> SockAddr -}
 --    mbcookie <- case hpOtherCookie of
 --                    Nothing -> case (nodeInfo hpCookieRemoteDhtkey addr) of
@@ -213,9 +226,9 @@ newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieR
    return $
      fmap (\freshCookie' ->
            HandshakeData
-                { baseNonce = basenonce
+                { baseNonce   = basenonce
-                , sessionKey = toPublic hpMySecretKey
+                , sessionKey  = toPublic hpMySecretKey
-                , cookieHash = digest
+                , cookieHash  = digest
                , otherCookie = freshCookie'
                }) freshCookie
@@ -275,8 +288,7 @@ receiveCrypto nc@NCrypto { ncState, ncPacketQueue } = do
                Accepted  -> Just <$> PQ.dequeue ncPacketQueue
                Confirmed -> Just <$> PQ.dequeue ncPacketQueue
                _         -> pure Nothing
-    tid <- myThreadId
+    forM_ cd $ runCryptoHook nc -- TODO: Is this useful?
-    forM_ cd $ runCryptoHook nc
    return $ bufferData <$> cd
 -- | called when we recieve a crypto handshake with valid cookie
@@ -334,23 +346,23 @@ freshCryptoSession  sessions
                return (return (f n24, n24, ncOutgoingIdMap0))
    pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0
    let netCryptoSession0 =
-            NCrypto { ncState         = ncState0
+            NCrypto { ncState              = ncState0
-                    , ncSessionId     = sessionId
+                    , ncSessionId          = sessionId
-                    , ncTheirPublicKey = remotePublicKey
+                    , ncTheirPublicKey     = remotePublicKey
-                    , ncTheirBaseNonce= ncTheirBaseNonce0
+                    , ncTheirBaseNonce     = ncTheirBaseNonce0
-                    , ncMyPacketNonce   = ncMyPacketNonce0
+                    , ncMyPacketNonce      = ncMyPacketNonce0
-                    , ncHandShake     = ncHandShake0
+                    , ncHandShake          = ncHandShake0
-                    , ncCookie        = cookie0
+                    , ncCookie             = cookie0
-                    , ncTheirDHTKey   = remoteDhtPublicKey
+                    , ncTheirDHTKey        = remoteDhtPublicKey
                    , ncTheirSessionPublic = Just theirSessionKey
-                    , ncSessionSecret = newsession
+                    , ncSessionSecret      = newsession
-                    , ncSockAddr      = addr
+                    , ncSockAddr           = addr
-                    , ncHooks         = ncHooks0
+                    , ncHooks              = ncHooks0
-                    , ncUnrecognizedHook = ncUnrecognizedHook0
+                    , ncUnrecognizedHook   = ncUnrecognizedHook0
-                    , ncAllSessions = sessions
+                    , ncAllSessions        = sessions
-                    , ncIncomingTypeArray = ncIncomingTypeArray0
+                    , ncIncomingTypeArray  = ncIncomingTypeArray0
-                    , ncOutgoingIdMap     = ncOutgoingIdMap0
+                    , ncOutgoingIdMap      = ncOutgoingIdMap0
-                    , ncView = ncView0
+                    , ncView               = ncView0
                    , ncPacketQueue        = pktq
                    , ncBufferStart        = bufstart
                    , ncPingMachine        = Nothing -- error "you want the NetCrypto-PingMachine, but is it started?"
@@ -438,22 +450,22 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
            -- talk to not yet existent Network-Manager to ascertain current permissions
            return
             HParam
-                { hpTheirBaseNonce = Just baseNonce
+                { hpTheirBaseNonce        = Just baseNonce
-                , hpOtherCookie    = otherCookie
+                , hpOtherCookie           = otherCookie
-                , hpTheirSessionKeyPublic =  sessionKey
+                , hpTheirSessionKeyPublic = sessionKey
-                , hpMySecretKey        = key
+                , hpMySecretKey           = key
-                , hpCookieRemotePubkey = remotePubkey
+                , hpCookieRemotePubkey    = remotePubkey
-                , hpCookieRemoteDhtkey = remoteDhtkey
+                , hpCookieRemoteDhtkey    = remoteDhtkey
                }
    case lr of
        Left _ -> return ()
        Right hp@(HParam
-                      { hpTheirBaseNonce = Just theirBaseNonce
+                      { hpTheirBaseNonce        = Just theirBaseNonce
-                      , hpOtherCookie    = otherCookie
+                      , hpOtherCookie           = otherCookie
                      , hpTheirSessionKeyPublic = theirSessionKey
-                      , hpMySecretKey        = key
+                      , hpMySecretKey           = key
-                      , hpCookieRemotePubkey = remotePublicKey
+                      , hpCookieRemotePubkey    = remotePublicKey
-                      , hpCookieRemoteDhtkey = remoteDhtPublicKey
+                      , hpCookieRemoteDhtkey    = remoteDhtPublicKey
                      }) -> do
            sessionsmap <- atomically $ readTVar allsessions
            -- Do a lookup, so we can handle the update case differently

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index e6669c3e..6e1623de 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -53,6 +53,7 @@ type NetCryptoHook = IOHook NetCryptoSession CryptoData
53	type MsgTypeArray = A.UArray Word8 Word16	53	type MsgTypeArray = A.UArray Word8 Word16
54	type MsgOutMap = W64.Word64Map Word8	54	type MsgOutMap = W64.Word64Map Word8
55	-- type MsgOutMap = A.UArray Word64 Word8 -- if above is too slow, switch to this, but use reasonable bounds	55	-- type MsgOutMap = A.UArray Word64 Word8 -- if above is too slow, switch to this, but use reasonable bounds
		56
56	msgOutMapLookup :: Word64 -> MsgOutMap -> Maybe Word8	57	msgOutMapLookup :: Word64 -> MsgOutMap -> Maybe Word8
57	msgOutMapLookup = W64.lookup	58	msgOutMapLookup = W64.lookup
58		59
@@ -60,65 +61,75 @@ msgOutMapLookup = W64.lookup
60	-- as displayed in some way to the user via mutiple views.	61	-- as displayed in some way to the user via mutiple views.
61	--	62	--
62	data SessionView = SessionView	63	data SessionView = SessionView
63	{ svNick :: TVar ByteString	64	{ svNick :: TVar ByteString
64	, svStatus :: TVar UserStatus	65	, svStatus :: TVar UserStatus
65	, svStatusMsg :: TVar ByteString	66	, svStatusMsg :: TVar ByteString
66	, svNoSpam :: TVar (Maybe NoSpam)	67	, svNoSpam :: TVar (Maybe NoSpam)
67	, svGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr))	68	, svGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr))
		69
68	-- allthough these directories are not visible to others on the net	70	-- allthough these directories are not visible to others on the net
69	-- they are included in this type, because it facilitates organizing	71	-- they are included in this type, because it facilitates organizing
70	-- the disk according to your public image.	72	-- the disk according to your public image.
71	, svCacheDir :: FilePath -- ^ directory path used if the session has to use the disk for cache	73
72	-- clean up only if space is needed	74	, svCacheDir :: FilePath -- ^ directory path used if the session has
73	, svTmpDir :: FilePath -- ^ Once off storage goes here, should clean up quickly	75	-- to use the disk for cache clean up only
74	, svConfigDir :: FilePath -- ^ profile related storage, etc, never clean up	76	-- if space is needed
		77
		78	, svTmpDir :: FilePath -- ^ Once off storage goes here, should
		79	-- clean up quickly
		80
		81	, svConfigDir :: FilePath -- ^ profile related storage, etc, never clean up
75	, svDownloadDir :: TVar FilePath -- ^ where to put files the user downloads	82	, svDownloadDir :: TVar FilePath -- ^ where to put files the user downloads
76	}	83	}
77		84
78	type SessionID = Word64	85	type SessionID = Word64
79		86
80	data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus	87	data NetCryptoSession = NCrypto
81	, ncSessionId :: SessionID	88	{ ncState :: TVar NetCryptoSessionStatus
82	, ncTheirPublicKey :: PublicKey -- Tox id w/o nospam	89	, ncSessionId :: SessionID
83	, ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number	90	, ncTheirPublicKey :: PublicKey -- Tox id w/o nospam
84	, ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number	91	, ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number
85	, ncHandShake :: TVar (Maybe (Handshake Encrypted))	92	, ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number
86	, ncCookie :: TVar (Maybe Cookie) -- ^ Cookie issued by remote peer	93	, ncHandShake :: TVar (Maybe (Handshake Encrypted))
87	, ncTheirDHTKey :: PublicKey	94	, ncCookie :: TVar (Maybe Cookie) -- ^ Cookie issued by remote peer
88	, ncTheirSessionPublic :: Maybe PublicKey	95	, ncTheirDHTKey :: PublicKey
89	, ncSessionSecret :: SecretKey	96	, ncTheirSessionPublic :: Maybe PublicKey
90	, ncSockAddr :: SockAddr	97	, ncSessionSecret :: SecretKey
91	, ncHooks :: TVar (Map.Map MessageType [NetCryptoHook])	98	, ncSockAddr :: SockAddr
92	, ncUnrecognizedHook :: TVar (MessageType -> NetCryptoHook)	99	, ncHooks :: TVar (Map.Map MessageType [NetCryptoHook])
93	, ncIncomingTypeArray :: TVar MsgTypeArray	100	, ncUnrecognizedHook :: TVar (MessageType -> NetCryptoHook)
94	-- ^ supported messages, 0 for unsupported,	101	, ncIncomingTypeArray :: TVar MsgTypeArray -- ^ supported messages, 0 for unsupported,
95	-- otherwise the messageType, some message types	102	-- otherwise the messageType, some message types
96	-- may not be in ncHooks yet, but they should appear	103	-- may not be in ncHooks yet, but they should appear
97	-- here if ncUnrecognizedHook will add them to ncHooks	104	-- here if ncUnrecognizedHook will add them to ncHooks
98	-- on an as-need basis.	105	-- on an as-need basis.
99	, ncOutgoingIdMap :: TVar MsgOutMap	106	, ncOutgoingIdMap :: TVar MsgOutMap
100	, ncAllSessions :: NetCryptoSessions -- ^ may be needed if one net-crypto session	107	, ncAllSessions :: NetCryptoSessions -- ^ may be needed if one net-crypto session
101	-- needs to possibly start another, as is	108	-- needs to possibly start another, as is
102	-- the case in group chats	109	-- the case in group chats
103	, ncView :: TVar SessionView	110	, ncView :: TVar SessionView
104	, ncPacketQueue :: PacketQueue CryptoData	111	, ncPacketQueue :: PacketQueue CryptoData
105	, ncBufferStart :: TVar Word32	112	, ncBufferStart :: TVar Word32
106	, ncPingMachine :: Maybe PingMachine	113	, ncPingMachine :: Maybe PingMachine
107	, ncOutgoingQueue :: PQ.PacketOutQueue (State,Nonce24,TVar MsgOutMap) CryptoMessage (CryptoPacket Encrypted) CryptoData	114	, ncOutgoingQueue :: PQ.PacketOutQueue (State,Nonce24,TVar MsgOutMap)
108	}	115	CryptoMessage
109		116	(CryptoPacket Encrypted)
110	data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)	117	CryptoData
111	, netCryptoSessionsByKey :: TVar (Map.Map PublicKey [NetCryptoSession])	118	}
112	, transportCrypto :: TransportCrypto	119
113	, defaultHooks :: Map.Map MessageType [NetCryptoHook]	120	data NetCryptoSessions = NCSessions
114	, defaultUnrecognizedHook :: MessageType -> NetCryptoHook	121	{ netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
115	, sessionView :: SessionView	122	, netCryptoSessionsByKey :: TVar (Map.Map PublicKey [NetCryptoSession])
116	, msgTypeArray :: MsgTypeArray	123	, transportCrypto :: TransportCrypto
117	, inboundQueueCapacity :: Word32	124	, defaultHooks :: Map.Map MessageType [NetCryptoHook]
118	, outboundQueueCapacity :: Word32	125	, defaultUnrecognizedHook :: MessageType -> NetCryptoHook
119	, nextSessionId :: TVar SessionID	126	, sessionView :: SessionView
120	, announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession]	127	, msgTypeArray :: MsgTypeArray
121	}	128	, inboundQueueCapacity :: Word32
		129	, outboundQueueCapacity :: Word32
		130	, nextSessionId :: TVar SessionID
		131	, announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession]
		132	}
122		133
123	type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession	134	type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession
124		135
@@ -141,7 +152,7 @@ forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) sess
141	ys -> Just ys) sPubKey)	152	ys -> Just ys) sPubKey)
142		153
143	newSessionsState :: TransportCrypto	154	newSessionsState :: TransportCrypto
144	-> (MessageType -> NetCryptoHook) -- ^ default hook	155	-> (MessageType -> NetCryptoHook) -- ^ default hook
145	-> Map.Map MessageType [NetCryptoHook] -- ^ all hooks, can be empty to start	156	-> Map.Map MessageType [NetCryptoHook] -- ^ all hooks, can be empty to start
146	-> IO NetCryptoSessions	157	-> IO NetCryptoSessions
147	newSessionsState crypto unrechook hooks = do	158	newSessionsState crypto unrechook hooks = do
@@ -160,37 +171,39 @@ newSessionsState crypto unrechook hooks = do
160	svDownloadDir0 <- atomically $ newTVar (homedir </> "Downloads")	171	svDownloadDir0 <- atomically $ newTVar (homedir </> "Downloads")
161	nextSessionId0 <- atomically $ newTVar 0	172	nextSessionId0 <- atomically $ newTVar 0
162	announceNewSessionHooks0 <- atomically $ newTVar []	173	announceNewSessionHooks0 <- atomically $ newTVar []
163	return NCSessions { netCryptoSessions = x	174	return NCSessions { netCryptoSessions = x
164	, netCryptoSessionsByKey = x2	175	, netCryptoSessionsByKey = x2
165	, transportCrypto = crypto	176	, transportCrypto = crypto
166	, defaultHooks = hooks	177	, defaultHooks = hooks
167	, defaultUnrecognizedHook = unrechook	178	, defaultUnrecognizedHook = unrechook
168	, sessionView = SessionView { svNick = nick	179	, sessionView = SessionView
169	, svStatus = status	180	{ svNick = nick
170	, svStatusMsg = statusmsg	181	, svStatus = status
171	, svNoSpam = nospam	182	, svStatusMsg = statusmsg
172	, svGroups = grps	183	, svNoSpam = nospam
173	, svCacheDir = cachedir	184	, svGroups = grps
174	, svTmpDir = tmpdir	185	, svCacheDir = cachedir
175	, svConfigDir = configdir	186	, svTmpDir = tmpdir
176	, svDownloadDir = svDownloadDir0	187	, svConfigDir = configdir
177	}	188	, svDownloadDir = svDownloadDir0
178	, msgTypeArray = allMsgTypes -- todo make this a parameter	189	}
179	, inboundQueueCapacity = 200	190	, msgTypeArray = allMsgTypes -- todo make this a parameter
180	, outboundQueueCapacity = 400	191	, inboundQueueCapacity = 200
181	, nextSessionId = nextSessionId0	192	, outboundQueueCapacity = 400
		193	, nextSessionId = nextSessionId0
182	, announceNewSessionHooks = announceNewSessionHooks0	194	, announceNewSessionHooks = announceNewSessionHooks0
183	}	195	}
184		196
185	data HandshakeParams	197	data HandshakeParams
186	= HParam	198	= HParam
187	{ hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own	199	{ hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own
188	, hpOtherCookie :: Cookie	200	, hpOtherCookie :: Cookie
189	, hpTheirSessionKeyPublic :: PublicKey	201	, hpTheirSessionKeyPublic :: PublicKey
190	, hpMySecretKey :: SecretKey	202	, hpMySecretKey :: SecretKey
191	, hpCookieRemotePubkey :: PublicKey	203	, hpCookieRemotePubkey :: PublicKey
192	, hpCookieRemoteDhtkey :: PublicKey	204	, hpCookieRemoteDhtkey :: PublicKey
193	}	205	}
		206
194	newHandShakeData :: TransportCrypto -> Nonce24 -> HandshakeParams -> SockAddr -> IO (Maybe HandshakeData)	207	newHandShakeData :: TransportCrypto -> Nonce24 -> HandshakeParams -> SockAddr -> IO (Maybe HandshakeData)
195	newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieRemotePubkey,hpCookieRemoteDhtkey}) addr	208	newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieRemotePubkey,hpCookieRemoteDhtkey}) addr
196	= do	209	= do
@@ -198,11 +211,11 @@ newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieR
198	<- case nodeInfo (key2id hpCookieRemoteDhtkey) addr of	211	<- case nodeInfo (key2id hpCookieRemoteDhtkey) addr of
199	Right nodeinfo -> Just <$> cookieRequestH crypto nodeinfo (CookieRequest hpCookieRemotePubkey)	212	Right nodeinfo -> Just <$> cookieRequestH crypto nodeinfo (CookieRequest hpCookieRemotePubkey)
200	Left er -> return Nothing	213	Left er -> return Nothing
201	let hinit = hashInit	214	let hinit = hashInit
202	Cookie n24 encrypted = hpOtherCookie	215	Cookie n24 encrypted = hpOtherCookie
203	hctx = hashUpdate hinit n24	216	hctx = hashUpdate hinit n24
204	hctx' = hashUpdate hctx encrypted	217	hctx' = hashUpdate hctx encrypted
205	digest = hashFinalize hctx'	218	digest = hashFinalize hctx'
206	-- parameters addr {--> SockAddr -}	219	-- parameters addr {--> SockAddr -}
207	-- mbcookie <- case hpOtherCookie of	220	-- mbcookie <- case hpOtherCookie of
208	-- Nothing -> case (nodeInfo hpCookieRemoteDhtkey addr) of	221	-- Nothing -> case (nodeInfo hpCookieRemoteDhtkey addr) of
@@ -213,9 +226,9 @@ newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieR
213	return $	226	return $
214	fmap (\freshCookie' ->	227	fmap (\freshCookie' ->
215	HandshakeData	228	HandshakeData
216	{ baseNonce = basenonce	229	{ baseNonce = basenonce
217	, sessionKey = toPublic hpMySecretKey	230	, sessionKey = toPublic hpMySecretKey
218	, cookieHash = digest	231	, cookieHash = digest
219	, otherCookie = freshCookie'	232	, otherCookie = freshCookie'
220	}) freshCookie	233	}) freshCookie
221		234
@@ -275,8 +288,7 @@ receiveCrypto nc@NCrypto { ncState, ncPacketQueue } = do
275	Accepted -> Just <$> PQ.dequeue ncPacketQueue	288	Accepted -> Just <$> PQ.dequeue ncPacketQueue
276	Confirmed -> Just <$> PQ.dequeue ncPacketQueue	289	Confirmed -> Just <$> PQ.dequeue ncPacketQueue
277	_ -> pure Nothing	290	_ -> pure Nothing
278	tid <- myThreadId	291	forM_ cd $ runCryptoHook nc -- TODO: Is this useful?
279	forM_ cd $ runCryptoHook nc
280	return $ bufferData <$> cd	292	return $ bufferData <$> cd
281		293
282	-- \| called when we recieve a crypto handshake with valid cookie	294	-- \| called when we recieve a crypto handshake with valid cookie
@@ -334,23 +346,23 @@ freshCryptoSession sessions
334	return (return (f n24, n24, ncOutgoingIdMap0))	346	return (return (f n24, n24, ncOutgoingIdMap0))
335	pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0	347	pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0
336	let netCryptoSession0 =	348	let netCryptoSession0 =
337	NCrypto { ncState = ncState0	349	NCrypto { ncState = ncState0
338	, ncSessionId = sessionId	350	, ncSessionId = sessionId
339	, ncTheirPublicKey = remotePublicKey	351	, ncTheirPublicKey = remotePublicKey
340	, ncTheirBaseNonce= ncTheirBaseNonce0	352	, ncTheirBaseNonce = ncTheirBaseNonce0
341	, ncMyPacketNonce = ncMyPacketNonce0	353	, ncMyPacketNonce = ncMyPacketNonce0
342	, ncHandShake = ncHandShake0	354	, ncHandShake = ncHandShake0
343	, ncCookie = cookie0	355	, ncCookie = cookie0
344	, ncTheirDHTKey = remoteDhtPublicKey	356	, ncTheirDHTKey = remoteDhtPublicKey
345	, ncTheirSessionPublic = Just theirSessionKey	357	, ncTheirSessionPublic = Just theirSessionKey
346	, ncSessionSecret = newsession	358	, ncSessionSecret = newsession
347	, ncSockAddr = addr	359	, ncSockAddr = addr
348	, ncHooks = ncHooks0	360	, ncHooks = ncHooks0
349	, ncUnrecognizedHook = ncUnrecognizedHook0	361	, ncUnrecognizedHook = ncUnrecognizedHook0
350	, ncAllSessions = sessions	362	, ncAllSessions = sessions
351	, ncIncomingTypeArray = ncIncomingTypeArray0	363	, ncIncomingTypeArray = ncIncomingTypeArray0
352	, ncOutgoingIdMap = ncOutgoingIdMap0	364	, ncOutgoingIdMap = ncOutgoingIdMap0
353	, ncView = ncView0	365	, ncView = ncView0
354	, ncPacketQueue = pktq	366	, ncPacketQueue = pktq
355	, ncBufferStart = bufstart	367	, ncBufferStart = bufstart
356	, ncPingMachine = Nothing -- error "you want the NetCrypto-PingMachine, but is it started?"	368	, ncPingMachine = Nothing -- error "you want the NetCrypto-PingMachine, but is it started?"
@@ -438,22 +450,22 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
438	-- talk to not yet existent Network-Manager to ascertain current permissions	450	-- talk to not yet existent Network-Manager to ascertain current permissions
439	return	451	return
440	HParam	452	HParam
441	{ hpTheirBaseNonce = Just baseNonce	453	{ hpTheirBaseNonce = Just baseNonce
442	, hpOtherCookie = otherCookie	454	, hpOtherCookie = otherCookie
443	, hpTheirSessionKeyPublic = sessionKey	455	, hpTheirSessionKeyPublic = sessionKey
444	, hpMySecretKey = key	456	, hpMySecretKey = key
445	, hpCookieRemotePubkey = remotePubkey	457	, hpCookieRemotePubkey = remotePubkey
446	, hpCookieRemoteDhtkey = remoteDhtkey	458	, hpCookieRemoteDhtkey = remoteDhtkey
447	}	459	}
448	case lr of	460	case lr of
449	Left _ -> return ()	461	Left _ -> return ()
450	Right hp@(HParam	462	Right hp@(HParam
451	{ hpTheirBaseNonce = Just theirBaseNonce	463	{ hpTheirBaseNonce = Just theirBaseNonce
452	, hpOtherCookie = otherCookie	464	, hpOtherCookie = otherCookie
453	, hpTheirSessionKeyPublic = theirSessionKey	465	, hpTheirSessionKeyPublic = theirSessionKey
454	, hpMySecretKey = key	466	, hpMySecretKey = key
455	, hpCookieRemotePubkey = remotePublicKey	467	, hpCookieRemotePubkey = remotePublicKey
456	, hpCookieRemoteDhtkey = remoteDhtPublicKey	468	, hpCookieRemoteDhtkey = remoteDhtPublicKey
457	}) -> do	469	}) -> do
458	sessionsmap <- atomically $ readTVar allsessions	470	sessionsmap <- atomically $ readTVar allsessions
459	-- Do a lookup, so we can handle the update case differently	471	-- Do a lookup, so we can handle the update case differently