hash-string (empty) → 0.1.0.0
raw patch · 13 files changed
+1134/−0 lines, 13 filesdep +basedep +base16dep +bytestring
Dependencies added: base, base16, bytestring, ghc-prim, hash-string, quickcheck-instances, tasty, tasty-quickcheck, text
Files
- CHANGELOG.md +3/−0
- LICENSE +202/−0
- csrc/hs_hashstring_base16.c +209/−0
- csrc/hs_hashstring_base16.h +30/−0
- csrc/hs_hashstring_memcmp.c +18/−0
- csrc/hs_hashstring_memcmp.h +9/−0
- csrc/hs_hashstring_xor.c +57/−0
- csrc/hs_hashstring_xor.h +32/−0
- hash-string.cabal +55/−0
- lib/Crypto/HashString.hs +35/−0
- lib/Crypto/HashString/FFI.hs +23/−0
- lib/Crypto/HashString/Implementation.hs +394/−0
- test/Main.hs +67/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# Revision history for hash-string++## 0.1.0.0 (2025-01-20)
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ 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++ http://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.
+ csrc/hs_hashstring_base16.c view
@@ -0,0 +1,209 @@+/*+ Copyright (c) 2014 Steve "Sc00bz" Thomas (steve at tobtu dot com)++ Permission is hereby granted, free of charge, to any person obtaining a copy+ of this software and associated documentation files (the "Software"), to deal+ in the Software without restriction, including without limitation the rights+ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+ copies of the Software, and to permit persons to whom the Software is+ furnished to do so, subject to the following conditions:++ The above copyright notice and this permission notice shall be included in all+ copies or substantial portions of the Software.++ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+ SOFTWARE.+*/++#include "hs_hashstring_base16.h"+#include <stdint.h>++// ************************+// *** Helper Functions ***+// ************************++static inline int hexDecodeNibble(char src)+{+ // 0-9 0x30-0x39+ // A-F 0x41-0x46 or a-f 0x61-0x66+ int ch = (unsigned char) src;+ int ret = -1;++ // if (ch > 0x2f && ch < 0x3a) ret += ch - 0x30 + 1; // -47+ ret += (((0x2f - ch) & (ch - 0x3a)) >> 8) & (ch - 47);++ ch |= 0x20;++ // if (ch > 0x60 && ch < 0x67) ret += ch - 0x61 + 10 + 1; // -86+ ret += (((0x60 - ch) & (ch - 0x67)) >> 8) & (ch - 86);++ return ret;+}++static inline int hexDecodeNibbleLower(char src)+{+ // 0-9 0x30-0x39+ // a-f 0x61-0x66+ int ch = (unsigned char) src;+ int ret = -1;++ // if (ch > 0x2f && ch < 0x3a) ret += ch - 0x30 + 1; // -47+ ret += (((0x2f - ch) & (ch - 0x3a)) >> 8) & (ch - 47);++ // if (ch > 0x60 && ch < 0x67) ret += ch - 0x61 + 10 + 1; // -86+ ret += (((0x60 - ch) & (ch - 0x67)) >> 8) & (ch - 86);++ return ret;+}++static inline int hexDecodeNibbleUpper(char src)+{+ // 0-9 0x30-0x39+ // A-F 0x41-0x46+ int ch = (unsigned char) src;+ int ret = -1;++ // if (ch > 0x2f && ch < 0x3a) ret += ch - 0x30 + 1; // -47+ ret += (((0x2f - ch) & (ch - 0x3a)) >> 8) & (ch - 47);++ // if (ch > 0x40 && ch < 0x47) ret += ch - 0x41 + 10 + 1; // -54+ ret += (((0x40 - ch) & (ch - 0x47)) >> 8) & (ch - 54);++ return ret;+}++static inline int hexDecodeByte(const char src[2])+{+ return (hexDecodeNibble(src[0]) << 4) | hexDecodeNibble(src[1]);+}++static inline int hexDecodeByteLower(const char src[2])+{+ return (hexDecodeNibbleLower(src[0]) << 4) | hexDecodeNibbleLower(src[1]);+}++static inline int hexDecodeByteUpper(const char src[2])+{+ return (hexDecodeNibbleUpper(src[0]) << 4) | hexDecodeNibbleUpper(src[1]);+}++static inline char hexEncodeNibbleLower(unsigned int src)+{+ // 0-9 0x30-0x39+ // a-f 0x61-0x66+ src += 0x30;++ // if (in > 0x39) in += 0x61 - 0x3a;+ src += ((0x39 - src) >> 8) & (0x61 - 0x3a);++ return (char) src;+}++static inline char hexEncodeNibbleUpper(unsigned int src)+{+ // 0-9 0x30-0x39+ // A-F 0x41-0x46+ src += 0x30;++ // if (in > 0x39) in += 0x41 - 0x3a;+ src += ((0x39 - src) >> 8) & (0x41 - 0x3a);++ return (char) src;+}++static inline void hexEncodeByteLower(char dest[2], uint8_t src)+{+ dest[0] = hexEncodeNibbleLower(src >> 4);+ dest[1] = hexEncodeNibbleLower(src & 0x0f);+}++static inline void hexEncodeByteUpper(char dest[2], uint8_t src)+{+ dest[0] = hexEncodeNibbleUpper(src >> 4);+ dest[1] = hexEncodeNibbleUpper(src & 0x0f);+}+++// **********************+// *** Main Functions ***+// **********************++int hs_hashstring_hexDecode(void *dest, const char *src, size_t srcLen)+{+ int err = 0;++ if (srcLen % 2 != 0)+ {+ return 1;+ }+ srcLen /= 2;+ for (size_t i = 0; i < srcLen; i++)+ {+ int tmp = hexDecodeByte(src + 2 * i);++ err |= tmp >> 8;+ ((uint8_t*) dest)[i] = (uint8_t) tmp;+ }+ return err != 0;+}++int hs_hashstring_hexDecodeLower(void *dest, const char *src, size_t srcLen)+{+ int err = 0;++ if (srcLen % 2 != 0)+ {+ return 1;+ }+ srcLen /= 2;+ for (size_t i = 0; i < srcLen; i++)+ {+ int tmp = hexDecodeByteLower(src + 2 * i);++ err |= tmp >> 8;+ ((uint8_t*) dest)[i] = (uint8_t) tmp;+ }+ return err != 0;+}++int hs_hashstring_hexDecodeUpper(void *dest, const char *src, size_t srcLen)+{+ int err = 0;++ if (srcLen % 2 != 0)+ {+ return 1;+ }+ srcLen /= 2;+ for (size_t i = 0; i < srcLen; i++)+ {+ int tmp = hexDecodeByteUpper(src + 2 * i);++ err |= tmp >> 8;+ ((uint8_t*) dest)[i] = (uint8_t) tmp;+ }+ return err != 0;+}++void hs_hashstring_hexEncode(char *dest, const void *src, size_t srcLen)+{+ for (size_t i = 0; i < srcLen; i++)+ {+ hexEncodeByteLower(dest + 2 * i, ((const uint8_t*) src)[i]);+ }+ dest[2 * srcLen] = 0;+}++void hs_hashstring_hexEncodeUpper(char *dest, const void *src, size_t srcLen)+{+ for (size_t i = 0; i < srcLen; i++)+ {+ hexEncodeByteUpper(dest + 2 * i, ((const uint8_t*) src)[i]);+ }+ dest[2 * srcLen] = 0;+}
+ csrc/hs_hashstring_base16.h view
@@ -0,0 +1,30 @@+#pragma once+/*+ Copyright (c) 2014 Steve "Sc00bz" Thomas (steve at tobtu dot com)++ Permission is hereby granted, free of charge, to any person obtaining a copy+ of this software and associated documentation files (the "Software"), to deal+ in the Software without restriction, including without limitation the rights+ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+ copies of the Software, and to permit persons to whom the Software is+ furnished to do so, subject to the following conditions:++ The above copyright notice and this permission notice shall be included in all+ copies or substantial portions of the Software.++ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+ SOFTWARE.+*/++#include <stddef.h>++int hs_hashstring_hexDecode (void *dest, const char *src, size_t srcLen);+int hs_hashstring_hexDecodeLower(void *dest, const char *src, size_t srcLen);+int hs_hashstring_hexDecodeUpper(void *dest, const char *src, size_t srcLen);+void hs_hashstring_hexEncode (char *dest, const void *src, size_t srcLen);+void hs_hashstring_hexEncodeUpper(char *dest, const void *src, size_t srcLen);
+ csrc/hs_hashstring_memcmp.c view
@@ -0,0 +1,18 @@+#include <stdint.h>+#include "hs_hashstring_memcmp.h"++int+hs_hashstring_const_memcmp+( const uint8_t *const a,+ const uint8_t *const b,+ size_t const n )+{+ int d, out = 0;+ size_t i = n;+ while (i > 0) {+ i--;+ d = a[i] - b[i];+ out = d == 0 ? out : d;+ }+ return out;+}
+ csrc/hs_hashstring_memcmp.h view
@@ -0,0 +1,9 @@+#pragma once++#include <stddef.h>++int+hs_hashstring_const_memcmp+( const uint8_t *const a,+ const uint8_t *const b,+ size_t const n );
+ csrc/hs_hashstring_xor.c view
@@ -0,0 +1,57 @@+#include <hs_hashstring_xor.h>+#include <string.h>++void+hs_hashstring_xormin+ ( const uint8_t *const restrict a,+ const uint8_t *const restrict b,+ const size_t len,+ uint8_t *const restrict out )+{+ for(size_t i = 0; i < len; i++) {+ out[i] = a[i] ^ b[i];+ }+}++void+hs_hashstring_xormax+ ( const uint8_t *const restrict a,+ const size_t alen,+ const uint8_t *const restrict b,+ const size_t blen,+ uint8_t *const restrict out )+{+ if (alen <= blen) {+ hs_hashstring_xormin(a,b,alen,out);+ memcpy(out + alen, b + alen, blen - alen);+ } else {+ hs_hashstring_xormin(a,b,blen,out);+ memcpy(out + blen, a + blen, alen - blen);+ }+}++void+hs_hashstring_xorleft+ ( const uint8_t *const restrict a,+ const size_t alen,+ const uint8_t *const restrict b,+ const size_t blen,+ uint8_t *const restrict out )+{+ if (alen <= blen) {+ hs_hashstring_xormin(a,b,alen,out);+ } else {+ hs_hashstring_xormin(a,b,blen,out);+ memcpy(out + blen, a + blen, alen - blen);+ }+}+void+hs_hashstring_xormutate+ ( const uint8_t *const restrict a,+ const size_t len,+ uint8_t *const restrict out )+{+ for(size_t i = 0; i < len; i++) {+ out[i] ^= a[i];+ }+}
+ csrc/hs_hashstring_xor.h view
@@ -0,0 +1,32 @@+#pragma once+#include <stdint.h>+#include <stddef.h>++void+hs_hashstring_xormin+ ( const uint8_t *const restrict a,+ const uint8_t *const restrict b,+ const size_t len,+ uint8_t *const restrict out );++void+hs_hashstring_xormax+ ( const uint8_t *const restrict a,+ const size_t alen,+ const uint8_t *const restrict b,+ const size_t blen,+ uint8_t *const restrict out );++void+hs_hashstring_xorleft+ ( const uint8_t *const restrict a,+ const size_t alen,+ const uint8_t *const restrict b,+ const size_t blen,+ uint8_t *const restrict out );++void+hs_hashstring_xormutate+ ( const uint8_t *const restrict a,+ const size_t alen,+ uint8_t *const restrict out );
+ hash-string.cabal view
@@ -0,0 +1,55 @@+cabal-version: 1.24+name: hash-string+version: 0.1.0.0+synopsis:+ binary strings supporting constant-time base16 and comparisons+description:+ binary string types supporting constant-time base16 encoding and decoding, as+ well as constant time lexicographic comparisons. Note that the time required+ does depend linearly on length, but is otherwise data-independent.+license: Apache-2.0+license-file: LICENSE+author: Steve "Sc00bz" Thomas, Leon P Smith+maintainer: Auth Global+copyright: 2024 Auth Global+category: Cryptography+build-type: Simple+extra-doc-files: CHANGELOG.md++library+ exposed-modules: Crypto.HashString+ Crypto.HashString.FFI++ other-modules: Crypto.HashString.Implementation++ build-depends: base < 5,+ bytestring,+ ghc-prim+ hs-source-dirs: lib+ include-dirs: csrc++ install-includes: csrc/hs_hashstring_memcmp.h+ csrc/hs_hashstring_base16.h+ -- csrc/hs_hashstring_base64.h+ csrc/hs_hashstring_xor.h+ c-sources: csrc/hs_hashstring_memcmp.c+ csrc/hs_hashstring_base16.c+ -- csrc/hs_hashstring_base64.c+ csrc/hs_hashstring_xor.c++ default-language: Haskell2010++test-suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base+ , base16 >= 1+ -- , base64 >= 1+ , bytestring+ , hash-string+ , quickcheck-instances+ , tasty+ , tasty-quickcheck+ , text
+ lib/Crypto/HashString.hs view
@@ -0,0 +1,35 @@+-------------------------------------------------------------------------------+-- |+-- Module: Crypto.HashString+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-- binary string types supporting constant-time base16 encoding and decoding, as+-- well as constant time lexicographic comparisons. Note that the time required+-- does depend linearly on length, but is otherwise data-independent.+--+-------------------------------------------------------------------------------++module Crypto.HashString+ ( HashString+ , fromShort+ , fromShortBase16+ -- , fromShortBase64+ , toShort+ , toShortBase16+ -- , toShortBase64+ , fromByteString+ , fromBase16+ -- , fromBase64+ , toByteString+ , toBase16+ -- , toBase64+ , toBase16Builder+ -- , toBase64Builder+ , xorLeft+ , xorMin+ , xorMax+ , takeBytes+ ) where++import Crypto.HashString.Implementation
+ lib/Crypto/HashString/FFI.hs view
@@ -0,0 +1,23 @@+-------------------------------------------------------------------------------+-- |+-- Module: Crypto.HashString.FFI+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-------------------------------------------------------------------------------++module Crypto.HashString.FFI+ ( HashString(..)+ , base16EncodeLength+ , base16DecodeLength+ , c_const_memcmp_ba+ , c_hexDecode_ba+ , c_hexDecode_mba_bs+ , c_hexEncode_ba+ , c_hexEncode_bs_ba+ , c_xorleft_ba+ , c_xormin_ba+ , c_xormax_ba+ ) where++import Crypto.HashString.Implementation
+ lib/Crypto/HashString/Implementation.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE MagicHash, UnboxedTuples, CApiFFI, UnliftedFFITypes, BangPatterns, LambdaCase, GeneralizedNewtypeDeriving #-}++-------------------------------------------------------------------------------+-- |+-- Module: Crypto.HashString.Implementation+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-------------------------------------------------------------------------------++module Crypto.HashString.Implementation where++import Prelude hiding (Foldable, foldr)++import Data.Array.Byte+import Data.Bits((.&.))+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Builder (Builder, shortByteString)+import Data.ByteString.Internal(c2w, w2c, unsafeCreate)+import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)+import Data.ByteString.Short.Internal (ShortByteString(..))+import qualified Data.ByteString.Short as SB+import qualified Data.Char as Char+import Data.Foldable(Foldable, foldr)+import Data.Maybe+import Data.Monoid+import Data.Word+import Foreign.C+import Foreign.Ptr+import GHC.Base hiding (foldr)+import GHC.Exts+import GHC.IO++-- | Type intended to represent short-ish cryptographic values, say up to 128+-- bytes or so. Supports constant-time comparisons (i.e. run time depends on+-- length of the inputs but is otherwise independent of content), as well as+-- constant-time base16 and base64 conversions.++newtype HashString = HashString { unHashString :: ByteArray } deriving (Semigroup, Monoid)++instance Eq HashString where+ x == y = compare x y == EQ++instance Ord HashString where+ compare (HashString (ByteArray x)) (HashString (ByteArray y)) =+ compare (c_const_memcmp_ba x y minlen) 0+ <> compare xlen ylen+ where+ xlen = SB.length (SBS x)+ ylen = SB.length (SBS y)+ minlen = fromIntegral (min xlen ylen)++instance IsString HashString where+ fromString = \case+ ( 'b' : '1' : '6' : ' ' : xs ) -> doBase16 xs+-- ( 'b' : '6' : '4' : ' ' : xs ) -> doBase64 xs+ xs -> doBase16 xs+ where+ doBase16 = fromMaybe err . fromShortBase16 . SB.pack . map myConv+ where+ err = error "fromString :: String -> HashString -- base16 syntax error"+ myConv x = if Char.isHexDigit x then c2w x else err+{--+ doBase64 = fromMaybe err . fromShortBase64 . SB.pack . map myConv+ where+ err = error "fromString :: String -> HashString -- base64 syntax error"+ myConv x = if Char.isAscii x then c2w x else err+--}++instance Show HashString where+ show xs = '"': enc xs ++ ['"']+ where+ enc = map w2c . SB.unpack . toShortBase16++-- | Xor two hashstrings. The length of the result is always the same as the+-- length of the left argument; bytes are either removed from or added to the+-- end of the right argument as needed to match length.++xorLeft :: HashString -> HashString -> HashString+xorLeft (HashString strl@(ByteArray ptrl)) (HashString strr@(ByteArray ptrr))+ | compareInt# 0# (unsafePtrEquality# ptrl ptrr) /= EQ = fromShort (SB.replicate (SB.length (SBS ptrl)) 0)+ | otherwise =+ unsafePerformIO . IO $ \st ->+ let !lenl0@(I# lenl) = SB.length (SBS ptrl)+ !lenr0@(I# lenr) = SB.length (SBS ptrr)+ !(# st0, a #) = newByteArray# lenl st+ !(# st1, () #) = unIO (c_xorleft_ba ptrl (fromIntegral lenl0) ptrr (fromIntegral lenr0) a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, HashString (ByteArray b) #)++-- | Xor two hashstrings. The length of the result is always the same as the+-- length of the shorter argument, removing bytes from the end of the longer+-- string as needed to match length.++xorMin :: HashString -> HashString -> HashString+xorMin (HashString strl@(ByteArray ptrl)) (HashString strr@(ByteArray ptrr))+ | compareInt# 0# (unsafePtrEquality# ptrl ptrr) /= EQ = fromShort (SB.replicate (SB.length (SBS ptrl)) 0)+ | otherwise =+ unsafePerformIO . IO $ \st ->+ let !minlen0@(I# minlen) = min (SB.length (SBS ptrl)) (SB.length (SBS ptrr))+ !(# st0, a #) = newByteArray# minlen st+ !(# st1, () #) = unIO (c_xormin_ba ptrl ptrr (fromIntegral minlen0) a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, HashString (ByteArray b) #)++-- | Xor two hashstrings. The length of the result is always the same as the+-- length of the longer argument, adding null bytes onto the end of the+-- shorter string as needed to match length.++xorMax :: HashString -> HashString -> HashString+xorMax (HashString strl@(ByteArray ptrl)) (HashString strr@(ByteArray ptrr))+ | compareInt# 0# (unsafePtrEquality# ptrl ptrr) /= EQ = fromShort (SB.replicate (SB.length (SBS ptrl)) 0)+ | otherwise =+ unsafePerformIO . IO $ \st ->+ let !lenl = SB.length (SBS ptrl)+ !lenr = SB.length (SBS ptrr)+ !(I# maxlen) = max lenl lenr+ !(# st0, a #) = newByteArray# maxlen st+ !(# st1, () #) = unIO (c_xormax_ba ptrl (fromIntegral lenl) ptrr (fromIntegral lenr) a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, HashString (ByteArray b) #)++fromShortBase16 :: ShortByteString -> Maybe HashString+fromShortBase16 str@(SBS ptr) =+ case base16DecodeLength ptrlen of+ Nothing -> Nothing+ Just !(I# outlen) ->+ unsafePerformIO . IO $ \st ->+ let !(# st0, a #) = newByteArray# outlen st+ !(# st1, err #) = unIO (c_hexDecode_ba a ptr (fromIntegral ptrlen)) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in if err /= 0+ then (# st2, Nothing #)+ else (# st2, Just (HashString (ByteArray b)) #)+ where+ ptrlen = SB.length str++toShortBase16 :: HashString -> ShortByteString+toShortBase16 (HashString str@(ByteArray ptr)) =+ unsafePerformIO . IO $ \st ->+ let !(I# outlen) = ptrlen * 2+ !(# st0, a #) = newByteArray# outlen st+ !(# st1, () #) = unIO (c_hexEncode_ba a ptr (fromIntegral ptrlen)) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, SBS b #)+ where+ ptrlen = SB.length (SBS ptr)++takeBytes :: Foldable f => Int -> f HashString -> [ HashString ]+takeBytes n strings = foldr delta (const []) strings n+ where+ delta :: HashString -> (Int -> [HashString]) -> Int -> [ HashString ]+ delta str f n+ | n <= 0 = []+ | strlen < n = str : f (n - strlen)+ | otherwise = [tak n str]+ where strlen = len str+ len = SB.length . toShort+ tak n = fromShort . SB.take n . toShort++{--+fromShortBase64 :: ShortByteString -> Maybe HashString+fromShortBase64 str@(SBS ptr) =+ case base64DecodeLength ptrlen of+ Nothing -> Nothing+ Just !(I# outlen) ->+ unsafePerformIO . IO $ \st ->+ let !(# st0, a #) = newByteArray# outlen st+ !(# st1, err #) = unIO (c_base64Decode_ba a ptr (fromIntegral ptrlen)) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in if err /= 0+ then (# st2, Nothing #)+ else (# st2, Just (HashString (ByteArray b)) #)+ where+ ptrlen0 = SB.length str+ ptrlen = ptrlen0 - fromIntegral (c_base64PadLength_ba ptr (fromIntegral ptrlen0))++toShortBase64 :: HashString -> ShortByteString+toShortBase64 (HashString str@(ByteArray ptr)) =+ unsafePerformIO . IO $ \st ->+ let !(I# outlen) = base64EncodeLength ptrlen+ !(# st0, a #) = newByteArray# outlen st+ !(# st1, () #) = unIO (c_base64Encode_ba a ptr (fromIntegral ptrlen)) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, SBS b #)+ where+ ptrlen = SB.length (SBS ptr)+--}++toShort :: HashString -> ShortByteString+toShort (HashString (ByteArray x)) = SBS x++fromShort :: ShortByteString -> HashString+fromShort (SBS x) = HashString (ByteArray x)++toByteString :: HashString -> ByteString+toByteString = SB.fromShort . toShort++fromByteString :: ByteString -> HashString+fromByteString = fromShort . SB.toShort++toBase16 :: HashString -> ByteString+toBase16 (HashString str@(ByteArray ptr)) =+ unsafeCreate (base16EncodeLength ptrlen) $ \out ->+ c_hexEncode_bs_ba out ptr (fromIntegral ptrlen)+ where+ ptrlen = SB.length (SBS ptr)++{--+toBase64 :: HashString -> ByteString+toBase64 (HashString str@(ByteArray ptr)) =+ unsafeCreate (base64EncodeLength ptrlen) $ \out ->+ c_base64Encode_bs_ba out ptr (fromIntegral ptrlen)+ where+ ptrlen = SB.length (SBS ptr)+--}++fromBase16 :: ByteString -> Maybe HashString+fromBase16 str =+ case base16DecodeLength ptrlen of+ Nothing -> Nothing+ Just !(I# outlen) ->+ unsafePerformIO . unsafeUseAsCString str $ \ptr -> IO $ \st ->+ let !(# st0, a #) = newByteArray# outlen st+ !(# st1, err #) = unIO (c_hexDecode_mba_bs a ptr (fromIntegral ptrlen)) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in if err /= 0+ then (# st2, Nothing #)+ else (# st2, Just (HashString (ByteArray b)) #)+ where+ ptrlen = B.length str++{--+fromBase64 :: ByteString -> Maybe HashString+fromBase64 str =+ case base64DecodeLength ptrlen of+ Nothing -> Nothing+ Just !(I# outlen) ->+ unsafePerformIO . unsafeUseAsCString str $ \ptr -> IO $ \st ->+ let !(# st0, a #) = newByteArray# outlen st+ !(# st1, err #) = unIO (c_base64Decode_mba_bs a ptr (fromIntegral ptrlen)) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in if err /= 0+ then (# st2, Nothing #)+ else (# st2, Just (HashString (ByteArray b)) #)+ where+ ptrlen = B.length str - base64PadLength_bs str+--}++-- TODO: implement these functions better++toBase16Builder :: HashString -> Builder+toBase16Builder = shortByteString . toShortBase16++{--+toBase64Builder :: HashString -> Builder+toBase64Builder = shortByteString . toShortBase64+--}++base16EncodeLength :: Int -> Int+base16EncodeLength = (*) 2++base16DecodeLength :: Int -> Maybe Int+base16DecodeLength n+ | r == 0 = Just q+ | otherwise = Nothing+ where+ (q,r) = n `divMod` 2++{--+-- | Given the length of some binary blob of data, how long will the base64 encoded+-- version be, without padding?++-- There's probably a "cleaner" way to compute this with bit tricks+base64EncodeLength :: Int -> Int+base64EncodeLength n =+ 4 * q + if r == 0 then 0 else 1 + r+ where+ (q,r) = n `divMod` 3++-- | Given the length of some base64 encoded data, how long will the binar blob be?+-- The input length must not include any padding, commonly appearing as one or+-- two @=@ characters at the end of a string.++-- There's probably a "cleaner" way to compute this with bit tricks+base64DecodeLength :: Int -> Maybe Int+base64DecodeLength n+ | r == 0 = Just (3 * q)+ | r == 1 = Nothing+ | otherwise = Just ((3 * q) + (r - 1))+ where+ (q,r) = n `divMod` 4++base64PadLength_bs :: ByteString -> Int+base64PadLength_bs xs = min 2 (B.length (B.takeWhileEnd ((==) (c2w '=')) xs))+--}++foreign import capi unsafe "hs_hashstring_memcmp.h hs_hashstring_const_memcmp"+ c_const_memcmp_ba+ :: ByteArray#+ -> ByteArray#+ -> CSize+ -> CInt++foreign import capi unsafe "hs_hashstring_base16.h hs_hashstring_hexDecode"+ c_hexDecode_ba+ :: MutableByteArray# RealWorld+ -> ByteArray#+ -> CSize+ -> IO CInt++foreign import capi unsafe "hs_hashstring_base16.h hs_hashstring_hexDecode"+ c_hexDecode_mba_bs+ :: MutableByteArray# RealWorld+ -> CString+ -> CSize+ -> IO CInt++foreign import capi unsafe "hs_hashstring_base16.h hs_hashstring_hexEncode"+ c_hexEncode_ba+ :: MutableByteArray# RealWorld+ -> ByteArray#+ -> CSize+ -> IO ()++foreign import capi unsafe "hs_hashstring_base16.h hs_hashstring_hexEncode"+ c_hexEncode_bs_ba+ :: Ptr Word8+ -> ByteArray#+ -> CSize+ -> IO ()++foreign import capi unsafe "hs_hashstring_xor.h hs_hashstring_xorleft"+ c_xorleft_ba+ :: ByteArray#+ -> CSize+ -> ByteArray#+ -> CSize+ -> MutableByteArray# RealWorld+ -> IO ()++foreign import capi unsafe "hs_hashstring_xor.h hs_hashstring_xormin"+ c_xormin_ba+ :: ByteArray#+ -> ByteArray#+ -> CSize+ -> MutableByteArray# RealWorld+ -> IO ()++foreign import capi unsafe "hs_hashstring_xor.h hs_hashstring_xormax"+ c_xormax_ba+ :: ByteArray#+ -> CSize+ -> ByteArray#+ -> CSize+ -> MutableByteArray# RealWorld+ -> IO ()++{--+foreign import capi unsafe "hs_hashstring_base64.h hs_hashstring_base64Decode"+ c_base64Decode_ba+ :: MutableByteArray# RealWorld+ -> ByteArray#+ -> CSize+ -> IO CInt++foreign import capi unsafe "hs_hashstring_base64.h hs_hashstring_base64Decode"+ c_base64Decode_mba_bs+ :: MutableByteArray# RealWorld+ -> CString+ -> CSize+ -> IO CInt++foreign import capi unsafe "hs_hashstring_base64.h hs_hashstring_base64Encode"+ c_base64Encode_ba+ :: MutableByteArray# RealWorld+ -> ByteArray#+ -> CSize+ -> IO ()++foreign import capi unsafe "hs_hashstring_base64.h hs_hashstring_base64Encode"+ c_base64Encode_bs_ba+ :: Ptr Word8+ -> ByteArray#+ -> CSize+ -> IO ()++foreign import capi unsafe "hs_hashstring_base64.h hs_hashstring_base64PadLength"+ c_base64PadLength_ba+ :: ByteArray#+ -> CSize+ -> CInt+--}
+ test/Main.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings, ViewPatterns #-}++module Main (main) where++import Data.Base16.Types+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as SB+import qualified Data.ByteString.Short.Base16 as SB+import Data.Function(on)+import Data.Text (Text)+import qualified Data.Text as T+import Crypto.HashString (HashString(..))+import qualified Crypto.HashString as HS++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck.Instances.ByteString()++main :: IO ()+main = defaultMain $ testGroup "toplevel" + [ testProperty "prop_compare" prop_compare+ , testProperty "prop_eq_refl" prop_eq_refl+ , testProperty "prop_compare_len" prop_compare_len+ , testProperty "prop_toShortBase16" prop_toShortBase16+ , testProperty "prop_fromShortBase16" prop_fromShortBase16+ , testProperty "prop_toBase16" prop_toBase16+ , testProperty "prop_fromBase16" prop_fromBase16+ ]++-- this should mostly exercise LT/GT, but not likely to exercise EQ or LT/GT determined by length, which we'll write other test cases for++prop_compare :: ShortByteString -> ShortByteString -> Bool+prop_compare as bs = compare as bs == (compare `on` HS.fromShort) as bs++prop_eq_refl :: ShortByteString -> Bool+prop_eq_refl (HS.fromShort -> bs) = bs == bs++prop_compare_len :: ShortByteString -> ShortByteString -> Bool+prop_compare_len as bs =+ SB.null bs+ || ( (compare `on` HS.fromShort) as abs == LT+ && (compare `on` HS.fromShort) abs as == GT )+ where+ abs = as <> bs++prop_toShortBase16 :: ShortByteString -> Bool+prop_toShortBase16 as = roundtrip as == Right as+ where+ roundtrip = SB.decodeBase16Untyped . HS.toShortBase16 . HS.fromShort++prop_fromShortBase16 :: ShortByteString -> Bool+prop_fromShortBase16 as = roundtrip as == Just as+ where+ roundtrip = fmap HS.toShort . HS.fromShortBase16 . extractBase16 . SB.encodeBase16'++prop_toBase16 :: ByteString -> Bool+prop_toBase16 as = roundtrip as == Right as+ where+ roundtrip = B.decodeBase16Untyped . HS.toBase16 . HS.fromByteString++prop_fromBase16 :: ByteString -> Bool+prop_fromBase16 as = roundtrip as == Just as+ where+ roundtrip = fmap HS.toByteString . HS.fromBase16 . extractBase16 . B.encodeBase16'