diff --git a/Crypto/Cipher/Types.hs b/Crypto/Cipher/Types.hs new file mode 100644 --- /dev/null +++ b/Crypto/Cipher/Types.hs @@ -0,0 +1,303 @@ +-- | +-- Module : Crypto.Cipher.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : Stable +-- Portability : Excellent +-- +-- symmetric cipher basic types +-- +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ExistentialQuantification #-} +module Crypto.Cipher.Types + ( + -- * Cipher classes + Cipher(..) + , BlockCipher(..) + , StreamCipher(..) + , DataUnitOffset + , AEAD(..) + , AEADState(..) + , AEADMode(..) + , AEADModeImpl(..) + -- * AEAD + , aeadAppendHeader + , aeadEncrypt + , aeadDecrypt + , aeadFinalize + , aeadSimpleEncrypt + , aeadSimpleDecrypt + -- * Key type and constructor + , Key + , makeKey + -- * Initial Vector type and constructor + , IV + , makeIV + , nullIV + , ivAdd + -- * Authentification Tag + , AuthTag(..) + ) where + +import Data.SecureMem +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Byteable +import Data.Word +import Data.Bits (shiftR, xor) +import Crypto.Cipher.Types.GF + +-- | Offset inside an XTS data unit, measured in block size. +type DataUnitOffset = Word32 + +-- | Symmetric cipher class. +class Cipher cipher where + -- | Initialize a cipher context from a key + cipherInit :: Key cipher -> cipher + -- | Cipher name + cipherName :: cipher -> String + -- | return the size of the key required for this cipher. + -- Some cipher accept any size for key + cipherKeySize :: cipher -> Maybe Int + +-- | Symmetric stream cipher class +class Cipher cipher => StreamCipher cipher where + -- | Encrypt using the stream cipher + streamEncrypt :: cipher -> ByteString -> (ByteString, cipher) + -- | Decrypt using the stream cipher + streamDecrypt :: cipher -> ByteString -> (ByteString, cipher) + +-- | Symmetric block cipher class +class Cipher cipher => BlockCipher cipher where + -- | Return the size of block required for this block cipher + blockSize :: cipher -> Int + + -- | Encrypt using the ECB mode. + -- + -- input need to be a multiple of the blocksize + ecbEncrypt :: cipher -> ByteString -> ByteString + -- | Decrypt using the ECB mode. + -- + -- input need to be a multiple of the blocksize + ecbDecrypt :: cipher -> ByteString -> ByteString + + -- | encrypt using the CBC mode. + -- + -- input need to be a multiple of the blocksize + cbcEncrypt :: cipher -> IV cipher -> ByteString -> ByteString + cbcEncrypt = cbcEncryptGeneric + -- | decrypt using the CBC mode. + -- + -- input need to be a multiple of the blocksize + cbcDecrypt :: cipher -> IV cipher -> ByteString -> ByteString + cbcDecrypt = cbcDecryptGeneric + + -- | combine using the CTR mode. + -- + -- CTR mode produce a stream of randomized data that is combined + -- (by XOR operation) with the input stream. + -- + -- encryption and decryption are the same operation. + -- + -- input can be of any size + ctrCombine :: cipher -> IV cipher -> ByteString -> ByteString + ctrCombine = ctrCombineGeneric + + -- | encrypt using the XTS mode. + -- + -- input need to be a multiple of the blocksize + xtsEncrypt :: (cipher, cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString + xtsEncrypt = xtsEncryptGeneric + -- | decrypt using the XTS mode. + -- + -- input need to be a multiple of the blocksize + xtsDecrypt :: (cipher, cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString + xtsDecrypt = xtsDecryptGeneric + + -- | Initialize a new AEAD State + -- + -- When Nothing is returns, it means the mode is not handled. + aeadInit :: Byteable iv => AEADMode -> cipher -> iv -> Maybe (AEAD cipher) + aeadInit _ _ _ = Nothing + +-- | AEAD Mode +data AEADMode = + AEAD_OCB + | AEAD_CCM + | AEAD_EAX + | AEAD_CWC + | AEAD_GCM + deriving (Show,Eq) + +-- | Authenticated Encryption with Associated Data algorithms +data AEAD cipher = AEAD cipher (AEADState cipher) + +-- | Wrapper for any AEADState +data AEADState cipher = forall st . AEADModeImpl cipher st => AEADState st + +-- | Class of AEAD Mode implementation +class BlockCipher cipher => AEADModeImpl cipher state where + aeadStateAppendHeader :: cipher -> state -> ByteString -> state + aeadStateEncrypt :: cipher -> state -> ByteString -> (ByteString, state) + aeadStateDecrypt :: cipher -> state -> ByteString -> (ByteString, state) + aeadStateFinalize :: cipher -> state -> Int -> AuthTag + +-- | Append associated data into the AEAD state +aeadAppendHeader :: BlockCipher a => AEAD a -> ByteString -> AEAD a +aeadAppendHeader (AEAD cipher (AEADState state)) bs = + AEAD cipher $ AEADState (aeadStateAppendHeader cipher state bs) + +-- | Encrypt input and append into the AEAD state +aeadEncrypt :: BlockCipher a => AEAD a -> ByteString -> (ByteString, AEAD a) +aeadEncrypt (AEAD cipher (AEADState state)) input = (output, AEAD cipher (AEADState nst)) + where (output, nst) = aeadStateEncrypt cipher state input + +-- | Decrypt input and append into the AEAD state +aeadDecrypt :: BlockCipher a => AEAD a -> ByteString -> (ByteString, AEAD a) +aeadDecrypt (AEAD cipher (AEADState state)) input = (output, AEAD cipher (AEADState nst)) + where (output, nst) = aeadStateDecrypt cipher state input + +-- | Finalize the AEAD state and create an authentification tag +aeadFinalize :: BlockCipher a => AEAD a -> Int -> AuthTag +aeadFinalize (AEAD cipher (AEADState state)) len = + aeadStateFinalize cipher state len + +-- | Simple AEAD encryption +aeadSimpleEncrypt :: BlockCipher a + => AEAD a -- ^ A new AEAD Context + -> B.ByteString -- ^ Optional Authentified Header + -> B.ByteString -- ^ Optional Plaintext + -> Int -- ^ Tag length + -> (AuthTag, B.ByteString) -- ^ Authentification tag and ciphertext +aeadSimpleEncrypt aeadIni header input taglen = (tag, output) + where aead = aeadAppendHeader aeadIni header + (output, aeadFinal) = aeadEncrypt aead input + tag = aeadFinalize aeadFinal taglen + +-- | Simple AEAD decryption +aeadSimpleDecrypt :: BlockCipher a + => AEAD a -- ^ A new AEAD Context + -> B.ByteString -- ^ Optional Authentified Header + -> B.ByteString -- ^ Optional Plaintext + -> AuthTag -- ^ Tag length + -> Maybe B.ByteString -- ^ Plaintext +aeadSimpleDecrypt aeadIni header input authTag + | tag == authTag = Just output + | otherwise = Nothing + where aead = aeadAppendHeader aeadIni header + (output, aeadFinal) = aeadDecrypt aead input + tag = aeadFinalize aeadFinal (byteableLength authTag) + +-- | a Key parametrized by the cipher +newtype Key c = Key SecureMem deriving (Eq) + +instance ToSecureMem (Key c) where + toSecureMem (Key sm) = sm +instance Byteable (Key c) where + toBytes (Key sm) = toBytes sm + +-- | an IV parametrized by the cipher +newtype IV c = IV ByteString deriving (Eq) + +instance Byteable (IV c) where + toBytes (IV sm) = sm + +-- | Authentification Tag for AE cipher mode +newtype AuthTag = AuthTag ByteString + deriving (Show) + +instance Eq AuthTag where + (AuthTag a) == (AuthTag b) = constEqBytes a b +instance Byteable AuthTag where + toBytes (AuthTag bs) = bs + +-- | Create an IV for a specified block cipher +makeIV :: (Byteable b, BlockCipher c) => b -> Maybe (IV c) +makeIV b = toIV undefined + where toIV :: BlockCipher c => c -> Maybe (IV c) + toIV cipher + | byteableLength b == sz = Just (IV $ toBytes b) + | otherwise = Nothing + where sz = blockSize cipher + +-- | Create an IV that is effectively representing the number 0 +nullIV :: BlockCipher c => IV c +nullIV = toIV undefined + where toIV :: BlockCipher c => c -> IV c + toIV cipher = IV $ B.replicate (blockSize cipher) 0 + +-- | Increment an IV by a number. +-- +-- Assume the IV is in Big Endian format. +ivAdd :: BlockCipher c => IV c -> Int -> IV c +ivAdd (IV b) i = IV $ snd $ B.mapAccumR addCarry i b + where addCarry :: Int -> Word8 -> (Int, Word8) + addCarry acc w + | acc == 0 = (0, w) + | otherwise = let (hi,lo) = acc `divMod` 256 + nw = lo + (fromIntegral w) + in (hi + (nw `shiftR` 8), fromIntegral nw) + +-- | Create a Key for a specified cipher +makeKey :: (ToSecureMem b, Cipher c) => b -> Maybe (Key c) +makeKey b = toKey undefined (toSecureMem b) + where toKey :: Cipher c => c -> SecureMem -> Maybe (Key c) + toKey cipher sm = + case cipherKeySize cipher of + Nothing -> Just $ Key sm + Just sz | sz == byteableLength sm -> Just $ Key sm + | otherwise -> Nothing + +cbcEncryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString +cbcEncryptGeneric cipher (IV ivini) input = B.concat $ doEnc ivini $ chunk (blockSize cipher) input + where doEnc _ [] = [] + doEnc iv (i:is) = + let o = ecbEncrypt cipher $ bxor iv i + in o : doEnc o is + +cbcDecryptGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString +cbcDecryptGeneric cipher (IV ivini) input = B.concat $ doDec ivini $ chunk (blockSize cipher) input + where doDec _ [] = [] + doDec iv (i:is) = + let o = bxor iv $ ecbDecrypt cipher i + in o : doDec i is + +ctrCombineGeneric :: BlockCipher cipher => cipher -> IV cipher -> ByteString -> ByteString +ctrCombineGeneric cipher ivini input = B.concat $ doCnt ivini $ chunk (blockSize cipher) input + where doCnt _ [] = [] + doCnt iv (i:is) = + let ivEnc = ecbEncrypt cipher (toBytes iv) + in bxor i ivEnc : doCnt (ivAdd iv 1) is + +xtsEncryptGeneric :: BlockCipher cipher => (cipher,cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString +xtsEncryptGeneric = xtsGeneric ecbEncrypt + +xtsDecryptGeneric :: BlockCipher cipher => (cipher,cipher) -> IV cipher -> DataUnitOffset -> ByteString -> ByteString +xtsDecryptGeneric = xtsGeneric ecbDecrypt + +xtsGeneric :: BlockCipher cipher + => (cipher -> B.ByteString -> B.ByteString) + -> (cipher,cipher) + -> IV cipher + -> DataUnitOffset + -> ByteString + -> ByteString +xtsGeneric f (cipher, tweakCipher) iv sPoint input = B.concat $ doXts iniTweak $ chunk (blockSize cipher) input + where encTweak = ecbEncrypt tweakCipher (toBytes iv) + iniTweak = iterate xtsGFMul encTweak !! fromIntegral sPoint + doXts _ [] = [] + doXts tweak (i:is) = + let o = bxor (f cipher $ bxor i tweak) tweak + in o : doXts (xtsGFMul tweak) is + + +chunk :: Int -> ByteString -> [ByteString] +chunk sz bs = split bs + where split b | B.length b <= sz = [b] + | otherwise = + let (b1, b2) = B.splitAt sz b + in b1 : split b2 + +bxor :: ByteString -> ByteString -> ByteString +bxor src dst = B.pack $ B.zipWith xor src dst diff --git a/Crypto/Cipher/Types/GF.hs b/Crypto/Cipher/Types/GF.hs new file mode 100644 --- /dev/null +++ b/Crypto/Cipher/Types/GF.hs @@ -0,0 +1,49 @@ +-- | +-- Module : Crypto.Cipher.Types.GF +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : Stable +-- Portability : Excellent +-- +-- Slow Galois Field arithmetic for generic XTS and GCM implementation +-- +module Crypto.Cipher.Types.GF + ( + -- * XTS support + xtsGFMul + ) where + +import Control.Applicative +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B +import Data.Byteable +import Foreign.Storable +import Foreign.Ptr +import Data.Word +import Data.Bits + +-- block size need to be 128 bits. +-- +-- FIXME: add support for big endian. +xtsGFMul :: ByteString -> ByteString +xtsGFMul b + | B.length b == 16 = B.unsafeCreate (B.length b) $ \dst -> + withBytePtr b $ \src -> do + (hi,lo) <- gf <$> peek (castPtr src) <*> peek (castPtr src `plusPtr` 8) + poke (castPtr dst) lo + poke (castPtr dst `plusPtr` 8) hi + | otherwise = error "unsupported block size in GF" + where gf :: Word64 -> Word64 -> (Word64, Word64) + gf srcLo srcHi = + ((if carryLo then (.|. 1) else id) (srcHi `shiftL` 1) + ,(if carryHi then xor 0x87 else id) $ (srcLo `shiftL` 1) + ) + where carryHi = srcHi `testBit` 63 + carryLo = srcLo `testBit` 63 +{- + const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL); + uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0); + a->q[1] = cpu_to_le64((le64_to_cpu(a->q[1]) << 1) | (a->q[0] & gf_mask ? 1 : 0)); + a->q[0] = cpu_to_le64(le64_to_cpu(a->q[0]) << 1) ^ r; +-} diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2013 Vincent Hanquez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +crypto-cipher-types +=================== + +Documentation: [crypto-cipher-types on hackage](http://hackage.haskell.org/package/crypto-cipher-types) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/crypto-cipher-types.cabal b/crypto-cipher-types.cabal new file mode 100644 --- /dev/null +++ b/crypto-cipher-types.cabal @@ -0,0 +1,45 @@ +Name: crypto-cipher-types +Version: 0.0.1 +Synopsis: Generic cryptography cipher types +Description: Generic cryptography cipher types +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: vincent@snarc.org +Category: Cryptography +Stability: experimental +Build-Type: Simple +Homepage: http://github.com/vincenthz/hs-crypto-cipher +Cabal-Version: >=1.8 +data-files: README.md + +Library + Exposed-modules: Crypto.Cipher.Types + Other-modules: Crypto.Cipher.Types.GF + Build-depends: base >= 4 && < 5 + , bytestring + , byteable >= 0.1.1 + , securemem >= 0.1.1 + ghc-options: -Wall -fwarn-tabs + +Test-Suite test-crypto-cipher-types + type: exitcode-stdio-1.0 + hs-source-dirs: tests ../tests + Main-is: Tests.hs + Build-Depends: base >= 3 && < 5 + , bytestring + , byteable + , crypto-cipher-types + , mtl + , QuickCheck >= 2 + , HUnit + , test-framework + , test-framework-quickcheck2 + , test-framework-hunit + ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures + +source-repository head + type: git + location: git://github.com/vincenthz/hs-crypto-cipher + subdir: types diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ViewPatterns #-} +module Main where + +import Test.Framework (defaultMain) +import Crypto.Cipher.Types +import Crypto.Cipher.Tests +import qualified Data.ByteString as B +import Data.Bits (xor) + +-- | the XOR cipher is so awesome that it doesn't need any key or state. +data XorCipher = XorCipher + +instance Cipher XorCipher where + cipherInit _ = XorCipher + cipherName _ = "xor" + cipherKeySize _ = Just 0 + +instance BlockCipher XorCipher where + blockSize _ = 16 + ecbEncrypt _ b = B.pack $ B.zipWith xor (B.replicate (B.length b) 0xa5) b + ecbDecrypt _ b = B.pack $ B.zipWith xor (B.replicate (B.length b) 0xa5) b + +tests = testBlockCipher defaultKATs (undefined :: XorCipher) + +main = defaultMain [tests]