diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c1d9b4c --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.stack-work \ No newline at end of file diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..bdaac4f --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Samuel Protas (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Samuel Protas nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..e69de29 diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Crypto/TripleSec.hs b/src/Crypto/TripleSec.hs new file mode 100644 index 0000000..ed9f972 --- /dev/null +++ b/src/Crypto/TripleSec.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +module Crypto.TripleSec + ( -- Types + TripleSec + + -- Exception Types + , TripleSecException (..) + , DecryptionFailureType (..) + + -- API + , encrypt + , decrypt + + -- Lower level API + , newCipher + , newCipherWithSalt + , encryptWithCipher + , decryptWithCipher + + -- Low level utils + , checkPrefix + , checkSalt + , checkCipher + ) where + +import Data.Maybe +import Data.Monoid ((<>)) +import Control.Monad (when) + +import Control.Exception.Safe +import qualified Crypto.Cipher.XSalsa as XSalsa +import qualified Crypto.KDF.Scrypt as Scrypt +import Crypto.Random +import Crypto.Cipher.Types (ctrCombine, makeIV) +import Crypto.Hash.Algorithms (SHA512, Keccak_512) +import Crypto.MAC.HMAC + +import Crypto.TripleSec.Internal (ByteArray, convert) +import qualified Crypto.TripleSec.Internal as I +import Crypto.TripleSec.Constants +import Crypto.TripleSec.Types +import Crypto.TripleSec.Utils + + +encrypt :: (ByteArray ba, MonadThrow m, MonadRandom m) => ba -> ba -> m ba +encrypt pass plaintext = do + cipher <- newCipher pass + encryptWithCipher cipher plaintext + +decrypt :: (ByteArray ba, MonadThrow m) => ba -> ba -> m ba +decrypt pass cipherText = do + (prefix, providedSalt, lessPrefix) <- checkPrefix cipherText + decryptor <- newCipherWithSalt pass providedSalt + decryptCommon decryptor prefix lessPrefix + +newCipher :: (ByteArray ba, MonadThrow m, MonadRandom m) => ba -> m (TripleSec ba) +newCipher pass = do + salt <- getRandomBytes saltLen + newCipherWithSalt pass salt + +newCipherWithSalt :: (ByteArray ba, MonadThrow m) => ba -> ba -> m (TripleSec ba) +newCipherWithSalt pass salt = do + checkSalt salt + when (I.length pass == 0) $ throw ZeroLengthPassword + let dk = Scrypt.generate paramsScrypt pass salt + let macKeys =I.take (macKeyLen * 2) dk + let sha512Key = I.take macKeyLen macKeys + let keccak512Key = I.drop macKeyLen macKeys + let cipherKeys = I.drop (macKeyLen * 2) dk + let aesKey = I.take cipherKeyLen cipherKeys + let twoFishKey = I.take cipherKeyLen $ I.drop cipherKeyLen cipherKeys + let xSalsaKey = I.drop (cipherKeyLen * 2) cipherKeys + twoFishCipher <- cipherInitOrPanic twoFishKey + aesCipher <- cipherInitOrPanic aesKey + return TripleSec { passwordSalt = salt + , hmacKeccak512 = convert . (hmac keccak512Key :: ByteArray ba => ba -> HMAC Keccak_512) + , hmacSHA512 = convert . (hmac sha512Key :: ByteArray ba => ba -> HMAC SHA512) + , aes = aesCipher + , twoFish = twoFishCipher + , xSalsa = xSalsaKey } + +encryptWithCipher :: (ByteArray ba, MonadThrow m, MonadRandom m) => TripleSec ba -> ba -> m ba +encryptWithCipher cipher plaintext = do + when (I.length plaintext == 0) $ throw ZeroLengthPlaintext + let prefix = packedMagicBytes <> packedVersionBytes <> passwordSalt cipher + ivs <- getRandomBytes totalIvLen + let (aesIv, lessAesIv) = I.splitAt ivLen ivs + let (twoFishIv, xSalsaIv) = I.splitAt ivLen lessAesIv + let xSalsaCipher = XSalsa.initialize 20 (xSalsa cipher) xSalsaIv + let xSalsaEncrypted = xSalsaIv <> xSalsaCombine xSalsaCipher plaintext + let twoFishEncrypted = twoFishIv <> ctrCombine (twoFish cipher) (fromJust $ makeIV twoFishIv) xSalsaEncrypted + let aesEncrypted = aesIv <> ctrCombine (aes cipher) (fromJust $ makeIV aesIv) twoFishEncrypted + let sha3HMACed = hmacKeccak512 cipher $ prefix <> aesEncrypted + let sha512HMACed = hmacSHA512 cipher $ prefix <> aesEncrypted + return $ + prefix <> + sha512HMACed <> + sha3HMACed <> + aesEncrypted + +decryptWithCipher :: (ByteArray ba, MonadThrow m) => TripleSec ba -> ba -> m ba +decryptWithCipher cipher cipherText = do + (prefix, providedSalt, lessPrefix) <- checkPrefix cipherText + checkCipher cipher providedSalt + decryptCommon cipher prefix lessPrefix + +decryptCommon :: (ByteArray ba, MonadThrow m) => TripleSec ba -> ba -> ba -> m ba +decryptCommon cipher prefix macsAndEncrypted = do + let (providedSHA512, lessSHA512) = I.splitAt macOutputLen macsAndEncrypted + let (providedSHA3, encryptedPayload) = I.splitAt macOutputLen lessSHA512 + let toMac = prefix <> encryptedPayload + when (providedSHA512 /= hmacSHA512 cipher toMac) $ throw $ DecryptionFailure InvalidSha512Hmac + when (providedSHA3 /= hmacKeccak512 cipher toMac) $ throw $ DecryptionFailure InvalidSha3Hmac + let (aesIV, lessAESiv) = I.splitAt ivLen encryptedPayload + let aesDecrypted = ctrCombine (aes cipher) (fromJust $ makeIV aesIV) lessAESiv + let (twoFishIV, lessTwoFishIv) = I.splitAt ivLen aesDecrypted + let twoFishDecrypted = ctrCombine (twoFish cipher) (fromJust $ makeIV twoFishIV) lessTwoFishIv + let (xSalsaIV, lessXSalsaIV) = I.splitAt salsaIvLen twoFishDecrypted + + return $ xSalsaCombine (initXSalsa (xSalsa cipher) xSalsaIV) lessXSalsaIV diff --git a/src/Crypto/TripleSec/Constants.hs b/src/Crypto/TripleSec/Constants.hs new file mode 100644 index 0000000..45ea7f9 --- /dev/null +++ b/src/Crypto/TripleSec/Constants.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DuplicateRecordFields #-} +module Crypto.TripleSec.Constants where + +import Data.Word + +import qualified Crypto.KDF.Scrypt as Scrypt + +import qualified Crypto.TripleSec.Internal as I +import Crypto.TripleSec.Internal (ByteArray) + + +magicBytes :: [Word8] +magicBytes = [0x1c, 0x94, 0xd7, 0xde] + +packedMagicBytes :: ByteArray ba => ba +packedMagicBytes = I.pack magicBytes + +versionBytes :: [Word8] +versionBytes = [0x00, 0x00, 0x00, 0x03] + +packedVersionBytes :: ByteArray ba => ba +packedVersionBytes = I.pack versionBytes + +saltLen, macOutputLen, macKeyLen, cipherKeyLen, ivLen, salsaIvLen, totalIvLen, dkLen, overhead :: Int + +saltLen = 16 +macOutputLen = 64 +macKeyLen = 48 +cipherKeyLen = 32 +ivLen = 16 +salsaIvLen = 24 +totalIvLen = 2 * ivLen + salsaIvLen +dkLen = 2 * macKeyLen + 3 * cipherKeyLen + +overhead = length magicBytes + length versionBytes + saltLen + 2 * macOutputLen + totalIvLen + +paramsScrypt :: Scrypt.Parameters +paramsScrypt = Scrypt.Parameters { n = (2 :: Word64) ^ (15 :: Word64) + , r = 8 + , p = 1 + , outputLength = dkLen } diff --git a/src/Crypto/TripleSec/Internal.hs b/src/Crypto/TripleSec/Internal.hs new file mode 100644 index 0000000..0683ddc --- /dev/null +++ b/src/Crypto/TripleSec/Internal.hs @@ -0,0 +1,7 @@ +module Crypto.TripleSec.Internal ( + module Export + ) where + +import Data.ByteArray as Export +import Data.ByteArray.Mapping as Export +import Data.ByteArray.Encoding as Export diff --git a/src/Crypto/TripleSec/Types.hs b/src/Crypto/TripleSec/Types.hs new file mode 100644 index 0000000..4e5488e --- /dev/null +++ b/src/Crypto/TripleSec/Types.hs @@ -0,0 +1,29 @@ +module Crypto.TripleSec.Types where + +import Control.Exception.Safe +import Crypto.Cipher.Twofish (Twofish256) +import Crypto.Cipher.AES (AES256) + +data TripleSec ba = TripleSec { passwordSalt :: ba + , hmacKeccak512 :: ba -> ba + , hmacSHA512 :: ba -> ba + , aes :: AES256 + , twoFish :: Twofish256 + , xSalsa :: ba } + +data TripleSecException = DecryptionFailure DecryptionFailureType + | ZeroLengthPlaintext + | ZeroLengthPassword + | MisMatchedCipherSalt + | InvalidSaltLength + | TripleSecPanic String + deriving (Show, Typeable, Eq) + +data DecryptionFailureType = InvalidCipherTextLength + | InvalidMagicBytes + | InvalidVersion + | InvalidSha512Hmac + | InvalidSha3Hmac + deriving (Show, Eq) + +instance Exception TripleSecException diff --git a/src/Crypto/TripleSec/Utils.hs b/src/Crypto/TripleSec/Utils.hs new file mode 100644 index 0000000..e7fab89 --- /dev/null +++ b/src/Crypto/TripleSec/Utils.hs @@ -0,0 +1,56 @@ + +module Crypto.TripleSec.Utils where + +import Data.Monoid ((<>)) +import Control.Monad (when) + +import Control.Exception.Safe +import Crypto.Error +import Crypto.Cipher.Types hiding (Cipher) +import qualified Crypto.Cipher.XSalsa as XSalsa + +import Crypto.TripleSec.Internal (ByteArray) +import qualified Crypto.TripleSec.Internal as I +import Crypto.TripleSec.Types +import Crypto.TripleSec.Constants + + +panic :: (Show e, MonadThrow m) => e -> m b +panic = throw . TripleSecPanic . show + +cipherInitOrPanic :: (ByteArray ba, MonadThrow m, BlockCipher c) => ba -> m c +cipherInitOrPanic key = case cipherInit key of CryptoFailed err -> panic err + CryptoPassed cipher -> return cipher + +initXSalsa :: ByteArray ba => ba -> ba -> XSalsa.State +initXSalsa = XSalsa.initialize 20 + +xSalsaCombine :: ByteArray ba => XSalsa.State -> ba -> ba +xSalsaCombine state input = output + where (output, _) = XSalsa.combine state input + +checkCipher :: (ByteArray ba, MonadThrow m) => TripleSec ba -> ba -> m () +checkCipher cipher providedSalt = when (providedSalt /= passwordSalt cipher) (throw MisMatchedCipherSalt) + +checkPrefix :: (ByteArray ba, MonadThrow m) => ba -> m (ba, ba, ba) +checkPrefix cipherText = checkLength cipherText >> checkMagicBytes cipherText >>= checkVersionBytes + +checkSalt :: (ByteArray ba, MonadThrow m) => ba -> m () +checkSalt salt = when (I.length salt /= saltLen) $ throw InvalidSaltLength + +checkLength :: (ByteArray ba, MonadThrow m) => ba -> m () +checkLength cipherText = when (I.length cipherText <= overhead) $ throw $ DecryptionFailure InvalidCipherTextLength + +checkMagicBytes :: (ByteArray ba, MonadThrow m) => ba -> m (ba, ba) +checkMagicBytes cipherText = do + let (providedMagicBytes, lessMagicBytes) = I.splitAt (length magicBytes) cipherText + when (providedMagicBytes /= packedMagicBytes) $ throw $ DecryptionFailure InvalidMagicBytes + return (providedMagicBytes, lessMagicBytes) + +checkVersionBytes :: (ByteArray ba, MonadThrow m) => (ba, ba) -> m (ba, ba, ba) +checkVersionBytes (providedMagicBytes, lessMagicBytes) = do + let (providedVersionBytes, lessVersion) = I.splitAt (length versionBytes) lessMagicBytes + when (providedVersionBytes /= packedVersionBytes) $ throw $ DecryptionFailure InvalidVersion + let (providedSalt, lessPrefix) = I.splitAt saltLen lessVersion + let prefix = providedMagicBytes <> providedVersionBytes <> providedSalt + return (prefix, providedSalt, lessPrefix) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..b7f8641 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,71 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-8.2 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +- location: + git: https://github.com/haskell-crypto/cryptonite.git + commit: 4f988181c7e2f875938b9c1d3c61c0ab70997bf2 + extra-dep: true + +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: [] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.2" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor \ No newline at end of file diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 index 0000000..73f02dc --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import Test.QuickCheck.Monadic as QC +import Data.ByteString (ByteString) +import qualified Data.ByteString as B + +import Utils + +import Crypto.TripleSec + + +main = defaultMain $ testGroup "triplesec" [katTests, knownFailures, properties] + +katTests :: TestTree +katTests = testGroup "Decryption KATs" $ makeKatTestTree <$> zip kats [1..] + +kats :: [(Password, PlainText, HexEncodedCipherText)] +kats = [ -- https://github.com/keybase/go-triplesec/blob/master/triplesec_test.go + ("42", "ciao", "1c94d7de0000000359a5e5d60f09ebb6bc3fdab6642725e03bc3d51e167fa60327df567476d467f8b6ce65a909b4f582443f230ff10a36f60315ebce1cf1395d7b763c768764207f4f4cc5207a21272f3a5542f35db73c94fbc7bd551d4d6b0733e0b27fdf9606b8a26d45c4b79818791b6ae1ad34c23e58de482d454895618a1528ec722c5218650f8a2f55f63a6066ccf875f46c9b68ed31bc1ddce8881d704be597e1b5006d16ebe091a02e24d569f3d09b0578d12f955543e1a1f1dd75784b8b4cba7ca0bb7044389eb6354cea628a21538d") + + -- https://github.com/keybase/python-triplesec/blob/master/triplesec/test/vectors.json + , (B.pack [0x74,0x68,0x69,0x73,0x20,0x62,0x65,0x20,0x74,0x68,0x65,0x20,0x70,0x61,0x73,0x73,0x77,0x6f,0x72,0x64],"this be the secret message -> this be the secret message -> this be the secret message -> this be the secret message -> this be the secret message -> this be the secret message", "1c94d7de00000003bd202d905238954eab386b1c8500de93847378e0791793d0c31625f9a7cf7af6ed75abaa248edabe103408ce65a8ada16186a8d08982b82397b59250c7e40b4db3e0f3e4abd4a351fc71799dd23b2c2027d45a311019cc5bcdcbf1978b068e107f53d26aa92c0ff00707754f3e31084fc2a1923c2733f72eb6bafd88784eb8e8b9a30b9f9e049be390c8dd24981ccbeaa448198494c662db397ff561182c25a1c62b279984d4cf3528ddf9215aa1a7acbbc83a2ef868d902593491dd34bf397d06c3bbecafa9eaacd9861b4ffd54fd86d7a69369646a25d2ba12afb80ca43026fd146b1d018bbb8e93f4e5e35f7e10bfe5ba5c7ee3ae5828a47902e0abd6bfdd3599c752f59aa2a3076da38ebe33818c96d5df3476918ec5d218da3cda2aff760ccf4f28e8fe5cc55f50fc1b7abf58039425303d6da2de01a355fa3fc54d285cc194b53e53b82063e3ee0e6d04ef727fda6312986c53067341a33d89ff1fafcfe04688f3e4dea13604c6c2bc3ef7a0cd9e416ced1e2d1a25") + , ("ANNA", "=)", "1c94d7de00000003d0c87b785a9daf6d25776df2d3f9a5d9a0b08e186ecebc2dc20c02a077ecde9e7a6f4cf705c45729d1dbd8f07acf94b6d756336265991b209ee94c57059699b06846506a043837463f594eb922660ee48f5c2a4de14ee4de70d5004668a84e396e2123a8a7de9fde35ccbcb58fdbb5b624cb67adfac29a9c0ccb67e09675da2bdf1cb47646822bfd5ac1e0887cc23e5e0c4866a9bdab3d4ab4ca394f7e1d0acb6697b477e1feae0d9faf1da42ef49f1a311e5ef7cbe2cf347d7e52d83fc18943cecfb0c310881799cff0") + , (B.pack [0xaa,0xbb,0xcc,0xee], B.pack [0x11,0x00,0xaa,0xbb,0xee], "1c94d7de00000003b0c835fe415bd9534bbb614952d2b373367d8a0f664ee0d791152f632d15a9aadef9d4ba6cbc1db87d5cee3e5a26b3209f2a653e83eac1c05a9ad10d4b29b465db35326268231f4f085aa2b0977c2cd5a8a80a93bcd1dec495be59a01f79a2e6b14ca4088ebb2a617fee688b1b0765339eaf8719276270c4b2f3c5753fb273df5e257d6caddc026ffec7ab4df4e8a77d124f5cd7ef4b77e2daeb1affb47d5f249c3a7fd27fac639d6c43c648129176b6c664396d7c8130513be61a4028cdfe573012e36c91edf5b661e294d53c") ] + +properties :: TestTree +properties = localOption (QuickCheckTests 10) $ testGroup "Properties" + [ testProperty "encrypt password plaintext >>= decrypt password == return plaintext" $ + \(NonEmptyByteString plaintext, NonEmptyByteString password) -> monadicIO $ do + cycledPlaintext <- run (decrypt password =<< encrypt password plaintext) + QC.assert $ plaintext == cycledPlaintext, + testProperty "encryptWithCipher cipher plaintext >>= decryptWithCipher cipher == return plaintext" $ + \(NonEmptyByteString plaintext, NonEmptyByteString password) -> monadicIO $ do + cipher <- run (newCipher password) + cycledPlaintext <- run (decryptWithCipher cipher =<< encryptWithCipher cipher plaintext) + QC.assert $ plaintext == cycledPlaintext + ] + +knownFailures :: TestTree +knownFailures = testGroup "Known Failures" + [ testCase "Test zero-length plaintext failure" $ + assertException ZeroLengthPlaintext (encrypt "password" "" :: IO ByteString), + testCase "Test zero-length password failure" $ + assertException ZeroLengthPassword (encrypt "" "super secret message" :: IO ByteString), + testCase "Test invalid salt length" $ + assertException InvalidSaltLength (newCipherWithSalt "password" "too-short" :: IO (TripleSec ByteString)), + testCase "Test mismatched cipher failure" $ + assertException MisMatchedCipherSalt $ do + let password = "password" :: ByteString + cipherA <- newCipherWithSalt password (B.replicate 16 0xA :: ByteString) + cipherB <- newCipherWithSalt password (B.replicate 16 0xB :: ByteString) + encrypted <- encryptWithCipher cipherA "plaintext" + _ <- decryptWithCipher cipherB encrypted + return (), + testCase "Test wrong decryption password" $ + assertException (DecryptionFailure InvalidSha512Hmac) + (encrypt "password" "secret message" >>= decrypt "wrong passwrod" :: IO ByteString)] + diff --git a/tests/Utils.hs b/tests/Utils.hs new file mode 100644 index 0000000..219fa19 --- /dev/null +++ b/tests/Utils.hs @@ -0,0 +1,40 @@ +module Utils where + +import Control.Monad (guard) +import Data.Monoid ((<>)) + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteArray.Encoding +import Control.Exception + +import Crypto.TripleSec + + +type Password = ByteString +type PlainText = ByteString +type HexEncodedCipherText = ByteString + +newtype NonEmptyByteString = NonEmptyByteString ByteString deriving Show + +instance Arbitrary NonEmptyByteString where + arbitrary = suchThat (NonEmptyByteString <$> arbitrary) (\(NonEmptyByteString generated) -> B.length generated >= 1) + +instance Arbitrary ByteString where + arbitrary = B.pack `fmap` arbitrary + +makeKatTestTree :: ((Password, PlainText, HexEncodedCipherText), Int) -> TestTree +makeKatTestTree ((pw, expected, hex), ind) = testCase ("KAT #" <> show ind) $ do + let (Right raw) = convertFromBase Base16 hex + decrypted <- decrypt pw raw + expected @=? decrypted + +assertException :: (Exception e, Eq e) => e -> IO a -> IO () +assertException ex action = + handleJust isWanted (const $ return ()) $ do + _ <- action + assertFailure $ "Expected exception: " ++ show ex + where isWanted = guard . (== ex) \ No newline at end of file diff --git a/triplesec.cabal b/triplesec.cabal new file mode 100644 index 0000000..fd5e507 --- /dev/null +++ b/triplesec.cabal @@ -0,0 +1,51 @@ +name: triplesec +version: 0.1.0.0 +synopsis: TripleSec is a simple, triple-paranoid, symmetric encryption library +description: +homepage: https://github.com/SamProtas/triplesec#readme +license: MIT +license-file: LICENSE +author: Sam Protas +maintainer: sam.protas@gmail.com +copyright: 2017 Samuel Protas +category: Cryptography +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Crypto.TripleSec + other-modules: Crypto.TripleSec.Internal + Crypto.TripleSec.Constants + Crypto.TripleSec.Types + Crypto.TripleSec.Utils + build-depends: base >= 4.7 && < 5 + , cryptonite + , bytestring + , memory >= 0.12 + , binary + , safe-exceptions + , transformers + ghc-options: -Wall -fwarn-tabs -fno-warn-unused-imports -fno-warn-missing-signatures + default-language: Haskell2010 + +Test-Suite test-triplesec + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Tests.hs + other-modules: Utils + build-depends: base >= 3 && < 5 + , tasty + , tasty-quickcheck + , QuickCheck + , tasty-hunit + , triplesec + , bytestring + , memory >= 0.12 + ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -threaded + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/githubuser/triplesec