diff options
-rw-r--r-- | Announcer.hs | 7 | ||||
-rw-r--r-- | src/Data/Wrapper/PSQ.hs | 13 | ||||
-rw-r--r-- | src/Data/Wrapper/PSQInt.hs | 6 | ||||
-rw-r--r-- | src/Network/Tox/Session.hs | 18 |
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 | ||
30 | import Data.Wrapper.PSQ as PSQ | 30 | import Data.Wrapper.PSQ as PSQ |
31 | 31 | ||
32 | import Control.Applicative | ||
32 | import Control.Concurrent.Lifted.Instrument | 33 | import Control.Concurrent.Lifted.Instrument |
33 | import Control.Concurrent.STM | 34 | import Control.Concurrent.STM |
34 | import Control.Monad | 35 | import Control.Monad |
35 | import Control.Applicative | ||
36 | import Data.ByteString (ByteString) | 36 | import Data.ByteString (ByteString) |
37 | import qualified Data.ByteString.Char8 as Char8 | 37 | import qualified Data.ByteString.Char8 as Char8 |
38 | import Data.Hashable | 38 | import Data.Hashable |
39 | import Data.Time.Clock.POSIX | 39 | import Data.Time.Clock.POSIX |
40 | import qualified GHC.Generics as Generics | 40 | import qualified GHC.Generics as Generics |
41 | -- import Generic.Data.Internal.Meta as Lyxia | 41 | -- import Generic.Data.Internal.Meta as Lyxia |
42 | 42 | ||
43 | newtype AnnounceKey = AnnounceKey ByteString | 43 | newtype AnnounceKey = AnnounceKey ByteString |
@@ -134,9 +134,6 @@ readTChanTimeout :: TVar Bool -> TChan a -> STM (Maybe a) | |||
134 | readTChanTimeout delay pktChannel = do | 134 | readTChanTimeout delay pktChannel = do |
135 | Just <$> readTChan pktChannel <|> pure Nothing <* (readTVar >=> check) delay | 135 | Just <$> readTChan pktChannel <|> pure Nothing <* (readTVar >=> check) delay |
136 | 136 | ||
137 | toMicroseconds :: POSIXTime -> Int | ||
138 | toMicroseconds = round . (* 1000) . (* 1000) | ||
139 | |||
140 | data SchedulerCommand | 137 | data 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 | ||
25 | import Data.HashPSQ as HashPSQ hiding (insert, map, singleton, minView) | ||
26 | import qualified Data.HashPSQ as Q | ||
27 | import Data.Hashable | 25 | import Data.Hashable |
26 | import qualified Data.HashPSQ as Q | ||
27 | ;import Data.HashPSQ as HashPSQ hiding (insert, map, minView, | ||
28 | singleton) | ||
29 | import Data.Time.Clock.POSIX (POSIXTime) | ||
28 | 30 | ||
29 | type PSQ' k p v = HashPSQ k p v | 31 | type PSQ' k p v = HashPSQ k p v |
30 | type PSQ k p = PSQ' k p () | 32 | type 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) | |||
78 | minView q = fmap (\(k,p,v,q') -> (Binding k v p, q')) $ Q.minView q | 80 | minView 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'. | ||
86 | toMicroseconds :: POSIXTime -> Int | ||
87 | toMicroseconds = 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 | ||
27 | import Data.Wrapper.PSQ (Binding, pattern (:->), key, prio) | 25 | import Data.Wrapper.PSQ (Binding, pattern (:->), key, prio, toMicroseconds) |
28 | 26 | ||
29 | import Data.IntPSQ as IntPSQ hiding (insert, map, singleton, minView) | 27 | import Data.IntPSQ as IntPSQ hiding (insert, map, singleton, minView) |
30 | import qualified Data.IntPSQ as Q | 28 | import 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 | |||
11 | import Control.Monad | 13 | import Control.Monad |
12 | import Data.Functor.Identity | 14 | import Data.Functor.Identity |
13 | import Data.Word | 15 | import Data.Word |
14 | import Network.Socket | 16 | import Network.Socket (SockAddr) |
15 | 17 | ||
16 | import Crypto.Tox | 18 | import Crypto.Tox |
17 | import Data.PacketBuffer (PacketInboundEvent (..)) | 19 | import Data.PacketBuffer (PacketInboundEvent (..)) |
@@ -21,7 +23,7 @@ import Network.Lossless | |||
21 | import Network.QueryResponse | 23 | import Network.QueryResponse |
22 | import Network.SessionTransports | 24 | import Network.SessionTransports |
23 | import Network.Tox.Crypto.Transport | 25 | import Network.Tox.Crypto.Transport |
24 | import Network.Tox.DHT.Transport (Cookie,key2id) | 26 | import Network.Tox.DHT.Transport (Cookie (..), key2id, longTermKey) |
25 | import Network.Tox.Handshake | 27 | import 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. | ||
86 | sTheirUserKey :: Session -> PublicKey | ||
87 | sTheirUserKey s = longTermKey $ runIdentity cookie | ||
88 | where | ||
89 | Cookie _ cookie = handshakeCookie (sReceivedHandshake s) | ||
90 | |||
91 | -- | Helper to close the 'Transport' associated with a session. | ||
92 | sClose :: Session -> IO () | ||
93 | sClose 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'. |