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

1 files changed, 183 insertions, 92 deletions

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