{-# LANGUAGE OverloadedStrings #-}
module Pdf.Core.Encryption
( Decryptor
, DecryptorScope(..)
, defaultUserPassword
, mkStandardDecryptor
, decryptObject
)
where
import Pdf.Core.Object
import Pdf.Core.Object.Util
import Pdf.Core.Util
import qualified Data.Traversable as Traversable
import Data.Bits (xor)
import Data.IORef
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Builder
import qualified Data.Vector as Vector
import qualified Data.HashMap.Strict as HashMap
import Control.Monad
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as Streams
import qualified Crypto.Cipher.RC4 as RC4
import qualified Crypto.Cipher.AES as AES
import qualified Crypto.Hash.MD5 as MD5
import qualified Crypto.Padding as Padding
data DecryptorScope
= DecryptString
| DecryptStream
type Decryptor
= Ref
-> DecryptorScope
-> InputStream ByteString
-> IO (InputStream ByteString)
decryptObject :: Decryptor -> Ref -> Object -> IO Object
decryptObject :: Decryptor -> Ref -> Object -> IO Object
decryptObject Decryptor
decryptor Ref
ref (String ByteString
str)
= ByteString -> Object
String (ByteString -> Object) -> IO ByteString -> IO Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decryptor -> Ref -> ByteString -> IO ByteString
decryptStr Decryptor
decryptor Ref
ref ByteString
str
decryptObject Decryptor
decryptor Ref
ref (Dict Dict
dict)
= Dict -> Object
Dict (Dict -> Object) -> IO Dict -> IO Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decryptor -> Ref -> Dict -> IO Dict
decryptDict Decryptor
decryptor Ref
ref Dict
dict
decryptObject Decryptor
decryptor Ref
ref (Array Array
arr)
= Array -> Object
Array (Array -> Object) -> IO Array -> IO Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decryptor -> Ref -> Array -> IO Array
decryptArray Decryptor
decryptor Ref
ref Array
arr
decryptObject Decryptor
_ Ref
_ Object
o = Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o
decryptStr :: Decryptor -> Ref -> ByteString -> IO ByteString
decryptStr :: Decryptor -> Ref -> ByteString -> IO ByteString
decryptStr Decryptor
decryptor Ref
ref ByteString
str = do
InputStream ByteString
is <- [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList [ByteString
str]
[ByteString]
res <- Decryptor
decryptor Ref
ref DecryptorScope
DecryptString InputStream ByteString
is IO (InputStream ByteString)
-> (InputStream ByteString -> IO [ByteString]) -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputStream ByteString -> IO [ByteString]
forall a. InputStream a -> IO [a]
Streams.toList
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ByteString]
res
decryptDict :: Decryptor -> Ref -> Dict -> IO Dict
decryptDict :: Decryptor -> Ref -> Dict -> IO Dict
decryptDict Decryptor
decryptor Ref
ref Dict
vals = Dict -> (Object -> IO Object) -> IO Dict
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
Traversable.forM Dict
vals ((Object -> IO Object) -> IO Dict)
-> (Object -> IO Object) -> IO Dict
forall a b. (a -> b) -> a -> b
$
Decryptor -> Ref -> Object -> IO Object
decryptObject Decryptor
decryptor Ref
ref
decryptArray :: Decryptor -> Ref -> Array -> IO Array
decryptArray :: Decryptor -> Ref -> Array -> IO Array
decryptArray Decryptor
decryptor Ref
ref Array
vals = Array -> (Object -> IO Object) -> IO Array
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
Vector.forM Array
vals Object -> IO Object
decr
where
decr :: Object -> IO Object
decr = Decryptor -> Ref -> Object -> IO Object
decryptObject Decryptor
decryptor Ref
ref
defaultUserPassword :: ByteString
defaultUserPassword :: ByteString
defaultUserPassword = [Word8] -> ByteString
BS.pack [
Word8
0x28, Word8
0xBF, Word8
0x4E, Word8
0x5E, Word8
0x4E, Word8
0x75, Word8
0x8A, Word8
0x41, Word8
0x64, Word8
0x00, Word8
0x4E,
Word8
0x56, Word8
0xFF, Word8
0xFA, Word8
0x01, Word8
0x08, Word8
0x2E, Word8
0x2E, Word8
0x00, Word8
0xB6, Word8
0xD0, Word8
0x68,
Word8
0x3E, Word8
0x80, Word8
0x2F, Word8
0x0C, Word8
0xA9, Word8
0xFE, Word8
0x64, Word8
0x53, Word8
0x69, Word8
0x7A
]
mkStandardDecryptor :: Dict
-> Dict
-> ByteString
-> Either String (Maybe Decryptor)
mkStandardDecryptor :: Dict -> Dict -> ByteString -> Either String (Maybe Decryptor)
mkStandardDecryptor Dict
tr Dict
enc ByteString
pass = do
Name
filterType <-
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Filter" Dict
enc of
Just Object
o -> Object -> Maybe Name
nameValue Object
o Maybe Name -> String -> Either String Name
forall a. Maybe a -> String -> Either String a
`notice` String
"Filter should be a name"
Maybe Object
_ -> String -> Either String Name
forall a b. a -> Either a b
Left String
"Filter missing"
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Name
filterType Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"Standard") (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a b. a -> Either a b
Left (String
"Unsupported encryption handler: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
filterType)
Int
v <-
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"V" Dict
enc of
Just Object
n -> Object -> Maybe Int
intValue Object
n Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"V should be an integer"
Maybe Object
_ -> String -> Either String Int
forall a b. a -> Either a b
Left String
"V is missing"
if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
then Either String (Maybe Decryptor)
mk4
else Int -> Either String (Maybe Decryptor)
forall a p.
(Eq a, Num a, Show a) =>
a
-> Either
String
(Maybe
(Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString)))
mk12 Int
v
where
mk12 :: a
-> Either
String
(Maybe
(Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString)))
mk12 a
v = do
Int
n <-
case a
v of
a
1 -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
5
a
2 -> do
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Length" Dict
enc of
Just Object
o -> (Int -> Int) -> Either String Int -> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) (Object -> Maybe Int
intValue Object
o
Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Length should be an integer")
Maybe Object
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Length is missing"
a
_ -> String -> Either String Int
forall a b. a -> Either a b
Left (String
"Unsuported encryption handler version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v)
ByteString
ekey <- Dict -> Dict -> ByteString -> Int -> Either String ByteString
mkKey Dict
tr Dict
enc ByteString
pass Int
n
Bool
ok <- Dict -> Dict -> ByteString -> Either String Bool
verifyKey Dict
tr Dict
enc ByteString
ekey
Maybe
(Ref -> p -> InputStream ByteString -> IO (InputStream ByteString))
-> Either
String
(Maybe
(Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
(Ref -> p -> InputStream ByteString -> IO (InputStream ByteString))
-> Either
String
(Maybe
(Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString))))
-> Maybe
(Ref -> p -> InputStream ByteString -> IO (InputStream ByteString))
-> Either
String
(Maybe
(Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString)))
forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not Bool
ok
then Maybe
(Ref -> p -> InputStream ByteString -> IO (InputStream ByteString))
forall a. Maybe a
Nothing
else (Ref -> p -> InputStream ByteString -> IO (InputStream ByteString))
-> Maybe
(Ref -> p -> InputStream ByteString -> IO (InputStream ByteString))
forall a. a -> Maybe a
Just ((Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString))
-> Maybe
(Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString)))
-> (Ref
-> p -> InputStream ByteString -> IO (InputStream ByteString))
-> Maybe
(Ref -> p -> InputStream ByteString -> IO (InputStream ByteString))
forall a b. (a -> b) -> a -> b
$ \Ref
ref p
_ InputStream ByteString
is -> Algorithm
-> ByteString
-> Int
-> Ref
-> InputStream ByteString
-> IO (InputStream ByteString)
mkDecryptor Algorithm
V2 ByteString
ekey Int
n Ref
ref InputStream ByteString
is
mk4 :: Either String (Maybe Decryptor)
mk4 = do
Dict
cryptoFilters <-
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"CF" Dict
enc of
Maybe Object
Nothing -> String -> Either String Dict
forall a b. a -> Either a b
Left String
"CF is missing in crypt handler V4"
Just Object
o -> Object -> Maybe Dict
dictValue Object
o Maybe Dict -> String -> Either String Dict
forall a. Maybe a -> String -> Either String a
`notice` String
"CF should be a dictionary"
HashMap Name (ByteString, Int, Algorithm)
keysMap <- Dict
-> (Object -> Either String (ByteString, Int, Algorithm))
-> Either String (HashMap Name (ByteString, Int, Algorithm))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
Traversable.forM Dict
cryptoFilters ((Object -> Either String (ByteString, Int, Algorithm))
-> Either String (HashMap Name (ByteString, Int, Algorithm)))
-> (Object -> Either String (ByteString, Int, Algorithm))
-> Either String (HashMap Name (ByteString, Int, Algorithm))
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
Dict
dict <- Object -> Maybe Dict
dictValue Object
obj Maybe Dict -> String -> Either String Dict
forall a. Maybe a -> String -> Either String a
`notice` String
"Crypto filter should be a dictionary"
Int
n <-
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Length" Dict
dict of
Maybe Object
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Crypto filter without Length"
Just Object
o -> Object -> Maybe Int
intValue Object
o Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Crypto filter length should be int"
Name
algName <-
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"CFM" Dict
dict of
Maybe Object
Nothing -> String -> Either String Name
forall a b. a -> Either a b
Left String
"CFM is missing"
Just Object
o -> Object -> Maybe Name
nameValue Object
o Maybe Name -> String -> Either String Name
forall a. Maybe a -> String -> Either String a
`notice` String
"CFM should be a name"
Algorithm
alg <-
case Name
algName of
Name
"V2" -> Algorithm -> Either String Algorithm
forall (m :: * -> *) a. Monad m => a -> m a
return Algorithm
V2
Name
"AESV2" -> Algorithm -> Either String Algorithm
forall (m :: * -> *) a. Monad m => a -> m a
return Algorithm
AESV2
Name
_ -> String -> Either String Algorithm
forall a b. a -> Either a b
Left (String -> Either String Algorithm)
-> String -> Either String Algorithm
forall a b. (a -> b) -> a -> b
$ String
"Unknown crypto method: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
algName
ByteString
ekey <- Dict -> Dict -> ByteString -> Int -> Either String ByteString
mkKey Dict
tr Dict
enc ByteString
pass Int
n
(ByteString, Int, Algorithm)
-> Either String (ByteString, Int, Algorithm)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ekey, Int
n, Algorithm
alg)
(ByteString
stdCfKey, Int
_, Algorithm
_) <- Name
-> HashMap Name (ByteString, Int, Algorithm)
-> Maybe (ByteString, Int, Algorithm)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"StdCF" HashMap Name (ByteString, Int, Algorithm)
keysMap
Maybe (ByteString, Int, Algorithm)
-> String -> Either String (ByteString, Int, Algorithm)
forall a. Maybe a -> String -> Either String a
`notice` String
"StdCF is missing"
Bool
ok <- Dict -> Dict -> ByteString -> Either String Bool
verifyKey Dict
tr Dict
enc ByteString
stdCfKey
if Bool -> Bool
not Bool
ok
then Maybe Decryptor -> Either String (Maybe Decryptor)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Decryptor
forall a. Maybe a
Nothing
else do
Name
strFName <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"StrF" Dict
enc Maybe Object -> (Object -> Maybe Name) -> Maybe Name
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Name
nameValue)
Maybe Name -> String -> Either String Name
forall a. Maybe a -> String -> Either String a
`notice` String
"StrF is missing"
(ByteString
strFKey, Int
strFN, Algorithm
strFAlg) <- Name
-> HashMap Name (ByteString, Int, Algorithm)
-> Maybe (ByteString, Int, Algorithm)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
strFName HashMap Name (ByteString, Int, Algorithm)
keysMap
Maybe (ByteString, Int, Algorithm)
-> String -> Either String (ByteString, Int, Algorithm)
forall a. Maybe a -> String -> Either String a
`notice` (String
"Crypto filter not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
strFName)
Name
stmFName <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"StmF" Dict
enc Maybe Object -> (Object -> Maybe Name) -> Maybe Name
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Name
nameValue)
Maybe Name -> String -> Either String Name
forall a. Maybe a -> String -> Either String a
`notice` String
"StmF is missing"
(ByteString
stmFKey, Int
stmFN, Algorithm
stmFAlg) <- Name
-> HashMap Name (ByteString, Int, Algorithm)
-> Maybe (ByteString, Int, Algorithm)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
stmFName HashMap Name (ByteString, Int, Algorithm)
keysMap
Maybe (ByteString, Int, Algorithm)
-> String -> Either String (ByteString, Int, Algorithm)
forall a. Maybe a -> String -> Either String a
`notice` (String
"Crypto filter not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
stmFName)
Maybe Decryptor -> Either String (Maybe Decryptor)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Decryptor -> Either String (Maybe Decryptor))
-> Maybe Decryptor -> Either String (Maybe Decryptor)
forall a b. (a -> b) -> a -> b
$ Decryptor -> Maybe Decryptor
forall a. a -> Maybe a
Just (Decryptor -> Maybe Decryptor) -> Decryptor -> Maybe Decryptor
forall a b. (a -> b) -> a -> b
$ \Ref
ref DecryptorScope
scope InputStream ByteString
is ->
case DecryptorScope
scope of
DecryptorScope
DecryptString -> Algorithm
-> ByteString
-> Int
-> Ref
-> InputStream ByteString
-> IO (InputStream ByteString)
mkDecryptor Algorithm
strFAlg ByteString
strFKey Int
strFN Ref
ref InputStream ByteString
is
DecryptorScope
DecryptStream -> Algorithm
-> ByteString
-> Int
-> Ref
-> InputStream ByteString
-> IO (InputStream ByteString)
mkDecryptor Algorithm
stmFAlg ByteString
stmFKey Int
stmFN Ref
ref InputStream ByteString
is
mkKey :: Dict -> Dict -> ByteString -> Int -> Either String ByteString
mkKey :: Dict -> Dict -> ByteString -> Int -> Either String ByteString
mkKey Dict
tr Dict
enc ByteString
pass Int
n = do
ByteString
oVal <- do
Object
o <- Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"O" Dict
enc Maybe Object -> String -> Either String Object
forall a. Maybe a -> String -> Either String a
`notice` String
"O is missing"
Object -> Maybe ByteString
stringValue Object
o Maybe ByteString -> String -> Either String ByteString
forall a. Maybe a -> String -> Either String a
`notice` String
"o should be a string"
ByteString
pVal <- do
Object
o <- Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"P" Dict
enc Maybe Object -> String -> Either String Object
forall a. Maybe a -> String -> Either String a
`notice` String
"P is missing"
Int
i <- Object -> Maybe Int
intValue Object
o Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"P should be an integer"
ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> (Int -> ByteString) -> Int -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> (Int -> [Word8]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BSL.unpack (ByteString -> [Word8]) -> (Int -> ByteString) -> Int -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
(Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
word32LE (Word32 -> Builder) -> (Int -> Word32) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Either String ByteString)
-> Int -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Int
i
ByteString
idVal <- do
Array
ids <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"ID" Dict
tr Maybe Object -> (Object -> Maybe Array) -> Maybe Array
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Array
arrayValue)
Maybe Array -> String -> Either String Array
forall a. Maybe a -> String -> Either String a
`notice` String
"ID should be an array"
case (Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
ids) of
[] -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"ID array is empty"
(Object
x:[Object]
_) -> Object -> Maybe ByteString
stringValue Object
x
Maybe ByteString -> String -> Either String ByteString
forall a. Maybe a -> String -> Either String a
`notice` String
"The first element if ID should be a string"
Int
rVal <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"R" Dict
enc Maybe Object -> (Object -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Int
intValue)
Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"R should be an integer"
Bool
encMD <-
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"EncryptMetadata" Dict
enc of
Maybe Object
Nothing -> Bool -> Either String Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just Object
o -> Object -> Maybe Bool
boolValue Object
o Maybe Bool -> String -> Either String Bool
forall a. Maybe a -> String -> Either String a
`notice` String
"EncryptMetadata should be a bool"
let ekey' :: ByteString
ekey' = Int -> ByteString -> ByteString
BS.take Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
MD5.hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ByteString
pass, ByteString
oVal, ByteString
pVal, ByteString
idVal, ByteString
pad]
pad :: ByteString
pad =
if Int
rVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
|| Bool
encMD
then ByteString
BS.empty
else [Word8] -> ByteString
BS.pack (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
4 Word8
255)
ekey :: ByteString
ekey =
if Int
rVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
then ByteString
ekey'
else (ByteString -> Int -> ByteString)
-> ByteString -> [Int] -> ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ByteString
bs Int
_ -> Int -> ByteString -> ByteString
BS.take Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
MD5.hash ByteString
bs)
ByteString
ekey'
[Int
1 :: Int .. Int
50]
ByteString -> Either String ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
ekey
verifyKey :: Dict -> Dict -> ByteString -> Either String Bool
verifyKey :: Dict -> Dict -> ByteString -> Either String Bool
verifyKey Dict
tr Dict
enc ByteString
ekey = do
Int
rVal <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"R" Dict
enc Maybe Object -> (Object -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Int
intValue)
Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"R should be an integer"
ByteString
idVal <- do
Array
ids <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"ID" Dict
tr Maybe Object -> (Object -> Maybe Array) -> Maybe Array
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Array
arrayValue)
Maybe Array -> String -> Either String Array
forall a. Maybe a -> String -> Either String a
`notice` String
"ID should be an array"
case (Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
ids) of
[] -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"ID array is empty"
(Object
x:[Object]
_) -> Object -> Maybe ByteString
stringValue Object
x
Maybe ByteString -> String -> Either String ByteString
forall a. Maybe a -> String -> Either String a
`notice` String
"The first element if ID should be a string"
ByteString
uVal <- (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"U" Dict
enc Maybe Object -> (Object -> Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe ByteString
stringValue)
Maybe ByteString -> String -> Either String ByteString
forall a. Maybe a -> String -> Either String a
`notice` String
"U should be a string"
Bool -> Either String Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either String Bool) -> Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$
case Int
rVal of
Int
2 ->
let uVal' :: ByteString
uVal' = (Ctx, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Ctx, ByteString) -> ByteString)
-> (Ctx, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString -> (Ctx, ByteString)
RC4.combine (ByteString -> Ctx
RC4.initCtx ByteString
ekey)
ByteString
defaultUserPassword
in ByteString
uVal ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
uVal'
Int
_ ->
let pass1 :: ByteString
pass1 = (Ctx, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Ctx, ByteString) -> ByteString)
-> (Ctx, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString -> (Ctx, ByteString)
RC4.combine (ByteString -> Ctx
RC4.initCtx ByteString
ekey)
(ByteString -> (Ctx, ByteString))
-> ByteString -> (Ctx, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
16 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
MD5.hash
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ByteString
defaultUserPassword, ByteString
idVal]
uVal' :: ByteString
uVal' = Word8 -> ByteString -> ByteString
loop Word8
1 ByteString
pass1
loop :: Word8 -> ByteString -> ByteString
loop Word8
20 ByteString
input = ByteString
input
loop Word8
i ByteString
input = Word8 -> ByteString -> ByteString
loop (Word8
i Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Ctx, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Ctx, ByteString) -> ByteString)
-> (Ctx, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString -> (Ctx, ByteString)
RC4.combine (ByteString -> Ctx
RC4.initCtx
(ByteString -> Ctx) -> ByteString -> Ctx
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
i) ByteString
ekey) ByteString
input
in Int -> ByteString -> ByteString
BS.take Int
16 ByteString
uVal ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
BS.take Int
16 ByteString
uVal'
data Algorithm
= V2
| AESV2
deriving (Int -> Algorithm -> String -> String
[Algorithm] -> String -> String
Algorithm -> String
(Int -> Algorithm -> String -> String)
-> (Algorithm -> String)
-> ([Algorithm] -> String -> String)
-> Show Algorithm
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Algorithm] -> String -> String
$cshowList :: [Algorithm] -> String -> String
show :: Algorithm -> String
$cshow :: Algorithm -> String
showsPrec :: Int -> Algorithm -> String -> String
$cshowsPrec :: Int -> Algorithm -> String -> String
Show)
mkDecryptor
:: Algorithm
-> ByteString
-> Int
-> Ref
-> InputStream ByteString
-> IO (InputStream ByteString)
mkDecryptor :: Algorithm
-> ByteString
-> Int
-> Ref
-> InputStream ByteString
-> IO (InputStream ByteString)
mkDecryptor Algorithm
alg ByteString
ekey Int
n (R Int
index Int
gen) InputStream ByteString
is = do
let key :: ByteString
key = Int -> ByteString -> ByteString
BS.take (Int
16 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
MD5.hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat
[ ByteString
ekey
, [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
3 ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BSL.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString
(Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int32 -> Builder
int32LE (Int32 -> Builder) -> Int32 -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index
, [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
2 ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BSL.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString
(Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int32 -> Builder
int32LE (Int32 -> Builder) -> Int32 -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gen
, Algorithm -> ByteString
forall p. IsString p => Algorithm -> p
salt Algorithm
alg
]
salt :: Algorithm -> p
salt Algorithm
V2 = p
""
salt Algorithm
AESV2 = p
"sAlT"
case Algorithm
alg of
Algorithm
V2 -> do
IORef Ctx
ioRef <- Ctx -> IO (IORef Ctx)
forall a. a -> IO (IORef a)
newIORef (Ctx -> IO (IORef Ctx)) -> Ctx -> IO (IORef Ctx)
forall a b. (a -> b) -> a -> b
$ ByteString -> Ctx
RC4.initCtx ByteString
key
let readNext :: IO (Maybe ByteString)
readNext = do
Maybe ByteString
chunk <- InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
is
case Maybe ByteString
chunk of
Maybe ByteString
Nothing -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
Just ByteString
c -> do
Ctx
ctx' <- IORef Ctx -> IO Ctx
forall a. IORef a -> IO a
readIORef IORef Ctx
ioRef
let (Ctx
ctx'', ByteString
res) = Ctx -> ByteString -> (Ctx, ByteString)
RC4.combine Ctx
ctx' ByteString
c
IORef Ctx -> Ctx -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Ctx
ioRef Ctx
ctx''
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
res)
IO (Maybe ByteString) -> IO (InputStream ByteString)
forall a. IO (Maybe a) -> IO (InputStream a)
Streams.makeInputStream IO (Maybe ByteString)
readNext
Algorithm
AESV2 -> do
ByteString
content <- [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputStream ByteString -> IO [ByteString]
forall a. InputStream a -> IO [a]
Streams.toList InputStream ByteString
is
let initV :: ByteString
initV = Int -> ByteString -> ByteString
BS.take Int
16 ByteString
content
aes :: AES
aes = ByteString -> AES
forall b. Byteable b => b -> AES
AES.initAES ByteString
key
decrypted :: ByteString
decrypted = AES -> ByteString -> ByteString -> ByteString
forall iv. Byteable iv => AES -> iv -> ByteString -> ByteString
AES.decryptCBC AES
aes ByteString
initV (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
16 ByteString
content
ByteString -> IO (InputStream ByteString)
Streams.fromByteString (ByteString -> IO (InputStream ByteString))
-> ByteString -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Padding.unpadPKCS5 ByteString
decrypted