diff options
| -rw-r--r-- | btls.cabal | 1 | ||||
| -rw-r--r-- | src/BTLS/BoringSSL/Digest.chs | 3 | ||||
| -rw-r--r-- | src/BTLS/BoringSSL/Obj.chs | 23 | ||||
| -rw-r--r-- | src/BTLS/Types.hs | 14 | ||||
| -rw-r--r-- | tests/Data/DigestTests.hs | 16 |
5 files changed, 55 insertions, 2 deletions
@@ -78,6 +78,7 @@ library , BTLS.BoringSSL.HKDF , BTLS.BoringSSL.HMAC , BTLS.BoringSSL.Mem + , BTLS.BoringSSL.Obj , BTLS.BoringSSL.Rand , BTLS.Buffer , BTLS.CreateWithFinalizer diff --git a/src/BTLS/BoringSSL/Digest.chs b/src/BTLS/BoringSSL/Digest.chs index c919125..793cc68 100644 --- a/src/BTLS/BoringSSL/Digest.chs +++ b/src/BTLS/BoringSSL/Digest.chs @@ -19,6 +19,7 @@ module BTLS.BoringSSL.Digest , mallocEVPMDCtx , evpDigestInitEx, evpDigestUpdate, evpDigestFinalEx , evpMaxMDSize + , evpMDType ) where import Data.ByteString (ByteString) @@ -63,6 +64,8 @@ foreign import ccall "&btlsFinalizeEVPMDCtx" evpMaxMDSize :: Int evpMaxMDSize = {#const EVP_MAX_MD_SIZE#} +{#fun pure EVP_MD_type as evpMDType {`Ptr EVPMD'} -> `Int'#} + instance Storable EVPMDCtx where sizeOf _ = {#sizeof EVP_MD_CTX#} alignment _ = {#alignof EVP_MD_CTX#} diff --git a/src/BTLS/BoringSSL/Obj.chs b/src/BTLS/BoringSSL/Obj.chs new file mode 100644 index 0000000..a337ad5 --- /dev/null +++ b/src/BTLS/BoringSSL/Obj.chs @@ -0,0 +1,23 @@ +-- 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.BoringSSL.Obj + ( objNID2SN + ) where + +import Foreign.C (CString) + +#include <openssl/obj.h> + +{#fun pure OBJ_nid2sn as objNID2SN {`Int'} -> `CString'#} diff --git a/src/BTLS/Types.hs b/src/BTLS/Types.hs index 4a4e518..6abd632 100644 --- a/src/BTLS/Types.hs +++ b/src/BTLS/Types.hs @@ -18,13 +18,25 @@ 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) +import Foreign (Ptr, nullPtr) +import Foreign.C (peekCString) +import Foreign.Marshal.Unsafe (unsafeLocalState) import BTLS.BoringSSL.Base (EVPMD) +import BTLS.BoringSSL.Digest (evpMDType) +import BTLS.BoringSSL.Obj (objNID2SN) -- | A cryptographic hash function. newtype Algorithm = Algorithm (Ptr EVPMD) +instance Eq Algorithm where + Algorithm a == Algorithm b = evpMDType a == evpMDType b + +instance Show Algorithm where + show (Algorithm md) = + let sn = objNID2SN (evpMDType md) in + if sn == nullPtr then "<algorithm>" else unsafeLocalState (peekCString sn) + -- | Context or application-specific information. Equality comparisons on this -- type are variable-time. newtype AssociatedData = AssociatedData ByteString diff --git a/tests/Data/DigestTests.hs b/tests/Data/DigestTests.hs index d56c3d8..cb62b55 100644 --- a/tests/Data/DigestTests.hs +++ b/tests/Data/DigestTests.hs @@ -15,13 +15,27 @@ module Data.DigestTests (tests) where import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit ((@?), testCase) +import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) import qualified Data.Digest.MD5Tests import qualified Data.Digest.SHA1Tests import qualified Data.Digest.SHA2Tests tests :: TestTree tests = testGroup "Data.Digest" - [ Data.Digest.MD5Tests.tests + [ showTests + , Data.Digest.MD5Tests.tests , Data.Digest.SHA1Tests.tests , Data.Digest.SHA2Tests.tests ] + +showTests = testGroup "show" + [ testNonEmpty "MD5" (show md5) + , testNonEmpty "SHA-1" (show sha1) + , testNonEmpty "SHA-224" (show sha224) + , testNonEmpty "SHA-256" (show sha256) + , testNonEmpty "SHA-384" (show sha384) + , testNonEmpty "SHA-512" (show sha512) ] + where + testNonEmpty description string = testCase description $ + not (null string) @? "expected: nonempty string\n but got: " ++ show string |