Commit c6cf6b55 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Fix after rebase

parent f4e80982
Pipeline #5522 failed with stages
in 83 minutes and 24 seconds
......@@ -116,7 +116,7 @@ source-repository-package
source-repository-package
type: git
location: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
tag: c1aba6034ceddcd1cdd0378c3841068c96accca7
tag: c0a08d62c40a169b7934ceb7cb12c39952160e7a
source-repository-package
type: git
......
......@@ -111,8 +111,6 @@ instance ToSchema ForgotPasswordGet where
-- Lenses
--
makeLenses ''AuthValid
>>>>>>> b7657056 (Fix compilation errors due to switch to GHC 9.4.7)
makeLenses ''AuthResponse
--
......@@ -121,8 +119,6 @@ makeLenses ''AuthResponse
$(deriveJSON (JSON.defaultOptions { JSON.fieldLabelModifier = tail . dropWhile ((/=) '_') . tail }) ''AuthenticatedUser)
$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
$(deriveJSON (unPrefix "_authVal_") ''AuthValid)
$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
$(deriveJSON (unPrefix "_fpReq_") ''ForgotPasswordRequest)
$(deriveJSON (unPrefix "_fpRes_") ''ForgotPasswordResponse)
......
......@@ -15,6 +15,7 @@ import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as C8
import Data.CaseInsensitive qualified as CI
import Data.List qualified as L
import Data.String
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Network.HTTP.Types
......@@ -38,7 +39,7 @@ logStdoutDevSanitised = mkRequestLogger $ defaultRequestLoggerSettings { outputF
-- >>> "{\"a\": 100, \"b\": 200}" & atKey "c" ?~ String "300"
-- "{\"a\":100,\"b\":200,\"c\":\"300\"}"
atKey :: L.AsValue t => T.Text -> Traversal' t (Maybe A.Value)
atKey i = L._Object . at i
atKey i = L._Object . at (fromString $ T.unpack i)
{-# INLINE atKey #-}
customOutput :: OutputFormatterWithDetailsAndHeaders
......
......@@ -47,7 +47,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
| Status{..} <- simpleStatus
->liftIO $ do
statusCode `shouldBe` 404
simpleBody `shouldBe` [r|{"node":99,"error":"Node does not exist"}|]
simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|]
it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do
withApplication app $ do
......
......@@ -2,7 +2,7 @@
module Main where
import Gargantext.Prelude
import Gargantext.Prelude hiding (isInfixOf)
import Control.Monad
import Data.Text (isInfixOf)
......
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