[refactor] get rid of servant-job

cabal.project

@@ -50,11 +50,6 @@ source-repository-package
     tag: b9fca8beee0f23c17a6b2001ec834d071709e6e7
     subdir: packages/base
 
-source-repository-package
-    type: git
-    location: https://github.com/adinapoli/servant-job.git
-    tag: 74a3296dfe1f0c4a3ade91336dcc689330e84156
-
 source-repository-package
     type: git
     location: https://github.com/alpmestan/sparse-linear.git

gargantext.cabal

@@ -240,6 +240,7 @@ library
       Gargantext.Core.Types.Phylo
       Gargantext.Core.Types.Query
       Gargantext.Core.Utils
+      Gargantext.Core.Utils.Aeson
       Gargantext.Core.Utils.Prefix
       Gargantext.Core.Viz.Graph.Index
       Gargantext.Core.Viz.Graph.Tools
@@ -391,6 +392,7 @@ library
       Gargantext.Core.Text.Terms.Multi.PosTagging.Types
       Gargantext.Core.Types.Search
       Gargantext.Core.Utils.DateUtils
+      Gargantext.Core.Utils.Swagger
       Gargantext.Core.Viz
       Gargantext.Core.Viz.Chart
       Gargantext.Core.Viz.Graph.API
@@ -585,7 +587,6 @@ library
     , servant-client >= 0.19 && < 0.20
     , servant-client-core >= 0.20 && < 0.21
     , servant-ekg ^>= 0.3.1
-    , servant-job >= 0.2.0.0
     , servant-routes < 0.2
     , servant-server >= 0.18.3 && < 0.21
     , servant-swagger ^>= 1.2
@@ -755,7 +756,6 @@ common testDependencies
     , servant-auth-client
     , servant-client >= 0.19 && < 0.20
     , servant-client-core >= 0.20 && < 0.21
-    , servant-job
     , servant-server >= 0.18.3 && < 0.21
     , servant-websockets >= 2.0.0 && < 2.1
     , shelly >= 1.9 && < 2

src/Gargantext/API/Admin/Orchestrator/Types.hs

@@ -19,12 +19,11 @@ module Gargantext.API.Admin.Orchestrator.Types
 
 import Data.Aeson (genericParseJSON, genericToJSON)
 import Data.Morpheus.Types ( GQLType, typeOptions )
-import Data.Swagger (ToParamSchema, ToSchema, declareNamedSchema, defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)
+import Data.Swagger (ToSchema, URL, declareNamedSchema, defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)
 import Gargantext.API.GraphQL.UnPrefix qualified as GQLU
 import Gargantext.Core.Types (TODO(..))
+import Gargantext.Core.Utils.Aeson (jsonOptions)
 import Gargantext.Prelude
-import Servant.Job.Types
-import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
@@ -106,9 +105,3 @@ instance ToSchema JobLog -- TODO _scst_ prefix
 instance GQLType JobLog where
   typeOptions _ = GQLU.unPrefix "_scst_"
 
-instance ToParamSchema Offset -- where
-  -- toParamSchema = panic "TODO"
-
-instance ToParamSchema Limit -- where
-  -- toParamSchema = panic "TODO"
-

src/Gargantext/API/Errors/Types.hs

@@ -23,8 +23,11 @@ Portability : POSIX
 {-# OPTIONS_GHC -Wno-orphans          #-} -- instance IsFrontendErrorData and stage restriction
 
 module Gargantext.API.Errors.Types (
+    HasServerError(..)
+  , serverError
+  
   -- * The main frontend error type
-    FrontendError(..)
+  , FrontendError(..)
 
   -- * The internal backend type and an enumeration of all possible backend error types
   , BackendErrorCode(..)
@@ -43,7 +46,7 @@ module Gargantext.API.Errors.Types (
   , IsFrontendErrorData(..)
   ) where
 
-import Control.Lens (makePrisms)
+import Control.Lens ((#), makePrisms, Prism')
 import Control.Monad.Fail (fail)
 import Data.Aeson (Value(..), (.:), (.=), object, withObject)
 import Data.Aeson.Types (typeMismatch, emptyArray)
@@ -64,8 +67,6 @@ import Gargantext.Prelude hiding (Location, WithStacktrace)
 import Gargantext.Utils.Dict (Dict(..))
 import Gargantext.Utils.Jobs.Monad qualified as Jobs
 import Servant (ServerError)
-import Servant.Job.Core ( HasServerError(..) )
-import Servant.Job.Types qualified as SJ
 
 -- | A 'WithStacktrace' carries an error alongside its
 -- 'CallStack', to be able to print the correct source location
@@ -80,6 +81,19 @@ instance Exception e => Exception (WithStacktrace e) where
   displayException WithStacktrace{..}
     = displayException ct_error <> "\n" <> prettyCallStack ct_callStack
 
+
+
+-------------------------------------------------------------------
+class HasServerError err where
+  _ServerError :: Prism' err ServerError
+
+serverError :: (MonadError err m, HasServerError err) => ServerError -> m a
+serverError e = throwError $ _ServerError # e
+
+instance HasServerError ServerError where
+  _ServerError = identity
+
+
 -------------------------------------------------------------------
 -- | An internal error which can be emitted from the backend and later
 -- converted into a 'FrontendError', for later consumption.
@@ -109,7 +123,7 @@ makePrisms ''BackendInternalError
 
 instance ToJSON BackendInternalError where
   toJSON (InternalJobError s) =
-    object [ ("status", toJSON SJ.IsFailure)
+    object [ ("status", toJSON ("IsFailure" :: Text))
            , ("log", emptyArray)
            , ("id", String mk_id)
            , ("error", String $ T.pack $ show s) ]

src/Gargantext/API/Ngrams/List/Types.hs

@@ -20,9 +20,9 @@ import Data.Text
 import Data.Text.Encoding qualified as E
 import Gargantext.API.Ngrams.Types (NgramsList)
 import Gargantext.API.Node.Corpus.New.Types (FileType(..))
+import Gargantext.Core.Utils.Aeson (jsonOptions)
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Protolude
-import Servant.Job.Utils (jsonOptions)
 import Web.FormUrlEncoded (FromForm(..), ToForm, parseUnique)
 
 

src/Gargantext/API/Ngrams/Types.hs

@@ -43,7 +43,9 @@ import Gargantext.Core.Text (size)
 import Gargantext.Core.Text.Ngrams qualified as Ngrams
 import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
 import Gargantext.Core.Types.Query (Limit, Offset, MaxSize, MinSize)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Core.Utils.Aeson (jsonOptions)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger)
+import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node (ContextId)
 import Gargantext.Database.Prelude (fromField', HasConnectionPool, CmdM')
 import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
@@ -51,7 +53,6 @@ import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Gargantext.Utils.Servant (TSV, ZIP)
 import Gargantext.Utils.Zip (zipContentsPure)
 import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ), MimeUnrender(..))
-import Servant.Job.Utils (jsonOptions)
 
 ------------------------------------------------------------------------
 

src/Gargantext/API/Node/Corpus/Annuaire.hs

@@ -18,13 +18,13 @@ import Data.Aeson (genericParseJSON, genericToJSON)
 import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Gargantext.API.Node.Corpus.New.Types qualified as NewTypes
 import Gargantext.Core (Lang(..))
+import Gargantext.Core.Utils.Aeson (jsonOptions)
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)  -- flowAnnuaire
 import Gargantext.Database.Admin.Types.Node (AnnuaireId)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Servant
-import Servant.Job.Utils (jsonOptions)
 import Web.FormUrlEncoded (FromForm)
 
 

src/Gargantext/API/Node/Types.hs

@@ -24,10 +24,10 @@ import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text.Corpus.Query qualified as API
 import Gargantext.Core.Text.List.Social (FlowSocialListWith)
 import Gargantext.Core.Types (NodeId)
+import Gargantext.Core.Utils.Aeson (jsonOptions)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.GargDB qualified as GargDB
 import Gargantext.Prelude
-import Servant.Job.Utils (jsonOptions)
 import Web.FormUrlEncoded (FromForm, ToForm)
 
 -------------------------------------------------------

src/Gargantext/API/Prelude.hs

@@ -15,13 +15,12 @@ Portability : POSIX
 module Gargantext.API.Prelude
   ( module Gargantext.API.Prelude
   , HasServerError(..)
-  , serverError
-  )
-  where
+  , serverError ) where
 
 import Control.Lens ((#))
 import Gargantext.API.Admin.Auth.Types (AuthenticationError)
 import Gargantext.API.Errors.Class (HasAuthenticationError, _AuthenticationError)
+import Gargantext.API.Errors.Types (HasServerError(..), serverError)
 import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
 import Gargantext.Core.Config (HasConfig)
 import Gargantext.Core.Mail.Types (HasMail)
@@ -35,7 +34,6 @@ import Gargantext.Prelude
 import Gargantext.System.Logging (MonadLogger)
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..), JobHandle)
 import Servant
-import Servant.Job.Core (HasServerError(..), serverError)
 
 authenticationError :: (MonadError e m, HasAuthenticationError e) => AuthenticationError -> m a
 authenticationError = throwError . (_AuthenticationError #)

src/Gargantext/Core/Notifications/Dispatcher/Types.hs

@@ -45,8 +45,6 @@ import Servant
 -- import Servant.API.NamedRoutes ((:-))
 import Servant.API.WebSocket qualified as WS
 import Servant.Auth.Server (verifyJWT)
-import Servant.Job.Core (Safety(Safe))
-import Servant.Job.Types (JobID, JobStatus(_job_id))
 import Servant.Server.Generic (AsServer, AsServerT)
 import StmContainers.Set as SSet
 

src/Gargantext/Core/Types.hs

@@ -38,7 +38,8 @@ import Data.Swagger (ToParamSchema, ToSchema(..))
 import Data.Text (unpack)
 import Data.Validity ( validationIsValid, Validation )
 import Gargantext.Core.Types.Main
-import Gargantext.Core.Utils.Prefix (unPrefix, wellNamedSchema)
+import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude hiding (Ordering, empty)
 

src/Gargantext/Core/Types/Main.hs

@@ -24,7 +24,8 @@ import Data.Swagger ( ToSchema(..), ToParamSchema, genericDeclareNamedSchema )
 import Data.Text (unpack, pack)
 import Data.TreeDiff
 import Gargantext.Core
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node  -- (NodeType(..), Node, Hyperdata(..))
 import Gargantext.Prelude
 import Servant.API (FromHttpApiData(..), ToHttpApiData(..))

src/Gargantext/Core/Utils/Aeson.hs

+{-|
+Module      : Gargantext.Core.Utils.Aeson
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Gargantext.Core.Utils.Aeson where
+
+import Data.Aeson.Types
+import Gargantext.Core.Utils.Swagger (modifier)
+import Gargantext.Prelude
+
+jsonOptions :: Text -> Options
+jsonOptions pref = defaultOptions
+  { fieldLabelModifier = modifier pref
+  , unwrapUnaryRecords = False
+  , omitNothingFields = True
+  }

src/Gargantext/Core/Utils/Prefix.hs

@@ -14,7 +14,6 @@ commentary with @some markup@.
 
 module Gargantext.Core.Utils.Prefix
   ( module Gargantext.Core.Utils.Prefix
-  , wellNamedSchema
   ) where
 
 import Prelude
@@ -24,7 +23,6 @@ import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields, sumEncodin
 import Data.Aeson.Types (Parser)
 import Data.Char (toLower)
 import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
-import Servant.Job.Utils (wellNamedSchema)
 import Text.Read (readMaybe)
 
 

src/Gargantext/Core/Utils/Swagger.hs

+{-|
+Module      : Gargantext.Core.Utils.Swagger
+Description : Swagger utilities
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+---------------------------------------------------------------------
+module Gargantext.Core.Utils.Swagger where
+---------------------------------------------------------------------
+import Control.Lens ((?~))
+import Data.Swagger
+import Data.Swagger qualified as S
+import Data.Swagger.Declare qualified as S
+import Data.Swagger.Internal.Schema qualified as S
+import Data.Swagger.Internal.TypeShape qualified as S
+import Data.Text qualified as T
+import Gargantext.Prelude
+import Prelude qualified
+
+
+wellNamedSchema ::
+     forall a.
+     ( Typeable a -- for the real full name
+     , Generic a
+     , S.GToSchema (Rep a)
+     , S.GenericHasSimpleShape a "genericDeclareNamedSchemaUnrestricted" (S.GenericShape (Rep a))
+     )
+  => Text
+  -> Proxy a
+  -> S.Declare (S.Definitions S.Schema) S.NamedSchema
+wellNamedSchema pref proxy =
+  (S.name ?~ (T.replace " " "_" . T.pack . show . typeRep) proxy) <$>
+  S.genericDeclareNamedSchema (swaggerOptions pref) proxy
+
+swaggerOptions :: Text -> SchemaOptions
+swaggerOptions pref = defaultSchemaOptions
+  { S.fieldLabelModifier = modifier pref
+  , S.unwrapUnaryRecords = False
+  }
+
+modifier :: Text -> Prelude.String -> Prelude.String
+modifier pref field = T.unpack $ T.stripPrefix pref (T.pack field) ?! "Expecting prefix " <> T.unpack pref
+
+infixr 4 ?!
+
+-- Reverse infix form of "fromJust" with a custom error message
+(?!) :: Maybe a -> Prelude.String -> a
+(?!) ma msg = ma ?| errorTrace msg
+
+infixr 4 ?|
+
+-- Reverse infix form of "fromMaybe"
+(?|) :: Maybe a -> a -> a
+(?|) = flip fromMaybe

src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs

@@ -48,7 +48,7 @@ import Data.Text (Text)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
 import GHC.Generics (Generic)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Prelude (fromField', JSONB)
 import Gargantext.Prelude
 import Opaleye (DefaultFromField, defaultFromField, Nullable, SqlJsonb, fromPGSFromField)

src/Gargantext/Database/Admin/Types/Metrics.hs

@@ -16,7 +16,8 @@ import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Data.Vector (Vector)
 import Data.Vector qualified as V
 import Gargantext.Core.Types (ListType(..))
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Prelude
 import Test.QuickCheck.Arbitrary
 

src/Gargantext/Database/Admin/Types/Node.hs

@@ -41,7 +41,8 @@ import Data.TreeDiff
 import Database.PostgreSQL.Simple.FromRow (FromRow, fromRow, field)
 import Fmt ( Buildable(..) )
 import Gargantext.Core (HasDBid(..))
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.Node ( NodePoly(Node), NodePolySearch(NodeSearch) )
 import Gargantext.Prelude

src/Gargantext/Database/Query/Facet/Types.hs

@@ -10,7 +10,8 @@ import Data.Text qualified as T
 import Data.Time (UTCTime)
 import Data.Time.Segment (jour)
 import Gargantext.Database.Admin.Types.Node ( NodeId )
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, arbitraryHyperdataDocuments )
 import Opaleye
 import Protolude hiding (null, map, sum, not)

src/Gargantext/Utils/Jobs/Monad.hs

@@ -24,7 +24,6 @@ module Gargantext.Utils.Jobs.Monad (
   , MonadJobStatus(..)
 
   -- * Functions
-  , genSecret
   , markFailedNoErr
   , markFailureNoErr
   ) where
@@ -36,12 +35,8 @@ import Data.Text qualified as T
 import Data.Void (Void)
 import Gargantext.Utils.Jobs.Error
 import Prelude
-import Servant.Job.Core qualified as SJ
 
 
-genSecret :: IO SJ.SecretKey
-genSecret = SJ.generateSecretKey
-
 data JobError
   =
   -- | We expected to find a job tagged internall as \"job\", but we found the input @T.Text@ instead.