Merge branch 'dev' into 'main'

Dev

See merge request !1

.gitignore

+dist-newstyle/
\ No newline at end of file

CHANGELOG.md

+# Revision history for epo-api-client
+
+## 0.1.0.0 -- 2023-10-11
+
+* First version. Released on an unsuspecting world.

app/Main.hs

+{-|
+Module      : Main
+Description : EPO Patents database crawler (API client)
+Copyright   : (c) CNRS, 2023-present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+
+module Main where
+
+import Data.Text qualified as T
+import EPO.API.Client qualified as Client
+import EPO.API.Client.Implementation (searchEPOAPI)
+import EPO.API.Client.Types
+import Network.URI
+import Options.Applicative.Simple
+import Protolude hiding (option)
+import System.IO.Error (userError)
+import Text.Pretty.Simple (pPrint)
+
+data AuthOptions = AuthOptions
+  { user  :: Text
+  , token :: Text
+  } deriving (Eq, Show)
+
+data SearchOptions = SearchOptions
+  { authOptions :: AuthOptions
+  , apiUrl      :: Text
+  , start       :: Maybe Start
+  , end         :: Maybe End
+  , search      :: Search
+  } deriving (Eq, Show)
+
+main :: IO ()
+main = do
+  let authOptions =
+        AuthOptions <$>
+          strOption (long "user") <*>
+          strOption (long "token")
+  let searchOptions =
+        SearchOptions <$>
+          authOptions <*>
+          (strOption (long "api-url")) <*>
+          optional (option auto (long "start")) <*>
+          optional (option auto (long "end")) <*>
+          (strOption (long "search"))
+
+  (opts, runCmd) <-
+    simpleOptions "0.1.0.0"
+                  "epo-api-client"
+                  "epo-api-client command line"
+                  (pure ()) $ do
+      addCommand "search"
+        "Search epo published data (via API)"
+        searchPublishedData
+        searchOptions
+
+  runCmd ()
+
+searchPublishedData :: SearchOptions -> () -> IO ()
+searchPublishedData opts@SearchOptions { .. } _ = do
+  putText $ "Options: " <> show opts
+  let rStart = fromMaybe 0 start
+  let rEnd = fromMaybe 20 end
+  case parseURI (T.unpack apiUrl) of
+    Nothing -> ioError $ userError $ T.unpack $ "Error parsing api url " <> apiUrl
+    Just uri -> do
+      Paginated { .. } <- searchEPOAPI uri (authKeyFromAuthOptions authOptions) rStart rEnd search
+      mapM_ pPrint items
+
+
+authKeyFromAuthOptions :: AuthOptions -> AuthKey
+authKeyFromAuthOptions AuthOptions { .. } =
+  AuthKey { user  = User user
+          , token = Token token }

cabal.project

+with-compiler: ghc-8.10.7
+
+packages:
+        ./
+
+source-repository-package
+        type: git
+        location: https://gitlab.iscpif.fr/gargantext/iso639.git
+        tag: 1a9e23e210a02da3b846d7cdc666541e2148334d
+        
+allow-newer: base:*

epo-api-client.cabal

+cabal-version:      3.0
+-- The cabal-version field refers to the version of the .cabal specification,
+-- and can be different from the cabal-install (the tool) version and the
+-- Cabal (the library) version you are using. As such, the Cabal (the library)
+-- version used must be equal or greater than the version stated in this field.
+-- Starting from the specification version 2.2, the cabal-version field must be
+-- the first thing in the cabal file.
+
+-- Initial package description 'epo-api-client' generated by
+-- 'cabal init'. For further documentation, see:
+--   http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name:               epo-api-client
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary:     +-+------- breaking API changes
+--                  | | +----- non-breaking API additions
+--                  | | | +--- code changes with no API change
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- The license under which the package is released.
+license:            AGPL-3.0-only
+
+-- The file containing the license text.
+license-file:       LICENSE
+
+author:         Gargantext Team
+maintainer:     team@gargantext.org
+
+-- A copyright notice.
+-- copyright:
+category:           Network
+build-type:         Simple
+
+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
+extra-doc-files:    CHANGELOG.md
+
+-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
+-- extra-source-files:
+
+common warnings
+    ghc-options: -Wall
+
+library
+    -- Import common warning flags.
+    import:           warnings
+
+    -- Modules exported by the library.
+    exposed-modules:  EPO.API.Client
+                    , EPO.API.Client.Implementation
+                    , EPO.API.Client.Types
+
+    -- Modules included in this library but not exported.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- Other library packages from which modules are imported.
+    build-depends:    base ^>=4.14.3.0
+                    , aeson ^>= 1.5.6.0
+                    , containers ^>= 0.6.7
+                    , http-client >= 0.7.13.1 && < 0.8
+                    , http-client-tls >= 0.3.6.2 && < 0.4
+                    , iso639
+                    , network-uri ^>= 2.6.4.2
+                    , protolude >= 0.3.3 && < 0.4
+                    , servant >= 0.19 && < 0.20
+                    , servant-client >= 0.19 && < 0.20
+                    , text >= 1.2.4 && < 1.3
+                    
+    -- Directories containing source files.
+    hs-source-dirs:   src
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+    default-extensions:
+      DataKinds
+      DeriveGeneric
+      DuplicateRecordFields
+      FlexibleContexts
+      FlexibleInstances
+      GADTs
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
+      LambdaCase
+      MultiParamTypeClasses
+      NamedFieldPuns
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+      RecordWildCards
+      StrictData
+      TypeOperators
+
+executable epo-api-client-main
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base >=4.12.0 && < 5
+                    , network-uri ^>= 2.6.4.2
+                    , optparse-simple >= 0.1.1.4 && < 0.2
+                    , pretty-simple ^>= 4.1.2.0
+                    , protolude >= 0.3.3 && < 0.4
+                    , text >= 1.2.4 && < 1.3
+
+                    , epo-api-client
+    hs-source-dirs:   app
+    default-language: Haskell2010
+    default-extensions:
+      DataKinds
+      DeriveGeneric
+      DuplicateRecordFields
+      FlexibleContexts
+      FlexibleInstances
+      GADTs
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
+      LambdaCase
+      MultiParamTypeClasses
+      NamedFieldPuns
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+      RecordWildCards
+      StrictData
+      TypeOperators
+
+test-suite epo-api-client-test
+    -- Import common warning flags.
+    import:           warnings
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- The interface type and version of the test suite.
+    type:             exitcode-stdio-1.0
+
+    -- Directories containing source files.
+    hs-source-dirs:   test
+
+    -- The entrypoint to the test suite.
+    main-is:          Main.hs
+
+    -- Test dependencies.
+    build-depends:
+        base ^>=4.14.3.0,
+        epo-api-client
+
+    default-extensions:
+      DataKinds
+      DeriveGeneric
+      DuplicateRecordFields
+      FlexibleContexts
+      FlexibleInstances
+      GADTs
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
+      LambdaCase
+      MultiParamTypeClasses
+      NamedFieldPuns
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+      RecordWildCards
+      StrictData
+      TypeOperators

src/EPO/API/Client.hs

+{-|
+Module      : EPO.API.Client
+Description : EPO Patents database crawler (API client)
+Copyright   : (c) CNRS, 2023-present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+module EPO.API.Client where
+
+import Data.Text qualified as T
+import EPO.API.Client.Types
+import Network.HTTP.Client (defaultManagerSettings, newManager, requestHeaders)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.URI qualified as URI
+import Protolude
+import Servant.API
+import Servant.Client
+
+
+defaultClientEnv :: URI.URI -> IO ClientEnv
+defaultClientEnv uri  = do
+  let (Just URI.URIAuth { uriRegName, uriPort }) = URI.uriAuthority uri
+  let (proto, port, managerSettings) =
+        if URI.uriScheme uri == "https:" then
+          (Https, 443, tlsManagerSettings)
+        else
+          (Http, 80, defaultManagerSettings)
+  let uriPort' =
+        if uriPort == ""
+        then Right port
+        else (readEither (T.unpack $ T.tail $ T.pack uriPort) :: Either [Char] Int)
+  manager <- newManager managerSettings
+  let env' = mkClientEnv manager $ BaseUrl proto uriRegName (fromRight 80 uriPort') ""
+  let makeClientRequest bu req =
+        let r = defaultMakeClientRequest bu req in
+        r { requestHeaders = (requestHeaders r) <> [("User-Agent", "servant.client")]}
+  let env = env' { makeClientRequest }
+  -- pure $ addLoggingToClientEnv env
+  pure env
+
+
+
+type EPOAPI =
+  "api"
+  :> "search"
+    :> Header "Authorization" AuthKey
+    :> QueryParam "start" Start
+    :> QueryParam "end" End
+    :> QueryParam "s" Search
+    :> Get '[JSON] HyperdataDocuments
+
+
+epoApi :: Proxy EPOAPI
+epoApi = Proxy
+
+search :: Maybe AuthKey
+       -> Maybe Int
+       -> Maybe Int
+       -> Maybe Text
+       -> ClientM (Paginated HyperdataDocument)
+
+search = client epoApi

src/EPO/API/Client/Implementation.hs

+{-|
+Module      : EPO.API.Client.Implementation
+Description : EPO Patents database crawler (API client)
+Copyright   : (c) CNRS, 2023-present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+module EPO.API.Client.Implementation
+  ( searchEPOAPI
+  )
+where
+
+import EPO.API.Client
+import EPO.API.Client.Types
+import Network.URI qualified as URI
+import Protolude
+import Servant.Client (runClientM)
+
+
+searchEPOAPI :: URI.URI
+             -> AuthKey
+             -> Start
+             -> End
+             -> Search
+             -> IO HyperdataDocuments
+searchEPOAPI uri auth start end search' = do
+  env <- defaultClientEnv uri
+  eRes <- runClientM (search (Just auth) (Just start) (Just end) (Just search')) env
+  case eRes of
+    Left err-> throwIO err
+    Right res -> pure res

src/EPO/API/Client/Types.hs

+{-|
+Module      : EPO.API.Client.Types
+Description : EPO Patents API client
+Copyright   : (c) CNRS, 2023-present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+
+module EPO.API.Client.Types where
+
+import Data.Aeson
+import Data.LanguageCodes (ISO639_1)
+import Data.Map.Strict qualified as Map
+import Data.Text.Encoding qualified as TE
+import Protolude
+import Servant.API
+
+
+type Start = Int
+type End = Int
+type Search = Text
+
+
+data HyperdataDocument = HyperdataDocument
+  { id                :: Maybe Text
+  , titles            :: Map.Map ISO639_1 Text
+  , authors           :: [Text]
+  , abstracts         :: Map.Map ISO639_1 Text
+  , publication_date  :: Maybe Text
+  , publication_year  :: Maybe Int
+  , publication_month :: Maybe Int
+  , publication_day   :: Maybe Int
+  } deriving (Show, Eq, Generic)
+instance ToJSON HyperdataDocument
+instance FromJSON HyperdataDocument
+
+
+data Paginated a = Paginated
+  { total :: Int
+  , start :: Start
+  , end   :: End
+  , items :: [a]
+  } deriving (Show, Eq, Generic)
+instance ToJSON a => ToJSON (Paginated a)
+instance FromJSON a => FromJSON (Paginated a)
+
+type HyperdataDocuments = Paginated HyperdataDocument
+
+
+
+newtype User = User { unUser :: Text }
+  deriving (Eq, Show, Generic, IsString)
+instance ToJSON User where
+  toJSON (User u) = toJSON u
+
+newtype Token = Token { unToken :: Text }
+  deriving (Eq, Show, Generic, IsString)
+instance ToJSON Token where
+  toJSON (Token t) = toJSON t
+
+
+data AuthKey = AuthKey { user  :: User
+                       , token :: Token }
+  deriving (Eq, Show, Generic)
+joinKeys :: AuthKey -> Text
+joinKeys (AuthKey { .. }) = unUser user <> ":" <> unToken token
+instance ToHttpApiData AuthKey where
+  toUrlPiece (AuthKey { }) = "not implemented"
+  toHeader authKey = TE.encodeUtf8 $ "Basic " <> (joinKeys authKey)
+

test/Main.hs

+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Test suite not yet implemented."