src/Gargantext/Prelude/Utils.hs

   1 {-|
   2 Module      : Gargantext.Prelude.Utils
   3 Description : Useful Tools near Prelude of the project
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12
  13 module Gargantext.Prelude.Utils
  14   where
  15
  16 import Data.Set (Set)
  17 import Data.List (foldl)
  18 import Control.Lens (view)
  19 import Control.Monad.Random.Class (MonadRandom)
  20 import Control.Monad.Reader (MonadReader)
  21 import Control.Monad.Reader (ask)
  22 import Data.Text (Text)
  23 import GHC.IO (FilePath)
  24 import Gargantext.API.Admin.Settings
  25 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
  26 import Gargantext.Prelude
  27 import System.Directory (createDirectoryIfMissing)
  28 import System.Random (newStdGen)
  29 import qualified Data.ByteString.Lazy.Char8  as Char
  30 import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
  31 import qualified Data.Set                    as Set
  32 import qualified Data.Text                   as Text
  33 import qualified System.Random.Shuffle as SRS
  34
  35 --------------------------------------------------------------------------
  36 shuffle :: MonadRandom m => [a] -> m [a]
  37 shuffle ns = SRS.shuffleM ns
  38
  39 --------------------------------------------------------------------------
  40 -- | Use this datatype to keep traceability of hashes
  41 -- TODO use newtype
  42 type Hash = Text
  43
  44 -- | API to hash text
  45 -- using sha256 for now
  46 hash :: Text -> Hash
  47 hash = sha
  48
  49 -- | Sugar fun to sha256 Text
  50 sha :: Text -> Hash
  51 sha = Text.pack
  52      . SHA.showDigest
  53      . SHA.sha256
  54      . Char.pack
  55      . Text.unpack
  56
  57 hashFromList :: [Hash] -> Hash
  58 hashFromList = hashFromSet . Set.fromList
  59
  60 hashFromSet :: Set Hash -> Hash
  61 hashFromSet = sha . foldl (<>) "" . Set.toList
  62
  63 --------------------------------------------------------------------------
  64 data NodeToHash = NodeToHash { nodeType :: NodeType
  65                              , nodeId   :: NodeId
  66                              }
  67
  68 type FolderPath = FilePath
  69 type FileName   = FilePath
  70
  71 toPath :: Int -> Text -> (FolderPath,FileName)
  72 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
  73   where
  74     (x1,x') = Text.splitAt n x
  75     (x2,xs) = Text.splitAt n x'
  76
  77 class SaveFile a where
  78   saveFile' :: FilePath -> a -> IO ()
  79
  80 class ReadFile a where
  81   readFile' :: FilePath -> IO a
  82
  83
  84 writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
  85          => a -> m FilePath
  86 writeFile a = do
  87   dataPath <- view (settings . fileFolder) <$> ask
  88   (fp,fn)  <- liftBase $ (toPath 3) . sha . Text.pack . show <$> newStdGen
  89
  90   let foldPath = dataPath <> "/" <> fp
  91       filePath = foldPath <> "/" <> fn
  92
  93   _ <- liftBase $ createDirectoryIfMissing True foldPath
  94   _ <- liftBase $ saveFile' filePath a
  95
  96   pure filePath
  97
  98
  99 readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
 100          => FilePath -> m a
 101 readFile fp = do
 102   dataPath <- view (settings . fileFolder) <$> ask
 103   liftBase $ readFile' $ dataPath <> "/" <> fp