{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Simplex.FileTransfer.Crypto
  ( encryptFile,
    decryptChunks,
    readChunks,
  ) where

import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans.Except
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (first)
import qualified Data.ByteArray as BA
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Int (Int64)
import Data.Text (Text)
import Simplex.FileTransfer.Types (FileHeader (..), authTagSize)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Crypto.Lazy (LazyByteString)
import qualified Simplex.Messaging.Crypto.Lazy as LC
import Simplex.Messaging.Encoding
import Simplex.Messaging.Util (liftEitherWith)
import UnliftIO
import UnliftIO.Directory (removeFile)

encryptFile :: CryptoFile -> ByteString -> C.SbKey -> C.CbNonce -> Int64 -> Int64 -> FilePath -> ExceptT FTCryptoError IO ()
encryptFile :: CryptoFile
-> ByteString
-> SbKey
-> CbNonce
-> Int64
-> Int64
-> FilePath
-> ExceptT FTCryptoError IO ()
encryptFile CryptoFile
srcFile ByteString
fileHdr SbKey
key CbNonce
nonce Int64
fileSize' Int64
encSize FilePath
encFile = do
  SbState
sb <- (CryptoError -> FTCryptoError)
-> Either CryptoError SbState -> ExceptT FTCryptoError IO SbState
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> Either e a -> ExceptT e' m a
liftEitherWith CryptoError -> FTCryptoError
FTCECryptoError (Either CryptoError SbState -> ExceptT FTCryptoError IO SbState)
-> Either CryptoError SbState -> ExceptT FTCryptoError IO SbState
forall a b. (a -> b) -> a -> b
$ SbKey -> CbNonce -> Either CryptoError SbState
LC.sbInit SbKey
key CbNonce
nonce
  CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a.
CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO a)
-> ExceptT FTCryptoError IO a
CF.withFile CryptoFile
srcFile IOMode
ReadMode ((CryptoFileHandle -> ExceptT FTCryptoError IO ())
 -> ExceptT FTCryptoError IO ())
-> (CryptoFileHandle -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ \CryptoFileHandle
r -> IO (Either FTCryptoError ()) -> ExceptT FTCryptoError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FTCryptoError ()) -> ExceptT FTCryptoError IO ())
-> ((Handle -> IO (Either FTCryptoError ()))
    -> IO (Either FTCryptoError ()))
-> (Handle -> IO (Either FTCryptoError ()))
-> ExceptT FTCryptoError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> IOMode
-> (Handle -> IO (Either FTCryptoError ()))
-> IO (Either FTCryptoError ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withFile FilePath
encFile IOMode
WriteMode ((Handle -> IO (Either FTCryptoError ()))
 -> ExceptT FTCryptoError IO ())
-> (Handle -> IO (Either FTCryptoError ()))
-> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
w -> ExceptT FTCryptoError IO () -> IO (Either FTCryptoError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FTCryptoError IO () -> IO (Either FTCryptoError ()))
-> ExceptT FTCryptoError IO () -> IO (Either FTCryptoError ())
forall a b. (a -> b) -> a -> b
$ do
    let lenStr :: ByteString
lenStr = Int64 -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode Int64
fileSize'
        (ByteString
hdr, !SbState
sb') = SbState -> ByteString -> (ByteString, SbState)
LC.sbEncryptChunk SbState
sb (ByteString -> (ByteString, SbState))
-> ByteString -> (ByteString, SbState)
forall a b. (a -> b) -> a -> b
$ ByteString
lenStr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
fileHdr
        padLen :: Int64
padLen = Int64
encSize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
authTagSize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
fileSize' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
8
    IO () -> ExceptT FTCryptoError IO ()
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FTCryptoError IO ())
-> IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPut Handle
w ByteString
hdr
    SbState
sb2 <- CryptoFileHandle
-> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptChunks CryptoFileHandle
r Handle
w (SbState
sb', Int64
fileSize' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
fileHdr))
    CryptoFileHandle -> ExceptT FTCryptoError IO ()
CF.hGetTag CryptoFileHandle
r
    SbState
sb3 <- Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptPad Handle
w (SbState
sb2, Int64
padLen)
    let tag :: ByteString
tag = Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Auth -> ByteString) -> Auth -> ByteString
forall a b. (a -> b) -> a -> b
$ SbState -> Auth
LC.sbAuth SbState
sb3
    IO () -> ExceptT FTCryptoError IO ()
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FTCryptoError IO ())
-> IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPut Handle
w ByteString
tag
  where
    encryptChunks :: CryptoFileHandle
-> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptChunks CryptoFileHandle
r = (Int64 -> IO ByteString)
-> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptChunks_ ((Int64 -> IO ByteString)
 -> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState)
-> (Int64 -> IO ByteString)
-> Handle
-> (SbState, Int64)
-> ExceptT FTCryptoError IO SbState
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO ByteString
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> IO ByteString)
-> (Int64 -> IO ByteString) -> Int64 -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFileHandle -> Int -> IO ByteString
CF.hGet CryptoFileHandle
r (Int -> IO ByteString) -> (Int64 -> Int) -> Int64 -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    encryptPad :: Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptPad = (Int64 -> IO ByteString)
-> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptChunks_ ((Int64 -> IO ByteString)
 -> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState)
-> (Int64 -> IO ByteString)
-> Handle
-> (SbState, Int64)
-> ExceptT FTCryptoError IO SbState
forall a b. (a -> b) -> a -> b
$ \Int64
sz -> ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char -> ByteString
B.replicate (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
sz) Char
'#'
    encryptChunks_ :: (Int64 -> IO ByteString) -> Handle -> (LC.SbState, Int64) -> ExceptT FTCryptoError IO LC.SbState
    encryptChunks_ :: (Int64 -> IO ByteString)
-> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptChunks_ Int64 -> IO ByteString
get Handle
w (!SbState
sb, !Int64
len)
      | Int64
len Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = SbState -> ExceptT FTCryptoError IO SbState
forall a. a -> ExceptT FTCryptoError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SbState
sb
      | Bool
otherwise = do
          let chSize :: Int64
chSize = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
len Int64
65536
          ByteString
ch <- IO ByteString -> ExceptT FTCryptoError IO ByteString
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT FTCryptoError IO ByteString)
-> IO ByteString -> ExceptT FTCryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> IO ByteString
get Int64
chSize
          Bool -> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
ch Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
chSize) (ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ FTCryptoError -> ExceptT FTCryptoError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (FTCryptoError -> ExceptT FTCryptoError IO ())
-> FTCryptoError -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FTCryptoError
FTCEFileIOError FilePath
"encrypting file: unexpected EOF"
          let (ByteString
ch', SbState
sb') = SbState -> ByteString -> (ByteString, SbState)
LC.sbEncryptChunk SbState
sb ByteString
ch
          IO () -> ExceptT FTCryptoError IO ()
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FTCryptoError IO ())
-> IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPut Handle
w ByteString
ch'
          (Int64 -> IO ByteString)
-> Handle -> (SbState, Int64) -> ExceptT FTCryptoError IO SbState
encryptChunks_ Int64 -> IO ByteString
get Handle
w (SbState
sb', Int64
len Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
chSize)

decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (Text -> ExceptT String IO CryptoFile) -> ExceptT FTCryptoError IO CryptoFile
decryptChunks :: Int64
-> [FilePath]
-> SbKey
-> CbNonce
-> (Text -> ExceptT FilePath IO CryptoFile)
-> ExceptT FTCryptoError IO CryptoFile
decryptChunks Int64
_ [] SbKey
_ CbNonce
_ Text -> ExceptT FilePath IO CryptoFile
_ = FTCryptoError -> ExceptT FTCryptoError IO CryptoFile
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (FTCryptoError -> ExceptT FTCryptoError IO CryptoFile)
-> FTCryptoError -> ExceptT FTCryptoError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ FilePath -> FTCryptoError
FTCEInvalidHeader FilePath
"empty"
decryptChunks Int64
encSize (FilePath
chPath : [FilePath]
chPaths) SbKey
key CbNonce
nonce Text -> ExceptT FilePath IO CryptoFile
getDestFile = case [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
chPaths of
  [] -> do
    (!Bool
authOk, !ByteString
f) <- Either FTCryptoError (Bool, ByteString)
-> ExceptT FTCryptoError IO (Bool, ByteString)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either FTCryptoError (Bool, ByteString)
 -> ExceptT FTCryptoError IO (Bool, ByteString))
-> (ByteString -> Either FTCryptoError (Bool, ByteString))
-> ByteString
-> ExceptT FTCryptoError IO (Bool, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CryptoError -> FTCryptoError)
-> Either CryptoError (Bool, ByteString)
-> Either FTCryptoError (Bool, ByteString)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoError -> FTCryptoError
FTCECryptoError (Either CryptoError (Bool, ByteString)
 -> Either FTCryptoError (Bool, ByteString))
-> (ByteString -> Either CryptoError (Bool, ByteString))
-> ByteString
-> Either FTCryptoError (Bool, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SbKey
-> CbNonce
-> Int64
-> ByteString
-> Either CryptoError (Bool, ByteString)
LC.sbDecryptTailTag SbKey
key CbNonce
nonce (Int64
encSize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
authTagSize) (ByteString -> ExceptT FTCryptoError IO (Bool, ByteString))
-> ExceptT FTCryptoError IO ByteString
-> ExceptT FTCryptoError IO (Bool, ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString -> ExceptT FTCryptoError IO ByteString
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
LB.readFile FilePath
chPath)
    Bool -> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
authOk (ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ FTCryptoError -> ExceptT FTCryptoError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE FTCryptoError
FTCEInvalidAuthTag
    (FileHeader {Text
fileName :: Text
$sel:fileName:FileHeader :: FileHeader -> Text
fileName}, !ByteString
f') <- ByteString -> ExceptT FTCryptoError IO (FileHeader, ByteString)
parseFileHeader ByteString
f
    CryptoFile
destFile <- (FilePath -> FTCryptoError)
-> ExceptT FilePath IO CryptoFile
-> ExceptT FTCryptoError IO CryptoFile
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT FilePath -> FTCryptoError
FTCEFileIOError (ExceptT FilePath IO CryptoFile
 -> ExceptT FTCryptoError IO CryptoFile)
-> ExceptT FilePath IO CryptoFile
-> ExceptT FTCryptoError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT FilePath IO CryptoFile
getDestFile Text
fileName
    CryptoFile -> ByteString -> ExceptT FTCryptoError IO ()
CF.writeFile CryptoFile
destFile ByteString
f'
    CryptoFile -> ExceptT FTCryptoError IO CryptoFile
forall a. a -> ExceptT FTCryptoError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CryptoFile
destFile
  FilePath
lastPath : [FilePath]
chPaths' -> do
    ((SbState, Int64)
state, Int64
expectedLen, ByteString
ch) <- ExceptT FTCryptoError IO ((SbState, Int64), Int64, ByteString)
decryptFirstChunk
    (FileHeader {Text
$sel:fileName:FileHeader :: FileHeader -> Text
fileName :: Text
fileName}, ByteString
ch') <- ByteString -> ExceptT FTCryptoError IO (FileHeader, ByteString)
parseFileHeader ByteString
ch
    destFile :: CryptoFile
destFile@(CryptoFile FilePath
path Maybe CryptoFileArgs
_) <- (FilePath -> FTCryptoError)
-> ExceptT FilePath IO CryptoFile
-> ExceptT FTCryptoError IO CryptoFile
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT FilePath -> FTCryptoError
FTCEFileIOError (ExceptT FilePath IO CryptoFile
 -> ExceptT FTCryptoError IO CryptoFile)
-> ExceptT FilePath IO CryptoFile
-> ExceptT FTCryptoError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT FilePath IO CryptoFile
getDestFile Text
fileName
    Bool
authOk <- CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO Bool)
-> ExceptT FTCryptoError IO Bool
forall a.
CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO a)
-> ExceptT FTCryptoError IO a
CF.withFile CryptoFile
destFile IOMode
WriteMode ((CryptoFileHandle -> ExceptT FTCryptoError IO Bool)
 -> ExceptT FTCryptoError IO Bool)
-> (CryptoFileHandle -> ExceptT FTCryptoError IO Bool)
-> ExceptT FTCryptoError IO Bool
forall a b. (a -> b) -> a -> b
$ \CryptoFileHandle
h -> IO Bool -> ExceptT FTCryptoError IO Bool
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT FTCryptoError IO Bool)
-> IO Bool -> ExceptT FTCryptoError IO Bool
forall a b. (a -> b) -> a -> b
$ do
      CryptoFileHandle -> ByteString -> IO ()
CF.hPut CryptoFileHandle
h ByteString
ch'
      (SbState, Int64)
state' <- ((SbState, Int64) -> FilePath -> IO (SbState, Int64))
-> (SbState, Int64) -> [FilePath] -> IO (SbState, Int64)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CryptoFileHandle
-> (SbState, Int64) -> FilePath -> IO (SbState, Int64)
decryptChunk CryptoFileHandle
h) (SbState, Int64)
state ([FilePath] -> IO (SbState, Int64))
-> [FilePath] -> IO (SbState, Int64)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
chPaths'
      CryptoFileHandle -> (SbState, Int64) -> Int64 -> IO Bool
decryptLastChunk CryptoFileHandle
h (SbState, Int64)
state' Int64
expectedLen
    Bool -> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
authOk (ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> ExceptT FTCryptoError IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
removeFile FilePath
path
      FTCryptoError -> ExceptT FTCryptoError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE FTCryptoError
FTCEInvalidAuthTag
    CryptoFile -> ExceptT FTCryptoError IO CryptoFile
forall a. a -> ExceptT FTCryptoError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CryptoFile
destFile
    where
      decryptFirstChunk :: ExceptT FTCryptoError IO ((SbState, Int64), Int64, ByteString)
decryptFirstChunk = do
        SbState
sb <- (CryptoError -> FTCryptoError)
-> Either CryptoError SbState -> ExceptT FTCryptoError IO SbState
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> Either e a -> ExceptT e' m a
liftEitherWith CryptoError -> FTCryptoError
FTCECryptoError (Either CryptoError SbState -> ExceptT FTCryptoError IO SbState)
-> Either CryptoError SbState -> ExceptT FTCryptoError IO SbState
forall a b. (a -> b) -> a -> b
$ SbKey -> CbNonce -> Either CryptoError SbState
LC.sbInit SbKey
key CbNonce
nonce
        ByteString
ch <- IO ByteString -> ExceptT FTCryptoError IO ByteString
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT FTCryptoError IO ByteString)
-> IO ByteString -> ExceptT FTCryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LB.readFile FilePath
chPath
        let (ByteString
ch1, !SbState
sb') = SbState -> ByteString -> (ByteString, SbState)
LC.sbDecryptChunkLazy SbState
sb ByteString
ch
        (!Int64
expectedLen, ByteString
ch2) <- (CryptoError -> FTCryptoError)
-> Either CryptoError (Int64, ByteString)
-> ExceptT FTCryptoError IO (Int64, ByteString)
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> Either e a -> ExceptT e' m a
liftEitherWith CryptoError -> FTCryptoError
FTCECryptoError (Either CryptoError (Int64, ByteString)
 -> ExceptT FTCryptoError IO (Int64, ByteString))
-> Either CryptoError (Int64, ByteString)
-> ExceptT FTCryptoError IO (Int64, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either CryptoError (Int64, ByteString)
LC.splitLen ByteString
ch1
        let len1 :: Int64
len1 = ByteString -> Int64
LB.length ByteString
ch2
        ((SbState, Int64), Int64, ByteString)
-> ExceptT FTCryptoError IO ((SbState, Int64), Int64, ByteString)
forall a. a -> ExceptT FTCryptoError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SbState
sb', Int64
len1), Int64
expectedLen, ByteString
ch2)
      decryptChunk :: CryptoFileHandle
-> (SbState, Int64) -> FilePath -> IO (SbState, Int64)
decryptChunk CryptoFileHandle
h (!SbState
sb, !Int64
len) FilePath
chPth = do
        ByteString
ch <- FilePath -> IO ByteString
LB.readFile FilePath
chPth
        let len' :: Int64
len' = Int64
len Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
LB.length ByteString
ch
            (ByteString
ch', SbState
sb') = SbState -> ByteString -> (ByteString, SbState)
LC.sbDecryptChunkLazy SbState
sb ByteString
ch
        CryptoFileHandle -> ByteString -> IO ()
CF.hPut CryptoFileHandle
h ByteString
ch'
        (SbState, Int64) -> IO (SbState, Int64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SbState
sb', Int64
len')
      decryptLastChunk :: CryptoFileHandle -> (SbState, Int64) -> Int64 -> IO Bool
decryptLastChunk CryptoFileHandle
h (!SbState
sb, !Int64
len) Int64
expectedLen = do
        ByteString
ch <- FilePath -> IO ByteString
LB.readFile FilePath
lastPath
        let (ByteString
ch1, ByteString
tag') = Int64 -> ByteString -> (ByteString, ByteString)
LB.splitAt (ByteString -> Int64
LB.length ByteString
ch Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
authTagSize) ByteString
ch
            tag'' :: ByteString
tag'' = ByteString -> ByteString
LB.toStrict ByteString
tag'
            (ByteString
ch2, SbState
sb') = SbState -> ByteString -> (ByteString, SbState)
LC.sbDecryptChunkLazy SbState
sb ByteString
ch1
            len' :: Int64
len' = Int64
len Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
LB.length ByteString
ch2
            ch3 :: ByteString
ch3 = Int64 -> ByteString -> ByteString
LB.take (ByteString -> Int64
LB.length ByteString
ch2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
len' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
expectedLen) ByteString
ch2
            ByteString
tag :: ByteString = Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SbState -> Auth
LC.sbAuth SbState
sb')
        CryptoFileHandle -> ByteString -> IO ()
CF.hPut CryptoFileHandle
h ByteString
ch3
        CryptoFileHandle -> IO ()
CF.hPutTag CryptoFileHandle
h
        Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
tag'' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
tag'' ByteString
tag
  where
    parseFileHeader :: LazyByteString -> ExceptT FTCryptoError IO (FileHeader, LazyByteString)
    parseFileHeader :: ByteString -> ExceptT FTCryptoError IO (FileHeader, ByteString)
parseFileHeader ByteString
s = do
      let (ByteString
hdrStr, ByteString
s') = Int64 -> ByteString -> (ByteString, ByteString)
LB.splitAt Int64
1024 ByteString
s
      case Parser FileHeader -> ByteString -> Result FileHeader
forall a. Parser a -> ByteString -> Result a
A.parse Parser FileHeader
forall a. Encoding a => Parser a
smpP (ByteString -> Result FileHeader)
-> ByteString -> Result FileHeader
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict ByteString
hdrStr of
        A.Fail ByteString
_ [FilePath]
_ FilePath
e -> FTCryptoError -> ExceptT FTCryptoError IO (FileHeader, ByteString)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (FTCryptoError
 -> ExceptT FTCryptoError IO (FileHeader, ByteString))
-> FTCryptoError
-> ExceptT FTCryptoError IO (FileHeader, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> FTCryptoError
FTCEInvalidHeader FilePath
e
        A.Partial ByteString -> Result FileHeader
_ -> FTCryptoError -> ExceptT FTCryptoError IO (FileHeader, ByteString)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (FTCryptoError
 -> ExceptT FTCryptoError IO (FileHeader, ByteString))
-> FTCryptoError
-> ExceptT FTCryptoError IO (FileHeader, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> FTCryptoError
FTCEInvalidHeader FilePath
"incomplete"
        A.Done ByteString
rest FileHeader
hdr -> (FileHeader, ByteString)
-> ExceptT FTCryptoError IO (FileHeader, ByteString)
forall a. a -> ExceptT FTCryptoError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileHeader
hdr, ByteString -> ByteString
LB.fromStrict ByteString
rest ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s')

readChunks :: [FilePath] -> IO LB.ByteString
readChunks :: [FilePath] -> IO ByteString
readChunks = (ByteString -> FilePath -> IO ByteString)
-> ByteString -> [FilePath] -> IO ByteString
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ByteString
s FilePath
path -> (ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
LB.readFile FilePath
path) ByteString
""