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 {-# LANGUAGE     NoImplicitPrelude       #-}
  13 {-# LANGUAGE     OverloadedStrings       #-}
  14
  15 module Gargantext.Prelude.Utils
  16   where
  17
  18 import Control.Lens (view)
  19 import Control.Monad.Reader (MonadReader)
  20 import Control.Monad.IO.Class (MonadIO, liftIO)
  21 import Control.Monad.Random.Class (MonadRandom)
  22 import Data.Text (Text)
  23 import Control.Monad.Reader (ask)
  24 import GHC.IO (FilePath)
  25 import Gargantext.Prelude
  26 import Gargantext.API.Settings
  27 import System.Random (newStdGen)
  28 import qualified System.Random.Shuffle as SRS
  29 import System.Directory (createDirectoryIfMissing)
  30 import qualified Data.ByteString.Lazy.Char8  as Char
  31 import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
  32 import qualified Data.Text                   as Text
  33 import Gargantext.Database.Types.Node (NodeId, NodeType)
  34 import Data.ByteString (ByteString)
  35 import Crypto.Argon2 as Crypto
  36 import Data.Either
  37 import Data.ByteString.Base64.URL as URL
  38
  39 shuffle :: MonadRandom m => [a] -> m [a]
  40 shuffle ns = SRS.shuffleM ns
  41
  42 type FolderPath = FilePath
  43 type FileName   = FilePath
  44
  45 sha :: Text -> Text
  46 sha = Text.pack
  47      . SHA.showDigest
  48      . SHA.sha256
  49      . Char.pack
  50      . Text.unpack
  51
  52 data NodeToHash = NodeToHash { nodeType :: NodeType
  53                              , nodeId   :: NodeId
  54                              }
  55
  56 secret_key :: ByteString
  57 secret_key = "WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
  58
  59 type SecretKey = ByteString
  60
  61 hashNode :: SecretKey -> NodeToHash -> ByteString
  62 hashNode sk (NodeToHash nt ni) = case hashResult of
  63     Left  e -> panic (cs $ show e)
  64     Right h -> URL.encode h
  65   where
  66     hashResult = Crypto.hash Crypto.defaultHashOptions
  67                   sk
  68                   (cs $ show nt <> show ni)
  69
  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, MonadIO m, HasSettings env, SaveFile a)
  85          => a -> m FilePath
  86 writeFile a = do
  87   dataPath <- view (settings . fileFolder) <$> ask
  88   (fp,fn)  <- liftIO $ (toPath 3) . sha . Text.pack . show <$> newStdGen
  89
  90   let foldPath = dataPath <> "/" <> fp
  91       filePath = foldPath <> "/" <> fn
  92
  93   _ <- liftIO $ createDirectoryIfMissing True foldPath
  94   _ <- liftIO $ saveFile' filePath a
  95
  96   pure filePath
  97
  98
  99 readFile :: (MonadReader env m, MonadIO m, HasSettings env, ReadFile a)
 100          => FilePath -> m a
 101 readFile fp = do
 102   dataPath <- view (settings . fileFolder) <$> ask
 103   liftIO $ readFile' $ dataPath <> "/" <> fp