Optional YAML configuration for Brig

libs/cassandra-util/src/Cassandra/Schema.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
@@ -22,6 +23,7 @@ import Control.Monad.Catch
 import Control.Error
 import Control.Monad
 import Control.Monad.IO.Class
+import Data.Aeson
 import Data.Int
 import Data.IORef
 import Data.Functor.Identity
@@ -35,6 +37,7 @@ import Data.Time.Clock
 import Data.Word
 import Database.CQL.IO
 import Database.CQL.Protocol (Request (..), Query (..), Response(..), Result (..))
+import GHC.Generics hiding (to, from, S)
 import Options.Applicative hiding (info)
 import Prelude hiding (log)
 import System.Logger (Logger, Level (..), log, msg)
@@ -50,21 +53,26 @@ data Migration = Migration
 data MigrationOpts = MigrationOpts
     { migHost     :: String
     , migPort     :: Word16
-    , migKeyspace :: Keyspace
+    , migKeyspace :: Text
     , migRepl     :: ReplicationStrategy
     , migReset    :: Bool
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 data ReplicationStrategy
     = SimpleStrategy { replicationFactor :: ReplicationFactor }
     | NetworkTopologyStrategy { dataCenters :: ReplicationMap }
-    deriving (Eq, Show)
+    deriving (Eq, Show, Generic)
 
 newtype ReplicationFactor = ReplicationFactor Word16
-    deriving (Eq, Show)
+    deriving (Eq, Show, Generic)
 
 newtype ReplicationMap = ReplicationMap [(Text, ReplicationFactor)]
-    deriving (Eq, Show)
+    deriving (Eq, Show, Generic)
+
+instance FromJSON ReplicationMap
+instance FromJSON ReplicationFactor
+instance FromJSON ReplicationStrategy
+instance FromJSON MigrationOpts
 
 instance Read ReplicationMap where
     -- ReplicationMap ::= DataCenter [("," DataCenter)*]
@@ -142,11 +150,12 @@ migrateSchema l o ms = do
           . setProtocolVersion V3
           $ defSettings
     runClient p $ do
+        let keyspace = Keyspace . migKeyspace $ o
         when (migReset o) $ do
             info "Dropping keyspace."
-            void $ schema (dropKeyspace (migKeyspace o)) (params All ())
-        createKeyspace (migKeyspace o) (migRepl o)
-        useKeyspace (migKeyspace o)
+            void $ schema (dropKeyspace keyspace) (params All ())
+        createKeyspace keyspace (migRepl o)
+        useKeyspace keyspace
         void $ schema metaCreate (params All ())
         migrations <- newer <$> schemaVersion
         if null migrations
@@ -203,7 +212,7 @@ migrationOptsParser = MigrationOpts
             <> value 9042
             <> help "Cassandra port")
 
-    <*> (fmap (Keyspace . pack) . strOption $
+    <*> ((fmap pack) . strOption $
             long "keyspace"
             <> metavar "STRING"
             <> help "Cassandra Keyspace")

libs/ropes/ropes.cabal

@@ -39,6 +39,7 @@ library
       , transformers          >= 0.3
       , time                  >= 1.1
       , tinylog               >= 0.10.2
+      , yaml                  >= 0.8.22
 
     ghc-options:
         -Wall

libs/ropes/src/Ropes/Aws.hs

@@ -58,11 +58,22 @@ import Prelude
 
 newtype AccessKeyId = AccessKeyId
     { unAccessKeyId :: ByteString }
-    deriving (Eq, Show)
+    deriving (Read, Eq, Show)
+
+instance FromJSON AccessKeyId where
+  parseJSON = withText "Aws.AccessKeyId" $
+    pure . AccessKeyId . encodeUtf8
 
 newtype SecretAccessKey = SecretAccessKey
     { unSecretAccessKey :: ByteString }
-    deriving (Eq)
+    deriving (Read, Eq)
+
+instance Show SecretAccessKey where
+  show _ = "AWS Secret hidden"
+
+instance FromJSON SecretAccessKey where
+  parseJSON = withText "Aws.SecretAccessKey" $
+    pure . SecretAccessKey . encodeUtf8
 
 data Auth
     = PermAuth Configuration

libs/ropes/src/Ropes/Nexmo.hs

@@ -44,7 +44,7 @@ import Data.ByteString (ByteString)
 import Data.ByteString.Lazy (toStrict)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Monoid ((<>))
-import Data.Text (Text)
+import Data.Text (Text, toLower, unpack)
 import Data.Text.Encoding (decodeLatin1, decodeUtf8)
 import Data.Time (UTCTime)
 import Data.Time.Format (formatTime, defaultTimeLocale)
@@ -61,6 +61,14 @@ import qualified Data.List.NonEmpty as N
 newtype ApiKey = ApiKey ByteString
 newtype ApiSecret = ApiSecret ByteString
 data ApiEndpoint = Production | Sandbox
+    deriving (Show)
+
+instance FromJSON ApiEndpoint where
+    parseJSON = withText "NexmoApiEndpoint" $ \s ->
+        case toLower s of
+            "sandbox" -> pure Sandbox
+            "production" -> pure Production
+            other -> fail $ "Unsupported Nexmo environment: " ++ unpack other
 
 data Charset = GSM7 | GSM8 | UCS2 deriving (Eq, Show)
 

libs/types-common/src/Util/Options.hs

@@ -0,0 +1,48 @@
+module Util.Options where
+
+import Data.Aeson (FromJSON)
+import Data.Maybe (fromMaybe)
+import Data.Monoid
+import Data.Yaml (ParseException, decodeFileEither)
+import Options.Applicative
+import System.Directory
+import System.Environment (getArgs)
+import System.IO (hPutStrLn, stderr)
+
+getOptions :: (FromJSON a) => String -> Parser a -> FilePath -> IO a
+getOptions desc parser defaultPath = do
+    path <- parseConfigPath defaultPath (mkDesc desc)
+    file <- doesFileExist path
+    if file
+        then do
+            configFile <- decodeConfigFile path
+            case configFile of
+                Left e -> fail $ show e
+                Right opts -> return opts
+        else do
+            hPutStrLn stderr $
+                "Config file at " ++
+                path ++
+                " does not exist, falling back to command-line arguments. \n"
+            execParser (info (helper <*> parser) (mkDesc desc))
+
+decodeConfigFile :: (FromJSON a) => FilePath -> IO (Either ParseException a)
+decodeConfigFile = decodeFileEither
+
+parseConfigPath :: FilePath -> InfoMod String -> IO String
+parseConfigPath defaultPath desc = do
+    args <- getArgs
+    let result =
+            getParseResult $
+            execParserPure defaultPrefs (info (helper <*> pathParser) desc) args
+    pure $ fromMaybe defaultPath result
+  where
+    pathParser :: Parser String
+    pathParser =
+        strOption $
+        long "config-file" <> short 'c' <> help "Config file to load" <>
+        showDefault <>
+        value defaultPath
+
+mkDesc :: String -> InfoMod a
+mkDesc desc = header desc <> fullDesc

libs/types-common/types-common.cabal

@@ -41,6 +41,7 @@ library
           Data.Swagger
           Data.Text.Ascii
           Data.UUID.Tagged
+          Util.Options
 
     build-depends:
           attoparsec            >= 0.11
@@ -54,9 +55,11 @@ library
         , cryptohash-md5        >= 0.11.7.2
         , cryptohash-sha1       >= 0.11.7.2
         , deepseq               >= 1.4
+        , directory             >= 1.2
         , errors                >= 2.0
         , hashable              >= 1.2
         , iproute               >= 1.5
+        , optparse-applicative  >= 0.10
         , lens                  >= 4.10
         , semigroups            >= 0.12
         , safe                  >= 0.3
@@ -70,6 +73,7 @@ library
         , uri-bytestring        >= 0.2
         , uuid                  >= 1.3.11
         , vector                >= 0.11
+        , yaml                  >= 0.8.22
 
     if flag(cql)
         cpp-options:   "-DWITH_CQL"

services/brig/Dockerfile

@@ -0,0 +1,21 @@
+# Requires docker >= 17.05 (requires support for multi-stage builds)
+# Requires to have created the wire-server-builder and wire-server-deps docker images
+
+#--- Builder stage ---
+FROM wire-server-builder:alpine as builder
+
+COPY . /src/wire-server/
+
+RUN cd /src/wire-server/services/brig && make install
+
+#--- Minified stage ---
+FROM wire-server-deps:alpine
+
+ARG executable
+COPY --from=builder /src/wire-server/services/brig/dist/${executable} /usr/bin/${exectuable}
+COPY --from=builder /src/wire-server/services/brig/deb/opt/brig/templates/ /usr/share/wire/templates/
+
+# ARGs are not available at runtime, create symlink at build time
+# more info: https://stackoverflow.com/questions/40902445/using-variable-interpolation-in-string-in-docker
+RUN ln -s /usr/bin/${executable} /usr/bin/service
+ENTRYPOINT ["/usr/bin/service"]

services/brig/Makefile

@@ -28,7 +28,6 @@ init:
 .PHONY: install
 install: init
 	stack install --pedantic --test --local-bin-path=dist
-	cp "$(shell stack path --dist-dir)/build/$(NAME)-integration/$(NAME)-integration" dist/
 
 .PHONY: clean
 clean:
@@ -118,8 +117,7 @@ index-reset: install
 docker:
 	$(foreach executable,$(EXECUTABLES),\
 	docker build -t $(executable) \
-	-f ../../build/alpine/Dockerfile \
-	--build-arg service=$(NAME) \
+	-f Dockerfile \
 	--build-arg executable=$(executable) \
 	../.. \
 	;)

services/brig/brig.cabal

@@ -139,12 +139,14 @@ library
       , multihash                 >= 0.1.3
       , mwc-random
       , network                   >= 2.4
+      , network-uri               >= 2.6
       , old-locale                >= 1.0
       , optparse-applicative      >= 0.11
       , pem                       >= 0.2
       , resourcet                 >= 1.1
       , ropes                     >= 0.4.20
       , safe                      >= 0.3
+      , scientific                >= 0.3.4
       , scrypt                    >= 0.5
       , semigroups                >= 0.15
       , singletons                >= 2.0
@@ -173,6 +175,7 @@ library
       , wai-routing               >= 0.12
       , wai-utilities             >= 0.16
       , warp                      >= 3.0.12.1
+      , yaml                      >= 0.8.22
       , zauth                     >= 0.10.3
 
     ghc-options:
@@ -188,8 +191,11 @@ executable brig
     build-depends:
         base
       , brig
+      , directory            >= 1.3
       , HsOpenSSL            >= 0.10
       , optparse-applicative >= 0.10
+      , types-common
+      , yaml                 >= 0.8.22
 
     ghc-options:
         -Wall
@@ -244,10 +250,13 @@ executable brig-schema
     build-depends:
         base
       , cassandra-util       >= 0.12
+      , directory            >= 1.3
       , optparse-applicative >= 0.10
       , raw-strings-qq       >= 1.0
       , text
       , tinylog              >= 0.10
+      , types-common
+      , yaml                 >= 0.8.22
 
 executable brig-index
     main-is:            Main.hs
@@ -279,16 +288,13 @@ executable brig-index
       , types-common
       , uri-bytestring
 
-test-suite brig-integration
-    type:               exitcode-stdio-1.0
+executable brig-integration
     default-language:   Haskell2010
     main-is:            Main.hs
     hs-source-dirs:     test/integration
     ghc-options:
-        -threaded
         -Wall
         -fwarn-tabs
-        -with-rtsopts=-N
 
     other-modules:
         API
@@ -330,6 +336,7 @@ test-suite brig-integration
       , lifted-async          >= 0.9.3
       , mtl                   >= 2.1
       , network
+      , optparse-applicative  >= 0.11
       , options               >= 0.1
       , pem
       , random                >= 1.0
@@ -354,4 +361,5 @@ test-suite brig-integration
       , warp
       , warp-tls              >= 3.2
       , zauth
+      , yaml                  >= 0.8.22
 

services/brig/schema/src/Main.hs

@@ -4,9 +4,8 @@ module Main where
 
 import Cassandra.Schema
 import Control.Exception (finally)
-import Data.Monoid
-import Options.Applicative
 import System.Logger hiding (info)
+import Util.Options
 
 import qualified V9
 import qualified V10
@@ -44,7 +43,9 @@ import qualified V43
 
 main :: IO ()
 main = do
-    o <- execParser (info (helper <*> migrationOptsParser) desc)
+    let desc = "Brig Cassandra Schema Migrations"
+        defaultPath = "/etc/wire/brig/conf/brig-schema.yaml"
+    o <- getOptions desc migrationOptsParser defaultPath
     l <- new $ setOutput StdOut . setFormat Nothing $ defSettings
     migrateSchema l o
         [ V9.migration
@@ -81,5 +82,3 @@ main = do
         , V42.migration
         , V43.migration
         ] `finally` close l
-  where
-    desc = header "Brig Cassandra Schema Migrations" <> fullDesc

services/brig/src/Brig/API.hs

@@ -32,7 +32,7 @@ import Data.Metrics.Middleware hiding (metrics)
 import Data.Misc (IpAddr (..))
 import Data.Monoid ((<>))
 import Data.Range
-import Data.Text (Text)
+import Data.Text (Text, unpack)
 import Data.Text.Encoding (decodeLatin1)
 import Data.Text.Lazy (pack)
 import Galley.Types (UserClients (..))
@@ -86,7 +86,8 @@ runServer o = do
         closeEnv e
   where
     rtree      = compile (sitemap o)
-    server   e = defaultServer (optHost o) (optPort o) (e^.applog) (e^.metrics)
+    endpoint   = brig o
+    server   e = defaultServer (unpack . host $ endpoint) (port endpoint) (e^.applog) (e^.metrics)
     pipeline e = measureRequests (e^.metrics) rtree
                . catchErrors (e^.applog) (e^.metrics)
                . GZip.gunzip . GZip.gzip GZip.def