summaryrefslogtreecommitdiff
path: root/src/Crypto/Tox.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Crypto/Tox.hs')
-rw-r--r--src/Crypto/Tox.hs16
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 #-}
11module Crypto.Tox 11module 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
258newtype Nonce24 = Nonce24 ByteString 259newtype Nonce24 = Nonce24 ByteString
259 deriving (Eq, Ord, ByteArrayAccess,Data) 260 deriving (Eq, Ord, ByteArrayAccess,Data)
260 261
261incrementNonce24 :: Nonce24 -> IO Nonce24 262addtoNonce24 :: Nonce24 -> Word -> IO Nonce24
262incrementNonce24 (Nonce24 n24) = Nonce24 <$> BA.copy n24 init 263addtoNonce24 (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
304incrementNonce24 :: Nonce24 -> IO Nonce24
305incrementNonce24 nonce24 = addtoNonce24 nonce24 1
306
301quoted :: ShowS -> ShowS 307quoted :: ShowS -> ShowS
302quoted shows s = '"':shows ('"':s) 308quoted shows s = '"':shows ('"':s)
303 309