diff options
Diffstat (limited to 'src/Crypto')
-rw-r--r-- | src/Crypto/Tox.hs | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs index a25f9f4f..9f86f6a4 100644 --- a/src/Crypto/Tox.hs +++ b/src/Crypto/Tox.hs | |||
@@ -7,7 +7,7 @@ | |||
7 | {-# LANGUAGE DeriveTraversable #-} | 7 | {-# LANGUAGE DeriveTraversable #-} |
8 | {-# LANGUAGE ExplicitNamespaces #-} | 8 | {-# LANGUAGE ExplicitNamespaces #-} |
9 | {-# LANGUAGE TypeOperators #-} | 9 | {-# LANGUAGE TypeOperators #-} |
10 | {-# LANGUAGE MagicHash, UnboxedTuples #-} | 10 | {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-} |
11 | module Crypto.Tox | 11 | module Crypto.Tox |
12 | ( PublicKey | 12 | ( PublicKey |
13 | , publicKey | 13 | , publicKey |
@@ -35,6 +35,7 @@ module Crypto.Tox | |||
35 | , Nonce8(..) | 35 | , Nonce8(..) |
36 | , Nonce24(..) | 36 | , Nonce24(..) |
37 | , incrementNonce24 | 37 | , incrementNonce24 |
38 | , addtoNonce24 | ||
38 | , Nonce32(..) | 39 | , Nonce32(..) |
39 | , getRemainingEncrypted | 40 | , getRemainingEncrypted |
40 | , putEncrypted | 41 | , putEncrypted |
@@ -258,17 +259,18 @@ hsalsa20 k n = BA.append a b | |||
258 | newtype Nonce24 = Nonce24 ByteString | 259 | newtype Nonce24 = Nonce24 ByteString |
259 | deriving (Eq, Ord, ByteArrayAccess,Data) | 260 | deriving (Eq, Ord, ByteArrayAccess,Data) |
260 | 261 | ||
261 | incrementNonce24 :: Nonce24 -> IO Nonce24 | 262 | addtoNonce24 :: Nonce24 -> Word -> IO Nonce24 |
262 | incrementNonce24 (Nonce24 n24) = Nonce24 <$> BA.copy n24 init | 263 | addtoNonce24 (Nonce24 n24) n = Nonce24 <$> BA.copy n24 init |
263 | where | 264 | where |
264 | init :: Ptr Word -> IO () | 265 | init :: Ptr Word -> IO () |
265 | init ptr | fitsInInt (Proxy :: Proxy Word64) = do | 266 | init ptr | fitsInInt (Proxy :: Proxy Word64) = do |
266 | let frmBE64 = fromIntegral . fromBE64 . fromIntegral | 267 | let frmBE64 = fromIntegral . fromBE64 . fromIntegral |
267 | tBE64 = fromIntegral . toBE64 . fromIntegral | 268 | tBE64 = fromIntegral . toBE64 . fromIntegral |
269 | !(W# input) = n | ||
268 | W# w1 <- frmBE64 <$> peek ptr | 270 | W# w1 <- frmBE64 <$> peek ptr |
269 | W# w2 <- frmBE64 <$> peekElemOff ptr 1 | 271 | W# w2 <- frmBE64 <$> peekElemOff ptr 1 |
270 | W# w3 <- frmBE64 <$> peekElemOff ptr 2 | 272 | W# w3 <- frmBE64 <$> peekElemOff ptr 2 |
271 | let (# overflw, sum #) = plusWord2# w3 (int2Word# 1#) | 273 | let (# overflw, sum #) = plusWord2# w3 input |
272 | (# overflw', sum' #) = plusWord2# w2 overflw | 274 | (# overflw', sum' #) = plusWord2# w2 overflw |
273 | (# discard, sum'' #) = plusWord2# w1 overflw' | 275 | (# discard, sum'' #) = plusWord2# w1 overflw' |
274 | poke ptr $ tBE64 (W# sum'') | 276 | poke ptr $ tBE64 (W# sum'') |
@@ -278,13 +280,14 @@ incrementNonce24 (Nonce24 n24) = Nonce24 <$> BA.copy n24 init | |||
278 | init ptr | fitsInInt (Proxy :: Proxy Word32) = do | 280 | init ptr | fitsInInt (Proxy :: Proxy Word32) = do |
279 | let frmBE32 = fromIntegral . fromBE32 . fromIntegral | 281 | let frmBE32 = fromIntegral . fromBE32 . fromIntegral |
280 | tBE32 = fromIntegral . toBE32 . fromIntegral | 282 | tBE32 = fromIntegral . toBE32 . fromIntegral |
283 | !(W# input) = n | ||
281 | W# w1 <- frmBE32 <$> peek ptr | 284 | W# w1 <- frmBE32 <$> peek ptr |
282 | W# w2 <- frmBE32 <$> peekElemOff ptr 1 | 285 | W# w2 <- frmBE32 <$> peekElemOff ptr 1 |
283 | W# w3 <- frmBE32 <$> peekElemOff ptr 2 | 286 | W# w3 <- frmBE32 <$> peekElemOff ptr 2 |
284 | W# w4 <- frmBE32 <$> peekElemOff ptr 3 | 287 | W# w4 <- frmBE32 <$> peekElemOff ptr 3 |
285 | W# w5 <- frmBE32 <$> peekElemOff ptr 4 | 288 | W# w5 <- frmBE32 <$> peekElemOff ptr 4 |
286 | W# w6 <- frmBE32 <$> peekElemOff ptr 5 | 289 | W# w6 <- frmBE32 <$> peekElemOff ptr 5 |
287 | let (# overflw_, sum_ #) = plusWord2# w6 (int2Word# 1#) | 290 | let (# overflw_, sum_ #) = plusWord2# w6 input |
288 | (# overflw__, sum__ #) = plusWord2# w5 overflw_ | 291 | (# overflw__, sum__ #) = plusWord2# w5 overflw_ |
289 | (# overflw___, sum___ #) = plusWord2# w6 overflw__ | 292 | (# overflw___, sum___ #) = plusWord2# w6 overflw__ |
290 | (# overflw, sum #) = plusWord2# w3 overflw___ | 293 | (# overflw, sum #) = plusWord2# w3 overflw___ |
@@ -298,6 +301,9 @@ incrementNonce24 (Nonce24 n24) = Nonce24 <$> BA.copy n24 init | |||
298 | pokeElemOff ptr 5 $ tBE32 (W# sum_) | 301 | pokeElemOff ptr 5 $ tBE32 (W# sum_) |
299 | init _ = error "incrementNonce24: I only support 64 and 32 bits" | 302 | init _ = error "incrementNonce24: I only support 64 and 32 bits" |
300 | 303 | ||
304 | incrementNonce24 :: Nonce24 -> IO Nonce24 | ||
305 | incrementNonce24 nonce24 = addtoNonce24 nonce24 1 | ||
306 | |||
301 | quoted :: ShowS -> ShowS | 307 | quoted :: ShowS -> ShowS |
302 | quoted shows s = '"':shows ('"':s) | 308 | quoted shows s = '"':shows ('"':s) |
303 | 309 | ||