Merge remote-tracking branch 'origin/dev-hackathon-fixes' into dev
[gargantext.git] / src / Gargantext / Database / Prelude.hs
index 903be083a9faaa851c20bdbf572478d52417103a..e95f3fbd02e128a10bef54b173e50c8006e37e33 100644 (file)
@@ -9,39 +9,42 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE ConstraintKinds   #-}
+{-# LANGUAGE ConstraintKinds, ScopedTypeVariables #-}
 
 module Gargantext.Database.Prelude where
 
--- import Control.Monad.Error.Class -- (MonadError(..), Error)
 import Control.Exception
 import Control.Lens (Getter, view)
 import Control.Monad.Except
+--import Control.Monad.Logger (MonadLogger)
 import Control.Monad.Random
 import Control.Monad.Reader
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
 import Data.ByteString.Char8 (hPutStrLn)
-import Data.Either.Extra (Either(Left, Right))
-import Data.Ini (readIniFile, lookupValue)
+import Data.Either.Extra (Either)
 import Data.Pool (Pool, withResource)
 import Data.Profunctor.Product.Default (Default)
-import Data.Text (unpack, pack)
+import Data.Text (pack, unpack, Text)
 import Data.Word (Word16)
 import Database.PostgreSQL.Simple (Connection, connect)
 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
 import Database.PostgreSQL.Simple.Internal  (Field)
+import Database.PostgreSQL.Simple.Types (Query(..))
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig())
-import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery, PGJsonb, QueryRunnerColumnDefault)
+import Gargantext.Prelude.Config (readIniFile', val)
+import Opaleye (Unpackspec, showSql, FromFields, Select, runSelect, SqlJsonb, DefaultFromField)
 import Opaleye.Aggregate (countRows)
 import System.IO (FilePath)
 import System.IO (stderr)
-import Text.Read (read)
+import Text.Read (readMaybe)
 import qualified Data.ByteString      as DB
 import qualified Data.List as DL
 import qualified Database.PostgreSQL.Simple as PGS
 
+import Gargantext.Prelude.Config (GargConfig())
+
 -------------------------------------------------------
 class HasConnectionPool env where
   connPool :: Getter env (Pool Connection)
@@ -56,7 +59,7 @@ instance HasConfig GargConfig where
   hasConfig = identity
 
 -------------------------------------------------------
-type JSONB = QueryRunnerColumnDefault PGJsonb
+type JSONB = DefaultFromField SqlJsonb
 -------------------------------------------------------
 
 type CmdM'' env err m =
@@ -64,12 +67,14 @@ type CmdM'' env err m =
   , MonadError          err m
   , MonadBaseControl IO     m
   , MonadRandom             m
+  --, MonadLogger             m
   )
 
 type CmdM' env err m =
   ( MonadReader     env     m
   , MonadError          err m
   , MonadBaseControl IO     m
+  --, MonadLogger             m
   -- , MonadRandom             m
   )
 
@@ -77,13 +82,15 @@ type CmdM env err m =
   ( CmdM'             env err m
   , HasConnectionPool env
   , HasConfig         env
+  , HasMail           env
   )
 
 type CmdRandom env err m =
   ( CmdM'             env err m
   , HasConnectionPool env
   , HasConfig         env
-  , MonadRandom             m
+  , MonadRandom       m
+  , HasMail           env
   )
 
 type Cmd'' env err a = forall m.     CmdM''    env err m => m a
@@ -111,11 +118,11 @@ runCmd env m = runExceptT $ runReaderT m env
 runOpaQuery :: Default FromFields fields haskells
             => Select fields
             -> Cmd err [haskells]
-runOpaQuery q = mkCmd $ \c -> runQuery c q
+runOpaQuery q = mkCmd $ \c -> runSelect c q
 
 runCountOpaQuery :: Select a -> Cmd err Int
 runCountOpaQuery q = do
-  counts <- mkCmd $ \c -> runQuery c $ countRows q
+  counts <- mkCmd $ \c -> runSelect c $ countRows q
   -- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
   pure $ fromInt64ToInt $ DL.head counts
 
@@ -137,28 +144,51 @@ runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
       hPutStrLn stderr q'
       throw (SomeException e)
 
+{-
+-- TODO
+runPGSQueryFold :: ( CmdM env err m
+               , PGS.FromRow r
+               )
+               => PGS.Query -> a -> (a -> r -> IO a) -> m a
+runPGSQueryFold q initialState consume = mkCmd $ \conn -> catch (PGS.fold_ conn initialState consume) (printError conn)
+  where
+    printError c (SomeException e) = do
+      q' <- PGS.formatQuery c q
+      hPutStrLn stderr q'
+      throw (SomeException e)
+-}
+
+
+
+-- | TODO catch error
+runPGSQuery_ :: ( CmdM env err m
+               , PGS.FromRow r
+               )
+               => PGS.Query -> m [r]
+runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
+  where
+    printError (SomeException e) = do
+      hPutStrLn stderr (fromQuery q)
+      throw (SomeException e)
 
 execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
 execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
 
 ------------------------------------------------------------------------
-
 databaseParameters :: FilePath -> IO PGS.ConnectInfo
 databaseParameters fp = do
-  ini         <- readIniFile fp
-  let ini'' = case ini of
-        Left e     -> panic (pack $ "No ini file error" <> show e)
-        Right ini' -> ini'
-
-  let val x = case (lookupValue (pack "database") (pack x) ini'') of
-        Left _ -> panic (pack $ "no" <> x)
-        Right p' -> unpack p'
-
-  pure $ PGS.ConnectInfo { PGS.connectHost     = val       "DB_HOST"
-                         , PGS.connectPort     = read (val "DB_PORT") :: Word16
-                         , PGS.connectUser     = val       "DB_USER"
-                         , PGS.connectPassword = val       "DB_PASS"
-                         , PGS.connectDatabase = val       "DB_NAME"
+  ini <- readIniFile' fp
+  let val' key = unpack $ val ini "database" key
+  let dbPortRaw = val' "DB_PORT"
+  let dbPort = case (readMaybe dbPortRaw :: Maybe Word16) of
+        Nothing -> panic $ "DB_PORT incorrect: " <> (pack dbPortRaw)
+        Just d  -> d
+
+  pure $ PGS.ConnectInfo { PGS.connectHost     = val' "DB_HOST"
+                         , PGS.connectPort     = dbPort
+                         , PGS.connectUser     = val' "DB_USER"
+                         , PGS.connectPassword = val' "DB_PASS"
+                         , PGS.connectDatabase = val' "DB_NAME"
                          }
 
 connectGargandb :: FilePath -> IO Connection
@@ -176,6 +206,12 @@ fromField' field mb = do
                                               , show v
                                               ]
 
-printSqlOpa :: Default Unpackspec a a => Query a -> IO ()
-printSqlOpa = putStrLn . maybe "Empty query" identity . showSqlForPostgres
+printSqlOpa :: Default Unpackspec a a => Select a -> IO ()
+printSqlOpa = putStrLn . maybe "Empty query" identity . showSql
 
+dbCheck :: CmdM env err m => m Bool
+dbCheck = do
+  r :: [PGS.Only Text] <- runPGSQuery_ "select username from public.auth_user"
+  case r of
+    [] -> return False
+    _  -> return True