summaryrefslogtreecommitdiff
path: root/src/Crypto
diff options
context:
space:
mode:
Diffstat (limited to 'src/Crypto')
-rw-r--r--src/Crypto/Tox.hs29
1 files changed, 28 insertions, 1 deletions
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index ad246d4e..bd4cdfba 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -6,11 +6,14 @@
6{-# LANGUAGE DeriveFunctor #-} 6{-# LANGUAGE DeriveFunctor #-}
7{-# LANGUAGE DeriveGeneric #-} 7{-# LANGUAGE DeriveGeneric #-}
8{-# LANGUAGE DeriveTraversable #-} 8{-# LANGUAGE DeriveTraversable #-}
9{-# LANGUAGE ExplicitNamespaces #-}
10{-# LANGUAGE TypeOperators #-} 9{-# LANGUAGE TypeOperators #-}
11{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-} 10{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
11{-# LANGUAGE MultiParamTypeClasses #-}
12{-# LANGUAGE ConstraintKinds #-}
13{-# LANGUAGE Rank2Types #-}
12{-# LANGUAGE NamedFieldPuns #-} 14{-# LANGUAGE NamedFieldPuns #-}
13{-# LANGUAGE PatternSynonyms #-} 15{-# LANGUAGE PatternSynonyms #-}
16{-# LANGUAGE FlexibleContexts #-}
14module Crypto.Tox 17module Crypto.Tox
15 ( PublicKey 18 ( PublicKey
16 , publicKey 19 , publicKey
@@ -38,8 +41,11 @@ module Crypto.Tox
38 , lookupSharedSecret 41 , lookupSharedSecret
39 , lookupNonceFunction 42 , lookupNonceFunction
40 , lookupNonceFunctionSTM 43 , lookupNonceFunctionSTM
44 , Payload(..)
41 , encrypt 45 , encrypt
42 , decrypt 46 , decrypt
47 , decryptPayload
48 , encryptPayload
43 , Nonce8(..) 49 , Nonce8(..)
44 , Nonce24(..) 50 , Nonce24(..)
45 , incrementNonce24 51 , incrementNonce24
@@ -110,6 +116,8 @@ import Data.Time.Clock.POSIX
110import Data.Hashable 116import Data.Hashable
111import System.IO.Unsafe (unsafeDupablePerformIO) 117import System.IO.Unsafe (unsafeDupablePerformIO)
112import Data.Functor.Compose 118import Data.Functor.Compose
119import qualified Rank2
120import Data.Functor.Identity
113 121
114-- | A 16-byte mac and an arbitrary-length encrypted stream. 122-- | A 16-byte mac and an arbitrary-length encrypted stream.
115newtype Encrypted a = Encrypted ByteString 123newtype Encrypted a = Encrypted ByteString
@@ -253,6 +261,18 @@ decrypt (State hash crypt) ciphertext
253 m = fst . XSalsa.combine crypt $ c 261 m = fst . XSalsa.combine crypt $ c
254 a = Auth . Poly1305.finalize . Poly1305.update hash $ c 262 a = Auth . Poly1305.finalize . Poly1305.update hash $ c
255 263
264class Rank2.Functor g => Payload c g where
265 mapPayload :: proxy c -> (forall a. c a => p a -> q a) -> g p -> g q
266
267decryptPayload :: ( Rank2.Traversable g
268 , Payload Serialize g
269 ) => State -> g Encrypted -> Either String (g Identity)
270decryptPayload st g = do
271 plain <- Rank2.traverse (decrypt st) g
272 Rank2.sequence $ mapPayload (Proxy :: Proxy Serialize)
273 (Composed . fmap pure . decodePlain)
274 plain
275
256-- Encrypt-then-Mac: Encrypt the cleartext, then compute the MAC on the 276-- Encrypt-then-Mac: Encrypt the cleartext, then compute the MAC on the
257-- ciphertext, and prepend it to the ciphertext 277-- ciphertext, and prepend it to the ciphertext
258encrypt :: State -> Plain s a -> Encrypted a 278encrypt :: State -> Plain s a -> Encrypted a
@@ -261,6 +281,13 @@ encrypt (State hash crypt) (Plain m) = Encrypted $ B.append (encode a) c
261 c = fst . XSalsa.combine crypt $ m 281 c = fst . XSalsa.combine crypt $ m
262 a = Auth . Poly1305.finalize . Poly1305.update hash $ c 282 a = Auth . Poly1305.finalize . Poly1305.update hash $ c
263 283
284encryptPayload :: Payload Serialize g => State -> g Identity -> g Encrypted
285encryptPayload st g =
286 encrypt st
287 Rank2.<$> mapPayload (Proxy :: Proxy Serialize)
288 (encodePlain . runIdentity)
289 g
290
264-- (Poly1305.State, XSalsa.State) 291-- (Poly1305.State, XSalsa.State)
265computeSharedSecret :: SecretKey -> PublicKey -> Nonce24 -> State 292computeSharedSecret :: SecretKey -> PublicKey -> Nonce24 -> State
266computeSharedSecret sk recipient = k `seq` \nonce -> 293computeSharedSecret sk recipient = k `seq` \nonce ->