From 4ab9322e3b1ec82343ea2f8a778e1b81d2a99e4d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=CE=A3rebe=20-=20Romain=20GERARD?= <erebe@erebe.eu>
Date: Sun, 2 May 2021 18:14:55 +0200
Subject: [PATCH] Add max item size limit

---
 src/Clipboard.hs |  9 ++++++++-
 src/Main.hs      | 18 ++++++++++++++----
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/src/Clipboard.hs b/src/Clipboard.hs
index c1fe92d..eccc5b0 100644
--- a/src/Clipboard.hs
+++ b/src/Clipboard.hs
@@ -16,6 +16,7 @@ import           Graphics.X11.Xlib.Extras
 
 import           Data.Binary              (Binary)
 import qualified Data.ByteString          as B
+import qualified Data.Text as T
 import           Lens.Micro
 
 import           System.Directory         (setCurrentDirectory)
@@ -33,6 +34,13 @@ data SelectionType = UTF8 Text
                    | BITMAP ByteString
                    deriving (Show, Eq, Generic, Binary)
 
+selectionLength :: Selection -> Int
+selectionLength (Selection _ (UTF8 a)) = T.length a
+selectionLength (Selection _ (PNG a)) = B.length a
+selectionLength (Selection _ (JPEG a)) = B.length a
+selectionLength (Selection _ (BITMAP a)) = B.length a
+
+
 data Selection = Selection {
     appName   :: Text
   , selection :: SelectionType
@@ -48,7 +56,6 @@ data XorgContext = XorgContext {
   , defaultMime      :: Atom
 } deriving (Show)
 
-
 test :: IO ()
 test =
   bracket getXorgContext destroyXorgContext $ \ctx -> do
diff --git a/src/Main.hs b/src/Main.hs
index dad1695..210b388 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -39,6 +39,7 @@ data Command = DAEMON | PRINT | COPY Text | CLEAR | HELP deriving (Show, Read)
 
 data Config = Config
   { maxHistoryLength           :: Int
+  , maxItemSizeBytes           :: Int
   , historyPath                :: Text
   , staticHistoryPath          :: Text
   , imageCachePath             :: Text
@@ -51,6 +52,7 @@ data Config = Config
 configCodec :: TomlCodec Config
 configCodec = Config
     <$> Toml.int "max_history_length"  .= maxHistoryLength
+    <*> Toml.int "max_item_size_bytes" .= maxItemSizeBytes
     <*> Toml.text "history_file" .= historyPath
     <*> Toml.text "static_history_file" .= staticHistoryPath
     <*> Toml.text "image_cache_directory" .= imageCachePath
@@ -168,8 +170,16 @@ runDaemon = prepareDirs >> setHistoryFilePermission >> (forever $ go `catchAll`
     innerloop :: (MonadIO m, MonadReader Config m) => [(IO (Maybe Clip.Selection), Maybe Clip.Selection)] -> ClipHistory -> m ClipHistory
     innerloop getSelections history = do
       -- Get selection from enabled clipboards
-      (getSelections', sel) <- liftIO $ getSelection getSelections
-
+      (getSelections', rawSelection) <- liftIO $ getSelection getSelections
+
+      -- Do not store selection items above threshold size
+      maxItemSize <- view (to maxItemSizeBytes)
+      let sel = case rawSelection of
+            Nothing -> Nothing
+            Just selection -> if maxItemSize > 0 && Clip.selectionLength selection >= maxItemSize
+                              then Nothing
+                              else Just selection
+             
       -- Do not use selection coming from blacklisted app
       liftIO $ when (isJust sel) (print (Clip.appName <$> sel))
       blacklist <- view (to blacklistedApps)
@@ -253,7 +263,7 @@ getConfig = do
   when (isLeft tomlRes) $ do
     die . toS $  "Error parsing the config file at " <> (show configPath) <> "\n" <> Toml.prettyTomlDecodeErrors (fromLeft mempty tomlRes)
   
-  let cfg = fromRight (Config 50 "" "" "" False [] True True) tomlRes 
+  let cfg = fromRight (Config 50 0 "" "" "" False [] True True) tomlRes 
   
   -- if it ends with / we don't create a temp directory
   -- user is responsible for it
@@ -268,7 +278,7 @@ getConfig = do
   where
     defaultConfig = do 
       homeDir <- toS . fromMaybe mempty . listToMaybe <$> wordexp "~/"
-      return $ Config 50 (homeDir <> ".cache/greenclip.history") (homeDir <> ".cache/greenclip.staticHistory" ) "/tmp/greenclip" False [] True True
+      return $ Config 50 0 (homeDir <> ".cache/greenclip.history") (homeDir <> ".cache/greenclip.staticHistory" ) "/tmp/greenclip" False [] True True
 
 
 parseArgs :: [Text] -> Command