Commit 973417fb authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Add bench for passwords, use test crypto in tests

parent 8a532ac6
...@@ -63,7 +63,7 @@ test: ...@@ -63,7 +63,7 @@ test:
nix-shell --run "./bin/update-cabal-project $CABAL_STORE_DIR" nix-shell --run "./bin/update-cabal-project $CABAL_STORE_DIR"
mkdir -p /root/.cache/cabal/logs mkdir -p /root/.cache/cabal/logs
chown -R test:test /root/.cache/cabal/logs/ chown -R test:test /root/.cache/cabal/logs/
nix-shell --run "chown -R test:test /root/.config/ && su -m test -c \"export PATH=$PATH:$TEST_NIX_PATH && cd /builds/gargantext/haskell-gargantext && $CABAL --store-dir=$CABAL_STORE_DIR v2-test --test-show-details=streaming --ghc-options='-O0 -fclear-plugins'\"" nix-shell --run "chown -R test:test /root/.config/ && su -m test -c \"export PATH=$PATH:$TEST_NIX_PATH && cd /builds/gargantext/haskell-gargantext && $CABAL --store-dir=$CABAL_STORE_DIR v2-test --test-show-details=streaming --flags test-crypto --ghc-options='-O0 -fclear-plugins'\""
chown -R root:root dist-newstyle/ chown -R root:root dist-newstyle/
chown -R root:root /root/ chown -R root:root /root/
chown -R root:root $CABAL_STORE_DIR chown -R root:root $CABAL_STORE_DIR
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import Gargantext.Core.Types.Individu
import Gargantext.Prelude.Crypto.Auth (createPasswordHash)
import Test.Tasty.Bench
main :: IO ()
main = defaultMain
[ bgroup "Benchmarks"
[ bgroup "User creation" [
bench "createPasswordHash" $ whnfIO (createPasswordHash "rabbit")
, bench "toUserHash" $
whnfIO (toUserHash $ NewUser "alfredo" "alfredo@well-typed.com" (GargPassword "rabbit"))
]
]
]
...@@ -68,7 +68,7 @@ source-repository-package ...@@ -68,7 +68,7 @@ source-repository-package
source-repository-package source-repository-package
type: git type: git
location: https://gitlab.iscpif.fr/cgenie/haskell-gargantext-prelude location: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
tag: 8f97fef4dfd941d773914ad058d8e02ce2bb1a3e tag: 8f97fef4dfd941d773914ad058d8e02ce2bb1a3e
source-repository-package source-repository-package
......
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -33,6 +33,13 @@ data-files: ...@@ -33,6 +33,13 @@ data-files:
test-data/test_config.ini test-data/test_config.ini
.clippy.dhall .clippy.dhall
-- When enabled, it swaps the hashing algorithm
-- with a quicker (and less secure) version, which
-- runs faster in tests.
flag test-crypto
default: False
manual: True
library library
exposed-modules: exposed-modules:
Gargantext Gargantext
...@@ -371,6 +378,8 @@ library ...@@ -371,6 +378,8 @@ library
RecordWildCards RecordWildCards
StrictData StrictData
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fplugin=Clippy ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fplugin=Clippy
if flag(test-crypto)
cpp-options: -DTEST_CRYPTO
build-depends: build-depends:
HSvm ^>= 0.1.1.3.22 HSvm ^>= 0.1.1.3.22
, KMP ^>= 0.2.0.0 , KMP ^>= 0.2.0.0
...@@ -965,3 +974,15 @@ test-suite garg-test ...@@ -965,3 +974,15 @@ test-suite garg-test
, validity ^>= 0.11.0.1 , validity ^>= 0.11.0.1
default-language: Haskell2010 default-language: Haskell2010
benchmark garg-bench
main-is: Main.hs
hs-source-dirs: bench
type: exitcode-stdio-1.0
build-depends: base
, bytestring
, gargantext
, gargantext-prelude
, tasty-bench
ghc-options: "-with-rtsopts=-A32m"
if impl(ghc >= 8.6)
ghc-options: "-with-rtsopts=--nonmoving-gc"
{-# LANGUAGE CPP #-}
{-| {-|
Module : Gargantext.Core.Types.Individu Module : Gargantext.Core.Types.Individu
Description : Short description Description : Short description
...@@ -15,11 +17,11 @@ Individu defintions ...@@ -15,11 +17,11 @@ Individu defintions
module Gargantext.Core.Types.Individu module Gargantext.Core.Types.Individu
where where
import Data.Aeson
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import GHC.Generics (Generic) import Data.Aeson
import Data.Swagger import Data.Swagger
import Data.Text (Text, pack, reverse) import Data.Text (Text, pack, reverse)
import GHC.Generics (Generic)
import Gargantext.Database.Admin.Types.Node (NodeId, UserId) import Gargantext.Database.Admin.Types.Node (NodeId, UserId)
import Gargantext.Prelude hiding (reverse) import Gargantext.Prelude hiding (reverse)
import qualified Gargantext.Prelude.Crypto.Auth as Auth import qualified Gargantext.Prelude.Crypto.Auth as Auth
...@@ -68,8 +70,15 @@ toUserHash :: MonadIO m ...@@ -68,8 +70,15 @@ toUserHash :: MonadIO m
=> NewUser GargPassword => NewUser GargPassword
-> m (NewUser HashPassword) -> m (NewUser HashPassword)
toUserHash (NewUser u m (GargPassword p)) = do toUserHash (NewUser u m (GargPassword p)) = do
h <- Auth.createPasswordHash p salt <- Auth.newSalt
let h = Auth.hashPasswordWithSalt params salt (Auth.mkPassword p)
pure $ NewUser u m h pure $ NewUser u m h
where
#if TEST_CRYPTO
params = Auth.defaultParams { Auth.argon2MemoryCost = 4096 }
#else
params = Auth.defaultParams
#endif
-- TODO remove -- TODO remove
arbitraryUsersHash :: MonadIO m arbitraryUsersHash :: MonadIO m
......
...@@ -39,6 +39,8 @@ import qualified Shelly as SH ...@@ -39,6 +39,8 @@ import qualified Shelly as SH
import Paths_gargantext import Paths_gargantext
-- | Keeps a log of usernames we have already generated, so that our
-- roundtrip tests won't fail.
uniqueArbitraryNewUser :: S.Set Username -> Gen (NewUser GargPassword) uniqueArbitraryNewUser :: S.Set Username -> Gen (NewUser GargPassword)
uniqueArbitraryNewUser alreadyTakenNames = do uniqueArbitraryNewUser alreadyTakenNames = do
ur <- ascii_txt `suchThat` (not . flip S.member alreadyTakenNames) ur <- ascii_txt `suchThat` (not . flip S.member alreadyTakenNames)
...@@ -135,7 +137,7 @@ unitTests :: IO TestEnv -> TestTree ...@@ -135,7 +137,7 @@ unitTests :: IO TestEnv -> TestTree
unitTests getEnv = testGroup "Read/Writes" unitTests getEnv = testGroup "Read/Writes"
[ testGroup "User creation" [ [ testGroup "User creation" [
testCase "Simple write" (write01 getEnv) testCase "Simple write" (write01 getEnv)
, testProperty "Read/Write roundtrip" $ withMaxSuccess 50 (prop_userCreationRoundtrip getEnv) , testProperty "Read/Write roundtrip" $ prop_userCreationRoundtrip getEnv
] ]
] ]
......
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