client functions for garg backend

cabal.project

 packages: .
-
-allow-newer: base, accelerate
+          -- ../servant-job
+          -- ../ekg-json
+          -- ../../../code/servant/servant
+          -- ../../../code/servant/servant-server
+          -- ../../../code/servant/servant-client-core
+          -- ../../../code/servant/servant-client
+          -- ../../../code/servant/servant-auth/servant-auth
+          -- ../../../code/servant/servant-auth/servant-auth-client
+          -- ../../../code/servant/servant-auth/servant-auth-server
+
+allow-newer: base, accelerate, servant, time
 
 -- Patches
+source-repository-package
+  type: git
+  location: https://github.com/alpmestan/servant-job.git
+  tag: ceb251b91e8ec1804198422a3cdbdab08d843b79
+
+source-repository-package
+  type: git
+  location: https://github.com/alpmestan/ekg-json.git
+  tag: c7bde4851a7cd41b3f3debf0c57f11bbcb11d698
+
+source-repository-package
+  type: git
+  location: https://github.com/haskell-servant/servant.git
+  tag: c2af6e775d1d36f2011d43aff230bb502f8fba63
+  subdir: servant/
+          servant-server/
+          servant-client-core/
+          servant-client/
+          servant-auth/servant-auth/
+          servant-auth/servant-auth-client/
+          servant-auth/servant-auth-server/
+
 source-repository-package
   type: git
   location: https://github.com/delanoe/patches-map.git
@@ -16,7 +47,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://gitlab.iscpif.fr/cgenie/haskell-gargantext-prelude.git
-  tag: 35b09629a658fc16cc9ff63e7591e58511cd98a7
+  tag: 6bfdb29e9a576472c7fd7ebe648ad101e5b3927f
 
 -- External Data API connectors
 source-repository-package
@@ -72,10 +103,10 @@ source-repository-package
   location: https://github.com/delanoe/servant-static-th.git
   tag: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8
 
-source-repository-package
-  type: git
-  location: https://github.com/alpmestan/servant-job.git
-  tag: e9a4c57ca3ddee450627ed251df942effb27e4be
+-- source-repository-package
+--   type: git
+--   location: https://github.com/alpmestan/servant-job.git
+--   tag: e9a4c57ca3ddee450627ed251df942effb27e4be
 
 -- Database libraries
 source-repository-package
@@ -105,4 +136,6 @@ source-repository-package
   location: https://gitlab.iscpif.fr/anoe/accelerate-utility.git
   tag: 83ada76e78ac10d9559af8ed6bd4064ec81308e4
 
-constraints: unordered-containers==0.2.14.*
\ No newline at end of file
+constraints: unordered-containers==0.2.14.*,
+             servant-ekg==0.3.1,
+             time==1.9.3
\ No newline at end of file

package.yaml

@@ -58,6 +58,7 @@ library:
   - Gargantext.API.Admin.EnvTypes
   - Gargantext.API.Admin.Types
   - Gargantext.API.Prelude
+  - Gargantext.Client
   - Gargantext.Core
   - Gargantext.Core.NodeStory
   - Gargantext.Core.Methods.Distances
@@ -212,12 +213,14 @@ library:
   - serialise
   - servant
   - servant-auth
+  - servant-auth-client
   - servant-auth-server >= 0.4.4.0
   - servant-auth-swagger
   - servant-blaze
   - servant-cassava
   - servant-client
   - servant-ekg
+  - servant-flatten
   - servant-job
   - servant-mock
   - servant-multipart

src/Gargantext/API/HashedResponse.hs

@@ -25,6 +25,8 @@ data HashedResponse a = HashedResponse { hash :: Text, value :: a }
 instance ToSchema a => ToSchema (HashedResponse a)
 instance ToJSON a => ToJSON (HashedResponse a) where
   toJSON = genericToJSON defaultOptions
+instance FromJSON a => FromJSON (HashedResponse a) where
+  parseJSON = genericParseJSON defaultOptions
 
 constructHashedResponse :: ToJSON a => a -> HashedResponse a
 constructHashedResponse v = HashedResponse { hash = Crypto.hash $ encode v, value = v }

src/Gargantext/API/Ngrams.hs

@@ -22,6 +22,7 @@ add get
 {-# LANGUAGE TypeOperators     #-}
 {-# LANGUAGE TypeFamilies      #-}
 
+{-# LANGUAGE IncoherentInstances #-}
 module Gargantext.API.Ngrams
   ( TableNgramsApi
   , TableNgramsApiGet
@@ -71,6 +72,8 @@ module Gargantext.API.Ngrams
   , VersionedWithCount(..)
   , currentVersion
   , listNgramsChangedSince
+  , MinSize, MaxSize, OrderBy, NgramsTable
+  , UpdateTableNgramsCharts
   )
   where
 
@@ -86,7 +89,7 @@ import Data.Monoid
 import Data.Ord (Down(..))
 import Data.Patch.Class (Action(act), Transformable(..), ours)
 import Data.Swagger hiding (version, patch)
-import Data.Text (Text, isInfixOf, unpack)
+import Data.Text (Text, isInfixOf, unpack, pack)
 import Data.Text.Lazy.IO as DTL
 import Formatting (hprint, int, (%))
 import GHC.Generics (Generic)
@@ -654,6 +657,8 @@ instance FromHttpApiData OrderBy
     parseUrlPiece "ScoreDesc" = pure ScoreDesc
     parseUrlPiece _           = Left "Unexpected value of OrderBy"
 
+instance ToHttpApiData OrderBy where
+  toUrlPiece = pack . show
 
 instance ToParamSchema OrderBy
 instance FromJSON  OrderBy

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

@@ -9,7 +9,7 @@ import Data.Aeson
 import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
 import Data.Text
 import Servant.Job.Utils (jsonOptions)
-import Web.FormUrlEncoded (FromForm)
+import Web.FormUrlEncoded (FromForm, ToForm)
 
 import Protolude
 
@@ -27,6 +27,7 @@ data WithFile = WithFile
 
 --makeLenses ''WithFile
 instance FromForm WithFile
+instance ToForm WithFile
 instance FromJSON WithFile where
   parseJSON = genericParseJSON $ jsonOptions "_wf_"
 instance ToJSON WithFile where
@@ -45,6 +46,7 @@ data WithTextFile = WithTextFile
 
 --makeLenses ''WithTextFile
 instance FromForm WithTextFile
+instance ToForm WithTextFile
 instance FromJSON WithTextFile where
   parseJSON = genericParseJSON $ jsonOptions "_wtf_"
 instance ToJSON WithTextFile where

src/Gargantext/API/Ngrams/Types.hs

@@ -62,8 +62,7 @@ data TabType   = Docs   | Trash   | MoreFav | MoreTrash
 
 instance Hashable TabType
 
-instance FromHttpApiData TabType
-   where
+instance FromHttpApiData TabType where
     parseUrlPiece "Docs"       = pure Docs
     parseUrlPiece "Trash"      = pure Trash
     parseUrlPiece "MoreFav"    = pure MoreFav
@@ -77,6 +76,8 @@ instance FromHttpApiData TabType
     parseUrlPiece "Contacts"   = pure Contacts
 
     parseUrlPiece _            = Left "Unexpected value of TabType"
+instance ToHttpApiData TabType where
+    toUrlPiece = pack . show
 instance ToParamSchema TabType
 instance ToJSON        TabType
 instance FromJSON      TabType
@@ -715,6 +716,9 @@ instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
   where
     parseUrlPiece x = maybeToEither x (decode $ cs x)
 
+instance ToHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap)) where
+  toUrlPiece m = cs (encode m)
+
 ngramsTypeFromTabType :: TabType -> TableNgrams.NgramsType
 ngramsTypeFromTabType tabType =
   let here = "Garg.API.Ngrams: " :: Text in

src/Gargantext/API/Node.hs

@@ -199,8 +199,6 @@ nodeAPI :: forall proxy a.
        ( JSONB a
        , FromJSON a
        , ToJSON a
-       , MimeRender JSON a
-       , MimeUnrender JSON a
        ) => proxy a
          -> UserId
          -> NodeId

src/Gargantext/API/Node/Corpus/New/File.hs

@@ -65,7 +65,13 @@ instance FromHttpApiData FileType
     parseUrlPiece "ZIP"       = pure ZIP
     parseUrlPiece "WOS"       = pure WOS
     parseUrlPiece _           = pure CSV -- TODO error here
-
+instance ToHttpApiData FileType where
+  toUrlPiece t = case t of
+    CSV -> "CSV"
+    CSV_HAL -> "CSV_HAL"
+    PresseRIS -> "PresseRis"
+    ZIP -> "ZIP"
+    WOS -> "WOS"
 
 instance (ToParamSchema a, HasSwagger sub) =>
          HasSwagger (MultipartForm tag a :> sub) where

src/Gargantext/API/Node/File.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE AllowAmbiguousTypes     #-}
 {-# LANGUAGE TypeOperators     #-}
 
+{-# LANGUAGE IncoherentInstances #-}
 module Gargantext.API.Node.File where
 
 import Control.Lens ((^.))
@@ -30,6 +31,7 @@ import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
+import Data.Either
 
 data RESPONSE deriving Typeable
 
@@ -43,6 +45,9 @@ type FileApi = Summary "File download"
             :> "download"
             :> Get '[RESPONSE] (Headers '[Servant.Header "Content-Type" Text] BSResponse)
 
+instance MimeUnrender RESPONSE BSResponse where
+  mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
+
 fileApi :: UserId -> NodeId -> GargServer FileApi
 fileApi uId nId = fileDownload uId nId
 

src/Gargantext/API/Node/New.hs

@@ -16,6 +16,7 @@ Async new node feature
 {-# LANGUAGE TypeOperators      #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
+{-# LANGUAGE IncoherentInstances #-}
 module Gargantext.API.Node.New
       where
 
@@ -28,7 +29,7 @@ import Servant
 import Servant.Job.Async
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import Web.FormUrlEncoded          (FromForm)
+import Web.FormUrlEncoded          (FromForm, ToForm)
 
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Prelude
@@ -51,6 +52,7 @@ instance FromJSON  PostNode
 instance ToJSON    PostNode
 instance ToSchema  PostNode
 instance FromForm  PostNode
+instance ToForm    PostNode
 instance Arbitrary PostNode where
   arbitrary = elements [PostNode "Node test" NodeCorpus]
 
@@ -73,7 +75,7 @@ type PostNodeAsync = Summary "Post Node"
 
 postNodeAsyncAPI :: UserId -> NodeId -> GargServer PostNodeAsync
 postNodeAsyncAPI uId nId =
-  serveJobsAPI $ 
+  serveJobsAPI $
     JobFunction (\p logs -> postNodeAsync uId nId p (liftBase . logs))
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Types.hs

@@ -13,7 +13,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import GHC.Generics (Generic)
 import Servant.Job.Utils (jsonOptions)
-import Web.FormUrlEncoded          (FromForm)
+import Web.FormUrlEncoded          (FromForm, ToForm)
 
 import Gargantext.Core (Lang(..){-, allLangs-})
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
@@ -31,6 +31,7 @@ data NewWithForm = NewWithForm
 
 makeLenses ''NewWithForm
 instance FromForm NewWithForm
+instance ToForm NewWithForm
 instance FromJSON NewWithForm where
   parseJSON = genericParseJSON $ jsonOptions "_wf_"
 instance ToJSON NewWithForm where
@@ -48,6 +49,7 @@ data NewWithFile = NewWithFile
 
 makeLenses ''NewWithFile
 instance FromForm NewWithFile
+instance ToForm NewWithFile
 instance FromJSON NewWithFile where
   parseJSON = genericParseJSON $ jsonOptions "_wfi_"
 instance ToJSON NewWithFile where

src/Gargantext/API/Prelude.hs

@@ -65,7 +65,7 @@ type ErrC err =
   , HasTreeError     err
   , HasServerError   err
   , HasJoseError     err
-  , ToJSON           err -- TODO this is arguable
+--  , ToJSON           err -- TODO this is arguable
   , Exception        err
   )
 
@@ -74,7 +74,7 @@ type GargServerC env err m =
   , HasNodeStory env err m
   , EnvC  env
   , ErrC      err
-  , MimeRender JSON err
+  , ToJSON err
   )
 
 type GargServerT env err m api = GargServerC env err m => ServerT api m

src/Gargantext/API/Routes.hs

@@ -58,7 +58,7 @@ import Gargantext.Prelude.Config (gc_max_docs_scrapers)
 
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
--- | TODO          :<|> Summary "Latest API" :> GargAPI'
+--- | TODO          :<|> Summary "Latest API" :> GargAPI'
 
 type GargAPIVersion = "v1.0"
                    :> Summary "Garg API Version "

src/Gargantext/API/Server.hs

@@ -17,6 +17,7 @@ module Gargantext.API.Server where
 import Control.Lens ((^.))
 import Control.Monad.Except (withExceptT)
 import Control.Monad.Reader (runReaderT)
+import Data.Aeson
 import Data.Text (Text)
 import Data.Version (showVersion)
 import Servant
@@ -39,7 +40,7 @@ import Gargantext.Prelude
 import Gargantext.Prelude.Config (gc_url_backend_api)
 
 
-serverGargAPI :: MimeRender JSON err => Text -> GargServerM env err GargAPI
+serverGargAPI :: ToJSON err => Text -> GargServerM env err GargAPI
 serverGargAPI baseUrl -- orchestrator
        =  auth
      :<|> gargVersion

src/Gargantext/API/ThrowAll.hs

@@ -17,6 +17,7 @@ module Gargantext.API.ThrowAll where
 
 import Control.Monad.Except (MonadError(..))
 import Control.Lens ((#))
+import Data.Aeson
 import Servant
 import Servant.Auth.Server (AuthResult(..))
 
@@ -44,7 +45,7 @@ instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where
 instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
   throwAll' = throwError
 
-serverPrivateGargAPI :: MimeRender JSON err => GargServerM env err GargPrivateAPI
+serverPrivateGargAPI :: ToJSON err => GargServerM env err GargPrivateAPI
 serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
 serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
 -- Here throwAll' requires a concrete type for the monad.

src/Gargantext/Core.hs

@@ -12,7 +12,7 @@ Portability : POSIX
 module Gargantext.Core
   where
 
-import Data.Text (Text)
+import Data.Text (Text, pack)
 import Data.Aeson
 import Data.Either(Either(Left))
 import Data.Hashable (Hashable)
@@ -49,6 +49,8 @@ instance FromHttpApiData Lang
     parseUrlPiece "FR"  = pure FR
     parseUrlPiece "All" = pure All
     parseUrlPiece _     = Left "Unexpected value of OrderBy"
+instance ToHttpApiData Lang where
+  toUrlPiece = pack . show
 instance Hashable Lang
 
 allLangs :: [Lang]

src/Gargantext/Core/Types/Main.hs

@@ -25,13 +25,13 @@ import Data.Map (fromList, lookup)
 import Data.Maybe (fromMaybe)
 import Data.Semigroup (Semigroup(..))
 import Data.Swagger
-import Data.Text (Text, unpack)
+import Data.Text (Text, unpack, pack)
 import GHC.Generics (Generic)
 import Gargantext.Core
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node  -- (NodeType(..), Node, Hyperdata(..))
 import Gargantext.Prelude
-import Servant.API (FromHttpApiData(..))
+import Servant.API (FromHttpApiData(..), ToHttpApiData(..))
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Text.Read (read)
@@ -75,6 +75,8 @@ instance Semigroup ListType
 
 instance FromHttpApiData ListType where
   parseUrlPiece = Right . read . unpack
+instance ToHttpApiData ListType where
+  toUrlPiece = pack . show
 
 type ListTypeId = Int
 

src/Gargantext/Core/Viz/Graph/API.hs

@@ -68,6 +68,7 @@ data GraphVersions =
                 }
    deriving (Show, Generic)
 
+instance FromJSON GraphVersions
 instance ToJSON GraphVersions
 instance ToSchema GraphVersions
 

src/Gargantext/Core/Viz/Graph/GEXF.hs

@@ -24,6 +24,7 @@ import qualified Data.HashMap.Lazy as HashMap
 import qualified Gargantext.Prelude as P
 import qualified Gargantext.Core.Viz.Graph as G
 import qualified Xmlbf as Xmlbf
+import Prelude (error)
 
 -- Converts to GEXF format
 -- See https://gephi.org/gexf/format/
@@ -65,3 +66,8 @@ instance Xmlbf.ToXml Graph where
           params = HashMap.fromList [ ("id", eId)
                                     , ("source", es)
                                     , ("target", et) ]
+
+-- just to be able to derive a client for the entire gargantext API,
+-- we however want to avoid sollicitating this instance
+instance Xmlbf.FromXml Graph where
+  fromXml = error "FromXml Graph: not defined, just a placeholder"

src/Gargantext/Core/Viz/Phylo/Legacy/LegacyAPI.hs

@@ -39,6 +39,7 @@ import Gargantext.Core.Viz.LegacyPhylo
 import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
 -- import Gargantext.Core.Viz.Phylo.Example
 import Gargantext.Core.Types (TODO(..))
+import Data.Either
 
 ------------------------------------------------------------------------
 type PhyloAPI = Summary "Phylo API"
@@ -71,6 +72,9 @@ instance Show a => MimeRender PlainText a where
 instance MimeRender SVG SVG where
    mimeRender _ (SVG s) = DBL.fromStrict s
 
+instance MimeUnrender SVG SVG where
+   mimeUnrender _ lbs = Right $ SVG (DBL.toStrict lbs)
+
 ------------------------------------------------------------------------
 type GetPhylo =  QueryParam "listId"      ListId
               :> QueryParam "level"       Level

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

@@ -26,7 +26,7 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Either
 import Data.Hashable (Hashable)
 import Data.Swagger
-import Data.Text (Text, unpack)
+import Data.Text (Text, unpack, pack)
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField)
@@ -176,7 +176,8 @@ type TSVector     = Text
 ------------------------------------------------------------------------
 instance FromHttpApiData NodeId where
   parseUrlPiece n = pure $ NodeId $ (read . cs) n
-
+instance ToHttpApiData NodeId where
+  toUrlPiece (NodeId n) = toUrlPiece n
 instance ToParamSchema NodeId
 instance Arbitrary NodeId where
   arbitrary = NodeId <$> arbitrary
@@ -328,9 +329,10 @@ defaultName NodeFile          = "File"
 instance FromJSON NodeType
 instance ToJSON NodeType
 
-instance FromHttpApiData NodeType
-  where
-      parseUrlPiece = Right . read . unpack
+instance FromHttpApiData NodeType where
+  parseUrlPiece = Right . read . unpack
+instance ToHttpApiData NodeType where
+  toUrlPiece = pack . show
 
 instance ToParamSchema NodeType
 instance ToSchema      NodeType

src/Gargantext/Database/Query/Facet.hs

@@ -229,6 +229,8 @@ instance FromHttpApiData OrderBy
     parseUrlPiece "SourceAsc"  = pure SourceAsc
     parseUrlPiece "SourceDesc" = pure SourceDesc
     parseUrlPiece _            = Left "Unexpected value of OrderBy"
+instance ToHttpApiData OrderBy where
+  toUrlPiece = T.pack . show
 
 instance ToParamSchema OrderBy
 instance FromJSON  OrderBy

src/Gargantext/Database/Schema/Ngrams.hs

@@ -30,7 +30,7 @@ import Data.Map (fromList, lookup)
 import Data.Text (Text, splitOn, pack, strip)
 import Gargantext.Core.Types (TODO(..), Typed(..))
 import Gargantext.Prelude
-import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
+import Servant (FromHttpApiData(..), Proxy(..), ToHttpApiData(..))
 import Text.Read (read)
 import Gargantext.Database.Types
 import Gargantext.Database.Schema.Prelude
@@ -112,6 +112,8 @@ instance ToJSONKey NgramsType where
 
 instance FromHttpApiData NgramsType where
   parseUrlPiece n = pure $ (read . cs) n
+instance ToHttpApiData NgramsType where
+  toUrlPiece = pack . show
 
 instance ToParamSchema NgramsType where
   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)

stack.yaml

@@ -16,8 +16,10 @@ docker:
   run-args:
     - '--publish=8008:8008'
 
+skip-ghc-check: true
+
 nix:
-  enable: false
+  enable: true
   add-gc-roots: true
   shell-file: nix/stack-shell.nix