diff options
author | Joe Crayne <joe@jerkface.net> | 2019-11-14 16:45:14 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-11-14 16:45:14 -0500 |
commit | b42c0d847a785487f3222b0d5360746d25d3209c (patch) | |
tree | 11ef85e3e4577eb047227f9938761bdac94a1309 /Crypto/JOSE/AESKW.hs | |
parent | 76bf7e08bccbb1a3a689068016b8a9c29d1e060e (diff) |
Cv25519 encryption.
Diffstat (limited to 'Crypto/JOSE/AESKW.hs')
-rw-r--r-- | Crypto/JOSE/AESKW.hs | 123 |
1 files changed, 123 insertions, 0 deletions
diff --git a/Crypto/JOSE/AESKW.hs b/Crypto/JOSE/AESKW.hs new file mode 100644 index 0000000..6b3d28e --- /dev/null +++ b/Crypto/JOSE/AESKW.hs | |||
@@ -0,0 +1,123 @@ | |||
1 | -- Copyright (C) 2016 Fraser Tweedale | ||
2 | -- | ||
3 | -- Licensed under the Apache License, Version 2.0 (the "License"); | ||
4 | -- you may not use this file except in compliance with the License. | ||
5 | -- You may obtain a copy of the License at | ||
6 | -- | ||
7 | -- http://www.apache.org/licenses/LICENSE-2.0 | ||
8 | -- | ||
9 | -- Unless required by applicable law or agreed to in writing, software | ||
10 | -- distributed under the License is distributed on an "AS IS" BASIS, | ||
11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | ||
12 | -- See the License for the specific language governing permissions and | ||
13 | -- limitations under the License. | ||
14 | |||
15 | {-# LANGUAGE ScopedTypeVariables #-} | ||
16 | |||
17 | {- | | ||
18 | |||
19 | Advanced Encryption Standard (AES) Key Wrap Algorithm; | ||
20 | <https://https://tools.ietf.org/html/rfc3394>. | ||
21 | |||
22 | -} | ||
23 | module Crypto.JOSE.AESKW | ||
24 | ( | ||
25 | aesKeyWrap | ||
26 | , aesKeyUnwrap | ||
27 | ) where | ||
28 | |||
29 | import Control.Monad.State | ||
30 | import Crypto.Cipher.Types | ||
31 | import Data.Bits (xor) | ||
32 | import Data.ByteArray as BA hiding (replicate, xor) | ||
33 | import Data.Memory.Endian (BE(..), toBE) | ||
34 | import Data.Memory.PtrMethods (memCopy) | ||
35 | import Data.Word (Word64) | ||
36 | import Foreign.Ptr (Ptr, plusPtr) | ||
37 | import Foreign.Storable (peek, peekElemOff, poke, pokeElemOff) | ||
38 | import System.IO.Unsafe (unsafePerformIO) | ||
39 | |||
40 | iv :: Word64 | ||
41 | iv = 0xA6A6A6A6A6A6A6A6 | ||
42 | |||
43 | aesKeyWrapStep | ||
44 | :: BlockCipher128 cipher | ||
45 | => cipher | ||
46 | -> Ptr Word64 -- ^ register | ||
47 | -> (Int, Int) -- ^ step (t) and offset (i) | ||
48 | -> StateT Word64 IO () | ||
49 | aesKeyWrapStep cipher p (t, i) = do | ||
50 | a <- get | ||
51 | r_i <- lift $ peekElemOff p i | ||
52 | m :: ScrubbedBytes <- | ||
53 | lift $ alloc 16 $ \p' -> poke p' a >> pokeElemOff p' 1 r_i | ||
54 | let b = ecbEncrypt cipher m | ||
55 | b_hi <- lift $ withByteArray b peek | ||
56 | b_lo <- lift $ withByteArray b (`peekElemOff` 1) | ||
57 | put (b_hi `xor` unBE (toBE (fromIntegral t))) | ||
58 | lift $ pokeElemOff p i b_lo | ||
59 | |||
60 | -- | Wrap a secret. | ||
61 | -- | ||
62 | -- Input size must be a multiple of 8 bytes, and at least 16 bytes. | ||
63 | -- Output size is input size plus 8 bytes. | ||
64 | -- | ||
65 | aesKeyWrap | ||
66 | :: (ByteArrayAccess m, ByteArray c, BlockCipher128 cipher) | ||
67 | => cipher | ||
68 | -> m | ||
69 | -> c | ||
70 | aesKeyWrap cipher m = unsafePerformIO $ do | ||
71 | let n = BA.length m | ||
72 | c <- withByteArray m $ \p -> | ||
73 | alloc (n + 8) $ \p' -> | ||
74 | memCopy (p' `plusPtr` 8) p n | ||
75 | withByteArray c $ \p -> do | ||
76 | let coords = zip [1..] (join (replicate 6 [1 .. n `div` 8])) | ||
77 | a <- execStateT (mapM_ (aesKeyWrapStep cipher p) coords) iv | ||
78 | poke p a | ||
79 | return c | ||
80 | |||
81 | aesKeyUnwrapStep | ||
82 | :: BlockCipher128 cipher | ||
83 | => cipher | ||
84 | -> Ptr Word64 -- ^ register | ||
85 | -> (Int, Int) -- ^ step (t) and offset (i) | ||
86 | -> StateT Word64 IO () | ||
87 | aesKeyUnwrapStep cipher p (t, i) = do | ||
88 | a <- get | ||
89 | r_i <- lift $ peekElemOff p i | ||
90 | let a_t = a `xor` unBE (toBE (fromIntegral t)) | ||
91 | m :: ScrubbedBytes <- | ||
92 | lift $ alloc 16 $ \p' -> poke p' a_t >> pokeElemOff p' 1 r_i | ||
93 | let b = ecbDecrypt cipher m | ||
94 | b_hi <- lift $ withByteArray b peek | ||
95 | b_lo <- lift $ withByteArray b (`peekElemOff` 1) | ||
96 | put b_hi | ||
97 | lift $ pokeElemOff p i b_lo | ||
98 | |||
99 | -- | Unwrap a secret. | ||
100 | -- | ||
101 | -- Input size must be a multiple of 8 bytes, and at least 24 bytes. | ||
102 | -- Output size is input size minus 8 bytes. | ||
103 | -- | ||
104 | -- Returns 'Nothing' if inherent integrity check fails. Otherwise, | ||
105 | -- the chance that the key data is corrupt is 2 ^ -64. | ||
106 | -- | ||
107 | aesKeyUnwrap | ||
108 | :: (ByteArrayAccess c, ByteArray m, BlockCipher128 cipher) | ||
109 | => cipher | ||
110 | -> c | ||
111 | -> Maybe m | ||
112 | aesKeyUnwrap cipher c = unsafePerformIO $ do | ||
113 | let n = BA.length c - 8 | ||
114 | m <- withByteArray c $ \p' -> | ||
115 | alloc n $ \p -> | ||
116 | memCopy p (p' `plusPtr` 8) n | ||
117 | a <- withByteArray c $ \p' -> peek p' | ||
118 | a' <- withByteArray m $ \p -> do | ||
119 | let n' = n `div` 8 | ||
120 | let tMax = n' * 6 | ||
121 | let coords = zip [tMax,tMax-1..1] (cycle [n'-1,n'-2..0]) | ||
122 | execStateT (mapM_ (aesKeyUnwrapStep cipher p) coords) a | ||
123 | return $ if a' == iv then Just m else Nothing | ||