Merge pull request #798 from wireapp/release/2019-07-08

CHANGELOG.md

@@ -1,8 +1,18 @@
-# 2019-04-09 #756
+# 2019-07-08 #798
+
+## Internal Changes
+
+* restund: add EXTRA_CFLAGS to work on ubuntu 16 (#788)
+* Fix flaky unit test. (#770)
+* Add upstream references in stack.yaml deps (wai-middleware-prometheus). (#760)
+* Cannon analytics (2) (#750)
+* fix this file.
+
+# 2019-05-13 #756
 
 ## Documentation changes
 
-* Group provisioning (#724)
+* Group provisioning (#748)
 * Instructions for running load tests (#738)
 * Twilio configuration (#733)
 
@@ -22,7 +32,7 @@ Docker image building improvements (#755)
 
 Config value `setEmailVisibility` must be set in brig's config file (if you're not sure, `visible_to_self` is the preferred default)
 
-# 2019-04-09 #746
+# 2019-05-02 #746
 
 ## Documentation changes
 

libs/extended/package.yaml

@@ -15,6 +15,7 @@ copyright: (c) 2018 Wire Swiss GmbH
 license: AGPL-3
 dependencies:
 - base
+- bytestring
 - extra
 - imports
 - optparse-applicative

libs/extended/src/System/Logger/Extended.hs

@@ -12,17 +12,55 @@ module System.Logger.Extended
 import Imports
 import Control.Monad.Catch
 import Database.CQL.IO
-
 import System.Logger as Log
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Lazy.Builder as B
 import qualified System.Logger.Class as LC
 
 mkLogger :: Log.Level -> Bool -> IO Log.Logger
-mkLogger lvl netstr = Log.new'
+mkLogger lvl netstr = Log.new
+ . Log.setReadEnvironment False
  . Log.setOutput Log.StdOut
  . Log.setFormat Nothing
- $ Log.simpleSettings (Just lvl) (Just netstr)
+ $ simpleSettings (Just lvl) (Just netstr)
+
+-- | Variant of Log.defSettings:
+--
+-- * change log level according to first arg (iff isJust).
+--
+-- * pick renderNetstr or renderDefault according to 2nd arg (iff isJust).
+--
+-- * use 'canonicalizeWhitespace'.
+--
+simpleSettings :: Maybe Level -> Maybe Bool -> Log.Settings
+simpleSettings lvl netstr
+ = maybe id setLogLevel lvl
+ . setRenderer (canonicalizeWhitespace rndr)
+ $ Log.defSettings
+ where
+ rndr = case netstr of
+ Just True -> \_ _ _ -> renderNetstr
+ _ -> \s _ _ -> renderDefault s
+
+-- | Replace all whitespace characters in the output of a renderer by @' '@.
+-- Log output must be ASCII encoding.
+--
+-- (Many logging processors handle newlines poorly. Instead of hunting down all
+-- places and situations in your code and your dependencies that inject newlines
+-- into your log messages, you can choose to call 'canonicalizeWhitespace' on
+-- your renderer.)
+canonicalizeWhitespace :: Renderer -> Renderer
+canonicalizeWhitespace rndrRaw delim df lvl
+ = B.lazyByteString . nl2sp . B.toLazyByteString . rndrRaw delim df lvl
+ where
+ nl2sp :: L.ByteString -> L.ByteString
+ nl2sp = L.concatMap $
+ \c -> if isSpace c
+ then " "
+ else L.singleton c
 
--- | Work where there are no options; Use Log.new which reads in LOG_* env variables.
+-- | Like 'mkLogger', but uses Log.new which reads in LOG_* env variables.
 --
 -- TODO: DEPRECATED! Use 'mkLogger' instead and get all settings from config files, not from
 -- environment!

libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs

@@ -46,10 +46,8 @@ normalizeWaiRequestRoute paths req = pathInfo
  pathInfo :: Text
  pathInfo = T.decodeUtf8 $ fromMaybe (Wai.rawPathInfo req) mPathInfo
 
-
--- the following code is copied and mutated from wai-middleware-prometheus. something like
--- this should be moved there.
-
+-- | This can be refactored away once https://github.com/fimad/prometheus-haskell/pull/45 has
+-- been released on hackage.
 instrumentHandlerValue ::
  (Wai.Request -> Text) -- ^ The function used to derive the "handler" value in Prometheus
  -> Wai.Application -- ^ The app to instrument

libs/types-common/test/Test/Properties.hs

@@ -31,7 +31,8 @@ tests = testGroup "Properties"
  [ testProperty "validate (toText x) == Right x" $
  \(a :: Ascii) -> Ascii.validate (Ascii.toText a) == Right a
  , testProperty "unsafeFromByteString (toByteString x) == x" $
- \(a :: Ascii) -> Ascii.unsafeFromByteString (toByteString' a) == a
+ \(encodeBase64 -> a) -> Ascii.unsafeFromByteString (toByteString' a) == a
+ -- (unsafeFromByteString occasionally fails on Ascii strings)
  , testProperty "validate (toText x <> \"𝄞\") /= Right x" $
  \(a :: Ascii) -> Ascii.validate (Ascii.toText a <> "𝄞") /= Right a
  ]

libs/wai-utilities/src/Network/Wai/Utilities/Server.hs

@@ -15,6 +15,8 @@ module Network.Wai.Utilities.Server
  , catchErrors
  , OnErrorMetrics
  , heavyDebugLogging
+ , rethrow5xx
+ , lazyResponseBody
 
  -- * Utilities
  , onError
@@ -48,14 +50,15 @@ import Network.Wai.Utilities.Response
 import System.Logger.Class hiding (Settings, Error, format)
 import System.Posix.Signals (installHandler, sigINT, sigTERM)
 
-import qualified Network.Wai.Utilities.Error as Wai
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as C
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text.Lazy.Encoding as LT
+import qualified Network.Wai.Internal as WaiInt
 import qualified Network.Wai.Predicate as P
 import qualified Network.Wai.Routing.Route as Route
 import qualified Network.Wai.Utilities.Error as Error
+import qualified Network.Wai.Utilities.Error as Wai
 import qualified Prometheus as Prm
 import qualified System.Logger as Log
 import qualified System.Posix.Signals as Sig
@@ -184,7 +187,7 @@ measureRequests m rtree = withPathTemplate rtree $ \p ->
 -- See 'catchErrors'.
 catchErrors :: Logger -> OnErrorMetrics -> Middleware
 catchErrors l m app req k =
- app req k `catch` errorResponse
+ rethrow5xx l app req k `catch` errorResponse
  where
  errorResponse :: SomeException -> IO ResponseReceived
  errorResponse ex = do
@@ -271,6 +274,38 @@ emitLByteString lbs = do
  -- | Emit the bytestring on the first read, then always return "" on subsequent reads
  return . atomically $ swapTVar tvar mempty
 
+-- | Run the 'Application'; check the response status; if >=500, throw a 'Wai.Error' with
+-- label @"server-error"@ and the body as the error message.
+rethrow5xx :: Logger -> Middleware
+rethrow5xx logger app req k = app req k'
+ where
+ k' resp@(WaiInt.ResponseRaw {}) = do -- See Note [Raw Response]
+ let logMsg = field "canoncalpath" (show $ pathInfo req)
+ . field "rawpath" (rawPathInfo req)
+ . field "request" (fromMaybe "N/A" $ lookupRequestId req)
+ . msg (val "ResponseRaw - cannot collect metrics or log info on errors")
+ Log.log logger Log.Debug logMsg
+ k resp
+ k' resp = do
+ let st = responseStatus resp
+ if statusCode st < 500
+ then k resp
+ else do
+ rsbody :: LText <- liftIO $ cs <$> lazyResponseBody resp
+ throwM $ Wai.Error st "server-error" rsbody
+
+-- | This flushes the response! If you want to keep using the response, you need to construct
+-- a new one with a fresh body stream.
+lazyResponseBody :: Response -> IO LByteString
+lazyResponseBody rs = case responseToStream rs of
+ (_, _, cont :: (StreamingBody -> IO ()) -> IO ()) -> do
+ tvar <- atomically $ newTVar mempty
+ let pushstream builder = atomically $ modifyTVar tvar (<> builder)
+ cont $ \streamingBody ->
+ streamingBody pushstream (pure ())
+ atomically $ toLazyByteString <$> readTVar tvar
+
+
 --------------------------------------------------------------------------------
 -- Utilities
 

services/cannon/src/Cannon/App.hs

@@ -65,11 +65,10 @@ continue l ws clock k = liftIO $ do
  case result of
  (Left (Left x)) ->
  let text = client (key2bytes k) . msg (val "read: " +++ show x) in
- case fromException x of
- Just ConnectionClosed -> Logger.debug l text
- _ -> Logger.warn l text
- (Right (Left x)) -> Logger.warn l $
- client (key2bytes k) . msg (val "write: " +++ show x)
+ Logger.debug l text
+ (Right (Left x)) ->
+ let text = client (key2bytes k) . msg (val "write: " +++ show x) in
+ Logger.debug l text
  _ -> return ()
 
 terminate :: Key -> Websocket -> WS ()
@@ -138,7 +137,7 @@ rejectOnError p x = do
  NotSupported -> rejectRequest p (f "protocol not supported" "N/A")
  MalformedRequest _ m -> rejectRequest p (f "malformed-request" (Text.pack m))
  OtherHandshakeException m -> rejectRequest p (f "other-error" (Text.pack m))
- _ -> throwM x
+ _ -> pure ()
  throwM x
 
 ioErrors :: MonadIO m => Logger -> Key -> [Handler m ()]

services/restund/Dockerfile

@@ -1,4 +1,4 @@
-FROM ubuntu:14.04
+FROM ubuntu:16.04
 
 ARG re_version
 ARG restund_version
@@ -12,7 +12,7 @@ RUN apt-get update \
  && make RELEASE=1 \
  && make RELEASE=1 PREFIX=/usr/local install \
  && cd /build/restund-${restund_version} \
- && make RELEASE=1 EXTRA_MODULES='${extra_modules}' \
+ && make RELEASE=1 EXTRA_CFLAGS="-std=gnu99" EXTRA_MODULES='${extra_modules}' \
  && make RELEASE=1 EXTRA_MODULES='${extra_modules}' PREFIX=/usr/local install \
  && ldconfig \
  && rm -rf /build \

services/restund/Makefile

@@ -13,7 +13,7 @@ RESTUND_TARBALL := restund-$(RESTUND_VERSION).tar.gz
 RESTUND_SRC := src/restund-$(RESTUND_VERSION)/Makefile
 RESTUND_URL := https://github.com/wireapp/restund/archive
 
-WIRE_VERSION := 6
+WIRE_VERSION := 7
 
 EXTRA_MODULES := zrest drain
 

snapshots/wire-1.3.yaml

@@ -0,0 +1,7 @@
+# DO NOT MODIFY THIS FILE. See README.md to learn why.
+
+resolver: https://raw.githubusercontent.com/wireapp/wire-server/develop/snapshots/wire-1.2.yaml
+name: wire-1.3
+
+packages:
+- tinylog-0.15.0

stack.yaml

@@ -1,4 +1,4 @@
-resolver: snapshots/wire-1.2.yaml
+resolver: snapshots/wire-1.3.yaml
 
 packages:
 - libs/api-bot
@@ -42,12 +42,19 @@ extra-deps:
  commit: 9bcd5423e0e33a6db8b1e69b50d74e8b47daa737
  subdirs:
  - wai-middleware-prometheus
+ # wai-middleware-prometheus can be pulled from hackage once the
+ # version including
+ # https://github.com/fimad/prometheus-haskell/pull/44 has been
+ # merged (any time after Tue 21 May 2019 03:42:48 PM CEST).
+ #
+ # an even better fix is in
+ # https://github.com/fimad/prometheus-haskell/pull/45; see comment
+ # in /libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs at
+ # `instrumentHandlerValue`.
 - git: https://github.com/wireapp/saml2-web-sso
  commit: c0bcbe8ae5bb6fdc0b5b94f640f63a615c068cbf # master (Apr 25, 2019)
 - git: https://github.com/wireapp/hscim
  commit: 6b98b894c127eed4a5bde646ebf20febcfa656fa # master (Apr 2, 2019)
-- git: https://gitlab.com/fisx/tinylog.git
- commit: fd7155aaf6f090f48004a8f7857ce9d3cb4f9417 # https://gitlab.com/twittner/tinylog/merge_requests/6
 
 flags:
  types-common: