Begin implementing HKDF

Implement the `extract` phase of HKDF.

4 files changed, 126 insertions, 5 deletions

diff --git a/src/Codec/Crypto/HKDF.hs b/src/Codec/Crypto/HKDF.hs
new file mode 100644
index 0000000..bb29ca6
--- /dev/null
+++ b/src/Codec/Crypto/HKDF.hs
@@ -0,0 +1,51 @@
+-- Copyright 2018 Google LLC
+--
+-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
+-- use this file except in compliance with the License. You may obtain a copy of
+-- the License at
+--
+--     https://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+-- License for the specific language governing permissions and limitations under
+-- the License.
+
+module Codec.Crypto.HKDF
+  ( Salt(Salt), SecretKey(SecretKey)
+  , extract
+  ) where
+
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Unsafe as ByteString
+import Foreign (Ptr, Storable(peek), alloca, allocaArray)
+import Foreign.C.Types
+import Foreign.Marshal.Unsafe (unsafeLocalState)
+import Unsafe.Coerce (unsafeCoerce)
+
+import Data.Digest.Internal (Algorithm(Algorithm))
+import Internal.Digest (evpMaxMDSize)
+import Internal.HKDF
+import Types (Salt(Salt), SecretKey(SecretKey))
+
+-- | Computes an HKDF pseudorandom key (PRK) as specified by RFC 5869.
+extract :: Algorithm -> Salt -> SecretKey -> SecretKey
+extract (Algorithm md) (Salt salt) (SecretKey secret) =
+  unsafeLocalState $
+    allocaArray evpMaxMDSize $ \pOutKey ->
+      alloca $ \pOutLen -> do
+        -- @HKDF_extract@ won't mutate @secret@ or @salt@, so the sharing inherent
+        -- in 'ByteString.unsafeUseAsCStringLen' is fine.
+        ByteString.unsafeUseAsCStringLen secret $ \(pSecret, secretLen) ->
+          ByteString.unsafeUseAsCStringLen salt $ \(pSalt, saltLen) ->
+            hkdfExtract
+              (asCUCharBuf pOutKey) pOutLen
+              md
+              (asCUCharBuf pSecret) (fromIntegral secretLen)
+              (asCUCharBuf pSalt) (fromIntegral saltLen)
+        outLen <- fromIntegral <$> peek pOutLen
+        SecretKey <$> ByteString.packCStringLen (pOutKey, outLen)
+  where
+    asCUCharBuf :: Ptr CChar -> Ptr CUChar
+    asCUCharBuf = unsafeCoerce
diff --git a/src/Data/HMAC.hs b/src/Data/HMAC.hs
index 4c424be..85e6886 100644
--- a/src/Data/HMAC.hs
+++ b/src/Data/HMAC.hs
@@ -31,14 +31,10 @@ import Data.Digest.Internal
 import Foreign.Ptr.ConstantTimeEquals (constantTimeEquals)
 import Internal.Base
 import Internal.HMAC
+import Types (SecretKey(SecretKey))
 
 type LazyByteString = ByteString.Lazy.ByteString
 
--- | A secret key used as input to a cipher or HMAC. Equality comparisons on
--- this type are variable-time.
-newtype SecretKey = SecretKey ByteString
-  deriving (Eq, Ord, Show)
-
 -- | A hash-based message authentication code. Equality comparisons on this type
 -- are constant-time.
 newtype HMAC = HMAC ByteString
diff --git a/src/Internal/HKDF.chs b/src/Internal/HKDF.chs
new file mode 100644
index 0000000..a3a48ed
--- /dev/null
+++ b/src/Internal/HKDF.chs
@@ -0,0 +1,45 @@
+-- Copyright 2018 Google LLC
+--
+-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
+-- use this file except in compliance with the License. You may obtain a copy of
+-- the License at
+--
+--     https://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+-- License for the specific language governing permissions and limitations under
+-- the License.
+
+module Internal.HKDF
+  ( hkdfExtract, hkdfExpand
+  ) where
+
+import Foreign (Ptr)
+import Foreign.C.Types
+
+{#import Internal.Base#}
+import Result
+
+#include <openssl/hkdf.h>
+
+hkdfExtract ::
+  Ptr CUChar -> Ptr CULong
+  -> Ptr EVPMD
+  -> Ptr CUChar -> CULong
+  -> Ptr CUChar -> CULong
+  -> IO ()
+hkdfExtract outKey outLen digest secret secretLen salt saltLen =
+  requireSuccess $
+    {#call HKDF_extract as ^#} outKey outLen digest secret secretLen salt saltLen
+
+hkdfExpand ::
+  Ptr CUChar -> CULong
+  -> Ptr EVPMD
+  -> Ptr CUChar -> CULong
+  -> Ptr CUChar -> CULong
+  -> IO ()
+hkdfExpand outKey outLen digest prk prkLen info infoLen =
+  requireSuccess $
+    {#call HKDF_expand as ^#} outKey outLen digest prk prkLen info infoLen
diff --git a/src/Types.hs b/src/Types.hs
new file mode 100644
index 0000000..a625c3e
--- /dev/null
+++ b/src/Types.hs
@@ -0,0 +1,29 @@
+-- Copyright 2018 Google LLC
+--
+-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
+-- use this file except in compliance with the License. You may obtain a copy of
+-- the License at
+--
+--     https://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+-- License for the specific language governing permissions and limitations under
+-- the License.
+
+module Types
+  ( Salt(Salt)
+  , SecretKey(SecretKey)
+  ) where
+
+import Data.ByteString (ByteString)
+
+-- | A salt. Equality comparisons on this type are variable-time.
+newtype Salt = Salt ByteString
+  deriving (Eq, Ord, Show)
+
+-- | A secret key used as input to a cipher or HMAC. Equality comparisons on
+-- this type are variable-time.
+newtype SecretKey = SecretKey ByteString
+  deriving (Eq, Ord, Show)