diff options
-rw-r--r-- | src/Crypto/Tox.hs | 27 |
1 files changed, 16 insertions, 11 deletions
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs index 88a7372f..665a38dd 100644 --- a/src/Crypto/Tox.hs +++ b/src/Crypto/Tox.hs | |||
@@ -89,14 +89,14 @@ import qualified Data.ByteString.Internal | |||
89 | import Control.Concurrent.STM | 89 | import Control.Concurrent.STM |
90 | import Crypto.Error.Types (CryptoFailable (..), throwCryptoError) | 90 | import Crypto.Error.Types (CryptoFailable (..), throwCryptoError) |
91 | import Network.Socket (SockAddr) | 91 | import Network.Socket (SockAddr) |
92 | import GHC.Exts (Word(..)) | 92 | import GHC.Exts (Word(..),inline) |
93 | import GHC.Prim | 93 | import GHC.Prim |
94 | import Data.Word64Map (fitsInInt) | 94 | import Data.Word64Map (fitsInInt) |
95 | import Data.MinMaxPSQ (MinMaxPSQ') | 95 | import Data.MinMaxPSQ (MinMaxPSQ') |
96 | import qualified Data.MinMaxPSQ as MM | 96 | import qualified Data.MinMaxPSQ as MM |
97 | import Data.Time.Clock.POSIX | 97 | import Data.Time.Clock.POSIX |
98 | import Data.Hashable | 98 | import Data.Hashable |
99 | import System.IO.Unsafe (unsafePerformIO) | 99 | import System.IO.Unsafe (unsafeDupablePerformIO) |
100 | 100 | ||
101 | -- | A 16-byte mac and an arbitrary-length encrypted stream. | 101 | -- | A 16-byte mac and an arbitrary-length encrypted stream. |
102 | newtype Encrypted a = Encrypted ByteString | 102 | newtype Encrypted a = Encrypted ByteString |
@@ -259,21 +259,26 @@ computeSharedSecret sk recipient = k `seq` \nonce -> | |||
259 | k = hsalsa20 shared zeros24 | 259 | k = hsalsa20 shared zeros24 |
260 | 260 | ||
261 | unsafeFirstWord64 :: ByteArrayAccess ba => ba -> Word64 | 261 | unsafeFirstWord64 :: ByteArrayAccess ba => ba -> Word64 |
262 | unsafeFirstWord64 ba = unsafePerformIO $ BA.withByteArray ba peek | 262 | unsafeFirstWord64 ba = unsafeDupablePerformIO $ BA.withByteArray ba peek |
263 | {-# INLINE unsafeFirstWord64 #-} | ||
263 | 264 | ||
264 | instance Hashable PublicKey where | 265 | instance Hashable PublicKey where |
265 | hashWithSalt salt pk = hashWithSalt salt (unsafeFirstWord64 pk) | 266 | hashWithSalt salt pk = hashWithSalt salt (unsafeFirstWord64 pk) |
267 | {-# INLINE hashWithSalt #-} | ||
266 | 268 | ||
267 | instance Hashable SecretKey where | 269 | instance Hashable SecretKey where |
268 | hashWithSalt salt sk = hashWithSalt salt (unsafeFirstWord64 sk) | 270 | hashWithSalt salt sk = hashWithSalt salt (unsafeFirstWord64 sk) |
271 | {-# INLINE hashWithSalt #-} | ||
269 | 272 | ||
270 | instance Ord PublicKey where compare = unsafeCompare32Bytes | 273 | instance Ord PublicKey where compare = unsafeCompare32Bytes |
274 | {-# INLINE compare #-} | ||
271 | instance Ord SecretKey where compare = unsafeCompare32Bytes | 275 | instance Ord SecretKey where compare = unsafeCompare32Bytes |
276 | {-# INLINE compare #-} | ||
272 | 277 | ||
273 | unsafeCompare32Bytes :: (ByteArrayAccess ba, ByteArrayAccess bb) | 278 | unsafeCompare32Bytes :: (ByteArrayAccess ba, ByteArrayAccess bb) |
274 | => ba -> bb -> Ordering | 279 | => ba -> bb -> Ordering |
275 | unsafeCompare32Bytes ba bb = | 280 | unsafeCompare32Bytes ba bb = |
276 | unsafePerformIO $ BA.withByteArray ba | 281 | unsafeDupablePerformIO $ BA.withByteArray ba |
277 | $ \pa -> BA.withByteArray bb | 282 | $ \pa -> BA.withByteArray bb |
278 | $ \pb -> unsafeCompare32Bytes' 3 pa pb | 283 | $ \pb -> unsafeCompare32Bytes' 3 pa pb |
279 | 284 | ||
@@ -281,13 +286,13 @@ unsafeCompare32Bytes' :: Int -> Ptr Word64 -> Ptr Word64 -> IO Ordering | |||
281 | unsafeCompare32Bytes' !n !pa !pb = do | 286 | unsafeCompare32Bytes' !n !pa !pb = do |
282 | a <- peek pa | 287 | a <- peek pa |
283 | b <- peek pb | 288 | b <- peek pb |
284 | case compare a b of | 289 | if n == 0 |
285 | EQ -> if n == 0 | 290 | then return $! inline compare a b |
286 | then return EQ | 291 | else case inline compare a b of |
287 | else unsafeCompare32Bytes' (n - 1) | 292 | EQ -> unsafeCompare32Bytes' (n - 1) |
288 | (pa `plusPtr` 8) | 293 | (pa `plusPtr` 8) |
289 | (pb `plusPtr` 8) | 294 | (pb `plusPtr` 8) |
290 | result -> return result | 295 | neq -> return neq |
291 | 296 | ||
292 | 297 | ||
293 | 298 | ||