Skip to content

haskell-gargantext
haskell-gargantext
Commit e36cc6ff authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[CLEAN] removing Prelude && adding gargantext-prelude dependency

parent 719fd6e7
Pipeline #1606 failed with stage
    in 5 minutes and 23 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 19 additions and 1058 deletions
    package.yaml
    View file @ e36cc6ff
    ......@@ -65,10 +65,6 @@ library:
    - Gargantext.Database.Admin.Config
    - Gargantext.Database.Admin.Types.Hyperdata
    - Gargantext.Database.Admin.Types.Node
    - Gargantext.Prelude
    - Gargantext.Prelude.Crypto.Pass.User
    - Gargantext.Prelude.Crypto.Hash
    - Gargantext.Prelude.Utils
    - Gargantext.Core.Text
    - Gargantext.Core.Text.Context
    - Gargantext.Core.Text.Corpus.Parsers
    ......@@ -100,13 +96,13 @@ library:
    dependencies:
    - HSvm
    - KMP
    - MissingH
    - MonadRandom
    - QuickCheck
    - SHA
    - Unique
    - accelerate
    - accelerate-utility
    - accelerate-arithmetic
    - accelerate-utility
    - aeson
    - aeson-lens
    - aeson-pretty
    ......@@ -124,16 +120,15 @@ library:
    - case-insensitive
    - cassava
    - cereal # (IGraph)
    - clock
    - conduit
    - conduit-extra
    - containers
    - contravariant
    - cryptohash
    - crawlerHAL
    - crawlerISTEX
    - crawlerIsidore
    - crawlerPubMed
    - cryptohash
    - data-time-segment
    - deepseq
    - directory
    ......@@ -147,6 +142,7 @@ library:
    - formatting
    - full-text-search
    - fullstop
    - gargantext-prelude
    - graphviz
    - hashable
    - haskell-igraph
    ......@@ -168,7 +164,6 @@ library:
    - located-base
    - logging-effect
    - matrix
    - MissingH
    - monad-control
    - monad-logger
    - mtl
    ......@@ -191,7 +186,6 @@ library:
    - quickcheck-instances
    - rake
    - random
    - random-shuffle
    - rdf4h
    - regex-compat
    - resource-pool
    ......@@ -216,24 +210,11 @@ library:
    - servant-xml
    - simple-reflect
    - singletons # (IGraph)
    - template-haskell
    - wai-app-static
    # for mail
    - smtp-mail
    - mime-mail
    # for password generation
    - cprng-aes
    - binary
    - crypto-random
    - password
    - split
    - stemmer
    - string-conversions
    - swagger2
    - tagsoup
    - template-haskell
    - temporary
    - text-metrics
    - time
    ......@@ -246,6 +227,7 @@ library:
    - validity
    - vector
    - wai
    - wai-app-static
    - wai-cors
    - wai-extra
    - warp
    ......@@ -256,10 +238,6 @@ library:
    - yaml
    - zip
    - zlib
    # - kmeans-vector
    #- charsetdetect-ae # detect charset
    # - utc
    # API external connections
    executables:
    gargantext-server:
    ......@@ -277,6 +255,7 @@ executables:
    - base
    - containers
    - gargantext
    - gargantext-prelude
    - vector
    - cassava
    - ini
    ......@@ -300,6 +279,7 @@ executables:
    - bytestring
    - containers
    - gargantext
    - gargantext-prelude
    - vector
    - cassava
    - ini
    ......@@ -325,6 +305,7 @@ executables:
    - containers
    - directory
    - gargantext
    - gargantext-prelude
    - vector
    - parallel
    - cassava
    ......@@ -346,6 +327,7 @@ executables:
    - -Wmissing-signatures
    dependencies:
    - gargantext
    - gargantext-prelude
    - base
    - servant-server
    ......@@ -360,6 +342,7 @@ executables:
    - -Wmissing-signatures
    dependencies:
    - gargantext
    - gargantext-prelude
    - base
    gargantext-upgrade:
    ......@@ -373,6 +356,7 @@ executables:
    - -Wmissing-signatures
    dependencies:
    - gargantext
    - gargantext-prelude
    - base
    gargantext-admin:
    ......@@ -386,6 +370,7 @@ executables:
    - -Wmissing-signatures
    dependencies:
    - gargantext
    - gargantext-prelude
    - base
    gargantext-cbor2json:
    ......@@ -399,6 +384,7 @@ executables:
    - -Wmissing-signatures
    dependencies:
    - gargantext
    - gargantext-prelude
    - base
    - bytestring
    - aeson
    ......@@ -426,6 +412,7 @@ tests:
    dependencies:
    - base
    - gargantext
    - gargantext-prelude
    - hspec
    - QuickCheck
    - quickcheck-instances
    ......
    src/Gargantext/Prelude/Job.hs → src/Gargantext/API/Job.hs
    View file @ e36cc6ff
    module Gargantext.Prelude.Job where
    module Gargantext.API.Job where
    import Data.IORef
    import Data.Maybe
    ......
    src/Gargantext/API/Ngrams.hs
    View file @ e36cc6ff
    ......@@ -117,7 +117,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
    import Gargantext.Database.Query.Table.Node.Select
    import Gargantext.Database.Schema.Node (node_id, node_parent_id, node_user_id)
    import Gargantext.Prelude hiding (log)
    import Gargantext.Prelude.Job
    import Gargantext.API.Job
    import Gargantext.Prelude.Clock (hasTime, getTime)
    import Prelude (error)
    import Servant hiding (Patch)
    ......
    src/Gargantext/Prelude.hs deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    Module : Gargantext.Prelude
    Description : Specific 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 #-}
    {-# OPTIONS_GHC -fno-warn-type-defaults #-}
    module Gargantext.Prelude
    ( module Gargantext.Prelude
    , module Protolude
    , module GHC.Err.Located
    , module Text.Show
    , module Text.Read
    , module Data.Maybe
    , module Prelude
    , MonadBase(..)
    , Typeable
    , cs
    , headMay, lastMay, sortWith
    , round
    )
    where
    import Control.Monad.Base (MonadBase(..))
    import Data.Set (Set)
    import GHC.Exts (sortWith)
    import GHC.Err.Located (undefined)
    import GHC.Real (round)
    import Data.Map (Map, lookup)
    import Data.Maybe (isJust, fromJust, maybe)
    import Data.Monoid (Monoid, mempty)
    import Data.Semigroup (Semigroup, (<>))
    import Data.Text (Text, pack)
    import Data.Typeable (Typeable)
    import Protolude ( Bool(True, False), Int, Int64, Double, Integer
    , Fractional, Num, Maybe(Just,Nothing)
    , Enum, Bounded, Float
    , Floating, Char, IO
    , Functor(..)
    , pure, (>>=), (=<<), (<*>), (<$>), (<&>), (>>)
    , head, flip
    , Ord, Integral, Foldable, RealFrac, Monad, filter
    , reverse, map, mapM, zip, drop, take, zipWith
    , sum, fromIntegral, length, fmap, foldl, foldl'
    , takeWhile, sqrt, identity
    , abs, min, max, maximum, minimum, return, snd, truncate
    , (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
    , Eq, (==), (>=), (<=), (<>), (/=), xor
    , (&&), (||), not, any, all
    , concatMap
    , fst, snd, toS
    , elem, die, mod, div, const, either
    , curry, uncurry, repeat
    , otherwise, when
    , IO()
    , compare
    , on
    , panic
    , seq
    )
    import qualified Protolude as Protolude (writeFile)
    import Prelude (Enum, Bounded, minBound, maxBound, putStrLn)
    -- TODO import functions optimized in Utils.Count
    -- import Protolude hiding (head, last, all, any, sum, product, length)
    -- import Gargantext.Utils.Count
    import Data.Map.Strict (insertWith)
    import Data.String.Conversions (cs)
    import Safe (headMay, lastMay, initMay, tailMay)
    import Text.Read (Read())
    import Text.Show (Show(), show)
    import qualified Control.Monad as M
    import qualified Data.List as L hiding (head, sum)
    import qualified Data.Map as M
    import qualified Data.Set as Set
    import qualified Data.Vector as V
    import System.FilePath.Posix (takeDirectory)
    import System.Directory (createDirectoryIfMissing)
    printDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m ()
    printDebug msg x = liftBase . putStrLn $ msg <> " " <> show x
    -- printDebug _ _ = pure ()
    saveAsFileDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m ()
    saveAsFileDebug fname x = do
    let dir = takeDirectory fname
    _ <- liftBase $ createDirectoryIfMissing True dir
    liftBase . Protolude.writeFile fname $ pack $ show x
    -- | splitEvery n == chunkAlong n n
    splitEvery :: Int -> [a] -> [[a]]
    splitEvery _ [] = []
    splitEvery n xs =
    let (h,t) = L.splitAt n xs
    in h : splitEvery n t
    type Grain = Int
    type Step = Int
    -- | Function to split a range into chunks
    -- if step == grain then linearity (splitEvery)
    -- elif step < grain then overlapping
    -- else dotted with holes
    -- TODO FIX BUG if Steps*Grain /= length l
    -- chunkAlong 10 10 [1..15] == [1..10]
    -- BUG: what about the rest of (divMod 15 10)?
    -- TODO: chunkAlongNoRest or chunkAlongWithRest
    -- default behavior: NoRest
    chunkAlong :: Eq a => Grain -> Step -> [a] -> [[a]]
    chunkAlong a b l = case a >= length l of
    True -> [l]
    False -> chunkAlong' a b l
    chunkAlong' :: Eq a => Grain -> Step -> [a] -> [[a]]
    chunkAlong' a b l = case a > 0 && b > 0 of
    True -> chunkAlong'' a b l
    False -> panic "ChunkAlong: Parameters should be > 0 and Grain > Step"
    chunkAlong'' :: Eq a => Int -> Int -> [a] -> [[a]]
    chunkAlong'' a b l = filter (/= []) $ only (while dropAlong)
    where
    only = map (take a)
    while = takeWhile (\x -> length x >= a)
    dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
    -- | Optimized version (Vector)
    chunkAlongV :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
    chunkAlongV a b l = only (while dropAlong)
    where
    only = V.map (V.take a)
    while = V.takeWhile (\x -> V.length x >= a)
    dropAlong = V.scanl (\x _y -> V.drop b x) l (V.fromList [1..])
    -- | TODO Inverse of chunk ? unchunkAlong ?
    -- unchunkAlong :: Int -> Int -> [[a]] -> [a]
    -- unchunkAlong = undefined
    -- splitAlong [2,3,4] ("helloworld" :: [Char]) == ["he", "llo", "worl", "d"]
    splitAlong :: [Int] -> [Char] -> [[Char]]
    splitAlong _ [] = [] -- No list? done
    splitAlong [] xs = [xs] -- No place to split at? Return the remainder
    splitAlong (x:xs) ys = take x ys : splitAlong xs (drop x ys)
    -- take until our split spot, recurse with next split spot and list remainder
    takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
    takeWhileM _ [] = return []
    takeWhileM p (a:as) = do
    v <- a
    if p v
    then do
    vs <- takeWhileM p as
    return (v:vs)
    else return []
    -- SUMS
    -- To select the right algorithme according to the type:
    -- https://github.com/mikeizbicki/ifcxt
    sumSimple :: Num a => [a] -> a
    sumSimple = L.foldl' (+) 0
    -- | https://en.wikipedia.org/wiki/Kahan_summation_algorithm
    sumKahan :: Num a => [a] -> a
    sumKahan = snd . L.foldl' go (0,0)
    where
    go (c,t) i = ((t'-t)-y,t')
    where
    y = i-c
    t' = t+y
    -- | compute part of the dict
    count2map :: (Ord k, Foldable t) => t k -> Map k Double
    count2map xs = M.map (/ (fromIntegral (length xs))) (count2map' xs)
    -- | insert in a dict
    count2map' :: (Ord k, Foldable t) => t k -> Map k Double
    count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) M.empty xs
    trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
    trunc n = truncate . (* 10^n)
    trunc' :: Int -> Double -> Double
    trunc' n x = fromIntegral $ truncate $ (x * 10^n)
    ------------------------------------------------------------------------
    bool2num :: Num a => Bool -> a
    bool2num True = 1
    bool2num False = 0
    bool2double :: Bool -> Double
    bool2double = bool2num
    bool2int :: Bool -> Int
    bool2int = bool2num
    ------------------------------------------------------------------------
    -- Normalizing && scaling data
    scale :: [Double] -> [Double]
    scale = scaleMinMax
    scaleMinMax :: [Double] -> [Double]
    scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
    where
    ma = maximum xs'
    mi = minimum xs'
    xs' = map abs xs
    scaleNormalize :: [Double] -> [Double]
    scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
    where
    v = variance xs'
    m = mean xs'
    xs' = map abs xs
    normalize :: [Double] -> [Double]
    normalize as = normalizeWith identity as
    normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
    normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
    where
    bs' = map extract bs
    -- Zip functions to add
    zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
    zipFst f xs = zip (f xs) xs
    zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
    zipSnd f xs = zip xs (f xs)
    -- | maximumWith
    maximumWith :: (Ord a1, Foldable t) => (a2 -> a1) -> t a2 -> a2
    maximumWith f = L.maximumBy (compare `on` f)
    -- | To get all combinations of a list with no
    -- repetition and apply a function to the resulting list of pairs
    listToCombi :: forall a b. (a -> b) -> [a] -> [(b,b)]
    listToCombi f l = [ (f x, f y) | (x:rest) <- L.tails l, y <- rest ]
    ------------------------------------------------------------------------
    -- Empty List Sugar Error Handling
    -- TODO add Garg Monad Errors
    listSafe1 :: Text -> ([a] -> Maybe a)
    -> Text -> [a] -> a
    listSafe1 s f e xs = maybe (panic $ h <> e) identity (f xs)
    where
    h = "[ERR][Gargantext] Empty list for " <> s <> " in "
    head' :: Text -> [a] -> a
    head' = listSafe1 "head" headMay
    last' :: Text -> [a] -> a
    last' = listSafe1 "last" lastMay
    ------------------------------------------------------------------------
    listSafeN :: Text -> ([a] -> Maybe [a])
    -> Text -> [a] -> [a]
    listSafeN s f e xs = maybe (panic $ h <> e) identity (f xs)
    where
    h = "[ERR][Gargantext] Empty list for " <> s <> " in "
    tail' :: Text -> [a] -> [a]
    tail' = listSafeN "tail" tailMay
    init' :: Text -> [a] -> [a]
    init' = listSafeN "init" initMay
    ------------------------------------------------------------------------
    --- Some Statistics sugar functions
    -- Exponential Average
    eavg :: [Double] -> Double
    eavg (x:xs) = a*x + (1-a)*(eavg xs)
    where a = 0.70
    eavg [] = 0
    -- Simple Average
    mean :: Fractional a => [a] -> a
    mean xs = sum xs / fromIntegral (length xs)
    sumMaybe :: Num a => [Maybe a] -> Maybe a
    sumMaybe = fmap sum . M.sequence
    variance :: Floating a => [a] -> a
    variance xs = sum ys / (fromIntegral (length xs) - 1)
    where
    m = mean xs
    ys = map (\x -> (x - m) ** 2) xs
    deviation :: Floating a => [a] -> a
    deviation = sqrt . variance
    movingAverage :: (Eq b, Fractional b) => Int -> [b] -> [b]
    movingAverage steps xs = map mean $ chunkAlong steps 1 xs
    -----------------------------------------------------------------------
    -----------------------------------------------------------------------
    --- Map in Map = Map2
    -- To avoid Map (a,a) b
    type Map2 a b = Map a (Map a b)
    lookup2 :: Ord a
    => a
    -> a
    -> Map2 a b
    -> Maybe b
    lookup2 a b m = do
    m' <- lookup a m
    lookup b m'
    -----------------------------------------------------------------------
    foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
    foldM' _ z [] = return z
    foldM' f z (x:xs) = do
    z' <- f z x
    z' `seq` foldM' f z' xs
    -----------------------------------------------------------------------
    -- | Instance for basic numerals
    -- See the difference between Double and (Int Or Integer)
    instance Monoid Double where
    mempty = 1
    instance Semigroup Double where
    (<>) a b = a * b
    -----------
    instance Monoid Int where
    mempty = 0
    instance Semigroup Int where
    (<>) a b = a + b
    ----
    instance Monoid Integer where
    mempty = 0
    instance Semigroup Integer where
    (<>) a b = a + b
    ------------------------------------------------------------------------
    hasDuplicates :: Ord a => [a] -> Bool
    hasDuplicates = hasDuplicatesWith Set.empty
    hasDuplicatesWith :: Ord a => Set a -> [a] -> Bool
    hasDuplicatesWith _seen [] =
    False -- base case: empty lists never contain duplicates
    hasDuplicatesWith seen (x:xs) =
    -- If we have seen the current item before, we can short-circuit; otherwise,
    -- we'll add it the the set of previously seen items and process the rest of the
    -- list against that.
    x `Set.member` seen || hasDuplicatesWith (Set.insert x seen) xs
    src/Gargantext/Prelude/Clock.hs deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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
    ------------------------------------------------------------------------
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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/Mail.hs deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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 deleted 100644 → 0
    View file @ 719fd6e7
    {-|
    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
    View file @ e36cc6ff
    ......@@ -23,7 +23,8 @@ nix:
    allow-newer: true
    extra-deps:
    - git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
    commit: 9dc45d72a52ece3bde5a104653a76ffb7a13a31e
    # Data Mining Libs
    - git: https://github.com/delanoe/data-time-segment.git
    commit: 10a416b9f6c443866b36479c3441ebb3bcdeb7ef
    ......
    Markdown is supported
    0% or
    You are about to add 0 people to the discussion. Proceed with caution.
    Finish editing this message first!
    Please register or to comment