summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Announcer.hs7
-rw-r--r--src/Data/Wrapper/PSQ.hs13
-rw-r--r--src/Data/Wrapper/PSQInt.hs6
-rw-r--r--src/Network/Tox/Session.hs18
4 files changed, 31 insertions, 13 deletions
diff --git a/Announcer.hs b/Announcer.hs
index 89dc5c3b..c6a04cb1 100644
--- a/Announcer.hs
+++ b/Announcer.hs
@@ -29,15 +29,15 @@ module Announcer
29 29
30import Data.Wrapper.PSQ as PSQ 30import Data.Wrapper.PSQ as PSQ
31 31
32import Control.Applicative
32import Control.Concurrent.Lifted.Instrument 33import Control.Concurrent.Lifted.Instrument
33import Control.Concurrent.STM 34import Control.Concurrent.STM
34import Control.Monad 35import Control.Monad
35import Control.Applicative
36import Data.ByteString (ByteString) 36import Data.ByteString (ByteString)
37import qualified Data.ByteString.Char8 as Char8 37import qualified Data.ByteString.Char8 as Char8
38import Data.Hashable 38import Data.Hashable
39import Data.Time.Clock.POSIX 39import Data.Time.Clock.POSIX
40import qualified GHC.Generics as Generics 40import qualified GHC.Generics as Generics
41-- import Generic.Data.Internal.Meta as Lyxia 41-- import Generic.Data.Internal.Meta as Lyxia
42 42
43newtype AnnounceKey = AnnounceKey ByteString 43newtype AnnounceKey = AnnounceKey ByteString
@@ -134,9 +134,6 @@ readTChanTimeout :: TVar Bool -> TChan a -> STM (Maybe a)
134readTChanTimeout delay pktChannel = do 134readTChanTimeout delay pktChannel = do
135 Just <$> readTChan pktChannel <|> pure Nothing <* (readTVar >=> check) delay 135 Just <$> readTChan pktChannel <|> pure Nothing <* (readTVar >=> check) delay
136 136
137toMicroseconds :: POSIXTime -> Int
138toMicroseconds = round . (* 1000) . (* 1000)
139
140data SchedulerCommand 137data SchedulerCommand
141 = ShutdownScheduler 138 = ShutdownScheduler
142 | ScheduleAction KPS -- run an action at an absolute time (todo: use UTCTime) 139 | ScheduleAction KPS -- run an action at an absolute time (todo: use UTCTime)
diff --git a/src/Data/Wrapper/PSQ.hs b/src/Data/Wrapper/PSQ.hs
index 5d32e16c..745e556b 100644
--- a/src/Data/Wrapper/PSQ.hs
+++ b/src/Data/Wrapper/PSQ.hs
@@ -22,9 +22,11 @@ fold' f a q = PSQueue.foldr f' a q
22-- import Data.OrdPSQ as OrdPSQ hiding (insert, map, singleton, minView) 22-- import Data.OrdPSQ as OrdPSQ hiding (insert, map, singleton, minView)
23-- import qualified Data.OrdPSQ as OrdPSQ 23-- import qualified Data.OrdPSQ as OrdPSQ
24 24
25import Data.HashPSQ as HashPSQ hiding (insert, map, singleton, minView)
26import qualified Data.HashPSQ as Q
27import Data.Hashable 25import Data.Hashable
26import qualified Data.HashPSQ as Q
27 ;import Data.HashPSQ as HashPSQ hiding (insert, map, minView,
28 singleton)
29import Data.Time.Clock.POSIX (POSIXTime)
28 30
29type PSQ' k p v = HashPSQ k p v 31type PSQ' k p v = HashPSQ k p v
30type PSQ k p = PSQ' k p () 32type PSQ k p = PSQ' k p ()
@@ -78,4 +80,11 @@ minView :: (PSQKey k, Ord p) => PSQ' k p v -> Maybe (Binding' k p v, PSQ' k p v)
78minView q = fmap (\(k,p,v,q') -> (Binding k v p, q')) $ Q.minView q 80minView q = fmap (\(k,p,v,q') -> (Binding k v p, q')) $ Q.minView q
79{-# INLINE minView #-} 81{-# INLINE minView #-}
80 82
83
84-- | Utility to convert a 'POSIXTime' delta into microseconds suitable for
85-- passing to 'threadDelay'.
86toMicroseconds :: POSIXTime -> Int
87toMicroseconds = round . (* 1000) . (* 1000)
88
89
81#endif 90#endif
diff --git a/src/Data/Wrapper/PSQInt.hs b/src/Data/Wrapper/PSQInt.hs
index c61b7ab6..5badb8b2 100644
--- a/src/Data/Wrapper/PSQInt.hs
+++ b/src/Data/Wrapper/PSQInt.hs
@@ -19,12 +19,10 @@ fold' f a q = PSQueue.foldr f' a q
19#else 19#else
20 ( module Data.Wrapper.PSQInt 20 ( module Data.Wrapper.PSQInt
21 , module IntPSQ 21 , module IntPSQ
22 , pattern (:->) 22 , module Data.Wrapper.PSQ
23 , key
24 , prio
25 ) where 23 ) where
26 24
27import Data.Wrapper.PSQ (Binding, pattern (:->), key, prio) 25import Data.Wrapper.PSQ (Binding, pattern (:->), key, prio, toMicroseconds)
28 26
29import Data.IntPSQ as IntPSQ hiding (insert, map, singleton, minView) 27import Data.IntPSQ as IntPSQ hiding (insert, map, singleton, minView)
30import qualified Data.IntPSQ as Q 28import qualified Data.IntPSQ as Q
diff --git a/src/Network/Tox/Session.hs b/src/Network/Tox/Session.hs
index e8be4d01..525338b2 100644
--- a/src/Network/Tox/Session.hs
+++ b/src/Network/Tox/Session.hs
@@ -4,6 +4,8 @@ module Network.Tox.Session
4 ( SessionParams(..) 4 ( SessionParams(..)
5 , SessionKey 5 , SessionKey
6 , Session(..) 6 , Session(..)
7 , sTheirUserKey
8 , sClose
7 , handshakeH 9 , handshakeH
8 ) where 10 ) where
9 11
@@ -11,7 +13,7 @@ import Control.Concurrent.STM
11import Control.Monad 13import Control.Monad
12import Data.Functor.Identity 14import Data.Functor.Identity
13import Data.Word 15import Data.Word
14import Network.Socket 16import Network.Socket (SockAddr)
15 17
16import Crypto.Tox 18import Crypto.Tox
17import Data.PacketBuffer (PacketInboundEvent (..)) 19import Data.PacketBuffer (PacketInboundEvent (..))
@@ -21,7 +23,7 @@ import Network.Lossless
21import Network.QueryResponse 23import Network.QueryResponse
22import Network.SessionTransports 24import Network.SessionTransports
23import Network.Tox.Crypto.Transport 25import Network.Tox.Crypto.Transport
24import Network.Tox.DHT.Transport (Cookie,key2id) 26import Network.Tox.DHT.Transport (Cookie (..), key2id, longTermKey)
25import Network.Tox.Handshake 27import Network.Tox.Handshake
26 28
27-- | Alias for 'SecretKey' to document that it is used as the temporary Tox 29-- | Alias for 'SecretKey' to document that it is used as the temporary Tox
@@ -79,6 +81,18 @@ data Session = Session
79 , sSessionID :: Int 81 , sSessionID :: Int
80 } 82 }
81 83
84-- | Helper to obtain the remote ToxID key from the locally-issued cookie
85-- associated with the session.
86sTheirUserKey :: Session -> PublicKey
87sTheirUserKey s = longTermKey $ runIdentity cookie
88 where
89 Cookie _ cookie = handshakeCookie (sReceivedHandshake s)
90
91-- | Helper to close the 'Transport' associated with a session.
92sClose :: Session -> IO ()
93sClose s = closeTransport (sTransport s)
94
95
82-- | Call this whenever a new handshake arrives so that a session is 96-- | Call this whenever a new handshake arrives so that a session is
83-- negotiated. It always returns Nothing which makes it convenient to use with 97-- negotiated. It always returns Nothing which makes it convenient to use with
84-- 'Network.QueryResponse.addHandler'. 98-- 'Network.QueryResponse.addHandler'.