OutGoing hooks so SessionView is updated etc

4 files changed, 211 insertions, 54 deletions

diff --git a/dht-client.cabal b/dht-client.cabal
index 7382eb76..aa2ab6cc 100644
--- a/dht-client.cabal
+++ b/dht-client.cabal
@@ -92,6 +92,7 @@ library
                     Data.CyclicBuffer
                     Data.Word64Map
                     Data.Word64RangeMap
+                    Data.Word64RangeMap.Unboxed
                     OnionRouter
                     Network.Tox
                     Network.Tox.Transport
@@ -273,6 +274,7 @@ executable dhtd
   default-language:    Haskell2010
   build-depends:       base, network, bytestring, hashable, deepseq
                      , aeson
+                     , array
                      , pretty
                      , dht-client
                      , unix
@@ -288,7 +290,11 @@ executable dhtd
                      , monad-control
                      , xml-types
                      , conduit
+                     , conduit-extra
                      , transformers
+                     , filepath
+                     , process
+                     , cereal-conduit >= 0.7.3
 
   if flag(thread-debug)
     build-depends: time
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 1821cb1c..8e34d4fe 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -62,7 +62,9 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import System.Posix.Signals
-
+import qualified Data.Array
+import qualified Data.Array.Unboxed as U
+import qualified Data.Conduit as Conduit
 
 import Announcer
 import Announcer.Tox
@@ -103,6 +105,13 @@ import OnionRouter
 import PingMachine
 import Data.PacketQueue
 import qualified Data.Word64Map as W64
+import System.FilePath
+import System.Process
+import System.Posix.IO
+import Data.Word64RangeMap
+import Network.Tox.Crypto.Transport
+import Data.Conduit.Cereal
+import qualified Data.Conduit.Binary as Conduit
 
 -- Presence imports.
 import ConsoleWriter
@@ -932,7 +941,9 @@ clientSession s@Session{..} sock cnum h = do
 
         -- necrypto <FRIEND-TOXID>
         -- establish a netcrypto session with specified person
-        ("netcrypto", s) -> cmd0 $ netcrypto (Map.lookup netname dhts) selectedKey h roster mbTox (strp s)
+        ("netcrypto", s) -> cmd0 $ do
+            let exes = Map.fromList [("atox",("/usr/bin/tmux -c","atox"))]
+            netcrypto (Map.lookup netname dhts) selectedKey h roster mbTox exes (strp s)
         ("g", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do
                         -- arguments: method
@@ -1282,11 +1293,12 @@ netcrypto
   -> ClientHandle
   -> ContactInfo extra1
   -> Maybe (Tox.Tox extra2)
+  -> Map.Map String (String,String) -- profile name to (multiplexer,exe name) for supported child executables
   -> String
   -> IO ()
-netcrypto _ _ h _ Nothing _ =  hPutClient h "Requires Tox enabled."
-netcrypto _ Nothing h _ _ _ =  hPutClient h "No key is selected, see k command."
-netcrypto (Just (DHT {..})) (Just mypubkey) h roster (Just tox) keystr =
+netcrypto _ _ h _ Nothing _ _ =  hPutClient h "Requires Tox enabled."
+netcrypto _ Nothing h _ _ _ _ =  hPutClient h "No key is selected, see k command."
+netcrypto (Just (DHT {..})) (Just mypubkey) h roster (Just tox) exes paramStr =
     either
       (const $
        either
@@ -1297,6 +1309,25 @@ netcrypto (Just (DHT {..})) (Just mypubkey) h roster (Just tox) keystr =
       (goPubkey . Tox.id2key) $
     readEither keystr -- attempt read as NodeId type
   where
+    params = words paramStr
+    keystr = bool (head params) "" (null params)
+    -- TODO:
+    -- execProfiles:
+    -- atox@24-25,48-51,64-45  gnome-tox-notifier@24-25,49,50
+    --      ^-- word64 type values that should be forwarded to this process
+    execParams=drop 1 params
+    parseExecParam :: String -> (String,[(Maybe Word64,Maybe Word64)])
+    parseExecParam param = let (name,drop 1 -> rangesCombined) = span (/='@') param
+                               wordsBy x str = groupBy (const (/=x)) str
+                               rangesUnparsed = wordsBy ',' rangesCombined
+                               parseRange :: String -> (Maybe Word64,Maybe Word64)
+                               parseRange "all" = (Nothing,Nothing)
+                               parseRange x = let (low,drop 1 -> high) = break (==',') x
+                                                  in (readMaybe low,readMaybe high)
+                               in (name,map parseRange rangesUnparsed)
+    execs = map parseExecParam execParams
+
+
     goNodeInfo userkey_nodeinfo = do
       msec <-
         atomically $ do
@@ -1314,7 +1345,78 @@ netcrypto (Just (DHT {..})) (Just mypubkey) h roster (Just tox) keystr =
             Just account -> do
               now <- getPOSIXTime
               atomically $ setContactAddr now their_pub their_addr account
-              Tox.netCrypto tox sec their_pub
+              sessions <- Tox.netCrypto tox sec their_pub
+              exeDir <- takeDirectory <$> getExecutablePath
+              forM_ sessions $ \session -> do
+                forM_ execs $ \(exekey,ranges) -> do
+                    case Map.lookup exekey exes of
+                        Nothing -> return ()
+                        Just (multiplexer,exename) -> do
+                            let exepath = exeDir </> exename
+                            (myReadFd,myWriteFd) <- System.Posix.IO.createPipe
+                            myRead  <- fdToHandle myReadFd
+                            myWrite <- fdToHandle myWriteFd
+                            whoAmI <- atomically $ newTVar mypubkey
+                            whoAreThey <- atomically $ newTVar their_pub
+                            let fdArgs = [show myWriteFd,show myReadFd]
+                            if null multiplexer
+                                then callProcess exepath fdArgs
+                                else do
+                                    let (multiplexer_exe,multiplexer_args) = splitAt 1 (words multiplexer)
+                                    callProcess multiplexer (multiplexer_args ++ [intercalate " " (exepath:fdArgs)])
+                            -- tell subprocess who is talking to who
+                            B.hPutStr myWrite ("\NUL\NUL" `B.append` S.encode (Tox.key2id mypubkey))
+                            B.hPutStr myWrite ("\NUL\SOH" `B.append` S.encode (Tox.key2id their_pub))
+                            -- add hooks so subprocess is updated on incoming
+                            let makeHook session typ
+                                    = \session msg
+                                       -> do -- if (getMessageType msg == typ)
+                                             me <- atomically $ readTVar whoAmI
+                                             when (me /= mypubkey) $ do
+                                                atomically $ writeTVar whoAmI mypubkey
+                                                B.hPutStr myWrite ("\NUL\NUL" `B.append` S.encode (Tox.key2id mypubkey))
+                                             them <- atomically $ readTVar whoAreThey
+                                             when (them /= their_pub) $ do
+                                                atomically $ writeTVar whoAreThey their_pub
+                                                B.hPutStr myWrite ("\NUL\SOH" `B.append` S.encode (Tox.key2id their_pub))
+                                             B.hPutStr myWrite (S.encode msg)
+                                             return (Just id)
+                                addHooks currentHooks typs = forM_ typs $ \typ -> modifyTVar (Tox.ncHooks session) (Map.insert typ (currentHooks typ ++ [makeHook session typ]))
+                            case ranges of
+                                [(Nothing,Nothing)] -> atomically $ do
+                                     typs <- map fromWord64 . filter (/=0) . U.elems <$> readTVar (Tox.ncIncomingTypeArray session)
+                                     addHooks (const []) typs
+                                _ -> atomically . forM_ ranges $ \range -> do
+                                    case range of
+                                        (Just first,Just last) -> do
+                                            let typs = map fromWord64 [first .. last]
+                                            hooks <- readTVar (Tox.ncHooks session)
+                                            let currentHooks typ = fromMaybe [] (Map.lookup typ hooks)
+                                            addHooks currentHooks typs
+                            -- forward messages from subprocess
+                            forwardThread <- forkIO $ do
+                                tid <- myThreadId
+                                let sidStr = printf "(%x)" (Tox.ncSessionId session)
+                                labelThread tid (exekey ++ ".forward" ++ sidStr)
+                                let myconduit = Conduit.sourceHandle myRead  .| conduitGet2 S.get -- :: ConduitT i CryptoMessage IO ()
+                                Conduit.runConduit (myconduit .| awaitForever (\msg -> do
+                                    let typ = toWord64 (getMessageType msg)
+                                    mbSendIt <- liftIO $ atomically (lookupInRangeMap typ (Tox.ncOutHooks session))
+                                    case mbSendIt of
+                                        Just sendit -> liftIO . void $ sendit (Tox.toxCryptoKeys tox) session msg
+                                        Nothing     -> return () -- do
+                                         -- uncomment to let unhooked pass thru:
+                                         -- if lossyness (msgId msg) == Lossless
+                                         --             then sendLossless (Tox.toxCryptoKeys tox) session msg
+                                         --             else sendLossy (Tox.toxCryptoKeys tox) session msg
+                                    ))
+                            -- add hook to killThread on kill packet
+                            atomically $ do
+                                hooks <- readTVar (Tox.ncHooks session)
+                                let currentHooks = fromMaybe [] $ Map.lookup (Msg KillPacket) hooks
+                                let myhook :: Tox.NetCryptoSession  -> CryptoMessage -> IO (Maybe (CryptoMessage -> CryptoMessage))
+                                    myhook _ _ = killThread forwardThread >> return (Just id)
+                                modifyTVar' (Tox.ncHooks session) (Map.insert (Msg KillPacket) (currentHooks ++ [myhook]))
               hPutClient h "Handshake sent"
     goPubkey their_pub = do
       msec <-
diff --git a/src/Data/Word64RangeMap.hs b/src/Data/Word64RangeMap.hs
index f4736d59..2e4cc8b7 100644
--- a/src/Data/Word64RangeMap.hs
+++ b/src/Data/Word64RangeMap.hs
@@ -20,14 +20,14 @@ import Data.IORef
 
 type OuterIndex = Int
 type Index = Word64
-type InnerArray b = UArray Index b
+type InnerArray b = Array Index b
 
 -- | Although this type includes a parameter for index, the code assumes bounds start at 0
 -- and the index has 'Integral', and 'Num' instances.
 newtype RefArray r ma i e = RefArray (r (ma i e))
 
 -- convenient contraint kind
-type RangeArray rangeArray m b ref = (IArray UArray b, MArray rangeArray (InnerArray b) m, Reference ref m)
+type RangeArray rangeArray m b ref = (MArray rangeArray (InnerArray b) m, Reference ref m)
 -- The RangeMap type, to be used with the above constraint
 type RangeMap rangeArray b ref = RefArray ref rangeArray OuterIndex (InnerArray b)
 
@@ -64,7 +64,7 @@ instance (Reference r m, MArray ma e m) => MArray (RefArray r ma) e m where
     unsafeWrite (RefArray r) i e = modifyRef r (\x -> Base.unsafeWrite x i e >> return (x,()))
 -}
 
-emptySTMRangeMap :: STM (RangeMap TArray Word8 TVar)
+emptySTMRangeMap :: STM (RangeMap TArray a TVar)
 emptySTMRangeMap = RefArray <$>
                      (newTVar =<<
                         newListArray (0,-1) [])
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index d5a49816..fabbf21d 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -32,7 +32,9 @@ import Data.Maybe
 import qualified Data.Word64Map as W64
 import Data.Word64RangeMap
 import qualified Data.Set         as Set
-import qualified Data.Array.Unboxed as A
+import qualified Data.Word64RangeMap.Unboxed as U
+import qualified Data.Array.Unboxed as U
+import qualified Data.Array as A
 import SensibleDir
 import System.FilePath
 import System.Environment
@@ -189,7 +191,7 @@ 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 MsgTypeArray = U.UArray Word8 Word64
 
 -- | Information, that may be made visible in multiple sessions, as well
 -- as displayed in some way to the user via mutiple views.
@@ -302,6 +304,9 @@ data NetCryptoSession = NCrypto
     -- 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])
+    , ncOutHooks           :: RangeMap TArray
+                                       (TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted)))
+                                       TVar
     , ncUnrecognizedHook   :: TVar (MessageType -> NetCryptoHook)
     , ncIdleEventHooks     :: TVar [(Int,NetCryptoSession -> IO ())]
     , ncIncomingTypeArray  :: TVar MsgTypeArray
@@ -315,7 +320,7 @@ data NetCryptoSession = NCrypto
     -- always escapes.
     --
     -- Currently, the values at these indices are ignored.
-    , ncOutgoingIdMap      :: RangeMap TArray Word8 TVar
+    , ncOutgoingIdMap      :: U.RangeMap TArray Word8 TVar
     -- ^ 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
@@ -363,7 +368,7 @@ data NetCryptoSession = NCrypto
     , ncOutgoingQueue      :: TVar
                                 (UponHandshake
                                     (PQ.PacketOutQueue
-                                          (State,Nonce24,RangeMap TArray Word8 TVar)
+                                          (State,Nonce24,U.RangeMap TArray Word8 TVar)
                                           CryptoMessage
                                           (CryptoPacket Encrypted)
                                           CryptoData))
@@ -495,7 +500,7 @@ type XMessage = CryptoMessage -- todo
 --    rangemap <- readTVar (ncOutgoingIdMap session)
 --    return (state,n24,rangemap)
 
-ncToWire :: STM (State,Nonce24,RangeMap TArray Word8 TVar)
+ncToWire :: STM (State,Nonce24,U.RangeMap TArray Word8 TVar)
          -> Word32{- packet number we expect to recieve -}
          -> Word32{- buffer_end -}
          -> Word32{- packet number -}
@@ -512,7 +517,7 @@ ncToWire getState seqno bufend pktno msg = do
     (state,n24,msgOutMapVar) <- getState
     -- msgOutMap <- readTVar msgOutMapVar
     result1 <- dtrace XNetCrypto ("lookupInRangeMap typ64=" ++ show typ64 ++ " " ++ show typ ++ show msg)
-                $ lookupInRangeMap typ64 msgOutMapVar
+                $ U.lookupInRangeMap typ64 msgOutMapVar
     case result1 of -- msgOutMapLookup typ64 msgOutMap of
         Nothing -> dtrace XNetCrypto "lookupInRangeMap gave Nothing!" $ return Nothing
         Just outid -> dtrace XNetCrypto ("encrypting packet with Nonce: " ++ show n24) $ do
@@ -589,18 +594,26 @@ freshCryptoSession  sessions
     ncIdleEventHooks0 <- newTVar (defaultIdleEventHooks sessions)
     ncIncomingTypeArray0 <- newTVar (msgTypeArray sessions)
     let idMap = foldl (\mp (x,y) -> W64.insert x y mp) W64.empty (zip [0..255] [0..255])
-    (ncOutgoingIdMap0,lossyEscapeIdMap,losslessEscapeIdMap) <- do
-        idmap <- emptySTMRangeMap
-        insertArrayAt idmap  0 (A.listArray (0,255) [0 .. 255])
+    (ncOutgoingIdMap0,lossyEscapeIdMap,losslessEscapeIdMap,ncOutHooks0) <- do
+        idmap <- U.emptySTMRangeMap
+        U.insertArrayAt idmap  0 (U.listArray (0,255) [0 .. 255])
         -- the 2 escape ranges are adjacent, so put them in one array:
-        insertArrayAt idmap  512 (A.listArray (512,1023) ( replicate 256 0xC7 -- lossy escaped
-                                                        ++ replicate 256 0x63 -- lossless escapped
-                                                         ))
+        U.insertArrayAt idmap  512 (U.listArray (512,1023) ( replicate 256 0xC7 -- lossy escaped
+                                                          ++ replicate 256 0x63 -- lossless escapped
+                                                           ))
         -- lossless as separate range could have been done:
         -- > insertArrayAt idmap  768 (A.listArray (768,1023)  (replicate 256 0x63))
-        lossyEsc    <- newTVar $ A.listArray (0,255) [0 .. 255]
-        losslessEsc <- newTVar $ A.listArray (0,255) [0 .. 255]
-        return (idmap,lossyEsc,losslessEsc)
+        lossyEsc    <- newTVar $ U.listArray (0,255) [0 .. 255]
+        losslessEsc <- newTVar $ U.listArray (0,255) [0 .. 255]
+        outHooks <- emptySTMRangeMap
+        mapM_ ($ outHooks) -- TODO: combine into larger ranges for faster lookup
+            [ insertWhereItGoes (A.listArray (2,2)   [sendKillHook])
+            , insertWhereItGoes (A.listArray (16,16) [sendLossless{-Ping-}])
+            , insertWhereItGoes (A.listArray (24,25) [sendOnlineHook,sendLossless{-Offline-}])
+            , insertWhereItGoes (A.listArray (48,51) [sendNickHook,sendStatusMsgHook,sendStatusHook,sendTypingHook])
+            , insertWhereItGoes (A.listArray (63,64) [sendMessageHook, sendMessageHook])
+            ]
+        return (idmap,lossyEsc,losslessEsc,outHooks)
     ncView0 <- newTVar (sessionView sessions)
     pktq <- PQ.new (inboundQueueCapacity sessions) 0
     bufstart <- newTVar 0
@@ -645,6 +658,7 @@ freshCryptoSession  sessions
                     , ncSessionSecret      = newsession
                     , ncSockAddr           = HaveDHTKey addr
                     , ncHooks              = ncHooks0
+                    , ncOutHooks           = ncOutHooks0
                     , ncUnrecognizedHook   = ncUnrecognizedHook0
                     , ncIdleEventHooks     = ncIdleEventHooks0
                     , ncAllSessions        = sessions
@@ -677,13 +691,13 @@ freshCryptoSession  sessions
             HaveHandshake pktoq -> return (runUponHandshake netCryptoSession0 addr pktoq)
     return (myhandshake,maybeLaunchMissles)
 
-type NetCryptoOutQueue = PQ.PacketOutQueue (State,Nonce24,RangeMap TArray Word8 TVar)
+type NetCryptoOutQueue = PQ.PacketOutQueue (State,Nonce24,U.RangeMap TArray Word8 TVar)
                                            CryptoMessage
                                            (CryptoPacket Encrypted)
                                            CryptoData
 
 createNetCryptoOutQueue :: NetCryptoSessions -> SecretKey -> PublicKey -> PacketQueue CryptoData
-                        -> TVar Nonce24    -> RangeMap TArray Word8 TVar     -> STM (UponHandshake NetCryptoOutQueue)
+                        -> TVar Nonce24    -> U.RangeMap TArray Word8 TVar     -> STM (UponHandshake NetCryptoOutQueue)
 createNetCryptoOutQueue sessions newsession theirSessionKey pktq ncMyPacketNonce0 ncOutgoingIdMap0 = do
             let crypto = transportCrypto sessions
             let toWireIO = do
@@ -1084,7 +1098,7 @@ sessionPacketH sessions addrRaw (CryptoPacket nonce16 encrypted) = do
                         Nothing -> return ()
                     msgTypes <- atomically $ readTVar ncIncomingTypeArray
                     let msgTyp = cd ^. messageType
-                        msgTypMapped64 = msgTypes A.! fromEnum8 (msgID cm)
+                        msgTypMapped64 = msgTypes U.! fromEnum8 (msgID cm)
                         msgTypMapped = fromWord64 $ msgTypMapped64
                         isLossy (GrpMsg KnownLossy _) = True
                         isLossy (Msg mid) | lossyness mid == Lossy = True
@@ -1116,7 +1130,7 @@ runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionP
     flip fix (cm,hookmap) $ \lookupAgain (cm,hookmap) -> do
         msgTypes <- atomically $ readTVar ncIncomingTypeArray
         let msgTyp = cm ^. messageType
-            msgTypMapped64 = msgTypes A.! fromEnum8 (msgID cm)
+            msgTypMapped64 = msgTypes U.! fromEnum8 (msgID cm)
             msgTypMapped = fromWord64 $ msgTypMapped64
         if msgTypMapped64 == 0
          then return Nothing
@@ -1147,8 +1161,8 @@ runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionP
 -- | construct a 'MsgTypeArray' for specified types, using their known common positions
 --   in the MessageId space if they have such a thing.
 mkMsgTypes :: [MessageType] -> MsgTypeArray
-mkMsgTypes msgs = let zeros = A.listArray (0,255) (replicate 256 0)
-                      in zeros A.// map (\x -> (toIndex x,toWord64 x)) msgs
+mkMsgTypes msgs = let zeros = U.listArray (0,255) (replicate 256 0)
+                      in zeros U.// map (\x -> (toIndex x,toWord64 x)) msgs
     where
         toIndex (Msg mid) = fromIntegral . fromEnum  $ mid
         toIndex (GrpMsg KnownLossless nam) = 0x63 -- fromEnum MESSAGE_GROUPCHAT
@@ -1189,10 +1203,10 @@ pattern   PACKET_ID_LOSSY_RANGE_SIZE     = 63
 --   The first parameter is a function which is applied to get the values
 --   for keys of unknown nature. Could be either 'id' or 'const 0'
 allMsgTypes :: (Word64 -> Word64) -> MsgTypeArray
-allMsgTypes fDefault = A.listArray (minBound,maxBound) (0:knownMsgs)
-  where
-    knownMsgs :: [Word64]
-    knownMsgs =
+allMsgTypes fDefault = U.listArray (minBound,maxBound) (0:knownMsgs)
+
+knownMsgs :: [Word64]
+knownMsgs =
       concat [ map (fromIntegral . fromEnum) [ PacketRequest .. KillPacket ]
              , map (const 0)                 [ 3 .. 15 ]  -- UnspecifiedPacket
              , map (const 0)                 [ 16 .. 23 ] -- MessengerLoseless
@@ -1236,6 +1250,10 @@ sendPing crypto session = do
 sendOnline :: TransportCrypto -> NetCryptoSession -> IO (Either String (CryptoPacket Encrypted))
 sendOnline crypto session = do
     let cm=OneByte ONLINE
+    sendOnlineHook crypto session cm
+
+sendOnlineHook :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendOnlineHook crypto session cm = do
     addMsgToLastN False (cm ^. messageType) session (Out cm)
     result <- sendCrypto crypto session (return ()) (OneByte ONLINE)
     -- double this packet
@@ -1252,49 +1270,61 @@ sendOnline crypto session = do
 sendOffline :: TransportCrypto -> NetCryptoSession -> IO (Either String (CryptoPacket Encrypted))
 sendOffline crypto session = do
     let cm=OneByte OFFLINE
+    sendLossless crypto session cm
+
+sendLossless :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendLossless crypto session cm = do
     addMsgToLastN False (cm ^. messageType) session (Out cm)
     sendCrypto crypto session (return ()) (OneByte OFFLINE)
 
+sendLossy :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendLossy crypto session cm = sendCryptoLossy crypto session (return ()) cm
 
 sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String (CryptoPacket Encrypted))
 sendKill crypto session = do
     let cm=OneByte KillPacket
+    sendKillHook crypto session cm
+
+sendKillHook :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendKillHook crypto session cm = sendCryptoLossy crypto session (destroySession session) cm
+
+sendCryptoLossy :: TransportCrypto -> NetCryptoSession -> (IO ()) -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendCryptoLossy crypto session updateLocal cm = do
     mbOutQ <- atomically $ readTVar (ncOutgoingQueue session)
     case mbOutQ of
         NeedHandshake -> do
-            let errmsg="NetCrypto NOT SENDING Kill packet (sessionid: " ++ show (ncSessionId session) ++ ") since no handshake yet"
-            dput XNetCrypto errmsg
-            dput XNetCrypto $ "Destroying session anyway"
-            destroySession session
+            let errmsg = "Error sending lossy packet! (sessionid: " ++ show (ncSessionId session) ++ ") Need the Handshake first!"
+            updateLocal
             return (Left errmsg)
         HaveHandshake outq -> do
-            dput XNetCrypto $ "NetCrypto sending Kill packet (sessionid: " ++ show (ncSessionId session) ++ ")"
             getOutGoingParam <- PQ.readyOutGoing outq
             mbPkt <- atomically $ PQ.peekPacket getOutGoingParam outq cm
             case mbPkt of
                 Nothing  -> do
-                    let errmsg = "Error sending kill packet! (sessionid: " ++ show (ncSessionId session) ++ ")"
-                    dput XNetCrypto errmsg
-                    dput XNetCrypto $ "Destroying session anyway"
-                    Right <$> destroySession session
+                    let errmsg = "Error sending lossy packet! (sessionid: " ++ show (ncSessionId session) ++ ") " ++ show cm
+                    updateLocal
                     return (Left errmsg)
                 Just (pkt,seqno) -> do
                     case (ncSockAddr session) of
                       NeedDHTKey -> do
-                        let errmsg= "NetCrypto NOT SENDING Kill packet (sessionid: " ++ show (ncSessionId session) ++ ") since no DHTkey(sockaddr) yet"
-                        dput XNetCrypto errmsg
-                        dput XNetCrypto $ "Destroying session anyway"
-                        Right <$> destroySession session
+                        let errmsg= "NetCrypto NOT SENDING Lossy packet (sessionid: " ++ show (ncSessionId session) ++ ") since no DHTkey(sockaddr) yet"
+                        updateLocal
                         return (Left errmsg)
                       HaveDHTKey saddr -> do
                         sendSessionPacket (ncAllSessions session) saddr pkt
-                        dput XNetCrypto $ "sent kill packet (sessionid: " ++ show (ncSessionId session) ++ ")... now destroying session..."
-                        destroySession session
+                        dput XNetCrypto $ "sent lossy packet (sessionid: " ++ show (ncSessionId session) ++ ") " ++ take 40 (show cm) ++ "..."
+                        updateLocal
                         return (Right pkt)
 
 setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String (CryptoPacket Encrypted))
 setNick crypto session nick = do
+    let cm = UpToN NICKNAME nick
+    sendNickHook crypto session cm
+
+sendNickHook :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendNickHook crypto session cm = do
     let Just (_,maxlen) = msgSizeParam NICKNAME
+    let nick = msgBytes cm
     if B.length nick > maxlen
      then return (Left $ "nickname must not exceed " ++ show maxlen ++ " bytes.")
      else do
@@ -1302,16 +1332,20 @@ setNick crypto session nick = do
                 let viewVar = ncView session
                 view <- readTVar viewVar
                 writeTVar (svNick view) nick
-        let cm = UpToN NICKNAME nick
         addMsgToLastN False (cm ^. messageType) session (Out cm)
         sendCrypto crypto session updateLocal cm
 
 setTyping :: TransportCrypto -> NetCryptoSession -> TypingStatus -> IO (Either String (CryptoPacket Encrypted))
 setTyping crypto session status = do
+   let cm = TwoByte TYPING (fromEnum8 status)
+   sendTypingHook crypto session cm
+
+sendTypingHook:: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendTypingHook crypto session cm = do
+   let status = toEnum8 (msgByte cm)
    let updateLocal = do
         view <- readTVar (ncView session)
         writeTVar (svTyping view) status
-   let cm = TwoByte TYPING (fromEnum8 status)
    addMsgToLastN False (cm ^. messageType) session (Out cm)
    sendCrypto crypto session updateLocal cm
 
@@ -1325,36 +1359,51 @@ setNoSpam crypto session mbnospam = do
 
 setStatus :: TransportCrypto -> NetCryptoSession -> UserStatus -> IO (Either String (CryptoPacket Encrypted))
 setStatus crypto session status = do
+   let cm = TwoByte USERSTATUS (fromEnum8 status)
+   sendStatusHook crypto session cm
+
+sendStatusHook :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendStatusHook crypto session cm = do
+   let status = toEnum8 (msgByte cm)
    let updateLocal = do
         view <- readTVar (ncView session)
         writeTVar (svStatus view) status
-   let cm = TwoByte USERSTATUS (fromEnum8 status)
    addMsgToLastN False (cm ^. messageType) session (Out cm)
    sendCrypto crypto session updateLocal cm
 
 setStatusMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String (CryptoPacket Encrypted))
 setStatusMsg crypto session msg = do
+    let cm = UpToN STATUSMESSAGE msg
+    sendStatusMsgHook crypto session cm
+
+sendStatusMsgHook :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendStatusMsgHook crypto session cm = do
     let Just (_,maxlen) = msgSizeParam STATUSMESSAGE
+    let msg = msgBytes cm
     if B.length msg > maxlen
      then return (Left $ "status message must not exceed " ++ show maxlen ++ " bytes.")
      else do
         let updateLocal = do
                 view <- readTVar (ncView session)
                 writeTVar (svStatusMsg view) msg
-        let cm = UpToN STATUSMESSAGE msg
         addMsgToLastN False (cm ^. messageType) session (Out cm)
         sendCrypto crypto session updateLocal cm
 
 sendChatMsg :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String (CryptoPacket Encrypted))
 sendChatMsg crypto session msg = do
+    let cm = UpToN MESSAGE msg
+    sendMessageHook crypto session cm
+
+sendMessageHook :: TransportCrypto -> NetCryptoSession -> CryptoMessage -> IO (Either String (CryptoPacket Encrypted))
+sendMessageHook crypto session cm = do
     let Just (_,maxlen) = msgSizeParam MESSAGE
+    let msg = msgBytes cm
     if B.length msg > maxlen
      then return (Left $ "status message must not exceed " ++ show maxlen ++ " bytes.")
      else do
         let updateLocal = do
                 view <- readTVar (ncView session)
                 writeTVar (svStatusMsg view) msg
-        let cm = UpToN MESSAGE msg
         addMsgToLastN False (cm ^. messageType) session (Out cm)
         sendCrypto crypto session updateLocal cm