[Init] first files

.gitignore

+.stack-work/
+*~
\ No newline at end of file

ChangeLog.md

+# Changelog for gargantext-prelude
+
+## Unreleased changes

LICENSE

+Copyright Author name here (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

+# gargantext-prelude

Setup.hs

+import Distribution.Simple
+main = defaultMain

app/Main.hs

+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc

gargantext-prelude.cabal

+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 4f8c4d6e24334ff69c434fceb4fc7135a3aec9926a3e99a1b0a85df27eb6fba1
+
+name:           gargantext-prelude
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/githubuser/gargantext-prelude#readme>
+homepage:       https://github.com/githubuser/gargantext-prelude#readme
+bug-reports:    https://github.com/githubuser/gargantext-prelude/issues
+author:         Author name here
+maintainer:     example@example.com
+copyright:      2021 Author name here
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/githubuser/gargantext-prelude
+
+library
+  exposed-modules:
+      Lib
+  other-modules:
+      Paths_gargantext_prelude
+  hs-source-dirs:
+      src
+  build-depends:
+      base >=4.7 && <5
+  default-language: Haskell2010
+
+executable gargantext-prelude-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_gargantext_prelude
+  hs-source-dirs:
+      app
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , gargantext-prelude
+  default-language: Haskell2010
+
+test-suite gargantext-prelude-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_gargantext_prelude
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , gargantext-prelude
+  default-language: Haskell2010

package.yaml

+name:                gargantext-prelude
+version:             0.1.0.0
+github:              "githubuser/gargantext-prelude"
+license:             GarganText like CNRS.LL
+author:              "Team Hello Word / CNRS"
+maintainer:          "team@gargantext.org"
+copyright:           "2021 HW/CNRS/Alexandre Delanoë"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/githubuser/gargantext-prelude#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- protolude
+
+library:
+  source-dirs: src
+
+executables:
+  gargantext-prelude-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - gargantext-prelude
+
+tests:
+  gargantext-prelude-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - gargantext-prelude

src/Gargantext/Prelude/Clock.hs

+{-|
+Module      : Gargantext.Prelude.Clock
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Gargantext.Prelude.Clock
+  where
+
+import Formatting.Clock (timeSpecs)
+import Formatting.Internal (Format(..))
+import Gargantext.Prelude
+import qualified System.Clock          as Clock (getTime, TimeSpec, Clock(..))
+
+---------------------------------------------------------------------------------
+getTime :: MonadBase IO m => m Clock.TimeSpec
+getTime = liftBase $ Clock.getTime Clock.ProcessCPUTime
+
+hasTime :: Formatting.Internal.Format r (Clock.TimeSpec -> Clock.TimeSpec -> r)
+hasTime = timeSpecs
+
+

src/Gargantext/Prelude/Config.hs

+{-|
+Module      : Gargantext.Prelude.Config
+Description : Textmining Collaborative Platform
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Gargantext.Prelude.Config where
+
+import Prelude (read)
+import System.IO (FilePath)
+import Data.Ini (readIniFile, lookupValue)
+import Data.Either.Extra (Either(Left, Right))
+import Data.Text as T
+import GHC.Generics (Generic)
+import Control.Lens (makeLenses)
+
+import Gargantext.Prelude
+
+
+-- | strip a given character from end of string
+stripRight :: Char -> T.Text -> T.Text
+stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s
+
+data GargConfig = GargConfig { _gc_url              :: !T.Text
+                             , _gc_url_backend_api  :: !T.Text
+
+                             , _gc_masteruser       :: !T.Text
+                             , _gc_secretkey        :: !T.Text
+
+                             , _gc_datafilepath     :: !FilePath
+                             , _gc_repofilepath     :: !FilePath
+
+                             , _gc_frame_write_url  :: !T.Text
+                             , _gc_frame_calc_url   :: !T.Text
+                             , _gc_frame_visio_url  :: !T.Text
+
+                             , _gc_frame_searx_url  :: !T.Text
+                             , _gc_frame_istex_url  :: !T.Text
+
+                             , _gc_max_docs_scrapers :: !Integer
+                             }
+  deriving (Generic, Show)
+
+makeLenses ''GargConfig
+
+readConfig :: FilePath -> IO GargConfig
+readConfig fp = do
+  ini         <- readIniFile fp
+  let ini'' = case ini of
+        Left e     -> panic (T.pack $ "gargantext.ini not found" <> show e)
+        Right ini' -> ini'
+
+  let val x = case (lookupValue (T.pack "gargantext") (T.pack x) ini'') of
+        Left _   -> panic (T.pack $ "ERROR: add " <> x <> " to your gargantext.ini")
+        Right p' -> p'
+
+  pure $ GargConfig (stripRight '/' $ val "URL")
+                    (stripRight '/' $ val "URL_BACKEND_API")
+                    (val "MASTER_USER")
+                    (val "SECRET_KEY")
+                    (cs $ val "DATA_FILEPATH")
+                    (cs $ val "REPO_FILEPATH")
+                    (stripRight '/' $ val "FRAME_WRITE_URL")
+                    (stripRight '/' $ val "FRAME_CALC_URL")
+                    (stripRight '/' $ val "FRAME_VISIO_URL")
+                    (stripRight '/' $ val "FRAME_SEARX_URL")
+                    (stripRight '/' $ val "FRAME_ISTEX_URL")
+                    (read $ cs $ val "MAX_DOCS_SCRAPERS")
+
+{- UNUSED
+defaultConfig :: GargConfig
+defaultConfig = GargConfig "https://localhost"
+                           "https://localhost:8008/api/v1.0"
+                           "gargantua"
+                           "secret"
+                           "data"
+                           "repos/"
+                           "https://frame_write.url"
+                           "https://frame_calc.url"
+                           "https://frame_searx.url"
+                           "https://frame_istex.url"
+                           1000
+-}

src/Gargantext/Prelude/Crypto/Auth.hs

+{-|
+Module      : Gargantext.Prelude.Crypto.Auth
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+
+module Gargantext.Prelude.Crypto.Auth ( createPasswordHash
+                               , checkPassword
+                               , module Data.Password.Argon2
+                               )
+      where
+
+import Control.Monad.IO.Class (MonadIO)
+import Data.Text (Text)
+import Data.Password.Argon2 hiding (checkPassword)
+import qualified Data.Password.Argon2 as A
+
+
+createPasswordHash :: MonadIO m 
+                   => Text
+                   -> m (PasswordHash Argon2)
+createPasswordHash x = hashPassword (mkPassword x)
+
+
+checkPassword :: Password
+              -> PasswordHash Argon2
+              -> PasswordCheck
+checkPassword = A.checkPassword
+
+{-
+-- Notes to implement Raw Password with argon2 lib
+-- (now using password library, which does not use salt anymore)
+-- import Crypto.Argon2 as Crypto
+-- import Data.ByteString.Base64.URL as URL
+-- import Data.Either
+-- import Data.ByteString (ByteString)
+secret_key :: ByteString
+secret_key = "WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
+
+type SecretKey = ByteString
+
+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)
+-}

src/Gargantext/Prelude/Crypto/Hash.hs

+{-|
+Module      : Gargantext.Prelude.Crypto.Hash
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans   #-}
+
+module Gargantext.Prelude.Crypto.Hash
+  where
+
+import Prelude (String)
+import Data.Set (Set)
+import Data.Text (Text)
+import Gargantext.Prelude
+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
+
+--------------------------------------------------------------------------
+-- | 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 {-# OVERLAPPING #-} 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 {-# OVERLAPPABLE #-} IsHashable a => IsHashable [a] where
+  hash = hash . Set.fromList . map hash
+

src/Gargantext/Prelude/Crypto/Pass/Machine.hs

+{-|
+Module      : Gargantext.Prelude.Crypto.Pass.Machine
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : Public Domain
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Random Text generator (for machines mainly)
+
+Thanks to 
+https://zuttobenkyou.wordpress.com/2011/12/23/simple-password-generation-with-haskell/
+
+-}
+
+
+module Gargantext.Prelude.Crypto.Pass.Machine
+      where
+
+import Data.List (nub)
+-- import System.Environment (getArgs)
+-- import System.IO (hSetEcho)
+import Control.Monad.State
+import Crypto.Random (cprgGenerate)
+import Crypto.Random.AESCtr
+import Data.Binary (decode)
+import Prelude
+import qualified Data.ByteString.Lazy as B
+import Data.ByteString as S (ByteString, unpack)
+import Data.ByteString.Char8 as C8 (pack)
+import Data.Char (chr)
+
+strToBS :: String -> S.ByteString
+strToBS = C8.pack
+
+bsToStr :: S.ByteString -> String
+bsToStr = map (chr . fromEnum) . S.unpack
+
+
+keysChar, keysNum, keysPunc, keysCharNum, keysAll, keysHex :: String
+keysChar = ['a'..'z'] ++ ['A'..'Z']
+keysHex = ['a'..'f']
+keysNum = ['0'..'9']
+keysPunc = "`~!@#$%^&*()-_=+[{]}\\|;:'\",<.>/? "
+keysCharNum = keysChar ++ keysNum
+keysAll = keysChar ++ keysNum ++ keysPunc
+ 
+giveKey ::  String -> Char -> Int -> Char
+giveKey keysCustom c n = extractChar $ case c of
+    'i'  -> (keysNum ++ keysHex)
+    'j'  -> keysNum
+    'k'  -> keysChar
+    'l'  -> keysCharNum
+    ';'  -> keysPunc
+    'h'  -> (keysCharNum ++ keysCustom)
+    '\n' -> ['\n']
+    _    -> keysAll
+    where
+    extractChar xs = xs!!mod n (length xs)
+ 
+showRandomKey :: Int -> String -> StateT AESRNG IO ()
+showRandomKey len keysCustom = handleKey =<< liftIO getChar
+    where
+    handleKey key = case key of
+        '\n' -> liftIO (putChar '\n') >> showRandomKey len keysCustom
+        'q' -> (liftIO $ putStrLn "\nBye!") >> return ()
+        _ -> mapM_ f [0..len] >> (liftIO $ putStrLn []) >> showRandomKey len keysCustom
+        where
+        f _ = liftIO
+            . putChar
+            . giveKey keysCustom key
+            . (\n -> mod n (length (keysAll ++ keysCustom) - 1))
+            =<< aesRandomInt
+
+
+aesRandomInt :: StateT AESRNG IO Int
+aesRandomInt = do
+    aesState <- get
+    -- aesState <- liftIO makeSystem
+    -- let aesState = 128
+    let (bs, aesState') = cprgGenerate 64 aesState
+    put aesState'
+    return (decode $ B.fromChunks [bs])
+
+printPass :: Int -> IO ()
+printPass len = do
+  let as = ["alphanumeric","punctuation"]
+  let as' = filter (\c -> elem c keysAll) . nub $ unwords as
+  aesState <- makeSystem -- gather entropy from the system to use as the initial seed
+  _ <- runStateT (showRandomKey len as') aesState -- enter loop
+  return ()
+
+gargPassMachine :: IO (Int, AESRNG)
+gargPassMachine = do
+  aesState <- makeSystem -- gather entropy from the system to use as the initial seed
+  pass <- runStateT aesRandomInt aesState -- enter loop
+  pure pass
+
+
+{- 
+main :: IO ()
+main = do
+    hSetBuffering stdin NoBuffering  -- disable buffering from STDIN
+    hSetBuffering stdout NoBuffering -- disable buffering from STDOUT
+    hSetEcho stdin False             -- disable terminal echo
+    as <- getArgs
+    let as' = filter (\c -> elem c keysAll) . nub $ unwords as
+    mapM_ putStrLn
+        [ []
+        , "poke: 'q'     quit"
+        , "      'j'     number"
+        , "      'k'     letter"
+        , "      'l'     alphanumeric"
+        , "      ';'     punctuation"
+        , "      'h'     alphanumeric" ++ (if null as' then [] else " + " ++ as')
+        , "      'i'     hexadecimal"
+        , "      'ENTER' newline"
+        , "      else    any"
+        , []
+        ]
+    aesState <- makeSystem -- gather entropy from the system to use as the initial seed
+    _ <- runStateT (showRandomKey as') aesState -- enter loop
+    return ()
+-}

src/Gargantext/Prelude/Crypto/Pass/User.hs

+{-|
+Module      : Gargantext.Prelude.Crypto.Pass.User
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : Public Domain
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+1) quick password generator for first invitations
+2) Easy password manager for User (easy to memorize) (needs list of words)
+
+-}
+
+
+module Gargantext.Prelude.Crypto.Pass.User
+      where
+
+
+-- 1) Quick password generator imports
+import Data.Text (Text)
+import Data.String (String)
+import Control.Monad
+import Control.Monad.Random
+import qualified Data.List as List
+
+-- 2) Easy password manager imports
+import Gargantext.Prelude
+import Gargantext.Prelude.Utils (shuffle)
+
+
+-- 1) Quick password generator
+-- Inspired by Rosetta code
+-- https://www.rosettacode.org/wiki/Password_generator#Haskell
+gargPass :: MonadRandom m => m Text
+gargPass = cs <$> gargPass' chars 33
+  where
+    chars = zipWith (List.\\) charSets visualySimilar
+
+    charSets = [ ['a'..'z']
+               , ['A'..'Z']
+               , ['0'..'9']
+               , "!\"#$%&'()*+,-./:;<=>?@[]^_{|}~"
+               ]
+ 
+    visualySimilar = ["l","IOSZ","012","!|.,'\""]
+
+gargPass' :: MonadRandom m => [String] -> Int -> m String
+gargPass' charSets n = do
+  parts <- getPartition n
+  chars <- zipWithM replicateM parts (uniform <$> charSets)
+  shuffle' (List.concat chars)
+  where
+    getPartition n' = adjust <$> replicateM (k-1) (getRandomR (1, n' `div` k))
+    k = length charSets
+    adjust p = (n - sum p) : p
+ 
+shuffle' :: (Eq a, MonadRandom m) => [a] -> m [a]
+shuffle' [] = pure []
+shuffle' lst = do
+  x <- uniform lst
+  xs <- shuffle (List.delete x lst)
+  return (x : xs)
+
+
+
+-- | 2) Easy password manager
+-- TODO add this as parameter to gargantext.ini
+gargPassUserEasy :: (Num a, Enum a, Integral a) => a -> [b] -> IO [b]
+gargPassUserEasy n = gargPassUserEasy' (100 * fromIntegral n) n
+
+gargPassUserEasy' :: (Num a, Enum a) => Int -> a -> [b] -> IO [b]
+gargPassUserEasy' threshold size wlist
+  | length wlist > threshold  = generatePassword size wlist
+  | otherwise                 = panic "List to short"
+
+generatePassword :: (Num a, Enum a) => a -> [b] -> IO [b]
+generatePassword size wlist = shuffle wlist
+  >>= \wlist' -> mapM (\_ -> getRandomElement wlist') [1..size]
+
+getRandomIndex :: Foldable t => t a -> IO Int
+getRandomIndex list = randomRIO (0, (length list - 1))
+
+getRandomElement :: [b] -> IO b
+getRandomElement list = do
+  index <- (getRandomIndex list)
+  pure (list List.!! index)
+

src/Gargantext/Prelude/Crypto/Share.hs

+{-|
+Module      : Gargantext.Prelude.Crypto.Share
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+# Random work/research (WIP)
+
+Goal: share secretly a sequence of random actions (either [Bool] or
+[Ordering] for instances here) but without sharing secrets.
+
+Motivation: useful to share clustering algorithm reproduction using BAC
+(Ballades Aléatoires Courtes).
+
+Question: how to certify the author of such (random) actions ? Solution
+later ;)
+
+-}
+
+------------------------------------------------------------------------
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+------------------------------------------------------------------------
+module Gargantext.Prelude.Crypto.Share
+  where
+
+import Data.Maybe
+import System.Random
+import Prelude (fromEnum, toEnum)
+import Gargantext.Core.Types (Ordering)
+import Gargantext.Prelude
+
+------------------------------------------------------------------------
+-- | Main Types
+newtype Seed = Seed Int
+type Private = Seed
+type Public  = Seed
+
+------------------------------------------------------------------------
+
+createSeed :: String -> (Char -> Int) -> Seed
+createSeed = undefined
+
+------------------------------------------------------------------------
+instance Random Ordering where
+  randomR (a, b) g =
+    case randomR (fromEnum a, fromEnum b) g of
+      (x, g') -> (toEnum x, g')
+  random g = randomR (minBound, maxBound) g
+
+
+randomOrdering :: Maybe Seed -> Int -> IO [Ordering]
+randomOrdering = randomWith
+
+randomBool :: Maybe Seed -> Int -> IO [Bool]
+randomBool= randomWith
+
+------------------------------------------------------------------
+
+randomWith :: Random a => Maybe Seed -> Int -> IO [a]
+randomWith seed n = do
+  g <- case seed of
+    Nothing        -> newStdGen
+    Just  (Seed s) -> pure $ mkStdGen s
+
+  pure $ take n $ (randoms g)
+
+genWith :: Private -> Public -> Int -> IO [Bool]
+genWith privateSeed publicSeed n = do
+  xs <- randomBool (Just  privateSeed) n
+  ys <- randomBool (Just  publicSeed ) n
+  pure $ zipWith xor xs ys
+
+{-
+- TODO WIP
+searchSeeds :: Int -> IO [Int]
+searchSeeds xs = mapM (\n -> randomWith (Just n) l) [1..]
+  where
+    l = length xs
+
+shareSeed = undefined
+
+certifySeed = undefined
+-}

src/Gargantext/Prelude/Fibonacci.hs

+{-|
+Module      : Gargantext.Prelude.Utils
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Nice optimization of the Fibonacci function.
+
+Source:
+Gabriel Gonzales, Blazing fast Fibonacci numbers using Monoids, 2020-04,
+http://www.haskellforall.com/2020/04/blazing-fast-fibonacci-numbers-using.html
+(This post illustrates a nifty application of Haskell’s standard library to solve a numeric problem.)
+
+TODO: quikcheck
+
+-}
+
+
+
+module Gargantext.Prelude.Fibonacci where
+
+import Protolude
+
+import qualified Data.Monoid as Monoid
+import qualified Data.Semigroup as Semigroup
+
+-------------------------------------------------------------
+fib' :: Integer -> Integer
+fib' 0 = 0
+fib' 1 = 1
+fib' n = fib (n-1) + fib (n-2)
+-------------------------------------------------------------
+
+
+data Matrix2x2 = Matrix
+    { x00 :: Integer, x01 :: Integer
+    , x10 :: Integer, x11 :: Integer
+    }
+
+instance Monoid.Monoid Matrix2x2 where
+    mempty =
+        Matrix
+            { x00 = 1, x01 = 0
+            , x10 = 0, x11 = 1
+            }
+
+instance Semigroup.Semigroup Matrix2x2 where
+    Matrix l00 l01 l10 l11 <> Matrix r00 r01 r10 r11 =
+        Matrix
+            { x00 = l00 * r00 + l01 * r10, x01 = l00 * r01 + l01 * r11
+            , x10 = l10 * r00 + l11 * r10, x11 = l10 * r01 + l11 * r11
+            }
+
+fib :: Integer -> Integer
+fib n = x01 (Semigroup.mtimesDefault n matrix)
+  where
+    matrix =
+        Matrix
+            { x00 = 0, x01 = 1
+            , x10 = 1, x11 = 1
+            }

src/Gargantext/Prelude/GargDB.hs

+{-|
+Module      : Gargantext.Prelude.GargDB
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+TODO_1: qualitative  tests (human)
+TODO_2: quantitative tests (coded)
+
+-}
+
+module Gargantext.Prelude.GargDB
+  where
+
+import Control.Exception
+import Control.Lens (view)
+import Control.Monad.Reader (MonadReader)
+import Data.Aeson (ToJSON, toJSON)
+import Data.Text (Text)
+import Data.Tuple.Extra (both)
+import GHC.IO (FilePath)
+import Gargantext.Database.Prelude (HasConfig(..))
+import Gargantext.Prelude
+import Gargantext.Prelude.Config
+import Gargantext.Prelude.Crypto.Hash
+import System.Directory (createDirectoryIfMissing)
+import System.IO.Error
+import System.Random (newStdGen)
+import qualified Data.Text             as Text
+import qualified System.Directory      as SD
+
+-------------------------------------------------------------------
+-- | Main Class to use (just declare needed functions)
+class GargDB a where
+  write :: a        -> IO ()
+  read  :: FilePath -> IO a
+
+  rm    :: (a, FilePath) -> IO ()
+  mv    :: (a, FilePath) -> FilePath -> IO ()
+
+
+-- | Why not this class too ?
+class ToJSON parameters => GargDB' parameters gargdata where
+  write' :: parameters -> gargdata -> IO ()
+  read'  :: parameters -> IO gargdata
+
+  rm'    :: gargdata -> parameters -> IO ()
+  mv'    :: gargdata -> parameters -> parameters -> IO ()
+
+-------------------------------------------------------------------
+-- | Deprecated Class, use GargDB instead
+class SaveFile a where
+  saveFile' :: FilePath -> a -> IO ()
+
+class ReadFile a where
+  readFile' :: FilePath -> IO a
+
+-------------------------------------------------------------------
+-------------------------------------------------------------------
+type GargFilePath = (FolderPath, FileName)
+-- where
+type FolderPath = FilePath
+type FileName   = FilePath
+
+           --------------------------------
+
+dataFilePath :: (ToJSON a) => a -> GargFilePath
+dataFilePath = toPath . hash . show . toJSON
+
+randomFilePath :: ( MonadReader  env m
+                  , MonadBase IO     m
+                  )
+               => m GargFilePath
+randomFilePath = do
+  (foldPath, fileName)  <- liftBase
+                         $ toPath
+                         . hash
+                         . show
+                         <$> newStdGen
+  pure (foldPath, fileName)
+
+
+-- | toPath' : how to hash text to path
+{- example of use:
+>>> toPath' (1,2) ("","helloword")
+("/he","lloword")
+
+>>> toPath' (2,2) ("","helloword")
+("/he/ll","oword")
+
+>>> toPath' (2,3) ("","helloword")
+("/hel/low","ord")
+-}
+toPath :: Text -> (FolderPath, FileName)
+toPath tx = both Text.unpack $ toPath' (2,3) ("", tx)
+
+toPath' :: (Int,Int) -> (Text,Text) -> (Text,Text)
+toPath' (n,m) (t,x) = foldl' (\tx _ -> toPath'' m tx) (t,x) [1..n]
+
+toPath'' :: Int -> (Text, Text) -> (Text, Text)
+toPath'' n (fp,fn) = (fp'',fn')
+  where
+    (fp',fn') = Text.splitAt n fn
+    fp''      = Text.intercalate "/" [fp,fp']
+
+-------------------------------------------------------------------
+type DataPath   = FilePath
+toFilePath :: FilePath -> FilePath -> FilePath
+toFilePath fp1 fp2 = fp1 <> "/" <> fp2
+
+-------------------------------------------------------------------
+
+-- | Disk operations
+-- | For example, this write file with a random filepath
+-- better use a hash of json of Type used to parameter as input 
+-- the functions
+writeFile :: ( MonadReader env m
+             , HasConfig   env
+             , MonadBase IO    m
+             , SaveFile        a
+             )
+          => a -> m FilePath
+writeFile a = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+
+  (foldPath, fileName) <- randomFilePath
+
+  let filePath     = toFilePath foldPath fileName
+      dataFoldPath = toFilePath dataPath foldPath
+      dataFileName = toFilePath dataPath filePath
+
+  _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
+  _ <- liftBase $ saveFile' dataFileName a
+
+  pure filePath
+
+---
+
+-- | Example to read a file with Type 
+readFile :: ( MonadReader  env m
+            , HasConfig    env
+            , MonadBase IO     m
+            , ReadFile         a
+            )
+         => FilePath -> m a
+readFile fp = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  liftBase $ readFile' $ toFilePath dataPath fp
+
+---
+
+rmFile :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+           => FilePath -> m ()
+rmFile = onDisk_1 SD.removeFile
+
+cpFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+           => FilePath -> FilePath -> m ()
+cpFile = onDisk_2 SD.copyFile
+
+---
+
+mvFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+       => FilePath -> FilePath -> m ()
+mvFile fp1 fp2 = do
+  cpFile fp1 fp2
+  rmFile fp1
+  pure ()
+
+------------------------------------------------------------------------
+onDisk_1 :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+        => (FilePath -> IO ()) -> FilePath -> m ()
+onDisk_1 action fp = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  liftBase $ action (toFilePath dataPath fp) `catch` handleExists
+    where
+      handleExists e
+        | isDoesNotExistError e = return ()
+        | otherwise = throwIO e
+
+
+onDisk_2 :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+        => (FilePath -> FilePath -> IO ())
+        -> FilePath
+        -> FilePath
+        -> m ()
+onDisk_2 action fp1 fp2 = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  let fp1' = toFilePath dataPath fp1
+      fp2' = toFilePath dataPath fp2
+  liftBase $ action fp1' fp2' `catch` handleExists
+    where
+      handleExists e
+        | isDoesNotExistError e = return ()
+        | otherwise = throwIO e
+------------------------------------------------------------------------
+

src/Gargantext/Prelude/Job.hs

+module Gargantext.Prelude.Job where
+
+import Data.IORef
+import Data.Maybe
+
+import Gargantext.Prelude
+
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+
+
+jobLogInit :: Int -> JobLog
+jobLogInit rem =
+  JobLog { _scst_succeeded = Just 0
+         , _scst_remaining = Just rem
+         , _scst_failed = Just 0
+         , _scst_events = Just [] }
+
+jobLogSuccess :: JobLog -> JobLog
+jobLogSuccess (JobLog { _scst_succeeded = mSucc
+                      , _scst_remaining = mRem
+                      , _scst_failed = mFail
+                      , _scst_events = evt }) =
+  JobLog { _scst_succeeded = (+ 1) <$> mSucc
+         , _scst_remaining = (\x -> x - 1) <$> mRem
+         , _scst_failed = mFail
+         , _scst_events = evt }
+
+
+jobLogFail :: JobLog -> JobLog
+jobLogFail (JobLog { _scst_succeeded = mSucc
+                   , _scst_remaining = mRem
+                   , _scst_failed = mFail
+                   , _scst_events = evt }) =
+  JobLog { _scst_succeeded = mSucc
+         , _scst_remaining = (\x -> x - 1) <$> mRem
+         , _scst_failed = (+ 1) <$> mFail
+         , _scst_events = evt }
+
+runJobLog :: MonadBase IO m => Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
+runJobLog num logStatus = do
+  jlRef <- liftBase $ newIORef $ jobLogInit num
+
+  return (logRefF jlRef, logRefSuccessF jlRef, getRefF jlRef)
+
+  where
+    logRefF ref = do
+      jl <- liftBase $ readIORef ref
+      logStatus jl
+    logRefSuccessF ref = do
+      jl <- liftBase $ readIORef ref
+      let jl' = jobLogSuccess jl
+      liftBase $ writeIORef ref jl'
+      logStatus jl'
+    getRefF ref = do
+      liftBase $ readIORef ref

src/Gargantext/Prelude/Mail.hs

+{-|
+Module      : Gargantext.Core.Mail
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Gargantext.Prelude.Mail
+  (gargMail, GargMail(..))
+  where
+
+-- import Data.Text.Internal.Lazy (Text)
+import Data.Text (Text)
+import Data.Maybe
+import Network.Mail.SMTP hiding (htmlPart)
+import Gargantext.Prelude
+import Network.Mail.Mime (plainPart)
+
+
+type Email = Text
+type Name  = Text
+
+data GargMail = GargMail { gm_to      :: Email
+                         , gm_name    :: Maybe Name
+                         , gm_subject :: Text
+                         , gm_body    :: Text
+                         }
+
+-- | TODO add parameters to gargantext.ini
+gargMail :: GargMail -> IO ()
+gargMail (GargMail to' name subject body) = sendMail "localhost" mail
+  where
+    mail = simpleMail from to cc bcc subject [plainPart $ cs body]
+
+    from       = Address (Just "GargTeam") "contact@gargantext.org"
+    to         = [Address name to']
+    cc         = []
+    bcc        = []
+
+

src/Gargantext/Prelude/Utils.hs

+{-|
+Module      : Gargantext.Prelude.Utils
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+TODO_1: qualitative  tests (human)
+TODO_2: quantitative tests (coded)
+
+
+-}
+
+module Gargantext.Prelude.Utils
+  where
+
+import Control.Monad.Random.Class (MonadRandom)
+import qualified System.Random.Shuffle as SRS
+
+------------------------------------------------------------------------
+-- | Misc Utils
+shuffle :: MonadRandom m => [a] -> m [a]
+shuffle ns = SRS.shuffleM ns 
+--------------------------------------------------------------------------
+
+-- TODO gargDB instance for NodeType
+{-
+data NodeToHash = NodeToHash { nodeType :: NodeType
+                             , nodeId   :: NodeId
+                             }
+-}

stack.yaml

+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/1.yaml
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.5"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

test/Spec.hs

+main :: IO ()
+main = putStrLn "Test suite not yet implemented"