Initial commit

.gitignore

@@ -0,0 +1 @@
+.stack-work

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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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

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 }

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

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

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)

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