{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Crypto.RNCryptor.Types
     ( RNCryptorException(..)
     , RNCryptorHeader(..)
     , RNCryptorContext(ctxHeader, ctxHMACCtx, ctxCipher)
     , newRNCryptorContext
     , newRNCryptorHeader
     , newRNCryptorHeaderFrom
     , renderRNCryptorHeader
     , makeHMAC
     , blockSize
     -- * Type synonyms to make the API more descriptive
     , Password
     , HMAC
     , Salt
     , EncryptionKey
     , EncryptionSalt
     , HMACSalt
     , IV
     ) where

import              Control.Applicative
import              Control.Exception (Exception)
import              Control.Monad
import              Crypto.Cipher.AES (AES256)
import              Crypto.Cipher.Types (Cipher(..))
import              Crypto.Error (CryptoFailable(..))
import              Crypto.Hash (Digest(..))
import              Crypto.Hash.Algorithms (SHA1(..), SHA256(..))
import              Crypto.Hash.IO (HashAlgorithm(..))
#if FASTPBKDF2
import "fastpbkdf2" Crypto.KDF.PBKDF2 (fastpbkdf2_hmac_sha1)
#else
import "cryptonite" Crypto.KDF.PBKDF2
#endif
import              Crypto.MAC.HMAC (Context, initialize, hmac)
import qualified    Crypto.MAC.HMAC as Crypto
import              Data.ByteArray (ByteArray, convert)
import              Data.ByteString (cons, ByteString, unpack)
import qualified    Data.ByteString.Char8 as C8
import              Data.Monoid
import              Data.Typeable
import              Data.Word
import              System.Random
import              Test.QuickCheck (Arbitrary(..), vector)


data RNCryptorException =
  InvalidHMACException !ByteString !ByteString
  -- ^ HMAC validation failed. First parameter is the untrusted hmac, the
  -- second the computed one.
  deriving (Typeable, RNCryptorException -> RNCryptorException -> Bool
(RNCryptorException -> RNCryptorException -> Bool)
-> (RNCryptorException -> RNCryptorException -> Bool)
-> Eq RNCryptorException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RNCryptorException -> RNCryptorException -> Bool
$c/= :: RNCryptorException -> RNCryptorException -> Bool
== :: RNCryptorException -> RNCryptorException -> Bool
$c== :: RNCryptorException -> RNCryptorException -> Bool
Eq)

instance Show RNCryptorException where
  show :: RNCryptorException -> String
show (InvalidHMACException ByteString
untrusted ByteString
computed) =
    String
"InvalidHMACException: Untrusted HMAC was " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
unpack ByteString
untrusted)
                                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", but the computed one is " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
unpack ByteString
computed) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."

instance Exception RNCryptorException

type Password = ByteString
type HMAC = ByteString
type EncryptionKey = ByteString
type Salt = ByteString
type EncryptionSalt = Salt
type HMACSalt = Salt
type IV = ByteString

data RNCryptorHeader = RNCryptorHeader {
        RNCryptorHeader -> Word8
rncVersion :: !Word8
      -- ^ Data format version. Currently 3.
      , RNCryptorHeader -> Word8
rncOptions :: !Word8
      -- ^ bit 0 - uses password
      , RNCryptorHeader -> ByteString
rncEncryptionSalt :: !EncryptionSalt
      -- ^ iff option includes "uses password"
      , RNCryptorHeader -> ByteString
rncHMACSalt :: !HMACSalt
      -- ^ iff options includes "uses password"
      , RNCryptorHeader -> ByteString
rncIV :: !IV
      -- ^ The initialisation vector
      -- The ciphertext is variable and encrypted in CBC mode
      }

instance Show RNCryptorHeader where
  show :: RNCryptorHeader -> String
show = ByteString -> String
C8.unpack (ByteString -> String)
-> (RNCryptorHeader -> ByteString) -> RNCryptorHeader -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RNCryptorHeader -> ByteString
renderRNCryptorHeader

instance Arbitrary RNCryptorHeader where
  arbitrary :: Gen RNCryptorHeader
arbitrary = do
    let version :: Word8
version = Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
3
    let options :: Word8
options = Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
1
    ByteString
eSalt    <- String -> ByteString
C8.pack (String -> ByteString) -> Gen String -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String
forall a. Arbitrary a => Int -> Gen [a]
vector Int
saltSize
    ByteString
iv       <- String -> ByteString
C8.pack (String -> ByteString) -> Gen String -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String
forall a. Arbitrary a => Int -> Gen [a]
vector Int
blockSize
    ByteString
hmacSalt <- String -> ByteString
C8.pack (String -> ByteString) -> Gen String -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String
forall a. Arbitrary a => Int -> Gen [a]
vector Int
saltSize
    RNCryptorHeader -> Gen RNCryptorHeader
forall (m :: * -> *) a. Monad m => a -> m a
return RNCryptorHeader :: Word8
-> Word8
-> ByteString
-> ByteString
-> ByteString
-> RNCryptorHeader
RNCryptorHeader {
          rncVersion :: Word8
rncVersion = Word8
version
        , rncOptions :: Word8
rncOptions = Word8
options
        , rncEncryptionSalt :: ByteString
rncEncryptionSalt = ByteString
eSalt
        , rncHMACSalt :: ByteString
rncHMACSalt = ByteString
hmacSalt
        , rncIV :: ByteString
rncIV = ByteString
iv
        }

--------------------------------------------------------------------------------
saltSize :: Int
saltSize :: Int
saltSize = Int
8

--------------------------------------------------------------------------------
blockSize :: Int
blockSize :: Int
blockSize = Int
16

--------------------------------------------------------------------------------
randomSaltIO :: Int -> IO ByteString
randomSaltIO :: Int -> IO ByteString
randomSaltIO Int
sz = String -> ByteString
C8.pack (String -> ByteString) -> IO String -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> (Int -> IO Char) -> IO String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1 .. Int
sz] (IO Char -> Int -> IO Char
forall a b. a -> b -> a
const (IO Char -> Int -> IO Char) -> IO Char -> Int -> IO Char
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> IO Char
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Char
'\NUL', Char
'\255'))

--------------------------------------------------------------------------------
makeKey :: ByteString -> ByteString -> ByteString
#if FASTPBKDF2
makeKey :: ByteString -> ByteString -> ByteString
makeKey ByteString
input ByteString
salt = ByteString -> ByteString -> Int -> Int -> ByteString
fastpbkdf2_hmac_sha1 ByteString
input ByteString
salt Int
10000 Int
32
#else
makeKey = generate (prfHMAC SHA1) (Parameters 10000 32)
#endif

--------------------------------------------------------------------------------
makeHMAC :: ByteString -> Password -> ByteString -> HMAC
makeHMAC :: ByteString -> ByteString -> ByteString -> ByteString
makeHMAC ByteString
hmacSalt ByteString
userKey ByteString
secret =
  let key :: ByteString
key        = ByteString -> ByteString -> ByteString
makeKey ByteString
userKey ByteString
hmacSalt
      hmacSha256 :: HMAC SHA256
hmacSha256 = ByteString -> ByteString -> HMAC SHA256
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
key ByteString
secret
  in
      HMAC SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (HMAC SHA256
hmacSha256 :: Crypto.HMAC SHA256)

--------------------------------------------------------------------------------
-- | Generates a new 'RNCryptorHeader', suitable for encryption.
newRNCryptorHeader :: IO RNCryptorHeader
newRNCryptorHeader :: IO RNCryptorHeader
newRNCryptorHeader = do
  let version :: Word8
version = Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
3
  let options :: Word8
options = Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
1
  ByteString
eSalt    <- Int -> IO ByteString
randomSaltIO Int
saltSize
  ByteString
iv       <- Int -> IO ByteString
randomSaltIO Int
blockSize
  ByteString
hmacSalt <- Int -> IO ByteString
randomSaltIO Int
saltSize
  RNCryptorHeader -> IO RNCryptorHeader
forall (m :: * -> *) a. Monad m => a -> m a
return RNCryptorHeader :: Word8
-> Word8
-> ByteString
-> ByteString
-> ByteString
-> RNCryptorHeader
RNCryptorHeader {
        rncVersion :: Word8
rncVersion = Word8
version
      , rncOptions :: Word8
rncOptions = Word8
options
      , rncEncryptionSalt :: ByteString
rncEncryptionSalt = ByteString
eSalt
      , rncHMACSalt :: ByteString
rncHMACSalt = ByteString
hmacSalt
      , rncIV :: ByteString
rncIV = ByteString
iv
      }

--------------------------------------------------------------------------------
newRNCryptorHeaderFrom :: EncryptionSalt -> HMACSalt -> IV -> RNCryptorHeader
newRNCryptorHeaderFrom :: ByteString -> ByteString -> ByteString -> RNCryptorHeader
newRNCryptorHeaderFrom ByteString
eSalt ByteString
hmacSalt ByteString
iv = do
  let version :: Word8
version = Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
3
  let options :: Word8
options = Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
1
  RNCryptorHeader :: Word8
-> Word8
-> ByteString
-> ByteString
-> ByteString
-> RNCryptorHeader
RNCryptorHeader {
        rncVersion :: Word8
rncVersion = Word8
version
      , rncOptions :: Word8
rncOptions = Word8
options
      , rncEncryptionSalt :: ByteString
rncEncryptionSalt = ByteString
eSalt
      , rncHMACSalt :: ByteString
rncHMACSalt = ByteString
hmacSalt
      , rncIV :: ByteString
rncIV = ByteString
iv
      }

--------------------------------------------------------------------------------
-- | Concatenates this 'RNCryptorHeader' into a raw sequence of bytes, up to the
-- IV. This means you need to append the ciphertext plus the HMAC to finalise
-- the encrypted file.
renderRNCryptorHeader :: RNCryptorHeader -> ByteString
renderRNCryptorHeader :: RNCryptorHeader -> ByteString
renderRNCryptorHeader RNCryptorHeader{Word8
ByteString
rncIV :: ByteString
rncHMACSalt :: ByteString
rncEncryptionSalt :: ByteString
rncOptions :: Word8
rncVersion :: Word8
rncIV :: RNCryptorHeader -> ByteString
rncHMACSalt :: RNCryptorHeader -> ByteString
rncEncryptionSalt :: RNCryptorHeader -> ByteString
rncOptions :: RNCryptorHeader -> Word8
rncVersion :: RNCryptorHeader -> Word8
..} =
  Word8
rncVersion Word8 -> ByteString -> ByteString
`cons` Word8
rncOptions Word8 -> ByteString -> ByteString
`cons` (ByteString
rncEncryptionSalt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
rncHMACSalt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
rncIV)

--------------------------------------------------------------------------------
-- A convenient datatype to avoid carrying around the AES cypher,
-- the encrypted key and so on and so forth.
data RNCryptorContext = RNCryptorContext {
        RNCryptorContext -> RNCryptorHeader
ctxHeader  :: RNCryptorHeader
      , RNCryptorContext -> AES256
ctxCipher  :: AES256
      , RNCryptorContext -> Context SHA256
ctxHMACCtx :: Context SHA256
      }

--------------------------------------------------------------------------------
cipherInitNoError :: ByteString -> AES256
cipherInitNoError :: ByteString -> AES256
cipherInitNoError ByteString
k = case ByteString -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
k of
  CryptoPassed AES256
a -> AES256
a
  CryptoFailed CryptoError
e -> String -> AES256
forall a. HasCallStack => String -> a
error (String
"cipherInitNoError: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)

--------------------------------------------------------------------------------
newRNCryptorContext :: Password -> RNCryptorHeader -> RNCryptorContext
newRNCryptorContext :: ByteString -> RNCryptorHeader -> RNCryptorContext
newRNCryptorContext ByteString
userKey RNCryptorHeader
hdr =
  let hmacSalt :: ByteString
hmacSalt = RNCryptorHeader -> ByteString
rncHMACSalt RNCryptorHeader
hdr
      hmacKey :: ByteString
hmacKey  = ByteString -> ByteString -> ByteString
makeKey ByteString
userKey ByteString
hmacSalt
      hmacCtx :: Context SHA256
hmacCtx  = ByteString -> Context SHA256
forall key a.
(ByteArrayAccess key, HashAlgorithm a) =>
key -> Context a
initialize ByteString
hmacKey
      encKey :: ByteString
encKey   = ByteString -> ByteString -> ByteString
makeKey ByteString
userKey (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ RNCryptorHeader -> ByteString
rncEncryptionSalt RNCryptorHeader
hdr
      cipher :: AES256
cipher   = ByteString -> AES256
cipherInitNoError ByteString
encKey
  in RNCryptorHeader -> AES256 -> Context SHA256 -> RNCryptorContext
RNCryptorContext RNCryptorHeader
hdr AES256
cipher (Context SHA256
hmacCtx :: Context SHA256)