chunked-crypto/src/Crypto/Chunked.hs

{- |
Functions for encrypting and decrypting long data.

Given a stream cypher and a chunk size,the functions on
this module encrypt long data in a way that requires
constant memory and permits random access to the chunks.

The encryption and decryption operations return lazy data
and lists of encryption errors. Those lists should not
be consumed before the data, as that would cause the
evaluation of all data, and its consequent store on the
memory.

The presence of any error on the error list
invalidates the list equivalent chunk and every subsequent
one. The errors are returned in the form of an either-like
monad, what permits validation of the operation with a
"sequence" call. (Just consume the data first!)
-}
module Crypto.Chunked (
  ChunkedCrypto(..),
  encrypt,
  decrypt
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Bits
import Data.Int
import Data.Word8
import Crypto.Error

import Debug.Trace

type Nonce = ByteString

-- | A set of encryption programs
data ChunkedCrypto = ChunkedCrypto {
  encryptGen :: Nonce -> ByteString -> CryptoFailable ByteString,
  decryptGen :: Nonce -> ByteString -> CryptoFailable ByteString,
  plainSize :: Int64,
  encryptedSize :: Int64
  }

encrypt ::
  -- | The algorithm used
  ChunkedCrypto ->
  -- | The nonce for this operation
  Nonce ->
  -- | The chunk index (starting at 0) of the start of the data.
  --   If reading from the begining of the data, use 0.
  Int64 ->
  -- | Data to be encrypted.
  LBS.ByteString ->
  (LBS.ByteString, [CryptoFailable ()])
encrypt _ _ _ t | LBS.null t = (LBS.empty, [])
encrypt algo nonce firstChunk plainText = let
  (d, dd) = LBS.splitAt (fromIntegral . plainSize $ algo) plainText
  cyp = encryptGen algo $ mixNonce firstChunk nonce
  (ct, st) = case cyp . LBS.toStrict $ d of
    CryptoPassed txt -> (txt, CryptoPassed ())
    CryptoFailed e -> (BS.empty, CryptoFailed e)
  (cct, sst) = encrypt algo nonce (firstChunk+1) dd
  in trace (show . LBS.length $ d) (LBS.append (LBS.fromStrict ct) cct, st:sst) 

decrypt ::
  -- | The algorithm used
  ChunkedCrypto ->
  -- | The nonce for this operation
  Nonce ->
  -- | The chunk index (starting at 0) of the start of the data.
  --   If reading from the begining of the data, use 0.
  Int64 ->
  -- | Encrypted data to be decrypted
  LBS.ByteString ->
  (LBS.ByteString, [CryptoFailable ()])
decrypt _ _ _ t | LBS.null t = (LBS.empty, [])
decrypt algo nonce firstChunk plainText = let
  (d, dd) = LBS.splitAt (fromIntegral . encryptedSize $ algo) plainText
  dec = decryptGen algo $ mixNonce firstChunk nonce
  (pt, st) = case dec . LBS.toStrict $ d of
    CryptoPassed txt -> (txt, CryptoPassed ())
    CryptoFailed e -> (BS.empty, CryptoFailed e)
  (ppt, sst) = decrypt algo nonce (firstChunk+1) dd
  in trace (show . LBS.length $ d) (LBS.append (LBS.fromStrict pt) ppt, st:sst)

toBytes :: Integral a => a -> [Word8]
toBytes x
  | x <= 0 = []
  | otherwise = fromIntegral (mod x 256) : toBytes (div x 256)
xorlist :: [Word8] -> [Word8] -> [Word8]
xorlist [] n = n
xorlist _ [] = [] -- Must preserve nonce length
xorlist (c:cc) (n:nn) = xor c n : xorlist cc nn
mixNonce c n = BS.pack $ xorlist (toBytes c) (BS.unpack n)