Initial version

.gitignore

@@ -0,0 +1,9 @@
+dist/
+.cabal-sandbox/
+cabal.sandbox.config
+*~
+*.[ao]
+**/*~
+**/*.[ao]
+
+

LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2016 Marcos Dumay de Medeiros
+
+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.

Setup.hs

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

chunked-crypto.cabal

@@ -0,0 +1,49 @@
+-- Initial chunked-crypto.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                chunked-crypto
+version:             0.1.0.0
+-- synopsis:            
+-- description:         
+homepage:            https://sealgram.com/git/haskell/chunked-crypto
+license:             MIT
+license-file:        LICENSE
+author:              Marcos Dumay de Medeiros
+maintainer:          marcos@marcosdumay.com
+-- copyright:           
+category:            System
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+library
+  exposed-modules:
+    Crypto.Chunked,
+    Crypto.ChunkedAlgorithms
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:
+    base >=4.7 && <4.8,
+    word8 >= 0.1 && <0.2,
+    bytestring >=0.10 && <0.11,
+    memory >=0.10 && <0.11,
+    cryptonite >=0.10 && <0.11
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+Test-suite roundtrips
+  type: detailed-0.9
+  test-module: RoundTrips
+  hs-source-dirs:
+    test
+  build-depends:
+    base >=4.7 && <5.0,
+    Cabal >= 1.9.2,
+    bytestring >=0.10 && <1.0,
+    cryptonite >=0.10 && <0.11,
+    chunked-crypto
+  other-modules:
+    Base
+  ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded
+  default-language: Haskell2010
+

src/Crypto/Chunked.hs

@@ -0,0 +1,96 @@
+{- |
+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)

src/Crypto/ChunkedAlgorithms.hs

@@ -0,0 +1,45 @@
+module Crypto.ChunkedAlgorithms where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteArray as BA
+
+import Crypto.Chunked
+import Crypto.Error
+
+import qualified Crypto.Cipher.ChaChaPoly1305 as ChaP
+
+{- |
+Constructs a ChunkedCrypto based on the ChaChaPoly1305 primitive.
+
+No authenticated data is used, and chunk authentication is concatenated
+to the begining of the chunk.
+-}
+chunkedChaChaPoly1305 ::
+  -- | Plain text block size
+  Int ->
+  -- | Encryption key
+  ByteString ->
+  ChunkedCrypto
+chunkedChaChaPoly1305 s k = ChunkedCrypto enc dec (fromIntegral s) (fromIntegral s + auth_size)
+  where
+    auth_size = 16
+    enc = \nonce dt -> do
+      n <- ChaP.nonce12 nonce
+      st0 <- ChaP.initialize k n
+      let st1 = ChaP.finalizeAAD st0
+      let (out, st2) = ChaP.encrypt dt st1
+      let auth = BA.convert $ ChaP.finalize st2
+      return $ BS.append auth out
+    dec = \nonce dt' -> do
+      let (auth, dt) = BS.splitAt 16 dt'
+      n <- ChaP.nonce12 nonce
+      st0 <- ChaP.initialize k n
+      let st1 = ChaP.finalizeAAD st0
+      let (out, st2) = ChaP.decrypt dt st1
+      let auth' = BA.convert $ ChaP.finalize st2
+      if auth == auth'
+        then return out
+        else CryptoFailed CryptoError_MacKeyInvalid
+
+      

test/Base.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Base (simpleTest) where
+
+import Distribution.TestSuite
+
+simpleTest :: String -> IO Progress -> Test
+simpleTest n t = 
+  let test = TestInstance
+        {run = t,
+         name = n,
+         tags = [],
+         options = [],
+         setOption = \_ _ -> Right test
+        }
+  in Test test

test/RoundTrips.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module RoundTrips (tests) where
+
+import Distribution.TestSuite
+import Base (simpleTest)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.Char8 as C8
+import qualified Data.ByteString.Char8 as SC8
+
+import Crypto.Error
+import Crypto.Chunked
+import Crypto.ChunkedAlgorithms
+
+tests :: IO [Test]
+tests = return [
+  simpleTest "Check MAC size" checkMacSize,
+  simpleTest "Good round trip" goodRoundTrip,
+  simpleTest "Auth error" authError
+  ]
+
+testKey :: ByteString
+testKey = SC8.pack "01234567890123456789012345678901"
+testNonce :: ByteString
+testNonce = SC8.pack "012345678901"
+testString :: LBS.ByteString
+testString = C8.pack $ unlines [
+  "ChaCha20 and Poly1305 for IETF Protocols",
+  "Abstract",
+  "This document defines the ChaCha20 stream cipher as well as the use",
+  "of the Poly1305 authenticator, both as stand-alone algorithms and as",
+  "a combined mode, or Authenticated Encryption with Associated Data",
+  "(AEAD) algorithm.",
+  "This document does not introduce any new crypto, but is meant to",
+  "serve as a stable reference and an implementation guide.  It is a",
+  "product of the Crypto Forum Research Group (CFRG).",
+  "Status of This Memo",
+   "This document is not an Internet Standards Track specification; it is",
+   "published for informational purposes.",
+   "This document is a product of the Internet Research Task Force",
+   "(IRTF).  The IRTF publishes the results of Internet-related research",
+   "and development activities.  These results might not be suitable for",
+   "deployment.  This RFC represents the consensus of the Crypto Forum",
+   "Research Group of the Internet Research Task Force (IRTF).  Documents",
+   "approved for publication by the IRSG are not a candidate for any",
+   "level of Internet Standard; see Section 2 of RFC 5741.",
+   "Information about the current status of this document, any errata,",
+   "and how to provide feedback on it may be obtained at",
+   "http://www.rfc-editor.org/info/rfc7539."
+  ]
+
+checkMacSize :: IO Progress
+checkMacSize = do
+  let algo = chunkedChaChaPoly1305 32 testKey
+      (enc, fails1) = encrypt algo testNonce 0 testString
+  case sequence fails1 of
+    CryptoFailed e -> return . Finished . Fail $ "Crypto failed: " ++ show e
+    CryptoPassed _ -> let
+      nchunks = LBS.length testString `div` plainSize algo
+      modchunks = LBS.length testString `mod` plainSize algo
+      expsize = nchunks * encryptedSize algo + modchunks + (encryptedSize algo - plainSize algo)
+      in if expsize == LBS.length enc
+         then return . Finished $ Pass
+         else return . Finished . Fail $ "Sizes mismatch. Original size is " ++ show (LBS.length testString) ++
+              " encrypted text size is " ++ show (LBS.length enc) ++ " extimated size is " ++ show expsize
+
+goodRoundTrip :: IO Progress
+goodRoundTrip = do
+  let algo = chunkedChaChaPoly1305 32 testKey
+      (enc, fails1) = encrypt algo testNonce 0 testString
+      (dec, fails2) = decrypt algo testNonce 0 enc
+  case sequence fails1 >> sequence fails2 of
+    CryptoPassed _ -> if dec == testString
+                      then return . Finished $ Pass
+                      else return . Finished . Fail $ "Text differs: " ++ C8.unpack dec
+    CryptoFailed e -> return . Finished . Fail $ "Crypto failed: " ++ show e
+
+authError :: IO Progress
+authError = do
+  let algo = chunkedChaChaPoly1305 32 testKey
+      (enc, fails1) = encrypt algo testNonce 0 testString
+  case LBS.uncons enc of
+    Nothing -> return . Finished . Fail $ "Empty encrypted text!"
+    Just (t, tt) -> do
+      let enc' = LBS.cons (t+1) tt
+          (dec, fails2) = decrypt algo testNonce 0 enc'
+      case sequence fails1 >> sequence fails2 of
+        CryptoFailed CryptoError_MacKeyInvalid -> return . Finished $ Pass
+        CryptoFailed e -> return . Finished . Fail $ "Crypto failed: " ++ show e
+        CryptoPassed _ -> return . Finished . Fail $ "Got decrypted text: " ++ C8.unpack dec