module Gargantext.Prelude.Utils
where
-import Prelude (String)
-import Data.Set (Set)
-import Data.List (foldl)
+import Control.Exception
import Control.Lens (view)
+import Control.Monad.Reader (ask, MonadReader)
import Control.Monad.Random.Class (MonadRandom)
-import Control.Monad.Reader (MonadReader)
-import Control.Monad.Reader (ask)
import Data.Text (Text)
+import qualified Data.Text as Text
import GHC.IO (FilePath)
-import Gargantext.API.Admin.Settings
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
-import Gargantext.Prelude
import System.Directory (createDirectoryIfMissing)
+import qualified System.Directory as SD
+import System.IO.Error
import System.Random (newStdGen)
-import qualified Data.ByteString.Lazy.Char8 as Char
-import qualified Data.Digest.Pure.SHA as SHA (sha256, showDigest)
-import qualified Data.Set as Set
-import qualified Data.Text as Text
import qualified System.Random.Shuffle as SRS
+import Gargantext.API.Admin.Settings
+import Gargantext.Prelude.Config
+import Gargantext.Prelude.Crypto.Hash
+import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
+import Gargantext.Prelude
+
--------------------------------------------------------------------------
shuffle :: MonadRandom m => [a] -> m [a]
shuffle ns = SRS.shuffleM ns
---------------------------------------------------------------------------
--- | Use this datatype to keep traceability of hashes
--- TODO use newtype
-type Hash = Text
-
--- | Class to make hashes
-class IsHashable a where
- hash :: a -> Hash
-
--- | Main API to hash text
--- using sha256 for now
-instance IsHashable Char.ByteString where
- hash = Text.pack
- . SHA.showDigest
- . SHA.sha256
-
-instance IsHashable String where
- hash = hash . Char.pack
-
-instance IsHashable Text where
- hash = hash . Text.unpack
-
-instance IsHashable (Set Hash) where
- hash = hash . foldl (<>) "" . Set.toList
-
-instance IsHashable [Hash] where
- hash = hash . Set.fromList
-
--------------------------------------------------------------------------
data NodeToHash = NodeToHash { nodeType :: NodeType
, nodeId :: NodeId
type FolderPath = FilePath
type FileName = FilePath
-toPath :: Int -> Text -> (FolderPath,FileName)
+-- | toPath example of use:
+-- toPath 2 "gargantexthello"
+-- ("ga/rg","antexthello")
+--
+-- toPath 3 "gargantexthello"
+-- ("gar/gan","texthello")
+
+
+toPath :: Int -> Text -> (FolderPath, FileName)
toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
where
(x1,x') = Text.splitAt n x
readFile' :: FilePath -> IO a
+folderFilePath :: (MonadReader env m, MonadBase IO m) => m (FolderPath, FileName)
+folderFilePath = do
+ (foldPath, fileName) <- liftBase $ (toPath 3) . hash . show <$> newStdGen
+
+ pure (foldPath, fileName)
+
+
writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
- => a -> m FilePath
+ => a -> m FilePath
writeFile a = do
- dataPath <- view (settings . fileFolder) <$> ask
- (fp,fn) <- liftBase $ (toPath 3) . hash . show <$> newStdGen
+ dataPath <- view (settings . config . gc_datafilepath) <$> ask
- let foldPath = dataPath <> "/" <> fp
- filePath = foldPath <> "/" <> fn
+ (foldPath, fileName) <- folderFilePath
- _ <- liftBase $ createDirectoryIfMissing True foldPath
- _ <- liftBase $ saveFile' filePath a
+ let filePath = foldPath <> "/" <> fileName
+ dataFoldPath = dataPath <> "/" <> foldPath
+ dataFileName = dataPath <> "/" <> filePath
+
+ _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
+ _ <- liftBase $ saveFile' dataFileName a
pure filePath
readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
=> FilePath -> m a
readFile fp = do
- dataPath <- view (settings . fileFolder) <$> ask
+ dataPath <- view (settings . config . gc_datafilepath) <$> ask
liftBase $ readFile' $ dataPath <> "/" <> fp
+
+removeFile :: (MonadReader env m, MonadBase IO m, HasSettings env)
+ => FilePath -> m ()
+removeFile fp = do
+ dataPath <- view (settings . config . gc_datafilepath) <$> ask
+ liftBase $ SD.removeFile (dataPath <> "/" <> fp) `catch` handleExists
+ where
+ handleExists e
+ | isDoesNotExistError e = return ()
+ | otherwise = throwIO e