[API] PostNodeAsync funs, before refactoring
[gargantext.git] / src / Gargantext / Prelude / Utils.hs
index 24b5c71d729a0f3ff41a756c14458a4e55db2743..bbca9ec691ee43def4e06a6cd39e01f77dff3ec8 100644 (file)
@@ -9,6 +9,7 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE     FlexibleContexts        #-}
 {-# LANGUAGE     NoImplicitPrelude       #-}
 {-# LANGUAGE     OverloadedStrings       #-}
 
@@ -16,30 +17,59 @@ module Gargantext.Prelude.Utils
   where
 
 import Control.Lens (view)
+import Control.Monad.Random.Class (MonadRandom)
 import Control.Monad.Reader (MonadReader)
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Data.Text (Text)
 import Control.Monad.Reader (ask)
+import Crypto.Argon2 as Crypto
+import Data.ByteString (ByteString)
+import Data.ByteString.Base64.URL as URL
+import Data.Either
+import Data.Text (Text)
 import GHC.IO (FilePath)
+import Gargantext.API.Admin.Settings
+import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
 import Gargantext.Prelude
-import Gargantext.API.Settings
-import System.Random (newStdGen)
 import System.Directory (createDirectoryIfMissing)
+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.Text                   as Text
+import qualified System.Random.Shuffle as SRS
 
-type FolderPath = FilePath
-type FileName   = FilePath
+--------------------------------------------------------------------------
+shuffle :: MonadRandom m => [a] -> m [a]
+shuffle ns = SRS.shuffleM ns 
 
-
-hash :: Text -> Text
-hash = Text.pack
-     .  SHA.showDigest
-     .  SHA.sha256
+--------------------------------------------------------------------------
+sha :: Text -> Text
+sha = Text.pack
+     . SHA.showDigest
+     . SHA.sha256
      . Char.pack
      . Text.unpack
 
+--------------------------------------------------------------------------
+data NodeToHash = NodeToHash { nodeType :: NodeType
+                             , nodeId   :: NodeId
+                             }
+
+secret_key :: ByteString
+secret_key = "WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
+
+type SecretKey = ByteString
+
+type FolderPath = FilePath
+type FileName   = FilePath
+
+hashNode :: SecretKey -> NodeToHash -> ByteString
+hashNode sk (NodeToHash nt ni) = case hashResult of
+    Left  e -> panic (cs $ show e)
+    Right h -> URL.encode h
+  where
+    hashResult = Crypto.hash Crypto.defaultHashOptions
+                  sk
+                  (cs $ show nt <> show ni)
+
 
 toPath :: Int -> Text -> (FolderPath,FileName)
 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
@@ -54,23 +84,23 @@ class ReadFile a where
   readFile' :: FilePath -> IO a
 
 
-writeFile :: (MonadReader env m, MonadIO m, HasSettings env, SaveFile a)
+writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
          => a -> m FilePath
 writeFile a = do
   dataPath <- view (settings . fileFolder) <$> ask
-  (fp,fn)  <- liftIO $ (toPath 3) . hash . Text.pack . show <$> newStdGen
+  (fp,fn)  <- liftBase $ (toPath 3) . sha . Text.pack . show <$> newStdGen
   
   let foldPath = dataPath <> "/" <> fp
       filePath = foldPath <> "/" <> fn
   
-  _ <- liftIO $ createDirectoryIfMissing True foldPath
-  _ <- liftIO $ saveFile' filePath a
+  _ <- liftBase $ createDirectoryIfMissing True foldPath
+  _ <- liftBase $ saveFile' filePath a
   
   pure filePath
 
 
-readFile :: (MonadReader env m, MonadIO m, HasSettings env, ReadFile a)
+readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
          => FilePath -> m a
 readFile fp = do
   dataPath <- view (settings . fileFolder) <$> ask
-  liftIO $ readFile' $ dataPath <> "/" <> fp
+  liftBase $ readFile' $ dataPath <> "/" <> fp