From 924d0109218f04f4a34bbfe1f5d18b75e1d9a66d Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Fri, 28 Sep 2018 17:20:36 -0400 Subject: Stop using newtypes for labeled arguments MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It’s getting messy, so switch to a parameters datatype pattern. --- src/BTLS/Show.hs | 22 ++++++++++++ src/BTLS/Types.hs | 35 ------------------- src/Codec/Crypto/HKDF.hs | 89 +++++++++++++++++++++--------------------------- src/Data/Digest.hs | 14 +++++++- src/Data/HMAC.hs | 19 ++++++----- 5 files changed, 85 insertions(+), 94 deletions(-) create mode 100644 src/BTLS/Show.hs (limited to 'src') diff --git a/src/BTLS/Show.hs b/src/BTLS/Show.hs new file mode 100644 index 0000000..8a6f883 --- /dev/null +++ b/src/BTLS/Show.hs @@ -0,0 +1,22 @@ +-- 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 BTLS.Show where + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as ByteString.Base16 +import qualified Data.ByteString.Char8 as ByteString.Char8 + +showHex :: ByteString -> String +showHex = ByteString.Char8.unpack . ByteString.Base16.encode diff --git a/src/BTLS/Types.hs b/src/BTLS/Types.hs index 6abd632..7a821f8 100644 --- a/src/BTLS/Types.hs +++ b/src/BTLS/Types.hs @@ -14,10 +14,6 @@ module BTLS.Types where -import Data.ByteString (ByteString) -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Base16 as ByteString.Base16 -import qualified Data.ByteString.Char8 as ByteString.Char8 import Foreign (Ptr, nullPtr) import Foreign.C (peekCString) import Foreign.Marshal.Unsafe (unsafeLocalState) @@ -36,34 +32,3 @@ instance Show Algorithm where show (Algorithm md) = let sn = objNID2SN (evpMDType md) in if sn == nullPtr then "" else unsafeLocalState (peekCString sn) - --- | Context or application-specific information. Equality comparisons on this --- type are variable-time. -newtype AssociatedData = AssociatedData ByteString - deriving (Eq, Ord, Show) - --- | The result of a hash operation. Equality comparisons on this type are --- variable-time. --- --- The 'Show' instance for this type displays the digest as a hexadecimal string. -newtype Digest = Digest ByteString - deriving (Eq, Ord) - -instance Show Digest where - show (Digest d) = showHex d - --- | A salt. Equality comparisons on this type are variable-time. -newtype Salt = Salt ByteString - deriving (Eq, Ord, Show) - --- | A special value used to request that no salt be used. -noSalt :: Salt -noSalt = Salt ByteString.empty - --- | 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) - -showHex :: ByteString -> String -showHex = ByteString.Char8.unpack . ByteString.Base16.encode \ No newline at end of file diff --git a/src/Codec/Crypto/HKDF.hs b/src/Codec/Crypto/HKDF.hs index 31d0be3..772fcf5 100644 --- a/src/Codec/Crypto/HKDF.hs +++ b/src/Codec/Crypto/HKDF.hs @@ -23,10 +23,9 @@ -} module Codec.Crypto.HKDF ( -- * Computing keys - SecretKey(SecretKey) - , hkdf - , extract - , expand + hkdf, HKDFParams(..) + , extract, ExtractParams(..) + , expand, ExpandParams(..) -- * Cryptographic hash algorithms , Algorithm @@ -37,17 +36,6 @@ module Codec.Crypto.HKDF -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). , sha224, sha256, sha384, sha512 - -- * Salt - - -- | You may salt the hash used to generate the key. If you do not wish to - -- do so, specify 'noSalt' as the salt. - , Salt(Salt), noSalt - - -- * Associated data - -- | You may mix in arbitrary data when generating a key. If you do not wish - -- to do so, specify the empty string as the associated data. - , AssociatedData(AssociatedData) - -- * Error handling , Error @@ -58,6 +46,7 @@ module Codec.Crypto.HKDF import Control.Monad ((>=>)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (runExceptT) +import Data.ByteString (ByteString) import Foreign (allocaArray) import Foreign.Marshal.Unsafe (unsafeLocalState) @@ -65,44 +54,44 @@ import BTLS.BoringSSL.Digest (evpMaxMDSize) import BTLS.BoringSSL.HKDF import BTLS.Buffer (onBufferOfMaxSize', packCUStringLen) import BTLS.Result (Error, check) -import BTLS.Types - ( Algorithm(Algorithm), AssociatedData(AssociatedData), Salt(Salt) - , SecretKey(SecretKey), noSalt - ) +import BTLS.Types (Algorithm(Algorithm)) import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) --- | Computes an HKDF. It is defined by --- --- prop> hkdf md salt info len = extract md salt >=> expand md info len --- --- but may be faster than calling the two functions individually. -hkdf :: - Algorithm - -> Salt - -> AssociatedData - -> Int -- ^ The length of the derived key, in bytes. - -> SecretKey - -> Either [Error] SecretKey -hkdf md salt info outLen = extract md salt >=> expand md info outLen +-- | Computes an HKDF. It is defined as the composition of 'extract' and +-- 'expand' but may be faster than calling the two functions individually. +hkdf :: HKDFParams -> ByteString -> Either [Error] ByteString +hkdf (HKDFParams md salt info outLen) = + extract (ExtractParams md salt) >=> expand (ExpandParams md info outLen) + +data HKDFParams = HKDFParams + { algorithm :: Algorithm + , salt :: ByteString + , associatedData :: ByteString + , secretLen :: Int + } deriving (Eq, Show) -- | Computes an HKDF pseudorandom key (PRK). -extract :: Algorithm -> Salt -> SecretKey -> Either [Error] SecretKey -extract (Algorithm md) (Salt salt) (SecretKey secret) = - fmap SecretKey $ - unsafeLocalState $ - onBufferOfMaxSize' evpMaxMDSize $ \pOutKey pOutLen -> - check $ hkdfExtract pOutKey pOutLen md secret salt +extract :: ExtractParams -> ByteString -> Either [Error] ByteString +extract (ExtractParams (Algorithm md) salt) secret = + unsafeLocalState $ + onBufferOfMaxSize' evpMaxMDSize $ \pOutKey pOutLen -> + check $ hkdfExtract pOutKey pOutLen md secret salt + +data ExtractParams = ExtractParams + { extractAlgorithm :: Algorithm + , extractSalt :: ByteString + } deriving (Eq, Show) -- | Computes HKDF output key material (OKM). -expand :: - Algorithm - -> AssociatedData - -> Int -- ^ The length of the OKM, in bytes. - -> SecretKey - -> Either [Error] SecretKey -expand (Algorithm md) (AssociatedData info) outLen (SecretKey secret) = - fmap SecretKey $ - unsafeLocalState $ - allocaArray outLen $ \pOutKey -> runExceptT $ do - check $ hkdfExpand pOutKey outLen md secret info - lift $ packCUStringLen (pOutKey, outLen) +expand :: ExpandParams -> ByteString -> Either [Error] ByteString +expand (ExpandParams (Algorithm md) info outLen) secret = + unsafeLocalState $ + allocaArray outLen $ \pOutKey -> runExceptT $ do + check $ hkdfExpand pOutKey outLen md secret info + lift $ packCUStringLen (pOutKey, outLen) + +data ExpandParams = ExpandParams + { expandAlgorithm :: Algorithm + , expandAssociatedData :: ByteString + , expandSecretLen :: Int + } deriving (Eq, Show) diff --git a/src/Data/Digest.hs b/src/Data/Digest.hs index 3bc53b7..bc2f944 100644 --- a/src/Data/Digest.hs +++ b/src/Data/Digest.hs @@ -38,6 +38,7 @@ module Data.Digest , sha1 ) where +import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy as ByteString.Lazy import Foreign.Marshal.Unsafe (unsafeLocalState) @@ -45,7 +46,18 @@ import Foreign.Marshal.Unsafe (unsafeLocalState) import BTLS.BoringSSL.Base import BTLS.BoringSSL.Digest import BTLS.Buffer (onBufferOfMaxSize) -import BTLS.Types (Algorithm(Algorithm), Digest(Digest)) +import BTLS.Show (showHex) +import BTLS.Types (Algorithm(Algorithm)) + +-- | The result of a hash operation. Equality comparisons on this type are +-- variable-time. +-- +-- The 'Show' instance for this type displays the digest as a hexadecimal string. +newtype Digest = Digest ByteString + deriving (Eq, Ord) + +instance Show Digest where + show (Digest d) = showHex d -- | Message Digest 5, a 128-bit digest defined in -- [RFC 1321](https://tools.ietf.org/html/rfc1321). This algorithm is diff --git a/src/Data/HMAC.hs b/src/Data/HMAC.hs index 0e5a67f..d27ce7e 100644 --- a/src/Data/HMAC.hs +++ b/src/Data/HMAC.hs @@ -24,7 +24,7 @@ module Data.HMAC ( -- * Computing HMACs HMAC(HMAC) - , hmac + , hmac, HMACParams(..) -- * Cryptographic hash algorithms , Algorithm @@ -35,9 +35,6 @@ module Data.HMAC -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). , sha224, sha256, sha384, sha512 - -- * Keys - , SecretKey(SecretKey) - -- * Error handling , Error @@ -59,7 +56,8 @@ import BTLS.BoringSSL.HMAC import BTLS.BoringSSL.Mem (cryptoMemcmp) import BTLS.Buffer (onBufferOfMaxSize) import BTLS.Result (Error, check) -import BTLS.Types (Algorithm(Algorithm), SecretKey(SecretKey), showHex) +import BTLS.Show (showHex) +import BTLS.Types (Algorithm(Algorithm)) import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) -- | A hash-based message authentication code. Equality comparisons on this type @@ -76,11 +74,16 @@ instance Eq HMAC where instance Show HMAC where show (HMAC m) = showHex m --- | Creates an HMAC according to the given 'Algorithm'. -hmac :: Algorithm -> SecretKey -> Lazy.ByteString -> Either [Error] HMAC -hmac (Algorithm md) (SecretKey key) bytes = +-- | Creates an HMAC. +hmac :: HMACParams -> Lazy.ByteString -> Either [Error] HMAC +hmac (HMACParams (Algorithm md) key) bytes = unsafeLocalState $ runExceptT $ do ctx <- lift mallocHMACCtx check $ hmacInitEx ctx key md noEngine lift $ mapM_ (hmacUpdate ctx) (ByteString.Lazy.toChunks bytes) lift $ HMAC <$> onBufferOfMaxSize evpMaxMDSize (hmacFinal ctx) + +data HMACParams = HMACParams + { algorithm :: Algorithm + , secretKey :: ByteString + } deriving (Eq, Show) -- cgit v1.2.3