fix conversation list parser in stern

changelog.d/5-internal/pr-3035

@@ -0,0 +1 @@
+Fixed broken stern endpoint `POST i/user/meta-info`

changelog.d/5-internal/pr-3036

@@ -0,0 +1 @@
+Make stern fail on startup if supported backend api version needs bumping

libs/wire-api/src/Wire/API/Routes/Version.hs

@@ -43,6 +43,7 @@ import Control.Lens ((?~))
 import Data.Aeson (FromJSON, ToJSON (..))
 import qualified Data.Aeson as Aeson
 import Data.Bifunctor
+import Data.ByteString.Conversion (ToByteString (builder))
 import qualified Data.ByteString.Lazy as LBS
 import Data.Domain
 import Data.Schema
@@ -83,6 +84,9 @@ instance ToHttpApiData Version where
   toHeader = LBS.toStrict . Aeson.encode
   toUrlPiece = Text.decodeUtf8 . toHeader
 
+instance ToByteString Version where
+  builder = toEncodedUrlPiece
+
 supportedVersions :: [Version]
 supportedVersions = [minBound .. maxBound]
 

tools/stern/default.nix

@@ -24,6 +24,7 @@
 , lib
 , metrics-wai
 , mtl
+, retry
 , schema-profunctor
 , servant
 , servant-server
@@ -75,6 +76,7 @@ mkDerivation {
     lens
     metrics-wai
     mtl
+    retry
     schema-profunctor
     servant
     servant-server

tools/stern/src/Stern/API.hs

@@ -74,6 +74,7 @@ default (ByteString)
 start :: Opts -> IO ()
 start o = do
   e <- newEnv o
+  runAppT e $ Intra.assertBackendApiVersion
   s <- Server.newSettings (server e)
   Server.runSettingsWithShutdown s (servantApp e) Nothing
   where
@@ -402,15 +403,15 @@ getUserData uid = do
   convs <- Intra.getUserConversations uid
   clts <- Intra.getUserClients uid
   notfs <- Intra.getUserNotifications uid
-  consent <- Intra.getUserConsentValue uid
-  consentLog <- Intra.getUserConsentLog uid
+  consent <- (Intra.getUserConsentValue uid <&> toJSON @ConsentValue) `catchE` (pure . String . cs . show)
+  consentLog <- (Intra.getUserConsentLog uid <&> toJSON @ConsentLog) `catchE` (pure . String . cs . show)
   cookies <- Intra.getUserCookies uid
   properties <- Intra.getUserProperties uid
   -- Get all info from Marketo too
   let em = userEmail $ accountUser account
   marketo <- do
     let noEmail = MarketoResult $ KeyMap.singleton "results" emptyArray
-    maybe (pure noEmail) Intra.getMarketoResult em
+    maybe (pure $ toJSON noEmail) (\e -> (Intra.getMarketoResult e <&> toJSON) `catchE` (pure . String . cs . show)) em
   pure . UserMetaInfo . KeyMap.fromList $
     [ "account" .= account,
       "cookies" .= cookies,

tools/stern/src/Stern/Intra.hs

@@ -22,7 +22,8 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Stern.Intra
-  ( putUser,
+  ( assertBackendApiVersion,
+    putUser,
     putUserStatus,
     getContacts,
     getUserConnections,
@@ -61,10 +62,12 @@ module Stern.Intra
   )
 where
 
-import Bilge hiding (head, options, requestId)
+import Bilge hiding (head, options, path, paths, requestId)
+import qualified Bilge
 import Bilge.RPC
 import Brig.Types.Intra
 import Control.Error
+import Control.Exception (ErrorCall (ErrorCall))
 import Control.Lens (view, (^.))
 import Control.Monad.Reader
 import Data.Aeson hiding (Error)
@@ -94,12 +97,15 @@ import Stern.Types
 import System.Logger.Class hiding (Error, name, (.=))
 import qualified System.Logger.Class as Log
 import UnliftIO.Exception hiding (Handler)
+import UnliftIO.Retry (constantDelay, limitRetries, recoverAll)
 import Wire.API.Connection
 import Wire.API.Conversation
 import Wire.API.Internal.Notification
 import Wire.API.Properties
 import Wire.API.Routes.Internal.Brig.Connection
 import qualified Wire.API.Routes.Internal.Brig.EJPD as EJPD
+import Wire.API.Routes.Version
+import Wire.API.Routes.Versioned
 import Wire.API.Team
 import Wire.API.Team.Feature
 import qualified Wire.API.Team.Feature as Public
@@ -112,6 +118,28 @@ import Wire.API.User.Search
 
 -------------------------------------------------------------------------------
 
+backendApiVersion :: Version
+backendApiVersion = V2
+
+-- | Make sure the backend supports `backendApiVersion`.  Crash if it doesn't.  (This is called
+-- in `Stern.API` so problems make `./services/integration.sh` crash.)
+assertBackendApiVersion :: App ()
+assertBackendApiVersion = recoverAll (constantDelay 1000000 <> limitRetries 5) $ \_retryStatus -> do
+  b <- view brig
+  vinfo :: VersionInfo <-
+    responseJsonError
+      =<< rpc' "brig" b (method GET . Bilge.path "/api-version" . contentJson . expect2xx)
+  unless (maximum (vinfoSupported vinfo) == backendApiVersion) $ do
+    throwIO . ErrorCall $ "newest supported backend api version must be " <> show backendApiVersion
+
+path :: ByteString -> Request -> Request
+path = Bilge.path . ((toByteString' backendApiVersion <> "/") <>)
+
+paths :: [ByteString] -> Request -> Request
+paths = Bilge.paths . (toByteString' backendApiVersion :)
+
+-------------------------------------------------------------------------------
+
 putUser :: UserId -> UserUpdate -> Handler ()
 putUser uid upd = do
   info $ userMsg uid . msg "Changing user state"
@@ -744,12 +772,12 @@ getUserConversations uid = do
             b
             ( method GET
                 . header "Z-User" (toByteString' uid)
-                . path "/conversations"
+                . path "conversations"
                 . queryItem "size" (toByteString' batchSize)
                 . maybe id (queryItem "start" . toByteString') start
                 . expect2xx
             )
-      parseResponse (mkError status502 "bad-upstream") r
+      unVersioned @'V2 <$> parseResponse (mkError status502 "bad-upstream") r
     batchSize = 100 :: Int
 
 getUserClients :: UserId -> Handler [Client]

tools/stern/stern.cabal

@@ -91,6 +91,7 @@ library
     , lens                   >=4.4
     , metrics-wai            >=0.3
     , mtl                    >=2.1
+    , retry
     , schema-profunctor
     , servant
     , servant-server