summaryrefslogtreecommitdiff
path: root/Crypto/JOSE/AESKW.hs
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-11-14 16:45:14 -0500
committerJoe Crayne <joe@jerkface.net>2019-11-14 16:45:14 -0500
commitb42c0d847a785487f3222b0d5360746d25d3209c (patch)
tree11ef85e3e4577eb047227f9938761bdac94a1309 /Crypto/JOSE/AESKW.hs
parent76bf7e08bccbb1a3a689068016b8a9c29d1e060e (diff)
Cv25519 encryption.
Diffstat (limited to 'Crypto/JOSE/AESKW.hs')
-rw-r--r--Crypto/JOSE/AESKW.hs123
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
19Advanced Encryption Standard (AES) Key Wrap Algorithm;
20<https://https://tools.ietf.org/html/rfc3394>.
21
22-}
23module Crypto.JOSE.AESKW
24 (
25 aesKeyWrap
26 , aesKeyUnwrap
27 ) where
28
29import Control.Monad.State
30import Crypto.Cipher.Types
31import Data.Bits (xor)
32import Data.ByteArray as BA hiding (replicate, xor)
33import Data.Memory.Endian (BE(..), toBE)
34import Data.Memory.PtrMethods (memCopy)
35import Data.Word (Word64)
36import Foreign.Ptr (Ptr, plusPtr)
37import Foreign.Storable (peek, peekElemOff, poke, pokeElemOff)
38import System.IO.Unsafe (unsafePerformIO)
39
40iv :: Word64
41iv = 0xA6A6A6A6A6A6A6A6
42
43aesKeyWrapStep
44 :: BlockCipher128 cipher
45 => cipher
46 -> Ptr Word64 -- ^ register
47 -> (Int, Int) -- ^ step (t) and offset (i)
48 -> StateT Word64 IO ()
49aesKeyWrapStep 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--
65aesKeyWrap
66 :: (ByteArrayAccess m, ByteArray c, BlockCipher128 cipher)
67 => cipher
68 -> m
69 -> c
70aesKeyWrap 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
81aesKeyUnwrapStep
82 :: BlockCipher128 cipher
83 => cipher
84 -> Ptr Word64 -- ^ register
85 -> (Int, Int) -- ^ step (t) and offset (i)
86 -> StateT Word64 IO ()
87aesKeyUnwrapStep 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--
107aesKeyUnwrap
108 :: (ByteArrayAccess c, ByteArray m, BlockCipher128 cipher)
109 => cipher
110 -> c
111 -> Maybe m
112aesKeyUnwrap 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