diff options
Diffstat (limited to 'src/Crypto')
-rw-r--r-- | src/Crypto/Tox.hs | 29 |
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 #-} | ||
14 | module Crypto.Tox | 17 | module 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 | |||
110 | import Data.Hashable | 116 | import Data.Hashable |
111 | import System.IO.Unsafe (unsafeDupablePerformIO) | 117 | import System.IO.Unsafe (unsafeDupablePerformIO) |
112 | import Data.Functor.Compose | 118 | import Data.Functor.Compose |
119 | import qualified Rank2 | ||
120 | import 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. |
115 | newtype Encrypted a = Encrypted ByteString | 123 | newtype 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 | ||
264 | class Rank2.Functor g => Payload c g where | ||
265 | mapPayload :: proxy c -> (forall a. c a => p a -> q a) -> g p -> g q | ||
266 | |||
267 | decryptPayload :: ( Rank2.Traversable g | ||
268 | , Payload Serialize g | ||
269 | ) => State -> g Encrypted -> Either String (g Identity) | ||
270 | decryptPayload 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 |
258 | encrypt :: State -> Plain s a -> Encrypted a | 278 | encrypt :: 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 | ||
284 | encryptPayload :: Payload Serialize g => State -> g Identity -> g Encrypted | ||
285 | encryptPayload 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) |
265 | computeSharedSecret :: SecretKey -> PublicKey -> Nonce24 -> State | 292 | computeSharedSecret :: SecretKey -> PublicKey -> Nonce24 -> State |
266 | computeSharedSecret sk recipient = k `seq` \nonce -> | 293 | computeSharedSecret sk recipient = k `seq` \nonce -> |