{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}

module Pdf.Document.Pdf
(
  Pdf,
  withPdfFile,
  fromFile,
  fromHandle,
  fromBytes,
  document,
  lookupObject,
  streamContent,
  rawStreamContent,
  deref,
  isEncrypted,
  setUserPassword,
  defaultUserPassword,
  EncryptedError (..),
  enableCache,
  disableCache,
)
where

import Pdf.Core.Object
import Pdf.Core.Stream (knownFilters)
import Pdf.Core.File (File)
import qualified Pdf.Core.File as File
import Pdf.Core.Encryption (defaultUserPassword)

import Pdf.Document.Internal.Types

import Data.Typeable
import Data.IORef
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.HashMap.Strict as HashMap
import Control.Monad
import Control.Exception hiding (throw)
import System.IO (Handle)
import System.IO.Streams (InputStream)

withPdfFile :: FilePath -> (Pdf -> IO a) -> IO a
withPdfFile :: FilePath -> (Pdf -> IO a) -> IO a
withPdfFile FilePath
path Pdf -> IO a
action = FilePath -> (File -> IO a) -> IO a
forall a. FilePath -> (File -> IO a) -> IO a
File.withPdfFile FilePath
path ((File -> IO a) -> IO a) -> (File -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \File
f -> do
  Pdf
pdf <- File -> IO Pdf
fromFile File
f
  Pdf -> IO a
action Pdf
pdf

-- | Make Pdf with interface to pdf file
fromFile :: File -> IO Pdf
fromFile :: File -> IO Pdf
fromFile File
f = File -> IORef ObjectCache -> Pdf
Pdf File
f
  (IORef ObjectCache -> Pdf) -> IO (IORef ObjectCache) -> IO Pdf
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObjectCache -> IO (IORef ObjectCache)
forall a. a -> IO (IORef a)
newIORef (Bool
False, HashMap Ref Object
forall k v. HashMap k v
HashMap.empty)

-- | Make Pdf with seekable handle
fromHandle :: Handle -> IO Pdf
fromHandle :: Handle -> IO Pdf
fromHandle Handle
h = do
  [StreamFilter] -> Handle -> IO File
File.fromHandle [StreamFilter]
knownFilters Handle
h IO File -> (File -> IO Pdf) -> IO Pdf
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= File -> IO Pdf
fromFile

-- | Make Pdf from a ByteString
fromBytes :: ByteString -> IO Pdf
fromBytes :: ByteString -> IO Pdf
fromBytes ByteString
h = do
  [StreamFilter] -> ByteString -> IO File
File.fromBytes [StreamFilter]
knownFilters ByteString
h IO File -> (File -> IO Pdf) -> IO Pdf
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= File -> IO Pdf
fromFile

file :: Pdf -> File
file :: Pdf -> File
file (Pdf File
f IORef ObjectCache
_) = File
f

-- | Get PDF document
document :: Pdf -> IO Document
document :: Pdf -> IO Document
document Pdf
pdf = do
  EncryptionStatus
status <- File -> IO EncryptionStatus
File.encryptionStatus (Pdf -> File
file Pdf
pdf)
  case EncryptionStatus
status of
    EncryptionStatus
File.Encrypted -> EncryptedError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (EncryptedError -> IO ()) -> EncryptedError -> IO ()
forall a b. (a -> b) -> a -> b
$
      Text -> EncryptedError
EncryptedError Text
"File is encrypted, use 'setUserPassword'"
    EncryptionStatus
File.Decrypted -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    EncryptionStatus
File.Plain -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Pdf -> Dict -> Document
Document Pdf
pdf (Dict -> Document) -> IO Dict -> IO Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File -> IO Dict
File.lastTrailer (Pdf -> File
file Pdf
pdf)

-- | Find object by it's reference
lookupObject :: Pdf -> Ref -> IO Object
lookupObject :: Pdf -> Ref -> IO Object
lookupObject Pdf
pdf Ref
ref = do
  let Pdf File
_ IORef ObjectCache
cacheRef = Pdf
pdf
  (Bool
useCache, HashMap Ref Object
cache) <- IORef ObjectCache -> IO ObjectCache
forall a. IORef a -> IO a
readIORef IORef ObjectCache
cacheRef
  case Ref -> HashMap Ref Object -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Ref
ref HashMap Ref Object
cache of
    Just Object
obj -> Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
obj
    Maybe Object
Nothing -> do
      Object
obj <- File -> Ref -> IO Object
File.findObject (Pdf -> File
file Pdf
pdf) Ref
ref
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useCache (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IORef ObjectCache -> ObjectCache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ObjectCache
cacheRef (Bool
useCache, Ref -> Object -> HashMap Ref Object -> HashMap Ref Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Ref
ref Object
obj HashMap Ref Object
cache)
      Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
obj

-- | Cache object for future lookups
enableCache :: Pdf -> IO ()
enableCache :: Pdf -> IO ()
enableCache (Pdf File
_ IORef ObjectCache
cacheRef) = do
  (Bool
_, HashMap Ref Object
cache) <- IORef ObjectCache -> IO ObjectCache
forall a. IORef a -> IO a
readIORef IORef ObjectCache
cacheRef
  IORef ObjectCache -> ObjectCache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ObjectCache
cacheRef (Bool
True, HashMap Ref Object
cache)

-- | Don't cache object for future lookups
disableCache :: Pdf -> IO ()
disableCache :: Pdf -> IO ()
disableCache (Pdf File
_ IORef ObjectCache
cacheRef) = do
  (Bool
_, HashMap Ref Object
cache) <- IORef ObjectCache -> IO ObjectCache
forall a. IORef a -> IO a
readIORef IORef ObjectCache
cacheRef
  IORef ObjectCache -> ObjectCache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ObjectCache
cacheRef (Bool
False, HashMap Ref Object
cache)

-- | Get stream content, decoded and decrypted
--
-- Note: length of the content may differ from the raw one
streamContent :: Pdf
              -> Ref
              -> Stream
              -> IO (InputStream ByteString)
streamContent :: Pdf -> Ref -> Stream -> IO (InputStream ByteString)
streamContent Pdf
pdf Ref
ref Stream
s =
  File -> Ref -> Stream -> IO (InputStream ByteString)
File.streamContent (Pdf -> File
file Pdf
pdf) Ref
ref Stream
s

-- | Get stream content without decoding it
rawStreamContent
  :: Pdf
  -> Ref
  -> Stream
  -> IO (InputStream ByteString)
rawStreamContent :: Pdf -> Ref -> Stream -> IO (InputStream ByteString)
rawStreamContent Pdf
pdf Ref
ref Stream
s =
  File -> Ref -> Stream -> IO (InputStream ByteString)
File.rawStreamContent (Pdf -> File
file Pdf
pdf) Ref
ref Stream
s

-- | Whether the PDF document it encrypted
isEncrypted :: Pdf -> IO Bool
isEncrypted :: Pdf -> IO Bool
isEncrypted Pdf
pdf = do
  EncryptionStatus
status <- File -> IO EncryptionStatus
File.encryptionStatus (Pdf -> File
file Pdf
pdf)
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case EncryptionStatus
status of
    EncryptionStatus
File.Encrypted -> Bool
True
    EncryptionStatus
File.Decrypted -> Bool
True
    EncryptionStatus
File.Plain -> Bool
False

-- | Set the password to be user for decryption
--
-- Returns False when the password is wrong
setUserPassword :: Pdf -> ByteString -> IO Bool
setUserPassword :: Pdf -> ByteString -> IO Bool
setUserPassword Pdf
pdf ByteString
password =
  File -> ByteString -> IO Bool
File.setUserPassword (Pdf -> File
file Pdf
pdf) ByteString
password

deref :: Pdf -> Object -> IO Object
deref :: Pdf -> Object -> IO Object
deref Pdf
pdf (Ref Ref
r) = Pdf -> Ref -> IO Object
lookupObject Pdf
pdf Ref
r
deref Pdf
_ Object
o = Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o

-- | File is enctypted
data EncryptedError = EncryptedError Text
  deriving (Int -> EncryptedError -> ShowS
[EncryptedError] -> ShowS
EncryptedError -> FilePath
(Int -> EncryptedError -> ShowS)
-> (EncryptedError -> FilePath)
-> ([EncryptedError] -> ShowS)
-> Show EncryptedError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EncryptedError] -> ShowS
$cshowList :: [EncryptedError] -> ShowS
show :: EncryptedError -> FilePath
$cshow :: EncryptedError -> FilePath
showsPrec :: Int -> EncryptedError -> ShowS
$cshowsPrec :: Int -> EncryptedError -> ShowS
Show, Typeable)

instance Exception EncryptedError