From c788767dae5898a642f569ae2e73930ce05c2117 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Wed, 30 May 2018 15:18:13 +0000 Subject: generalize NetCryptoSession to more states * adapt code to use types isomorphic to Maybe but which inform what state the connection must be in at the time the code is run. * also add more documentation --- src/Network/Tox/Crypto/Handlers.hs | 275 ++++++++++++++++++++++++------------- 1 file changed, 183 insertions(+), 92 deletions(-) (limited to 'src/Network') diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 2f8b059a..bcca65e6 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs @@ -1,6 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DeriveFunctor #-} module Network.Tox.Crypto.Handlers where import Network.QueryResponse @@ -50,23 +51,72 @@ import Debug.Trace import Text.Printf import Data.Bool + +-- * These types are isomorphic to Maybe, but have the advantage of documenting +-- when an item is expected to become known. +data UponDHTKey a = NeedDHTKey | HaveDHTKey a deriving (Functor,Show,Eq) +data UponCookie a = NeedCookie | HaveCookie a deriving (Functor,Show,Eq) +data UponHandshake a = NeedHandshake | HaveHandshake a deriving (Functor,Show,Eq) +data UponCryptoPacket a = NeedCryptoPacket | HaveCryptoPacket a deriving (Functor,Show,Eq) + -- util, todo: move to another module -maybeToEither :: Maybe b -> Either String b -maybeToEither (Just x) = Right x -maybeToEither Nothing = Left "maybeToEither" +maybeToEither :: AsMaybe f => f b -> Either String b +maybeToEither y | Just x <- toMaybe y = Right x +maybeToEither _ = Left "maybeToEither" + +-- | type class encoding of isomorphism to Maybe +class AsMaybe f where + toMaybe :: f a -> Maybe a + -- | The o in from is left out so as not to colide with 'Data.Maybe.fromMaybe' + frmMaybe :: Maybe a -> f a + +instance AsMaybe Maybe where + toMaybe x = x + frmMaybe x = x + +instance AsMaybe UponDHTKey where + toMaybe NeedDHTKey = Nothing + toMaybe (HaveDHTKey x) = Just x + frmMaybe Nothing = NeedDHTKey + frmMaybe (Just x) = HaveDHTKey x + +instance AsMaybe UponCookie where + toMaybe NeedCookie = Nothing + toMaybe (HaveCookie x) = Just x + frmMaybe Nothing = NeedCookie + frmMaybe (Just x) = HaveCookie x + +instance AsMaybe UponHandshake where + toMaybe NeedHandshake = Nothing + toMaybe (HaveHandshake x) = Just x + frmMaybe Nothing = NeedHandshake + frmMaybe (Just x) = HaveHandshake x + +instance AsMaybe UponCryptoPacket where + toMaybe NeedCryptoPacket = Nothing + toMaybe (HaveCryptoPacket x) = Just x + frmMaybe Nothing = NeedCryptoPacket + frmMaybe (Just x) = HaveCryptoPacket x + data NetCryptoSessionStatus = Unaccepted | Accepted {- InProgress AwaitingSessionPacket -} | Confirmed {- Established -} deriving (Eq,Ord,Show,Enum) +-- | The idea of IOHook is to replicate the familiar pattern +-- where a function returns Nothing to consume a value +-- or a function used to modify the value and pass it +-- to be processed by another hook. type IOHook addr x = addr -> x -> IO (Maybe (x -> x)) + +-- | NetCryptoHook's use the Session as their 'addr' and the +-- value they consume or modify is CryptoMessage. type NetCryptoHook = IOHook NetCryptoSession CryptoMessage + +-- | Convert an id byte to it's type (in Word64 format) +-- Although the type doesn't enforce it, MsgTypeArray +-- should always have 256 entries. type MsgTypeArray = A.UArray Word8 Word64 --- type MsgOutMap = RangeMap STArray Word8 STRef --- 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 -> STM (Maybe Word8) --- msgOutMapLookup k mp = return (W64.lookup k mp) -- | Information, that may be made visible in multiple sessions, as well -- as displayed in some way to the user via mutiple views. @@ -168,36 +218,65 @@ data NetCryptoSession = NCrypto , ncMyPublicKey :: PublicKey , ncSessionId :: SessionID , ncTheirPublicKey :: PublicKey -- Tox id w/o nospam - , ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number + , ncTheirBaseNonce :: TVar (UponHandshake Nonce24) -- base nonce + packet number , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number - , ncHandShake :: TVar (Maybe (Handshake Encrypted)) - , ncCookie :: TVar (Maybe Cookie) -- ^ Cookie issued by remote peer - , ncTheirDHTKey :: PublicKey - , ncTheirSessionPublic :: Maybe PublicKey + , ncHandShake :: TVar (UponHandshake (Handshake Encrypted)) + , ncCookie :: TVar (UponCookie Cookie) -- ^ Cookie issued by remote peer + , ncTheirDHTKey :: UponDHTKey PublicKey + , ncTheirSessionPublic :: UponHandshake PublicKey , ncSessionSecret :: SecretKey - , ncSockAddr :: SockAddr + , ncSockAddr :: UponDHTKey SockAddr + -- The remaining fields correspond to implementation specific state -- + -- where as the prior fields will be used in any implementation -- , ncHooks :: TVar (Map.Map MessageType [NetCryptoHook]) , ncUnrecognizedHook :: TVar (MessageType -> NetCryptoHook) - , ncIncomingTypeArray :: TVar MsgTypeArray -- ^ supported messages, 0 for unsupported, - -- otherwise the messageType, some message types - -- may not be in ncHooks yet, but they should appear - -- here if ncUnrecognizedHook will add them to ncHooks - -- on an as-need basis. + , ncIncomingTypeArray :: TVar MsgTypeArray + -- ^ This array maps 255 Id bytes to MessageType + -- It should contain all messages this session understands. + -- Use 0 for unsupported. It is used when a message comes + -- in, and should ordinarily be the identity map. + -- + -- Id's 0xC7 and 0x63 should contain range-specifying types only, if + -- such things come to be defined, because these MessageId's are + -- always escapes. + -- + -- Currently, the values at these indices are ignored. , ncOutgoingIdMap :: RangeMap TArray Word8 TVar - -- ^ used to lookup the outgoing id for a type, for now always an identity map - -- TODO: need 2 more outgoing id maps for escape-lossy and escape-lossless (group msgs) - , ncAllSessions :: NetCryptoSessions -- ^ may be needed if one net-crypto session - -- needs to possibly start another, as is - -- the case in group chats + -- ^ used to lookup the outgoing id for a type when sending an outoing message + , ncOutgoingIdMapEscapedLossy :: TVar (A.Array Word8 Word8) + -- ^ mapping of secondary id, when primary id is 0xC7 + -- (These Id's are called 'MessageName' in 'Network.Tox.Crypto.Transport') + -- used when sending an outoing message + , ncOutgoingIdMapEscapedLossless :: TVar (A.Array Word8 Word8) + -- ^ mapping of secondary id, when primary id is 0x63 + -- (These Id's are called 'MessageName' in 'Network.Tox.Crypto.Transport') + -- used when sending an outoing message + , ncAllSessions :: NetCryptoSessions + -- ^ needed if one net-crypto session + -- needs to possibly start another, as is + -- the case in group chats , ncView :: TVar SessionView + -- ^ contains your nick, status etc , ncPacketQueue :: PacketQueue CryptoData - , ncBufferStart :: TVar Word32 + -- ^ a buffer in which incoming packets may be stored out of order + -- but from which they may be extracted in sequence, + -- helps ensure lossless packets are processed in order , ncDequeueThread :: Maybe ThreadId + -- ^ when the thread which dequeues from ncPacketQueue + -- is started, its ThreadId is stored here , ncPingMachine :: Maybe PingMachine - , ncOutgoingQueue :: PQ.PacketOutQueue (State,Nonce24,RangeMap TArray Word8 TVar) - CryptoMessage - (CryptoPacket Encrypted) - CryptoData + -- ^ when the ping thread is started, store it here + , ncOutgoingQueue :: UponHandshake + (PQ.PacketOutQueue + (State,Nonce24,RangeMap TArray Word8 TVar) + CryptoMessage + (CryptoPacket Encrypted) + CryptoData) + -- ^ To send a message add it to this queue, by calling 'tryAppendQueueOutgoing' + -- but remember to call 'readyOutGoing' first, because the shared secret cache + -- presently requires the IO monad. + -- This specialized queue handles setting buffer_start and buffer_end and encrypting + -- 'readyOutGoing' provides the first parameter to 'tryAppendQueueOutgoing' , ncLastNMsgs :: CyclicBuffer (Bool{-Handled?-},(ViewSnapshot,InOrOut CryptoMessage)) -- ^ cyclic buffer, holds the last N non-handshake crypto messages -- even if there is no attached user interface. @@ -222,6 +301,7 @@ data NetCryptoSessions = NCSessions , listenerIDSupply :: TVar Supply } +-- | This is the type of a hook to run when a session is created. type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession addNewSessionHook :: NetCryptoSessions -> NewSessionHook -> STM () @@ -229,7 +309,7 @@ addNewSessionHook allsessions@(NCSessions { announceNewSessionHooks }) hook = mo forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM () forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) session = do - let addr = ncSockAddr session + let HaveDHTKey addr = ncSockAddr session sid = ncSessionId session sPubKey = ncTheirPublicKey session byAddrMap <- readTVar netCryptoSessions @@ -305,7 +385,7 @@ data HandshakeParams = HParam { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own , hpOtherCookie :: Cookie - , hpTheirSessionKeyPublic :: PublicKey + , hpTheirSessionKeyPublic :: Maybe PublicKey , hpMySecretKey :: SecretKey , hpCookieRemotePubkey :: PublicKey , hpCookieRemoteDhtkey :: PublicKey @@ -409,9 +489,9 @@ freshCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> IO () freshCryptoSession sessions addr hp@(HParam - { hpTheirBaseNonce = Just theirBaseNonce + { hpTheirBaseNonce = mbtheirBaseNonce , hpOtherCookie = otherCookie - , hpTheirSessionKeyPublic = theirSessionKey + , hpTheirSessionKeyPublic = mbtheirSessionKey , hpMySecretKey = key , hpCookieRemotePubkey = remotePublicKey , hpCookieRemoteDhtkey = remoteDhtPublicKey @@ -424,7 +504,7 @@ freshCryptoSession sessions modifyTVar (nextSessionId sessions) (+1) return x ncState0 <- atomically $ newTVar Accepted -- (InProgress AwaitingSessionPacket) - ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce + ncTheirBaseNonce0 <- atomically $ newTVar (frmMaybe mbtheirBaseNonce) n24 <- atomically $ transportNewNonce crypto state <- lookupSharedSecret crypto key remotePublicKey n24 newBaseNonce <- atomically $ transportNewNonce crypto @@ -437,17 +517,17 @@ freshCryptoSession sessions , handshakeData = encrypted } let myhandshake= encodeHandshake <$> mbMyhandshakeData - ncHandShake0 <- atomically $ newTVar myhandshake + ncHandShake0 <- atomically $ newTVar (frmMaybe myhandshake) forM myhandshake $ \response_handshake -> do sendMessage (sessionTransport sessions) addr (NetHandshake response_handshake) ncMyPacketNonce0 <- atomically $ newTVar newBaseNonce - cookie0 <- atomically $ newTVar (Just otherCookie) + cookie0 <- atomically $ newTVar (HaveCookie otherCookie) newsession <- generateSecretKey ncHooks0 <- atomically $ newTVar (defaultHooks sessions) ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions) ncIncomingTypeArray0 <- atomically $ newTVar (msgTypeArray sessions) let idMap = foldl (\mp (x,y) -> W64.insert x y mp) W64.empty (zip [0..255] [0..255]) - ncOutgoingIdMap0 <- atomically $ do + (ncOutgoingIdMap0,lossyEscapeIdMap,losslessEscapeIdMap) <- atomically $ do idmap <- emptySTMRangeMap insertArrayAt idmap 0 (A.listArray (0,255) [0 .. 255]) -- the 2 escape ranges are adjacent, so put them in one array: @@ -456,18 +536,25 @@ freshCryptoSession sessions )) -- lossless as separate range could have been done: -- > insertArrayAt idmap 768 (A.listArray (768,1023) (replicate 256 0x63)) - return idmap + lossyEsc <- newTVar $ A.listArray (0,255) [0 .. 255] + losslessEsc <- newTVar $ A.listArray (0,255) [0 .. 255] + return (idmap,lossyEsc,losslessEsc) ncView0 <- atomically $ newTVar (sessionView sessions) pktq <- atomically $ PQ.new (inboundQueueCapacity sessions) 0 bufstart <- atomically $ newTVar 0 - let toWireIO = do - f <- lookupNonceFunction crypto newsession theirSessionKey - atomically $ do - n24 <- readTVar ncMyPacketNonce0 - let n24plus1 = incrementNonce24 n24 - writeTVar ncMyPacketNonce0 n24plus1 - return (return (f n24, n24, ncOutgoingIdMap0)) - pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0 + mbpktoq + <- case mbtheirSessionKey of + Nothing -> return NeedHandshake + Just theirSessionKey -> do + let toWireIO = do + f <- lookupNonceFunction crypto newsession theirSessionKey + atomically $ do + n24 <- readTVar ncMyPacketNonce0 + let n24plus1 = incrementNonce24 n24 + writeTVar ncMyPacketNonce0 n24plus1 + return (return (f n24, n24, ncOutgoingIdMap0)) + pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0 + return (HaveHandshake pktoq) lastNQ <- atomically (CB.new 10 0 :: STM (CyclicBuffer (Bool,(ViewSnapshot,InOrOut CryptoMessage)))) listeners <- atomically $ newTVar IntMap.empty msgNum <- atomically $ newTVar 0 @@ -481,21 +568,22 @@ freshCryptoSession sessions , ncMyPacketNonce = ncMyPacketNonce0 , ncHandShake = ncHandShake0 , ncCookie = cookie0 - , ncTheirDHTKey = remoteDhtPublicKey - , ncTheirSessionPublic = Just theirSessionKey + , ncTheirDHTKey = HaveDHTKey remoteDhtPublicKey + , ncTheirSessionPublic = frmMaybe mbtheirSessionKey , ncSessionSecret = newsession - , ncSockAddr = addr + , ncSockAddr = HaveDHTKey addr , ncHooks = ncHooks0 , ncUnrecognizedHook = ncUnrecognizedHook0 , ncAllSessions = sessions , ncIncomingTypeArray = ncIncomingTypeArray0 , ncOutgoingIdMap = ncOutgoingIdMap0 + , ncOutgoingIdMapEscapedLossy = lossyEscapeIdMap + , ncOutgoingIdMapEscapedLossless = losslessEscapeIdMap , ncView = ncView0 , ncPacketQueue = pktq - , ncBufferStart = bufstart , ncDequeueThread = Nothing -- error "you want the NetCrypto-Dequeue thread id, but is it started?" , ncPingMachine = Nothing -- error "you want the NetCrypto-PingMachine, but is it started?" - , ncOutgoingQueue = pktoq + , ncOutgoingQueue = mbpktoq , ncLastNMsgs = lastNQ , ncListeners = listeners } @@ -507,37 +595,40 @@ freshCryptoSession sessions cd <- atomically $ PQ.dequeue pktq _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) (bufferData cd) loop - -- launch dequeueOutgoing thread - threadidOutgoing <- forkIO $ do - tid <- myThreadId - labelThread tid ("NetCryptoDequeueOutgoing." ++ show (key2id remotePublicKey)) - fix $ \loop -> do - (_,pkt) <- atomically $ PQ.dequeueOutgoing pktoq - dput XNetCrypto "NetCryptoDequeueOutgoing thread... Sending encrypted Packet" - sendMessage (sessionTransport sessions) addr (NetCrypto pkt) - loop - -- launch ping thread - fuzz <- randomRIO (0,2000) - pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000 - -- update session with thread ids - let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine} - -- add this session to the lookup maps - atomically $ do - modifyTVar allsessions (Map.insert addr netCryptoSession) - byKeyResult <- readTVar allsessionsByKey >>= return . Map.lookup remotePublicKey - case byKeyResult of - Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession]) - Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs)) - -- run announceNewSessionHooks - hooks <- atomically $ readTVar (announceNewSessionHooks sessions) - flip fix (hooks,netCryptoSession) $ \loop (hooks,session) -> - case hooks of - [] -> return () - (h:hs) -> do - r <- h Nothing session - case r of - Just f -> loop (hs, f session) - Nothing -> return () + case mbpktoq of + NeedHandshake -> return () + HaveHandshake pktoq -> do + -- launch dequeueOutgoing thread + threadidOutgoing <- forkIO $ do + tid <- myThreadId + labelThread tid ("NetCryptoDequeueOutgoing." ++ show (key2id remotePublicKey)) + fix $ \loop -> do + (_,pkt) <- atomically $ PQ.dequeueOutgoing pktoq + dput XNetCrypto "NetCryptoDequeueOutgoing thread... Sending encrypted Packet" + sendMessage (sessionTransport sessions) addr (NetCrypto pkt) + loop + -- launch ping thread + fuzz <- randomRIO (0,2000) + pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000 + -- update session with thread ids + let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine} + -- add this session to the lookup maps + atomically $ do + modifyTVar allsessions (Map.insert addr netCryptoSession) + byKeyResult <- readTVar allsessionsByKey >>= return . Map.lookup remotePublicKey + case byKeyResult of + Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession]) + Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs)) + -- run announceNewSessionHooks + hooks <- atomically $ readTVar (announceNewSessionHooks sessions) + flip fix (hooks,netCryptoSession) $ \loop (hooks,session) -> + case hooks of + [] -> return () + (h:hs) -> do + r <- h Nothing session + case r of + Just f -> loop (hs, f session) + Nothing -> return () -- | Called when we get a handshake, but there's already a session entry. updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCryptoSession -> IO () @@ -554,21 +645,21 @@ updateCryptoSession sessions addr hp session = do then do dput XNetCrypto "updateCryptoSession already accepted.." dput XNetCrypto (" ncTheirBaseNonce0=" ++ show ncTheirBaseNonce0 - ++ bool "(/=)" "(==)" (Just ncTheirBaseNonce0 == hpTheirBaseNonce hp) + ++ bool "(/=)" "(==)" (toMaybe ncTheirBaseNonce0 == hpTheirBaseNonce hp) ++ "hpTheirBaseNonce=" ++ show (hpTheirBaseNonce hp)) dput XNetCrypto (" ncTheirDHTKey=" ++ show (ncTheirDHTKey session) - ++ bool "{/=}" "{==}" (ncTheirDHTKey session == hpCookieRemoteDhtkey hp) + ++ bool "{/=}" "{==}" (ncTheirDHTKey session == HaveDHTKey (hpCookieRemoteDhtkey hp)) ++ "hpCookieRemoteDhtkey=" ++ show (hpCookieRemoteDhtkey hp)) when ( -- Just ncTheirBaseNonce0 /= hpTheirBaseNonce hp -- XXX: Do we really want to compare base nonce here? -- || - ncTheirDHTKey session /= hpCookieRemoteDhtkey hp + ncTheirDHTKey session /= HaveDHTKey (hpCookieRemoteDhtkey hp) ) $ freshCryptoSession sessions addr hp else do dput XNetCrypto "updateCryptoSession else clause" dput XNetCrypto (" ncTheirBaseNonce0=" ++ show ncTheirBaseNonce0 - ++ bool "(/=)" "(==)" (Just ncTheirBaseNonce0 == hpTheirBaseNonce hp) + ++ bool "(/=)" "(==)" (toMaybe ncTheirBaseNonce0 == hpTheirBaseNonce hp) ++ "hpTheirBaseNonce=" ++ show (hpTheirBaseNonce hp)) - if ( Just ncTheirBaseNonce0 /= hpTheirBaseNonce hp) + if ( ncTheirBaseNonce0 /= frmMaybe (hpTheirBaseNonce hp)) then freshCryptoSession sessions addr hp -- basenonce mismatch, trigger refresh else atomically $ writeTVar (ncState session) Accepted -- (InProgress AwaitingSessionPacket) @@ -622,7 +713,7 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non HParam { hpTheirBaseNonce = Just baseNonce , hpOtherCookie = otherCookie - , hpTheirSessionKeyPublic = sessionKey + , hpTheirSessionKeyPublic = Just sessionKey , hpMySecretKey = key , hpCookieRemotePubkey = remotePubkey , hpCookieRemoteDhtkey = remoteDhtkey @@ -661,7 +752,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do Just session@(NCrypto { ncIncomingTypeArray, ncState, ncPacketQueue, ncHooks, ncSessionSecret, ncTheirSessionPublic, ncTheirBaseNonce, ncPingMachine}) -> do - theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce + HaveHandshake theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce -- Try to decrypt message let diff :: Word16 diff = nonce16 - (last2Bytes theirBaseNonce) -- truncating to Word16 @@ -699,11 +790,11 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do -- update ncTheirBaseNonce if necessary when (diff > 2 * dATA_NUM_THRESHOLD)$ atomically $ do - y <- readTVar ncTheirBaseNonce + HaveHandshake y <- readTVar ncTheirBaseNonce let x = addtoNonce24 y (fromIntegral dATA_NUM_THRESHOLD) trace ("nonce y(" ++ show y ++ ") + " ++ show (fromIntegral dATA_NUM_THRESHOLD) ++ " = " ++ show x) (return ()) - writeTVar ncTheirBaseNonce y + writeTVar ncTheirBaseNonce (HaveHandshake y) -- then set session confirmed, atomically $ writeTVar ncState Confirmed {-Established-} -- bump ping machine @@ -807,7 +898,7 @@ allMsgTypes fDefault = A.listArray (minBound,maxBound) (0:knownMsgs) sendCrypto :: TransportCrypto -> NetCryptoSession -> (STM ()) -> CryptoMessage -> IO (Either String ()) sendCrypto crypto session updateLocal cm = do - let outq = ncOutgoingQueue session + let HaveHandshake outq = ncOutgoingQueue session -- XXX: potential race? if shared secret comes out of sync with cache? dput XNetCrypto "sendCrypto: enter " getOutGoingParam <- PQ.readyOutGoing outq -- cgit v1.2.3