diff --git a/libs/api-bot/src/Network/Wire/Bot/Clients.hs b/libs/api-bot/src/Network/Wire/Bot/Clients.hs index 306621ef8e4..d0605c15116 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Clients.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Clients.hs @@ -31,15 +31,13 @@ import qualified Data.Set as Set import Imports import System.CryptoBox (Session) -data Clients - = Clients - { members :: TVar (Map ConvId (Set UserId)), - sessions :: TVar Sessions - } +data Clients = Clients + { members :: TVar (Map ConvId (Set UserId)), + sessions :: TVar Sessions + } -newtype Sessions - = Sessions - {clients :: Map UserId (Map ClientId Session)} +newtype Sessions = Sessions + {clients :: Map UserId (Map ClientId Session)} empty :: IO Clients empty = Clients <$> newTVarIO Map.empty <*> newTVarIO (Sessions Map.empty) diff --git a/libs/api-bot/src/Network/Wire/Bot/Crypto.hs b/libs/api-bot/src/Network/Wire/Bot/Crypto.hs index 516d505cb35..672ec009fbe 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Crypto.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Crypto.hs @@ -152,11 +152,10 @@ decryptMessage clt e = do ----------------------------------------------------------------------------- -- Auxiliary Symmetric Encryption -data SymmetricKeys - = SymmetricKeys - { symmetricEncKey :: !ByteString, - symmetricMacKey :: !ByteString - } +data SymmetricKeys = SymmetricKeys + { symmetricEncKey :: !ByteString, + symmetricMacKey :: !ByteString + } deriving (Eq, Show) instance Serialize SymmetricKeys where diff --git a/libs/api-bot/src/Network/Wire/Bot/Email.hs b/libs/api-bot/src/Network/Wire/Bot/Email.hs index f224abc32c4..243554bbbfe 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Email.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Email.hs @@ -47,13 +47,12 @@ import Network.HaskellNet.IMAP.Connection import Network.HaskellNet.IMAP.SSL import Network.Wire.Client.API.User -data MailboxSettings - = MailboxSettings - { mailboxHost :: String, - mailboxUser :: Email, - mailboxPassword :: String, - mailboxConnections :: Int - } +data MailboxSettings = MailboxSettings + { mailboxHost :: String, + mailboxUser :: Email, + mailboxPassword :: String, + mailboxConnections :: Int + } instance FromJSON MailboxSettings where parseJSON = withObject "mailbox-settings" $ \o -> @@ -62,11 +61,10 @@ instance FromJSON MailboxSettings where <*> o .: "pass" <*> o .: "conn" -data Mailbox - = Mailbox - { mailboxSettings :: MailboxSettings, - mailboxPool :: Pool IMAPConnection - } +data Mailbox = Mailbox + { mailboxSettings :: MailboxSettings, + mailboxPool :: Pool IMAPConnection + } data MailException = -- | Missing e-mail headers needed for automation. diff --git a/libs/api-bot/src/Network/Wire/Bot/Monad.hs b/libs/api-bot/src/Network/Wire/Bot/Monad.hs index 953ee92dcb5..81dc76665d9 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Monad.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Monad.hs @@ -133,20 +133,19 @@ import qualified System.Random.MWC as MWC -- * BotNetEnv -data BotNetEnv - = BotNetEnv - { botNetGen :: MWC.GenIO, - botNetMailboxes :: [Mailbox], - botNetSender :: Email, - botNetUsers :: Cache, - botNetServer :: Server, - botNetLogger :: Logger, - botNetAssert :: !Bool, - botNetSettings :: BotSettings, - botNetMetrics :: Metrics, - botNetReportDir :: Maybe FilePath, - botNetMailboxFolders :: [String] - } +data BotNetEnv = BotNetEnv + { botNetGen :: MWC.GenIO, + botNetMailboxes :: [Mailbox], + botNetSender :: Email, + botNetUsers :: Cache, + botNetServer :: Server, + botNetLogger :: Logger, + botNetAssert :: !Bool, + botNetSettings :: BotSettings, + botNetMetrics :: Metrics, + botNetReportDir :: Maybe FilePath, + botNetMailboxFolders :: [String] + } newBotNetEnv :: Manager -> Logger -> BotNetSettings -> IO BotNetEnv newBotNetEnv manager logger o = do @@ -322,25 +321,24 @@ runBotSession b (BotSession s) = liftBotNet $ runReaderT s b newtype BotTag = BotTag {unTag :: Text} deriving (Eq, Show, IsString) -data Bot - = Bot - { botTag :: BotTag, - botSettings :: BotSettings, - botUser :: User, - -- TODO: Move into BotClient? - botAuth :: IORef (Auth, UTCTime), - botEvents :: TVar (Word16, [(UTCTime, Event)]), - botAsserts :: TQueue EventAssertion, - botBacklog :: TVar [EventAssertion], - botAssertCount :: TVar Word16, - botPushThread :: IORef (Maybe (Async ())), - botHeartThread :: IORef (Maybe (Async ())), - botAssertThread :: IORef (Maybe (Async ())), - botMetrics :: BotMetrics, - -- END TODO - botClients :: TVar [BotClient], -- TODO: IORef? - botPassphrase :: PlainTextPassword - } +data Bot = Bot + { botTag :: BotTag, + botSettings :: BotSettings, + botUser :: User, + -- TODO: Move into BotClient? + botAuth :: IORef (Auth, UTCTime), + botEvents :: TVar (Word16, [(UTCTime, Event)]), + botAsserts :: TQueue EventAssertion, + botBacklog :: TVar [EventAssertion], + botAssertCount :: TVar Word16, + botPushThread :: IORef (Maybe (Async ())), + botHeartThread :: IORef (Maybe (Async ())), + botAssertThread :: IORef (Maybe (Async ())), + botMetrics :: BotMetrics, + -- END TODO + botClients :: TVar [BotClient], -- TODO: IORef? + botPassphrase :: PlainTextPassword + } instance Show Bot where showsPrec _ b = @@ -356,13 +354,12 @@ instance Show Bot where instance Eq Bot where a == b = botId a == botId b -data BotClient - = BotClient - { botClientId :: !ClientId, - botClientLabel :: !(Maybe Text), - botClientBox :: !Box, - botClientSessions :: !Clients -- TODO: Map UserId (Map ClientId Session) - } +data BotClient = BotClient + { botClientId :: !ClientId, + botClientLabel :: !(Maybe Text), + botClientBox :: !Box, + botClientSessions :: !Clients -- TODO: Map UserId (Map ClientId Session) + } instance Eq BotClient where a == b = botClientId a == botClientId b @@ -518,14 +515,13 @@ withCachedBot t f = do ------------------------------------------------------------------------------- -- Assertions -data EventAssertion - = EventAssertion - { _assertType :: !EventType, - _assertTime :: !UTCTime, - _assertPred :: Event -> Bool, - _assertOut :: !(Maybe (TMVar (Maybe Event))), - _assertStack :: !CallStack - } +data EventAssertion = EventAssertion + { _assertType :: !EventType, + _assertTime :: !UTCTime, + _assertPred :: Event -> Bool, + _assertOut :: !(Maybe (TMVar (Maybe Event))), + _assertStack :: !CallStack + } whenAsserts :: MonadBotNet m => BotNet () -> m () whenAsserts ma = liftBotNet $ do @@ -890,13 +886,12 @@ decrBotsAlive :: MonadBotNet m => m () decrBotsAlive = getMetrics >>= liftIO . Metrics.gaugeDecr Metrics.botsAlive -- Note: Separate TVars to avoid contention. -data BotMetrics - = BotMetrics - { botEventsRcvd :: TVar (HashMap Metrics.Path Double), - botEventsAckd :: TVar (HashMap Metrics.Path Double), - botEventsIgnd :: TVar (HashMap Metrics.Path Double), - botEventsMssd :: TVar (HashMap Metrics.Path Double) - } +data BotMetrics = BotMetrics + { botEventsRcvd :: TVar (HashMap Metrics.Path Double), + botEventsAckd :: TVar (HashMap Metrics.Path Double), + botEventsIgnd :: TVar (HashMap Metrics.Path Double), + botEventsMssd :: TVar (HashMap Metrics.Path Double) + } newBotMetrics :: IO BotMetrics newBotMetrics = diff --git a/libs/api-bot/src/Network/Wire/Bot/Report.hs b/libs/api-bot/src/Network/Wire/Bot/Report.hs index 9d8f53c8b24..1f6c1abcd2f 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Report.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Report.hs @@ -56,13 +56,12 @@ import Network.Wire.Client.API.Push (EventType (..), eventTypeText) -- * Create Reports -data Report - = Report - { reportTitle :: !Text, - reportDate :: !UTCTime, - reportSections :: [Section], - _data :: !Data - } +data Report = Report + { reportTitle :: !Text, + reportDate :: !UTCTime, + reportSections :: [Section], + _data :: !Data + } deriving (Eq) -- | Create a 'Report' of the metrics in the given 'Section's. @@ -90,13 +89,12 @@ createReport t m (SectionS (Endo f)) = do -- * Access Report Data -data Data - = Data - { _counters :: HashMap Path Double, - _labels :: HashMap Path Text, - _histograms :: HashMap Path (Map Bucket Int), - _gauges :: HashMap Path Double - } +data Data = Data + { _counters :: HashMap Path Double, + _labels :: HashMap Path Text, + _histograms :: HashMap Path (Map Bucket Int), + _gauges :: HashMap Path Double + } deriving (Eq) instance Semigroup Data where @@ -124,11 +122,10 @@ reportBucket r p = fromMaybe mempty $ HashMap.lookup p (_histograms (_data r)) newtype SectionS = SectionS (Endo [Section]) deriving (Semigroup, Monoid) -data Section - = Section - { sectionName :: !Text, - sectionMetrics :: [Metric] - } +data Section = Section + { sectionName :: !Text, + sectionMetrics :: [Metric] + } deriving (Eq) data Metric diff --git a/libs/api-bot/src/Network/Wire/Bot/Settings.hs b/libs/api-bot/src/Network/Wire/Bot/Settings.hs index a6ac3349592..ccdb7b4ead6 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Settings.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Settings.hs @@ -44,21 +44,20 @@ import Options.Applicative ------------------------------------------------------------------------------- -- BotNetSettings -data BotNetSettings - = BotNetSettings - { setBotNetApiHost :: !ByteString, - setBotNetApiPort :: !Word16, - setBotNetApiWsHost :: !(Maybe ByteString), - setBotNetApiWsPort :: !(Maybe Word16), - setBotNetApiSSL :: !Bool, - setBotNetAssert :: !Bool, - setBotNetMailboxConfig :: !(Maybe FilePath), - setBotNetSender :: !Email, - setBotNetUsersFile :: !(Maybe FilePath), - setBotNetReportDir :: !(Maybe FilePath), - setBotNetBotSettings :: !BotSettings, - setBotNetMailboxFolders :: ![String] - } +data BotNetSettings = BotNetSettings + { setBotNetApiHost :: !ByteString, + setBotNetApiPort :: !Word16, + setBotNetApiWsHost :: !(Maybe ByteString), + setBotNetApiWsPort :: !(Maybe Word16), + setBotNetApiSSL :: !Bool, + setBotNetAssert :: !Bool, + setBotNetMailboxConfig :: !(Maybe FilePath), + setBotNetSender :: !Email, + setBotNetUsersFile :: !(Maybe FilePath), + setBotNetReportDir :: !(Maybe FilePath), + setBotNetBotSettings :: !BotSettings, + setBotNetMailboxFolders :: ![String] + } deriving (Eq, Show) botNetSettingsParser :: Parser BotNetSettings @@ -164,13 +163,12 @@ mailboxFoldersOption = ------------------------------------------------------------------------------- -- BotSettings -data BotSettings - = BotSettings - { _botMaxEvents :: Word16, - _botEventTimeout :: NominalDiffTime, - _botMaxAsserts :: Word16, - _botAssertTimeout :: NominalDiffTime - } +data BotSettings = BotSettings + { _botMaxEvents :: Word16, + _botEventTimeout :: NominalDiffTime, + _botMaxAsserts :: Word16, + _botAssertTimeout :: NominalDiffTime + } deriving (Eq, Show) defBotSettings :: BotSettings diff --git a/libs/api-client/src/Network/Wire/Client/API/Auth.hs b/libs/api-client/src/Network/Wire/Client/API/Auth.hs index 14c06919438..d71a57ee1be 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Auth.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Auth.hs @@ -47,11 +47,10 @@ import Web.Cookie (parseSetCookie) newtype AuthCookie = AuthCookie Cookie -data Auth - = Auth - { authCookie :: !AuthCookie, - authToken :: !AccessToken - } +data Auth = Auth + { authCookie :: !AuthCookie, + authToken :: !AccessToken + } ------------------------------------------------------------------------------- -- Unauthenticated diff --git a/libs/api-client/src/Network/Wire/Client/API/Push.hs b/libs/api-client/src/Network/Wire/Client/API/Push.hs index 32adcf5d03c..103e17bd0f9 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Push.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Push.hs @@ -80,11 +80,10 @@ import qualified System.Logger as Log newtype NotifId = NotifId UUID deriving (Eq, Show) -data Notification - = Notification - { notifId :: NotifId, - notifEvents :: [Event] - } +data Notification = Notification + { notifId :: NotifId, + notifEvents :: [Event] + } awaitNotifications :: (MonadSession m, Functor m) => @@ -190,13 +189,12 @@ instance Show Event where show (EOtrMessage x) = "EOtrMessage: " ++ show x -- | An event in a 'Conversation'. -data ConvEvent a - = ConvEvent - { convEvtConv :: !ConvId, - convEvtFrom :: !UserId, - convEvtTime :: !UTCTime, - convEvtData :: !a - } +data ConvEvent a = ConvEvent + { convEvtConv :: !ConvId, + convEvtFrom :: !UserId, + convEvtTime :: !UTCTime, + convEvtData :: !a + } deriving (Eq, Show) data NoData = NoData deriving (Show) diff --git a/libs/api-client/src/Network/Wire/Client/API/Search.hs b/libs/api-client/src/Network/Wire/Client/API/Search.hs index 5f6fced2d82..d68caa988de 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Search.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Search.hs @@ -39,13 +39,12 @@ import Network.HTTP.Types.Status (status200) import Network.Wire.Client.HTTP import Network.Wire.Client.Session -data SearchParams - = SearchParams - { searchText :: !Text, - searchDistance :: !Word8, - searchLimit :: !Word8, - searchDirectory :: !Bool - } +data SearchParams = SearchParams + { searchText :: !Text, + searchDistance :: !Word8, + searchLimit :: !Word8, + searchDirectory :: !Bool + } deriving (Show) instance Default SearchParams where diff --git a/libs/api-client/src/Network/Wire/Client/HTTP.hs b/libs/api-client/src/Network/Wire/Client/HTTP.hs index e96234d7c86..e04313af0b0 100644 --- a/libs/api-client/src/Network/Wire/Client/HTTP.hs +++ b/libs/api-client/src/Network/Wire/Client/HTTP.hs @@ -43,12 +43,11 @@ import Network.Wire.Client.Monad import qualified System.Logger.Class as Log import UnliftIO.Exception (throwIO) -data Error - = Error - { code :: Int, - label :: Text, - message :: Text - } +data Error = Error + { code :: Int, + label :: Text, + message :: Text + } deriving (Show) instance FromJSON Error where diff --git a/libs/api-client/src/Network/Wire/Client/Monad.hs b/libs/api-client/src/Network/Wire/Client/Monad.hs index af7b76e0a67..63197bef41e 100644 --- a/libs/api-client/src/Network/Wire/Client/Monad.hs +++ b/libs/api-client/src/Network/Wire/Client/Monad.hs @@ -39,11 +39,10 @@ import Network.HTTP.Types import qualified System.Logger as Logger import System.Logger.Class -data Env - = Env - { clientServer :: Server, - clientLogger :: Logger - } +data Env = Env + { clientServer :: Server, + clientLogger :: Logger + } newtype Client a = Client (ReaderT Env IO a) deriving @@ -58,15 +57,14 @@ newtype Client a = Client (ReaderT Env IO a) MonadMask ) -data Server - = Server - { serverHost :: ByteString, - serverPort :: Word16, - serverWsHost :: Maybe ByteString, - serverWsPort :: Maybe Word16, - serverSSL :: Bool, - serverManager :: Manager - } +data Server = Server + { serverHost :: ByteString, + serverPort :: Word16, + serverWsHost :: Maybe ByteString, + serverWsPort :: Maybe Word16, + serverSSL :: Bool, + serverManager :: Manager + } class (MonadHttp m, MonadLogger m, MonadIO m) => MonadClient m where getServer :: m Server diff --git a/libs/bilge/src/Bilge/Assert.hs b/libs/bilge/src/Bilge/Assert.hs index 253ff6c6292..f2bfe648ddf 100644 --- a/libs/bilge/src/Bilge/Assert.hs +++ b/libs/bilge/src/Bilge/Assert.hs @@ -65,10 +65,9 @@ instance Contains a => Contains (Maybe a) where -- | A 'Writer' monad containing the list of assertions as predicate -- functions of a 'Response'. -newtype Assertions a - = Assertions - { _assertions :: Writer [Response (Maybe Lazy.ByteString) -> Maybe String] a - } +newtype Assertions a = Assertions + { _assertions :: Writer [Response (Maybe Lazy.ByteString) -> Maybe String] a + } deriving (Functor, Applicative, Monad) -- | Given an IO action to get a 'Response' and a set of assertions, diff --git a/libs/bilge/src/Bilge/IO.hs b/libs/bilge/src/Bilge/IO.hs index 0c134290e94..221a3552d84 100644 --- a/libs/bilge/src/Bilge/IO.hs +++ b/libs/bilge/src/Bilge/IO.hs @@ -95,10 +95,9 @@ data Debug type Http a = HttpT IO a -newtype HttpT m a - = HttpT - { unwrap :: ReaderT Manager m a - } +newtype HttpT m a = HttpT + { unwrap :: ReaderT Manager m a + } deriving ( Functor, Applicative, diff --git a/libs/bilge/src/Bilge/RPC.hs b/libs/bilge/src/Bilge/RPC.hs index 0428cef43a4..b671eabf961 100644 --- a/libs/bilge/src/Bilge/RPC.hs +++ b/libs/bilge/src/Bilge/RPC.hs @@ -46,12 +46,11 @@ import UnliftIO.Exception (try) class HasRequestId m where getRequestId :: m RequestId -data RPCException - = RPCException - { rpceRemote :: !LText, - rpceRequest :: !Request, - rpceCause :: !SomeException - } +data RPCException = RPCException + { rpceRemote :: !LText, + rpceRequest :: !Request, + rpceCause :: !SomeException + } deriving (Typeable) instance Exception RPCException diff --git a/libs/brig-types/src/Brig/Types/Activation.hs b/libs/brig-types/src/Brig/Types/Activation.hs index e0cd1b61580..c22c6c5a712 100644 --- a/libs/brig-types/src/Brig/Types/Activation.hs +++ b/libs/brig-types/src/Brig/Types/Activation.hs @@ -32,28 +32,25 @@ import Data.Text.Ascii import Imports -- | An opaque identifier of a 'UserKey' awaiting activation. -newtype ActivationKey - = ActivationKey - {fromActivationKey :: AsciiBase64Url} +newtype ActivationKey = ActivationKey + {fromActivationKey :: AsciiBase64Url} deriving (Eq, Show, FromByteString, ToByteString, FromJSON, ToJSON, Generic) -- | A random code for use with an 'ActivationKey' that is usually transmitted -- out-of-band, e.g. via email or sms. -newtype ActivationCode - = ActivationCode - {fromActivationCode :: AsciiBase64Url} +newtype ActivationCode = ActivationCode + {fromActivationCode :: AsciiBase64Url} deriving (Eq, Show, FromByteString, ToByteString, FromJSON, ToJSON, Generic) -- | A pair of 'ActivationKey' and 'ActivationCode' as required for activation. type ActivationPair = (ActivationKey, ActivationCode) -- | Data for an activation request. -data Activate - = Activate - { activateTarget :: !ActivationTarget, - activateCode :: !ActivationCode, - activateDryrun :: !Bool - } +data Activate = Activate + { activateTarget :: !ActivationTarget, + activateCode :: !ActivationCode, + activateDryrun :: !Bool + } -- | The target of an activation request. data ActivationTarget @@ -70,23 +67,21 @@ instance ToByteString ActivationTarget where builder (ActivatePhone p) = builder p -- | Information returned as part of a successful activation. -data ActivationResponse - = ActivationResponse - { -- | The activated / verified user identity. - activatedIdentity :: !UserIdentity, - -- | Whether this is the first verified identity of the account. - activatedFirst :: !Bool - } +data ActivationResponse = ActivationResponse + { -- | The activated / verified user identity. + activatedIdentity :: !UserIdentity, + -- | Whether this is the first verified identity of the account. + activatedFirst :: !Bool + } -- | Payload for a request to (re-)send an activation code -- for a phone number or e-mail address. If a phone is used, -- one can also request a call instead of SMS. -data SendActivationCode - = SendActivationCode - { saUserKey :: !(Either Email Phone), - saLocale :: !(Maybe Locale), - saCall :: !Bool - } +data SendActivationCode = SendActivationCode + { saUserKey :: !(Either Email Phone), + saLocale :: !(Maybe Locale), + saCall :: !Bool + } -- * JSON Instances: diff --git a/libs/brig-types/src/Brig/Types/Client.hs b/libs/brig-types/src/Brig/Types/Client.hs index 0a36264b7ec..d9842bc312c 100644 --- a/libs/brig-types/src/Brig/Types/Client.hs +++ b/libs/brig-types/src/Brig/Types/Client.hs @@ -67,17 +67,16 @@ data ClientClass | LegalHoldClient -- see Note [LegalHold] deriving (Eq, Ord, Show) -data NewClient - = NewClient - { newClientPrekeys :: [Prekey], - newClientLastKey :: !LastPrekey, - newClientType :: !ClientType, - newClientLabel :: !(Maybe Text), - newClientClass :: !(Maybe ClientClass), - newClientCookie :: !(Maybe CookieLabel), - newClientPassword :: !(Maybe PlainTextPassword), - newClientModel :: !(Maybe Text) - } +data NewClient = NewClient + { newClientPrekeys :: [Prekey], + newClientLastKey :: !LastPrekey, + newClientType :: !ClientType, + newClientLabel :: !(Maybe Text), + newClientClass :: !(Maybe ClientClass), + newClientCookie :: !(Maybe CookieLabel), + newClientPassword :: !(Maybe PlainTextPassword), + newClientModel :: !(Maybe Text) + } newClient :: ClientType -> LastPrekey -> NewClient newClient t k = @@ -92,38 +91,34 @@ newClient t k = newClientModel = Nothing } -data Client - = Client - { clientId :: !ClientId, - clientType :: !ClientType, - clientTime :: !UTCTimeMillis, - clientClass :: !(Maybe ClientClass), - clientLabel :: !(Maybe Text), - clientCookie :: !(Maybe CookieLabel), - clientLocation :: !(Maybe Location), - clientModel :: !(Maybe Text) - } +data Client = Client + { clientId :: !ClientId, + clientType :: !ClientType, + clientTime :: !UTCTimeMillis, + clientClass :: !(Maybe ClientClass), + clientLabel :: !(Maybe Text), + clientCookie :: !(Maybe CookieLabel), + clientLocation :: !(Maybe Location), + clientModel :: !(Maybe Text) + } deriving (Eq, Show, Generic) -data PubClient - = PubClient - { pubClientId :: !ClientId, - pubClientClass :: !(Maybe ClientClass) - } +data PubClient = PubClient + { pubClientId :: !ClientId, + pubClientClass :: !(Maybe ClientClass) + } deriving (Eq, Show, Generic) -newtype RmClient - = RmClient - { rmPassword :: Maybe PlainTextPassword - } +newtype RmClient = RmClient + { rmPassword :: Maybe PlainTextPassword + } deriving (Generic) -data UpdateClient - = UpdateClient - { updateClientPrekeys :: ![Prekey], - updateClientLastKey :: !(Maybe LastPrekey), - updateClientLabel :: !(Maybe Text) - } +data UpdateClient = UpdateClient + { updateClientPrekeys :: ![Prekey], + updateClientLastKey :: !(Maybe LastPrekey), + updateClientLabel :: !(Maybe Text) + } deriving (Generic) -- * JSON instances: diff --git a/libs/brig-types/src/Brig/Types/Client/Prekey.hs b/libs/brig-types/src/Brig/Types/Client/Prekey.hs index 3e7f9cbad55..f15068d9239 100644 --- a/libs/brig-types/src/Brig/Types/Client/Prekey.hs +++ b/libs/brig-types/src/Brig/Types/Client/Prekey.hs @@ -39,30 +39,26 @@ import Imports newtype PrekeyId = PrekeyId {keyId :: Word16} deriving (Eq, Ord, Show, ToJSON, FromJSON, Generic) -data Prekey - = Prekey - { prekeyId :: !PrekeyId, - prekeyKey :: !Text - } +data Prekey = Prekey + { prekeyId :: !PrekeyId, + prekeyKey :: !Text + } deriving (Eq, Show, Generic) -data PrekeyBundle - = PrekeyBundle - { prekeyUser :: !OpaqueUserId, - prekeyClients :: ![ClientPrekey] - } +data PrekeyBundle = PrekeyBundle + { prekeyUser :: !OpaqueUserId, + prekeyClients :: ![ClientPrekey] + } deriving (Eq, Show, Generic) -data ClientPrekey - = ClientPrekey - { prekeyClient :: !ClientId, - prekeyData :: !Prekey - } +data ClientPrekey = ClientPrekey + { prekeyClient :: !ClientId, + prekeyData :: !Prekey + } deriving (Eq, Show, Generic) -newtype LastPrekey - = LastPrekey - {unpackLastPrekey :: Prekey} +newtype LastPrekey = LastPrekey + {unpackLastPrekey :: Prekey} deriving (Eq, Show, Generic) lastPrekey :: Text -> LastPrekey diff --git a/libs/brig-types/src/Brig/Types/Common.hs b/libs/brig-types/src/Brig/Types/Common.hs index e8d8864d5dd..1c7f5a81450 100644 --- a/libs/brig-types/src/Brig/Types/Common.hs +++ b/libs/brig-types/src/Brig/Types/Common.hs @@ -43,9 +43,8 @@ import Imports -- Name -- | Usually called display name. -newtype Name - = Name - {fromName :: Text} +newtype Name = Name + {fromName :: Text} deriving (Eq, Ord, Show, ToJSON, FromByteString, ToByteString, Generic) instance FromJSON Name where @@ -66,11 +65,10 @@ defaultAccentId = ColourId 0 -- Email -- FUTUREWORK: replace this type with 'EmailAddress' -data Email - = Email - { emailLocal :: !Text, - emailDomain :: !Text - } +data Email = Email + { emailLocal :: !Text, + emailDomain :: !Text + } deriving (Eq, Ord, Generic) instance Show Email where @@ -133,9 +131,8 @@ instance ToByteString Phone where -- | If the budget for SMS and voice calls for a phone number -- has been exhausted within a certain time frame, this timeout -- indicates in seconds when another attempt may be made. -newtype PhoneBudgetTimeout - = PhoneBudgetTimeout - {phoneBudgetTimeout :: NominalDiffTime} +newtype PhoneBudgetTimeout = PhoneBudgetTimeout + {phoneBudgetTimeout :: NominalDiffTime} deriving (Eq, Show, Generic) instance FromJSON PhoneBudgetTimeout where @@ -184,11 +181,10 @@ instance FromByteString PhonePrefix where instance ToByteString PhonePrefix where builder = builder . fromPhonePrefix -data ExcludedPrefix - = ExcludedPrefix - { phonePrefix :: PhonePrefix, - comment :: Text - } +data ExcludedPrefix = ExcludedPrefix + { phonePrefix :: PhonePrefix, + comment :: Text + } deriving (Eq, Show, Generic) instance FromJSON ExcludedPrefix where @@ -265,14 +261,13 @@ ssoIdentity _ = Nothing -- -- TODO: once we have @/libs/spar-types@ for the wire-sso-sp-server called spar, this type should -- move there. -data UserSSOId - = UserSSOId - { -- | An XML blob pointing to the identity provider that can confirm - -- user's identity. - userSSOIdTenant :: Text, - -- | An XML blob specifying the user's ID on the identity provider's side. - userSSOIdSubject :: Text - } +data UserSSOId = UserSSOId + { -- | An XML blob pointing to the identity provider that can confirm + -- user's identity. + userSSOIdTenant :: Text, + -- | An XML blob specifying the user's ID on the identity provider's side. + userSSOIdSubject :: Text + } deriving (Eq, Show, Generic) instance FromJSON UserSSOId where @@ -291,11 +286,10 @@ data AssetSize = AssetComplete | AssetPreview deriving (Eq, Show, Enum, Bounded, Generic) -- Note: Intended to be turned into a sum type to add further asset types. -data Asset - = ImageAsset - { assetKey :: !Text, - assetSize :: !(Maybe AssetSize) - } +data Asset = ImageAsset + { assetKey :: !Text, + assetSize :: !(Maybe AssetSize) + } deriving (Eq, Show, Generic) instance FromJSON AssetSize where @@ -357,11 +351,10 @@ parseCountry = hush . parseOnly countryParser ----------------------------------------------------------------------------- -- Locale -data Locale - = Locale - { lLanguage :: !Language, - lCountry :: !(Maybe Country) - } +data Locale = Locale + { lLanguage :: !Language, + lCountry :: !(Maybe Country) + } deriving (Eq, Ord, Generic) locToText :: Locale -> Text @@ -437,4 +430,5 @@ instance ToJSON ManagedBy where defaultManagedBy :: ManagedBy defaultManagedBy = ManagedByWire + -- NB: when adding new types, please add a roundtrip test to "Test.Brig.Types.Common" diff --git a/libs/brig-types/src/Brig/Types/Connection.hs b/libs/brig-types/src/Brig/Types/Connection.hs index f16b824b502..c3730e18843 100644 --- a/libs/brig-types/src/Brig/Types/Connection.hs +++ b/libs/brig-types/src/Brig/Types/Connection.hs @@ -65,60 +65,54 @@ data Relation -- -- Connection states have a direction -- e.g. if A sends a connection request to B, we'll -- create connections (A, B, Sent) and (B, A, Pending). -data UserConnection - = UserConnection - { ucFrom :: !UserId, - ucTo :: !UserId, - ucStatus :: !Relation, - -- | When 'ucStatus' was last changed - ucLastUpdate :: !UTCTimeMillis, - ucMessage :: !(Maybe Message), - ucConvId :: !(Maybe ConvId) - } +data UserConnection = UserConnection + { ucFrom :: !UserId, + ucTo :: !UserId, + ucStatus :: !Relation, + -- | When 'ucStatus' was last changed + ucLastUpdate :: !UTCTimeMillis, + ucMessage :: !(Maybe Message), + ucConvId :: !(Maybe ConvId) + } deriving (Eq, Show, Generic) -- | Payload type for a connection request from one user to another. -data ConnectionRequest - = ConnectionRequest - { -- | Connection recipient - crUser :: !OpaqueUserId, - -- | Name of the conversation to be created - crName :: !Text, - -- | Initial message - crMessage :: !Message - } +data ConnectionRequest = ConnectionRequest + { -- | Connection recipient + crUser :: !OpaqueUserId, + -- | Name of the conversation to be created + crName :: !Text, + -- | Initial message + crMessage :: !Message + } deriving (Eq, Show, Generic) -- | Payload type for "please change the status of this connection". -data ConnectionUpdate - = ConnectionUpdate - { cuStatus :: !Relation - } +data ConnectionUpdate = ConnectionUpdate + { cuStatus :: !Relation + } deriving (Eq, Show, Generic) -- | Response type for endpoints returning lists of connections. -data UserConnectionList - = UserConnectionList - { clConnections :: [UserConnection], - -- | Pagination flag ("we have more results") - clHasMore :: !Bool - } +data UserConnectionList = UserConnectionList + { clConnections :: [UserConnection], + -- | Pagination flag ("we have more results") + clHasMore :: !Bool + } deriving (Eq, Show, Generic) -- | Response type for endpoints returning lists of users with a specific connection state. -- E.g. 'getContactList' returns a 'UserIds' containing the list of connections in an -- 'Accepted' state. -data UserIds - = UserIds - {cUsers :: [UserId]} +data UserIds = UserIds + {cUsers :: [UserId]} deriving (Eq, Show, Generic) -- | Data that is passed to the @\/i\/users\/connections-status@ endpoint. -data ConnectionsStatusRequest - = ConnectionsStatusRequest - { csrFrom :: ![UserId], - csrTo :: ![UserId] - } +data ConnectionsStatusRequest = ConnectionsStatusRequest + { csrFrom :: ![UserId], + csrTo :: ![UserId] + } deriving (Eq, Show, Generic) ---------------------------------------------------------------------------- diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs index c2e1be5f277..92030b4352a 100644 --- a/libs/brig-types/src/Brig/Types/Intra.hs +++ b/libs/brig-types/src/Brig/Types/Intra.hs @@ -56,9 +56,8 @@ instance ToJSON AccountStatus where toJSON Deleted = String "deleted" toJSON Ephemeral = String "ephemeral" -newtype AccountStatusUpdate - = AccountStatusUpdate - {suStatus :: AccountStatus} +newtype AccountStatusUpdate = AccountStatusUpdate + {suStatus :: AccountStatus} deriving (Generic) instance FromJSON AccountStatusUpdate where @@ -71,12 +70,11 @@ instance ToJSON AccountStatusUpdate where ------------------------------------------------------------------------------- -- ConnectionStatus -data ConnectionStatus - = ConnectionStatus - { csFrom :: !UserId, - csTo :: !UserId, - csStatus :: !Relation - } +data ConnectionStatus = ConnectionStatus + { csFrom :: !UserId, + csTo :: !UserId, + csStatus :: !Relation + } deriving (Eq, Show, Generic) instance FromJSON ConnectionStatus where @@ -99,11 +97,10 @@ instance ToJSON ConnectionStatus where -- | A UserAccount is targeted to be used by our \"backoffice\" and represents -- all the data related to a user in our system, regardless of whether they -- are active or not, their status, etc. -data UserAccount - = UserAccount - { accountUser :: !User, - accountStatus :: !AccountStatus - } +data UserAccount = UserAccount + { accountUser :: !User, + accountStatus :: !AccountStatus + } deriving (Eq, Show, Generic) instance FromJSON UserAccount where @@ -123,10 +120,9 @@ instance ToJSON UserAccount where -- | Set of user ids, can be used for different purposes (e.g., used on the internal -- APIs for auto-connections, listing user's clients) -data UserSet - = UserSet - { usUsrs :: !(Set UserId) - } +data UserSet = UserSet + { usUsrs :: !(Set UserId) + } deriving (Eq, Show, Generic) instance FromJSON UserSet where @@ -144,9 +140,8 @@ instance ToJSON UserSet where -- | Certain operations might require reauth of the user. These are available -- only for users that have already set a password. -newtype ReAuthUser - = ReAuthUser - {reAuthPassword :: Maybe PlainTextPassword} +newtype ReAuthUser = ReAuthUser + {reAuthPassword :: Maybe PlainTextPassword} deriving (Eq, Show, Generic) instance FromJSON ReAuthUser where diff --git a/libs/brig-types/src/Brig/Types/Properties.hs b/libs/brig-types/src/Brig/Types/Properties.hs index b4b6706c513..f197347cbd3 100644 --- a/libs/brig-types/src/Brig/Types/Properties.hs +++ b/libs/brig-types/src/Brig/Types/Properties.hs @@ -27,9 +27,8 @@ import Data.Hashable (Hashable) import Data.Text.Ascii import Imports -newtype PropertyKey - = PropertyKey - {propertyKeyName :: AsciiPrintable} +newtype PropertyKey = PropertyKey + {propertyKeyName :: AsciiPrintable} deriving ( Eq, Ord, @@ -44,9 +43,8 @@ newtype PropertyKey Hashable ) -newtype PropertyValue - = PropertyValue - {propertyValueJson :: Value} +newtype PropertyValue = PropertyValue + {propertyValueJson :: Value} deriving (Eq, Show, FromJSON, ToJSON, Generic, Hashable) newtype PropertyKeysAndValues = PropertyKeysAndValues [(PropertyKey, PropertyValue)] diff --git a/libs/brig-types/src/Brig/Types/Provider.hs b/libs/brig-types/src/Brig/Types/Provider.hs index 81d34a3e426..eda4be26bb3 100644 --- a/libs/brig-types/src/Brig/Types/Provider.hs +++ b/libs/brig-types/src/Brig/Types/Provider.hs @@ -63,15 +63,14 @@ import Imports -- NewProvider -- | Input data for registering a new provider. -data NewProvider - = NewProvider - { newProviderName :: !Name, - newProviderEmail :: !Email, - newProviderUrl :: !HttpsUrl, - newProviderDescr :: !(Range 1 1024 Text), - -- | If none provided, a password is generated. - newProviderPassword :: !(Maybe PlainTextPassword) - } +data NewProvider = NewProvider + { newProviderName :: !Name, + newProviderEmail :: !Email, + newProviderUrl :: !HttpsUrl, + newProviderDescr :: !(Range 1 1024 Text), + -- | If none provided, a password is generated. + newProviderPassword :: !(Maybe PlainTextPassword) + } instance FromJSON NewProvider where parseJSON = withObject "NewProvider" $ \o -> @@ -92,13 +91,12 @@ instance ToJSON NewProvider where # [] -- | Response data upon registering a new provider. -data NewProviderResponse - = NewProviderResponse - { rsNewProviderId :: !ProviderId, - -- | The generated password, if none was provided - -- in the 'NewProvider' request. - rsNewProviderPassword :: !(Maybe PlainTextPassword) - } +data NewProviderResponse = NewProviderResponse + { rsNewProviderId :: !ProviderId, + -- | The generated password, if none was provided + -- in the 'NewProvider' request. + rsNewProviderPassword :: !(Maybe PlainTextPassword) + } instance FromJSON NewProviderResponse where parseJSON = withObject "NewProviderResponse" $ \o -> @@ -116,14 +114,13 @@ instance ToJSON NewProviderResponse where -- Provider -- | Full provider definition as seen by a verified provider itself. -data Provider - = Provider - { providerId :: !ProviderId, - providerName :: !Name, - providerEmail :: !Email, - providerUrl :: !HttpsUrl, - providerDescr :: !Text - } +data Provider = Provider + { providerId :: !ProviderId, + providerName :: !Name, + providerEmail :: !Email, + providerUrl :: !HttpsUrl, + providerDescr :: !Text + } deriving (Eq, Show) instance FromJSON Provider where @@ -157,12 +154,11 @@ newtype ProviderProfile = ProviderProfile Provider -- UpdateProvider -- | Input data for updating general provider information. -data UpdateProvider - = UpdateProvider - { updateProviderName :: !(Maybe Name), - updateProviderUrl :: !(Maybe HttpsUrl), - updateProviderDescr :: !(Maybe Text) - } +data UpdateProvider = UpdateProvider + { updateProviderName :: !(Maybe Name), + updateProviderUrl :: !(Maybe HttpsUrl), + updateProviderDescr :: !(Maybe Text) + } deriving (Eq, Show) instance FromJSON UpdateProvider where @@ -184,9 +180,8 @@ instance ToJSON UpdateProvider where -- | Successful response upon activating an email address (or possibly phone -- number in the future) of a provider. -newtype ProviderActivationResponse - = ProviderActivationResponse - {activatedProviderIdentity :: Email} +newtype ProviderActivationResponse = ProviderActivationResponse + {activatedProviderIdentity :: Email} deriving (Eq, Show) instance FromJSON ProviderActivationResponse where @@ -201,11 +196,10 @@ instance ToJSON ProviderActivationResponse where -- ProviderLogin -- | Input data for a provider login request. -data ProviderLogin - = ProviderLogin - { providerLoginEmail :: !Email, - providerLoginPassword :: !PlainTextPassword - } +data ProviderLogin = ProviderLogin + { providerLoginEmail :: !Email, + providerLoginPassword :: !PlainTextPassword + } instance FromJSON ProviderLogin where parseJSON = withObject "ProviderLogin" $ \o -> @@ -223,9 +217,8 @@ instance ToJSON ProviderLogin where -- DeleteProvider -- | Input data for a provider deletion request. -newtype DeleteProvider - = DeleteProvider - {deleteProviderPassword :: PlainTextPassword} +newtype DeleteProvider = DeleteProvider + {deleteProviderPassword :: PlainTextPassword} instance FromJSON DeleteProvider where parseJSON = withObject "DeleteProvider" $ \o -> @@ -246,21 +239,19 @@ newtype PasswordReset = PasswordReset {nprEmail :: Email} deriveJSON toJSONFieldName ''PasswordReset -- | The payload for completing a password reset. -data CompletePasswordReset - = CompletePasswordReset - { cpwrKey :: !Code.Key, - cpwrCode :: !Code.Value, - cpwrPassword :: !PlainTextPassword - } +data CompletePasswordReset = CompletePasswordReset + { cpwrKey :: !Code.Key, + cpwrCode :: !Code.Value, + cpwrPassword :: !PlainTextPassword + } deriveJSON toJSONFieldName ''CompletePasswordReset -- | The payload for changing a password. -data PasswordChange - = PasswordChange - { cpOldPassword :: !PlainTextPassword, - cpNewPassword :: !PlainTextPassword - } +data PasswordChange = PasswordChange + { cpOldPassword :: !PlainTextPassword, + cpNewPassword :: !PlainTextPassword + } deriveJSON toJSONFieldName ''PasswordChange @@ -281,9 +272,8 @@ queryAllTags :: LTE m n => Tag.MatchAll -> Maybe (QueryAllTags m n) queryAllTags = fmap QueryAllTags . Range.checked . Tag.matchAllSet -- | Bounded logical disjunction of 'm' to 'n' 'QueryAllTags'. -newtype QueryAnyTags (m :: Nat) (n :: Nat) - = QueryAnyTags - {queryAnyTagsRange :: Range m n (Set (QueryAllTags m n))} +newtype QueryAnyTags (m :: Nat) (n :: Nat) = QueryAnyTags + {queryAnyTagsRange :: Range m n (Set (QueryAllTags m n))} deriving (Eq, Show, Ord) -- | QueryAny ::= QueryAll { "," QueryAll } @@ -305,9 +295,8 @@ instance ToByteString (QueryAnyTags m n) where . queryAnyTagsRange -- | Bounded logical conjunction of 'm' to 'n' 'ServiceTag's to match. -newtype QueryAllTags (m :: Nat) (n :: Nat) - = QueryAllTags - {queryAllTagsRange :: Range m n (Set ServiceTag)} +newtype QueryAllTags (m :: Nat) (n :: Nat) = QueryAllTags + {queryAllTagsRange :: Range m n (Set ServiceTag)} deriving (Eq, Show, Ord) -- | QueryAll ::= tag { "." tag } @@ -378,12 +367,11 @@ instance ToJSON ServiceKeyType where -- identity of the remote peer in every established TLS connection -- towards the service (i.e. public key pinning to prevent MITM attacks -- with forged certificates). -data ServiceKey - = ServiceKey - { serviceKeyType :: !ServiceKeyType, - serviceKeySize :: !Int32, - serviceKeyPEM :: !ServiceKeyPEM - } +data ServiceKey = ServiceKey + { serviceKeyType :: !ServiceKeyType, + serviceKeySize :: !Int32, + serviceKeyPEM :: !ServiceKeyPEM + } deriving (Eq, Show) instance FromJSON ServiceKey where @@ -404,17 +392,16 @@ instance ToJSON ServiceKey where -- NewService -- | Input data for registering a new service. -data NewService - = NewService - { newServiceName :: !Name, - newServiceSummary :: !(Range 1 128 Text), - newServiceDescr :: !(Range 1 1024 Text), - newServiceUrl :: !HttpsUrl, - newServiceKey :: !ServiceKeyPEM, - newServiceToken :: !(Maybe ServiceToken), - newServiceAssets :: [Asset], - newServiceTags :: Range 1 3 (Set ServiceTag) - } +data NewService = NewService + { newServiceName :: !Name, + newServiceSummary :: !(Range 1 128 Text), + newServiceDescr :: !(Range 1 1024 Text), + newServiceUrl :: !HttpsUrl, + newServiceKey :: !ServiceKeyPEM, + newServiceToken :: !(Maybe ServiceToken), + newServiceAssets :: [Asset], + newServiceTags :: Range 1 3 (Set ServiceTag) + } instance FromJSON NewService where parseJSON = withObject "NewService" $ \o -> @@ -441,14 +428,13 @@ instance ToJSON NewService where # [] -- | Response data upon adding a new service. -data NewServiceResponse - = NewServiceResponse - { rsNewServiceId :: !ServiceId, - -- | The generated bearer token that we will use for - -- authenticating requests towards the service, if none was - -- provided in the 'NewService' request. - rsNewServiceToken :: !(Maybe ServiceToken) - } +data NewServiceResponse = NewServiceResponse + { rsNewServiceId :: !ServiceId, + -- | The generated bearer token that we will use for + -- authenticating requests towards the service, if none was + -- provided in the 'NewService' request. + rsNewServiceToken :: !(Maybe ServiceToken) + } instance FromJSON NewServiceResponse where parseJSON = withObject "NewServiceResponse" $ \o -> @@ -466,19 +452,18 @@ instance ToJSON NewServiceResponse where -- Service -- | Full service definition as seen by the provider. -data Service - = Service - { serviceId :: !ServiceId, - serviceName :: !Name, - serviceSummary :: !Text, - serviceDescr :: !Text, - serviceUrl :: !HttpsUrl, - serviceTokens :: !(List1 ServiceToken), - serviceKeys :: !(List1 ServiceKey), - serviceAssets :: ![Asset], - serviceTags :: !(Set ServiceTag), - serviceEnabled :: !Bool - } +data Service = Service + { serviceId :: !ServiceId, + serviceName :: !Name, + serviceSummary :: !Text, + serviceDescr :: !Text, + serviceUrl :: !HttpsUrl, + serviceTokens :: !(List1 ServiceToken), + serviceKeys :: !(List1 ServiceKey), + serviceAssets :: ![Asset], + serviceTags :: !(Set ServiceTag), + serviceEnabled :: !Bool + } instance FromJSON Service where parseJSON = withObject "Service" $ \o -> @@ -512,17 +497,16 @@ instance ToJSON Service where -- ServiceProfile -- | Public profile of a service as seen by users. -data ServiceProfile - = ServiceProfile - { serviceProfileId :: !ServiceId, - serviceProfileProvider :: !ProviderId, - serviceProfileName :: !Name, - serviceProfileSummary :: !Text, - serviceProfileDescr :: !Text, - serviceProfileAssets :: ![Asset], - serviceProfileTags :: !(Set ServiceTag), - serviceProfileEnabled :: !Bool - } +data ServiceProfile = ServiceProfile + { serviceProfileId :: !ServiceId, + serviceProfileProvider :: !ProviderId, + serviceProfileName :: !Name, + serviceProfileSummary :: !Text, + serviceProfileDescr :: !Text, + serviceProfileAssets :: ![Asset], + serviceProfileTags :: !(Set ServiceTag), + serviceProfileEnabled :: !Bool + } deriving (Eq, Show) instance FromJSON ServiceProfile where @@ -552,11 +536,10 @@ instance ToJSON ServiceProfile where -------------------------------------------------------------------------------- -- ServiceProfilePage -data ServiceProfilePage - = ServiceProfilePage - { serviceProfilePageHasMore :: !Bool, - serviceProfilePageResults :: ![ServiceProfile] - } +data ServiceProfilePage = ServiceProfilePage + { serviceProfilePageHasMore :: !Bool, + serviceProfilePageResults :: ![ServiceProfile] + } deriving (Eq, Show) instance FromJSON ServiceProfilePage where @@ -575,14 +558,13 @@ instance ToJSON ServiceProfilePage where -- UpdateService -- | Update service profile information. -data UpdateService - = UpdateService - { updateServiceName :: !(Maybe Name), - updateServiceSummary :: !(Maybe (Range 1 128 Text)), - updateServiceDescr :: !(Maybe (Range 1 1024 Text)), - updateServiceAssets :: !(Maybe [Asset]), - updateServiceTags :: !(Maybe (Range 1 3 (Set ServiceTag))) - } +data UpdateService = UpdateService + { updateServiceName :: !(Maybe Name), + updateServiceSummary :: !(Maybe (Range 1 128 Text)), + updateServiceDescr :: !(Maybe (Range 1 1024 Text)), + updateServiceAssets :: !(Maybe [Asset]), + updateServiceTags :: !(Maybe (Range 1 3 (Set ServiceTag))) + } instance FromJSON UpdateService where parseJSON = withObject "UpdateService" $ \o -> @@ -607,14 +589,13 @@ instance ToJSON UpdateService where -- | Update service connection information. -- This operation requires re-authentication via password. -data UpdateServiceConn - = UpdateServiceConn - { updateServiceConnPassword :: !PlainTextPassword, - updateServiceConnUrl :: !(Maybe HttpsUrl), - updateServiceConnKeys :: !(Maybe (Range 1 2 [ServiceKeyPEM])), - updateServiceConnTokens :: !(Maybe (Range 1 2 [ServiceToken])), - updateServiceConnEnabled :: !(Maybe Bool) - } +data UpdateServiceConn = UpdateServiceConn + { updateServiceConnPassword :: !PlainTextPassword, + updateServiceConnUrl :: !(Maybe HttpsUrl), + updateServiceConnKeys :: !(Maybe (Range 1 2 [ServiceKeyPEM])), + updateServiceConnTokens :: !(Maybe (Range 1 2 [ServiceToken])), + updateServiceConnEnabled :: !(Maybe Bool) + } mkUpdateServiceConn :: PlainTextPassword -> UpdateServiceConn mkUpdateServiceConn pw = UpdateServiceConn pw Nothing Nothing Nothing Nothing @@ -641,9 +622,8 @@ instance ToJSON UpdateServiceConn where -- DeleteService -- | Input data for a service deletion request. -newtype DeleteService - = DeleteService - {deleteServicePassword :: PlainTextPassword} +newtype DeleteService = DeleteService + {deleteServicePassword :: PlainTextPassword} instance FromJSON DeleteService where parseJSON = withObject "DeleteService" $ \o -> @@ -658,12 +638,11 @@ instance ToJSON DeleteService where -------------------------------------------------------------------------------- -- UpdateServiceWhitelist -data UpdateServiceWhitelist - = UpdateServiceWhitelist - { updateServiceWhitelistProvider :: !ProviderId, - updateServiceWhitelistService :: !ServiceId, - updateServiceWhitelistStatus :: !Bool - } +data UpdateServiceWhitelist = UpdateServiceWhitelist + { updateServiceWhitelistProvider :: !ProviderId, + updateServiceWhitelistService :: !ServiceId, + updateServiceWhitelistStatus :: !Bool + } deriving (Eq, Show) instance FromJSON UpdateServiceWhitelist where @@ -684,12 +663,11 @@ instance ToJSON UpdateServiceWhitelist where -- AddBot -- | Input data for adding a bot to a conversation. -data AddBot - = AddBot - { addBotProvider :: !ProviderId, - addBotService :: !ServiceId, - addBotLocale :: !(Maybe Locale) - } +data AddBot = AddBot + { addBotProvider :: !ProviderId, + addBotService :: !ServiceId, + addBotLocale :: !(Maybe Locale) + } instance FromJSON AddBot where parseJSON = withObject "NewBot" $ \o -> @@ -705,15 +683,14 @@ instance ToJSON AddBot where # "locale" .= addBotLocale n # [] -data AddBotResponse - = AddBotResponse - { rsAddBotId :: !BotId, - rsAddBotClient :: !ClientId, - rsAddBotName :: !Name, - rsAddBotColour :: !ColourId, - rsAddBotAssets :: ![Asset], - rsAddBotEvent :: !Event - } +data AddBotResponse = AddBotResponse + { rsAddBotId :: !BotId, + rsAddBotClient :: !ClientId, + rsAddBotName :: !Name, + rsAddBotColour :: !ColourId, + rsAddBotAssets :: ![Asset], + rsAddBotEvent :: !Event + } instance FromJSON AddBotResponse where parseJSON = withObject "AddBotResponse" $ \o -> @@ -740,10 +717,9 @@ instance ToJSON AddBotResponse where -- (There is no request payload for bot removal) -newtype RemoveBotResponse - = RemoveBotResponse - { rsRemoveBotEvent :: Event - } +newtype RemoveBotResponse = RemoveBotResponse + { rsRemoveBotEvent :: Event + } instance FromJSON RemoveBotResponse where parseJSON = withObject "RemoveBotResponse" $ \o -> @@ -758,10 +734,9 @@ instance ToJSON RemoveBotResponse where -------------------------------------------------------------------------------- -- UpdateBotPrekeys -newtype UpdateBotPrekeys - = UpdateBotPrekeys - { updateBotPrekeyList :: [Prekey] - } +newtype UpdateBotPrekeys = UpdateBotPrekeys + { updateBotPrekeyList :: [Prekey] + } instance FromJSON UpdateBotPrekeys where parseJSON = withObject "UpdateBotPrekeys" $ \o -> diff --git a/libs/brig-types/src/Brig/Types/Provider/External.hs b/libs/brig-types/src/Brig/Types/Provider/External.hs index f2c4678e429..5657fea2d1d 100644 --- a/libs/brig-types/src/Brig/Types/Provider/External.hs +++ b/libs/brig-types/src/Brig/Types/Provider/External.hs @@ -43,22 +43,21 @@ import Imports -- NewBotRequest -- | Request for a bot in a conversation. -data NewBotRequest - = NewBotRequest - { -- | The user ID to use for the bot. - newBotId :: !BotId, - -- | The client ID to use for the bot. - newBotClient :: !ClientId, - -- | The origin (user) of the bot request. - newBotOrigin :: !BotUserView, - -- | The conversation as seen by the bot. - newBotConv :: !BotConvView, - -- | The API access token. - newBotToken :: !Text, - -- | The preferred locale (i.e. language) for the bot - -- to use. - newBotLocale :: !Locale - } +data NewBotRequest = NewBotRequest + { -- | The user ID to use for the bot. + newBotId :: !BotId, + -- | The client ID to use for the bot. + newBotClient :: !ClientId, + -- | The origin (user) of the bot request. + newBotOrigin :: !BotUserView, + -- | The conversation as seen by the bot. + newBotConv :: !BotConvView, + -- | The API access token. + newBotToken :: !Text, + -- | The preferred locale (i.e. language) for the bot + -- to use. + newBotLocale :: !Locale + } instance FromJSON NewBotRequest where parseJSON = withObject "NewBotRequest" $ \o -> @@ -86,14 +85,13 @@ instance ToJSON NewBotRequest where -- | Bot data provided by a service in response to a 'NewBotRequest'. -- The returned optional data overrides the defaults taken from -- the 'Service' definition. -data NewBotResponse - = NewBotResponse - { rsNewBotPrekeys :: ![Prekey], - rsNewBotLastPrekey :: !LastPrekey, - rsNewBotName :: !(Maybe Name), - rsNewBotColour :: !(Maybe ColourId), - rsNewBotAssets :: !(Maybe [Asset]) - } +data NewBotResponse = NewBotResponse + { rsNewBotPrekeys :: ![Prekey], + rsNewBotLastPrekey :: !LastPrekey, + rsNewBotName :: !(Maybe Name), + rsNewBotColour :: !(Maybe ColourId), + rsNewBotAssets :: !(Maybe [Asset]) + } instance FromJSON NewBotResponse where parseJSON = withObject "NewBotResponse" $ \o -> @@ -116,14 +114,13 @@ instance ToJSON NewBotResponse where -------------------------------------------------------------------------------- -- BotUserView -data BotUserView - = BotUserView - { botUserViewId :: !UserId, - botUserViewName :: !Name, - botUserViewColour :: !ColourId, - botUserViewHandle :: !(Maybe Handle), - botUserViewTeam :: !(Maybe TeamId) - } +data BotUserView = BotUserView + { botUserViewId :: !UserId, + botUserViewName :: !Name, + botUserViewColour :: !ColourId, + botUserViewHandle :: !(Maybe Handle), + botUserViewTeam :: !(Maybe TeamId) + } deriving (Eq, Show) instance FromJSON BotUserView where diff --git a/libs/brig-types/src/Brig/Types/Provider/Tag.hs b/libs/brig-types/src/Brig/Types/Provider/Tag.hs index a5a67e05ebf..2226e9442ea 100644 --- a/libs/brig-types/src/Brig/Types/Provider/Tag.hs +++ b/libs/brig-types/src/Brig/Types/Provider/Tag.hs @@ -150,15 +150,13 @@ instance ToJSON ServiceTag where -- ServiceTag Matchers -- | Logical disjunction of 'MatchAllTags' to match. -newtype MatchAny - = MatchAny - {matchAnySet :: Set MatchAll} +newtype MatchAny = MatchAny + {matchAnySet :: Set MatchAll} deriving (Eq, Show, Ord) -- | Logical conjunction of 'ServiceTag's to match. -newtype MatchAll - = MatchAll - {matchAllSet :: Set ServiceTag} +newtype MatchAll = MatchAll + {matchAllSet :: Set ServiceTag} deriving (Eq, Show, Ord) (.||.) :: MatchAny -> MatchAny -> MatchAny diff --git a/libs/brig-types/src/Brig/Types/Search.hs b/libs/brig-types/src/Brig/Types/Search.hs index afd019baf90..50a057e0356 100644 --- a/libs/brig-types/src/Brig/Types/Search.hs +++ b/libs/brig-types/src/Brig/Types/Search.hs @@ -24,24 +24,22 @@ import Data.Aeson import Data.Id (TeamId, UserId) import Imports -data SearchResult a - = SearchResult - { searchFound :: Int, - searchReturned :: Int, - searchTook :: Int, - searchResults :: [a] - } +data SearchResult a = SearchResult + { searchFound :: Int, + searchReturned :: Int, + searchTook :: Int, + searchResults :: [a] + } deriving (Show) -- | This is a subset of 'User' and json instances should reflect that. -data Contact - = Contact - { contactUserId :: UserId, - contactName :: Text, - contactColorId :: Maybe Int, - contactHandle :: Maybe Text, - contactTeam :: Maybe TeamId - } +data Contact = Contact + { contactUserId :: UserId, + contactName :: Text, + contactColorId :: Maybe Int, + contactHandle :: Maybe Text, + contactTeam :: Maybe TeamId + } deriving (Show) data TeamSearchInfo diff --git a/libs/brig-types/src/Brig/Types/TURN.hs b/libs/brig-types/src/Brig/Types/TURN.hs index 827e7fb3fee..db249c0aa03 100644 --- a/libs/brig-types/src/Brig/Types/TURN.hs +++ b/libs/brig-types/src/Brig/Types/TURN.hs @@ -74,22 +74,20 @@ import Imports -- The \"ttl\" field is a proprietary extension -- -- cf. https://developer.mozilla.org/en-US/docs/Web/API/RTCPeerConnection/RTCPeerConnection#RTCConfiguration_dictionary -data RTCConfiguration - = RTCConfiguration - { _rtcConfIceServers :: List1 RTCIceServer, - _rtcConfTTL :: Word32 - } +data RTCConfiguration = RTCConfiguration + { _rtcConfIceServers :: List1 RTCIceServer, + _rtcConfTTL :: Word32 + } deriving (Show, Generic) -- | A configuration object resembling \"RTCIceServer\" -- -- cf. https://developer.mozilla.org/en-US/docs/Web/API/RTCIceServer -data RTCIceServer - = RTCIceServer - { _iceURLs :: List1 TurnURI, - _iceUsername :: TurnUsername, - _iceCredential :: AsciiBase64 - } +data RTCIceServer = RTCIceServer + { _iceURLs :: List1 TurnURI, + _iceUsername :: TurnUsername, + _iceCredential :: AsciiBase64 + } deriving (Show, Generic) -- | TURN server URI as described in https://tools.ietf.org/html/rfc7065, minus ext @@ -99,13 +97,12 @@ data RTCIceServer -- | scheme = "turn" / "turns" -- | transport = "udp" / "tcp" / transport-ext -- | transport-ext = 1*unreserved -data TurnURI - = TurnURI - { _turiScheme :: Scheme, - _turiHost :: TurnHost, - _turiPort :: Port, - _turiTransport :: Maybe Transport - } +data TurnURI = TurnURI + { _turiScheme :: Scheme, + _turiHost :: TurnHost, + _turiPort :: Port, + _turiTransport :: Maybe Transport + } deriving (Eq, Show, Generic) data Scheme @@ -118,14 +115,13 @@ data Transport | TransportTCP deriving (Eq, Show, Generic, Enum, Bounded) -data TurnUsername - = TurnUsername - { _tuExpiresAt :: POSIXTime, - _tuVersion :: Word, - _tuKeyindex :: Word32, -- seems to large, but uint32_t is used in C - _tuT :: Char, -- undocumented, always 's' - _tuRandom :: Text -- [a-z0-9]+ - } +data TurnUsername = TurnUsername + { _tuExpiresAt :: POSIXTime, + _tuVersion :: Word, + _tuKeyindex :: Word32, -- seems to large, but uint32_t is used in C + _tuT :: Char, -- undocumented, always 's' + _tuRandom :: Text -- [a-z0-9]+ + } deriving (Show, Generic) rtcConfiguration :: List1 RTCIceServer -> Word32 -> RTCConfiguration diff --git a/libs/brig-types/src/Brig/Types/Team/Invitation.hs b/libs/brig-types/src/Brig/Types/Team/Invitation.hs index 755236db26b..9de3fb22464 100644 --- a/libs/brig-types/src/Brig/Types/Team/Invitation.hs +++ b/libs/brig-types/src/Brig/Types/Team/Invitation.hs @@ -26,37 +26,34 @@ import Data.Json.Util import Galley.Types.Teams import Imports -data InvitationRequest - = InvitationRequest - { irEmail :: !Email, - irName :: !Name, - irLocale :: !(Maybe Locale), - irRole :: !(Maybe Role), - irInviteeName :: !(Maybe Name), - irPhone :: !(Maybe Phone) - } +data InvitationRequest = InvitationRequest + { irEmail :: !Email, + irName :: !Name, + irLocale :: !(Maybe Locale), + irRole :: !(Maybe Role), + irInviteeName :: !(Maybe Name), + irPhone :: !(Maybe Phone) + } deriving (Eq, Show) -data Invitation - = Invitation - { inTeam :: !TeamId, - inRole :: !Role, - inInvitation :: !InvitationId, - inIdentity :: !Email, - inCreatedAt :: !UTCTimeMillis, - -- | this is always 'Just' for new invitations, but for - -- migration it is allowed to be 'Nothing'. - inCreatedBy :: !(Maybe UserId), - inInviteeName :: !(Maybe Name), - inPhone :: !(Maybe Phone) - } +data Invitation = Invitation + { inTeam :: !TeamId, + inRole :: !Role, + inInvitation :: !InvitationId, + inIdentity :: !Email, + inCreatedAt :: !UTCTimeMillis, + -- | this is always 'Just' for new invitations, but for + -- migration it is allowed to be 'Nothing'. + inCreatedBy :: !(Maybe UserId), + inInviteeName :: !(Maybe Name), + inPhone :: !(Maybe Phone) + } deriving (Eq, Show) -data InvitationList - = InvitationList - { ilInvitations :: [Invitation], - ilHasMore :: !Bool - } +data InvitationList = InvitationList + { ilInvitations :: [Invitation], + ilHasMore :: !Bool + } deriving (Eq, Show) instance FromJSON InvitationRequest where diff --git a/libs/brig-types/src/Brig/Types/Team/LegalHold.hs b/libs/brig-types/src/Brig/Types/Team/LegalHold.hs index 4e10d9be751..5c2faa0a528 100644 --- a/libs/brig-types/src/Brig/Types/Team/LegalHold.hs +++ b/libs/brig-types/src/Brig/Types/Team/LegalHold.hs @@ -43,10 +43,9 @@ instance FromJSON LegalHoldStatus where "disabled" -> pure LegalHoldDisabled x -> fail $ "unexpected status type: " <> T.unpack x -data LegalHoldTeamConfig - = LegalHoldTeamConfig - { legalHoldTeamConfigStatus :: !LegalHoldStatus - } +data LegalHoldTeamConfig = LegalHoldTeamConfig + { legalHoldTeamConfigStatus :: !LegalHoldStatus + } deriving stock (Eq, Show, Generic) instance ToJSON LegalHoldTeamConfig where @@ -60,12 +59,11 @@ instance FromJSON LegalHoldTeamConfig where LegalHoldTeamConfig <$> o .: "status" -- | This type is analogous to 'NewService' for bots. -data NewLegalHoldService - = NewLegalHoldService - { newLegalHoldServiceUrl :: !HttpsUrl, - newLegalHoldServiceKey :: !ServiceKeyPEM, - newLegalHoldServiceToken :: !ServiceToken - } +data NewLegalHoldService = NewLegalHoldService + { newLegalHoldServiceUrl :: !HttpsUrl, + newLegalHoldServiceKey :: !ServiceKeyPEM, + newLegalHoldServiceToken :: !ServiceToken + } deriving stock (Eq, Show, Generic) instance ToJSON NewLegalHoldService where @@ -83,14 +81,13 @@ instance FromJSON NewLegalHoldService where <*> o .: "public_key" <*> o .: "auth_token" -data LegalHoldService - = LegalHoldService - { legalHoldServiceTeam :: !TeamId, - legalHoldServiceUrl :: !HttpsUrl, - legalHoldServiceFingerprint :: !(Fingerprint Rsa), - legalHoldServiceToken :: !ServiceToken, - legalHoldServiceKey :: !ServiceKey - } +data LegalHoldService = LegalHoldService + { legalHoldServiceTeam :: !TeamId, + legalHoldServiceUrl :: !HttpsUrl, + legalHoldServiceFingerprint :: !(Fingerprint Rsa), + legalHoldServiceToken :: !ServiceToken, + legalHoldServiceKey :: !ServiceKey + } deriving stock (Eq, Show, Generic) instance ToJSON LegalHoldService where @@ -143,14 +140,13 @@ instance FromJSON ViewLegalHoldService where "disabled" -> pure ViewLegalHoldServiceDisabled _ -> fail "status (one of configured, not_configured, disabled)" -data ViewLegalHoldServiceInfo - = ViewLegalHoldServiceInfo - { viewLegalHoldServiceTeam :: !TeamId, - viewLegalHoldServiceUrl :: !HttpsUrl, - viewLegalHoldServiceFingerprint :: !(Fingerprint Rsa), - viewLegalHoldServiceAuthToken :: !ServiceToken, - viewLegalHoldServiceKey :: !ServiceKeyPEM - } +data ViewLegalHoldServiceInfo = ViewLegalHoldServiceInfo + { viewLegalHoldServiceTeam :: !TeamId, + viewLegalHoldServiceUrl :: !HttpsUrl, + viewLegalHoldServiceFingerprint :: !(Fingerprint Rsa), + viewLegalHoldServiceAuthToken :: !ServiceToken, + viewLegalHoldServiceKey :: !ServiceKeyPEM + } deriving stock (Eq, Show, Generic) instance ToJSON ViewLegalHoldServiceInfo where @@ -180,11 +176,10 @@ viewLegalHoldService (LegalHoldService tid u fpr t k) = ViewLegalHoldService $ ViewLegalHoldServiceInfo tid u fpr t (serviceKeyPEM k) -- This is the payload that the LH service returns upon calling @/initiate@ -data NewLegalHoldClient - = NewLegalHoldClient - { newLegalHoldClientPrekeys :: [Prekey], - newLegalHoldClientLastKey :: !LastPrekey - } +data NewLegalHoldClient = NewLegalHoldClient + { newLegalHoldClientPrekeys :: [Prekey], + newLegalHoldClientLastKey :: !LastPrekey + } deriving stock (Eq, Show, Generic) instance ToJSON NewLegalHoldClient where @@ -200,11 +195,10 @@ instance FromJSON NewLegalHoldClient where <*> o .: "last_prekey" -- This is the payload that the LH service expects -data RequestNewLegalHoldClient - = RequestNewLegalHoldClient - { userId :: !UserId, - teamId :: !TeamId - } +data RequestNewLegalHoldClient = RequestNewLegalHoldClient + { userId :: !UserId, + teamId :: !TeamId + } deriving stock (Show, Eq, Generic) instance ToJSON RequestNewLegalHoldClient where @@ -219,14 +213,13 @@ instance FromJSON RequestNewLegalHoldClient where RequestNewLegalHoldClient <$> o .: "user_id" <*> o .: "team_id" -data UserLegalHoldStatusResponse - = UserLegalHoldStatusResponse - { ulhsrStatus :: UserLegalHoldStatus, - -- | Exists only when status is Pending or Enabled - ulhsrLastPrekey :: Maybe LastPrekey, - -- | Exists only when status is Pending or Enabled - ulhsrClientId :: Maybe ClientId - } +data UserLegalHoldStatusResponse = UserLegalHoldStatusResponse + { ulhsrStatus :: UserLegalHoldStatus, + -- | Exists only when status is Pending or Enabled + ulhsrLastPrekey :: Maybe LastPrekey, + -- | Exists only when status is Pending or Enabled + ulhsrClientId :: Maybe ClientId + } deriving stock (Eq, Show, Generic) instance ToJSON UserLegalHoldStatusResponse where @@ -243,11 +236,10 @@ instance FromJSON UserLegalHoldStatusResponse where <*> o .:? "last_prekey" <*> (fromIdObject @ClientId <$$> (o .:? "client")) -data LegalHoldClientRequest - = LegalHoldClientRequest - { lhcrRequester :: !UserId, - lhcrLastPrekey :: !LastPrekey - } +data LegalHoldClientRequest = LegalHoldClientRequest + { lhcrRequester :: !UserId, + lhcrLastPrekey :: !LastPrekey + } deriving stock (Eq, Show, Generic) instance FromJSON LegalHoldClientRequest where @@ -264,14 +256,13 @@ instance ToJSON LegalHoldClientRequest where # [] -- Request body definition for the @/confirm@ endpoint on the LegalHold Service -data LegalHoldServiceConfirm - = LegalHoldServiceConfirm - { lhcClientId :: !ClientId, - lhcUserId :: !UserId, - lhcTeamId :: !TeamId, - -- | Replace with Legal Hold Token Type - lhcRefreshToken :: !Text - } +data LegalHoldServiceConfirm = LegalHoldServiceConfirm + { lhcClientId :: !ClientId, + lhcUserId :: !UserId, + lhcTeamId :: !TeamId, + -- | Replace with Legal Hold Token Type + lhcRefreshToken :: !Text + } deriving stock (Eq, Show, Generic) instance ToJSON LegalHoldServiceConfirm where @@ -291,11 +282,10 @@ instance FromJSON LegalHoldServiceConfirm where <*> o .: "team_id" <*> o .: "refresh_token" -data LegalHoldServiceRemove - = LegalHoldServiceRemove - { lhrUserId :: !UserId, - lhrTeamId :: !TeamId - } +data LegalHoldServiceRemove = LegalHoldServiceRemove + { lhrUserId :: !UserId, + lhrTeamId :: !TeamId + } deriving stock (Eq, Show, Generic) instance ToJSON LegalHoldServiceRemove where @@ -305,10 +295,9 @@ instance ToJSON LegalHoldServiceRemove where # "team_id" .= teamId # [] -data RemoveLegalHoldSettingsRequest - = RemoveLegalHoldSettingsRequest - { rmlhsrPassword :: !(Maybe PlainTextPassword) - } +data RemoveLegalHoldSettingsRequest = RemoveLegalHoldSettingsRequest + { rmlhsrPassword :: !(Maybe PlainTextPassword) + } deriving stock (Eq, Show, Generic) instance ToJSON RemoveLegalHoldSettingsRequest where @@ -322,10 +311,9 @@ instance FromJSON RemoveLegalHoldSettingsRequest where RemoveLegalHoldSettingsRequest <$> o .:? "password" -data DisableLegalHoldForUserRequest - = DisableLegalHoldForUserRequest - { dlhfuPassword :: !(Maybe PlainTextPassword) - } +data DisableLegalHoldForUserRequest = DisableLegalHoldForUserRequest + { dlhfuPassword :: !(Maybe PlainTextPassword) + } deriving stock (Eq, Show, Generic) instance ToJSON DisableLegalHoldForUserRequest where @@ -339,10 +327,9 @@ instance FromJSON DisableLegalHoldForUserRequest where DisableLegalHoldForUserRequest <$> o .:? "password" -data ApproveLegalHoldForUserRequest - = ApproveLegalHoldForUserRequest - { alhfuPassword :: !(Maybe PlainTextPassword) - } +data ApproveLegalHoldForUserRequest = ApproveLegalHoldForUserRequest + { alhfuPassword :: !(Maybe PlainTextPassword) + } deriving stock (Eq, Show, Generic) instance ToJSON ApproveLegalHoldForUserRequest where diff --git a/libs/brig-types/src/Brig/Types/User.hs b/libs/brig-types/src/Brig/Types/User.hs index 1c3c445d62e..62ebb62068a 100644 --- a/libs/brig-types/src/Brig/Types/User.hs +++ b/libs/brig-types/src/Brig/Types/User.hs @@ -89,13 +89,12 @@ instance FromJSON UserHandleInfo where -- CheckHandles -- | Check the availability of user handles. -data CheckHandles - = CheckHandles - { -- | Handles to check for availability, in ascending order of preference. - checkHandlesList :: Range 1 50 [Text], - -- | Number of free handles to return. Default 1. - checkHandlesNum :: Range 1 10 Word - } +data CheckHandles = CheckHandles + { -- | Handles to check for availability, in ascending order of preference. + checkHandlesList :: Range 1 50 [Text], + -- | Number of free handles to return. Default 1. + checkHandlesNum :: Range 1 10 Word + } deriving (Eq, Show, Generic) instance ToJSON CheckHandles where @@ -114,9 +113,8 @@ instance FromJSON CheckHandles where -- User Profiles -- | A self profile. -data SelfProfile - = SelfProfile - {selfUser :: !User} +data SelfProfile = SelfProfile + {selfUser :: !User} deriving (Eq, Show, Generic) connectedProfile :: User -> UserProfile @@ -171,34 +169,33 @@ publicProfile u = } -- | The data of an existing user. -data User - = User - { userId :: !UserId, - -- | User identity. For endpoints like @/self@, it will be present in the response iff - -- the user is activated, and the email/phone contained in it will be guaranteedly - -- verified. {#RefActivation} - userIdentity :: !(Maybe UserIdentity), - -- | required; non-unique - userDisplayName :: !Name, - -- | DEPRECATED - userPict :: !Pict, - userAssets :: [Asset], - userAccentId :: !ColourId, - userDeleted :: !Bool, - userLocale :: !Locale, - -- | Set if the user represents an external service, - -- i.e. it is a "bot". - userService :: !(Maybe ServiceRef), - -- | not required; must be unique if present - userHandle :: !(Maybe Handle), - -- | Set if the user is ephemeral - userExpire :: !(Maybe UTCTimeMillis), - -- | Set if the user is part of a binding team - userTeam :: !(Maybe TeamId), - -- | How is the user profile managed (e.g. if it's via SCIM then the user profile - -- can't be edited via normal means) - userManagedBy :: !ManagedBy - } +data User = User + { userId :: !UserId, + -- | User identity. For endpoints like @/self@, it will be present in the response iff + -- the user is activated, and the email/phone contained in it will be guaranteedly + -- verified. {#RefActivation} + userIdentity :: !(Maybe UserIdentity), + -- | required; non-unique + userDisplayName :: !Name, + -- | DEPRECATED + userPict :: !Pict, + userAssets :: [Asset], + userAccentId :: !ColourId, + userDeleted :: !Bool, + userLocale :: !Locale, + -- | Set if the user represents an external service, + -- i.e. it is a "bot". + userService :: !(Maybe ServiceRef), + -- | not required; must be unique if present + userHandle :: !(Maybe Handle), + -- | Set if the user is ephemeral + userExpire :: !(Maybe UTCTimeMillis), + -- | Set if the user is part of a binding team + userTeam :: !(Maybe TeamId), + -- | How is the user profile managed (e.g. if it's via SCIM then the user profile + -- can't be edited via normal means) + userManagedBy :: !ManagedBy + } deriving (Eq, Show, Generic) userEmail :: User -> Maybe Email @@ -213,24 +210,23 @@ userSSOId = ssoIdentity <=< userIdentity -- | A subset of the data of an existing 'User' that is returned on the API and is visible to -- other users. Each user also has access to their own profile in a richer format -- -- 'SelfProfile'. -data UserProfile - = UserProfile - { profileId :: !UserId, - profileName :: !Name, - -- | DEPRECATED - profilePict :: !Pict, - profileAssets :: [Asset], - profileAccentId :: !ColourId, - profileDeleted :: !Bool, - -- | Set if the user represents an external service, - -- i.e. it is a "bot". - profileService :: !(Maybe ServiceRef), - profileHandle :: !(Maybe Handle), - profileLocale :: !(Maybe Locale), - profileExpire :: !(Maybe UTCTimeMillis), - profileTeam :: !(Maybe TeamId), - profileEmail :: !(Maybe Email) - } +data UserProfile = UserProfile + { profileId :: !UserId, + profileName :: !Name, + -- | DEPRECATED + profilePict :: !Pict, + profileAssets :: [Asset], + profileAccentId :: !ColourId, + profileDeleted :: !Bool, + -- | Set if the user represents an external service, + -- i.e. it is a "bot". + profileService :: !(Maybe ServiceRef), + profileHandle :: !(Maybe Handle), + profileLocale :: !(Maybe Locale), + profileExpire :: !(Maybe UTCTimeMillis), + profileTeam :: !(Maybe TeamId), + profileEmail :: !(Maybe Email) + } deriving (Eq, Show, Generic) -- TODO: disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'. @@ -312,11 +308,10 @@ instance ToJSON SelfProfile where ---------------------------------------------------------------------------- -- Rich info -data RichInfo - = RichInfo - { richInfoMap :: Map (CI Text) Text, - richInfoAssocList :: [RichField] - } +data RichInfo = RichInfo + { richInfoMap :: Map (CI Text) Text, + richInfoAssocList :: [RichField] + } deriving (Eq, Show, Generic) newtype RichInfoAssocList = RichInfoAssocList [RichField] @@ -411,11 +406,10 @@ instance ToJSON RichInfoAssocList where ] -- TODO: Make richFieldType @CI Text@ -data RichField - = RichField - { richFieldType :: !(CI Text), - richFieldValue :: !Text - } +data RichField = RichField + { richFieldType :: !(CI Text), + richFieldValue :: !Text + } deriving (Eq, Show, Generic) instance ToJSON RichField where @@ -469,25 +463,24 @@ emptyRichInfoAssocList = RichInfoAssocList [] ----------------------------------------------------------------------------- -- New Users -data NewUser - = NewUser - { newUserDisplayName :: !Name, - -- | use this as 'UserId' (if 'Nothing', call 'Data.UUID.nextRandom'). - newUserUUID :: !(Maybe UUID), - newUserIdentity :: !(Maybe UserIdentity), - -- | DEPRECATED - newUserPict :: !(Maybe Pict), - newUserAssets :: [Asset], - newUserAccentId :: !(Maybe ColourId), - newUserEmailCode :: !(Maybe ActivationCode), - newUserPhoneCode :: !(Maybe ActivationCode), - newUserOrigin :: !(Maybe NewUserOrigin), - newUserLabel :: !(Maybe CookieLabel), - newUserLocale :: !(Maybe Locale), - newUserPassword :: !(Maybe PlainTextPassword), - newUserExpiresIn :: !(Maybe ExpiresIn), - newUserManagedBy :: !(Maybe ManagedBy) - } +data NewUser = NewUser + { newUserDisplayName :: !Name, + -- | use this as 'UserId' (if 'Nothing', call 'Data.UUID.nextRandom'). + newUserUUID :: !(Maybe UUID), + newUserIdentity :: !(Maybe UserIdentity), + -- | DEPRECATED + newUserPict :: !(Maybe Pict), + newUserAssets :: [Asset], + newUserAccentId :: !(Maybe ColourId), + newUserEmailCode :: !(Maybe ActivationCode), + newUserPhoneCode :: !(Maybe ActivationCode), + newUserOrigin :: !(Maybe NewUserOrigin), + newUserLabel :: !(Maybe CookieLabel), + newUserLocale :: !(Maybe Locale), + newUserPassword :: !(Maybe PlainTextPassword), + newUserExpiresIn :: !(Maybe ExpiresIn), + newUserManagedBy :: !(Maybe ManagedBy) + } deriving (Eq, Show, Generic) -- | 1 second - 1 week @@ -600,17 +593,15 @@ parseIdentity ssoid o = else pure Nothing -- | A random invitation code for use during registration -newtype InvitationCode - = InvitationCode - {fromInvitationCode :: AsciiBase64Url} +newtype InvitationCode = InvitationCode + {fromInvitationCode :: AsciiBase64Url} deriving (Eq, Show, FromJSON, ToJSON, ToByteString, FromByteString, Generic) -data BindingNewTeamUser - = BindingNewTeamUser - { bnuTeam :: !BindingNewTeam, - bnuCurrency :: !(Maybe Currency.Alpha) - -- TODO: Remove Currency selection once billing supports currency changes after team creation - } +data BindingNewTeamUser = BindingNewTeamUser + { bnuTeam :: !BindingNewTeam, + bnuCurrency :: !(Maybe Currency.Alpha) + -- TODO: Remove Currency selection once billing supports currency changes after team creation + } deriving (Eq, Show, Generic) instance FromJSON BindingNewTeamUser where @@ -664,13 +655,12 @@ instance FromJSON NewUserPublic where ----------------------------------------------------------------------------- -- Profile Updates -data UserUpdate - = UserUpdate - { uupName :: !(Maybe Name), - uupPict :: !(Maybe Pict), -- DEPRECATED - uupAssets :: !(Maybe [Asset]), - uupAccentId :: !(Maybe ColourId) - } +data UserUpdate = UserUpdate + { uupName :: !(Maybe Name), + uupPict :: !(Maybe Pict), -- DEPRECATED + uupAssets :: !(Maybe [Asset]), + uupAccentId :: !(Maybe ColourId) + } deriving (Eq, Show, Generic) newtype LocaleUpdate = LocaleUpdate {luLocale :: Locale} deriving (Eq, Show, Generic) @@ -768,30 +758,27 @@ instance ToJSON PhoneRemove where -- Account Deletion -- | Payload for requesting account deletion. -newtype DeleteUser - = DeleteUser - { deleteUserPassword :: Maybe PlainTextPassword - } +newtype DeleteUser = DeleteUser + { deleteUserPassword :: Maybe PlainTextPassword + } deriving (Eq, Show, Generic) mkDeleteUser :: Maybe PlainTextPassword -> DeleteUser mkDeleteUser = DeleteUser -- | Payload for verifying account deletion via a code. -data VerifyDeleteUser - = VerifyDeleteUser - { verifyDeleteUserKey :: !Code.Key, - verifyDeleteUserCode :: !Code.Value - } +data VerifyDeleteUser = VerifyDeleteUser + { verifyDeleteUserKey :: !Code.Key, + verifyDeleteUserCode :: !Code.Value + } deriving (Eq, Show, Generic) mkVerifyDeleteUser :: Code.Key -> Code.Value -> VerifyDeleteUser mkVerifyDeleteUser = VerifyDeleteUser -- | A response for a pending deletion code. -newtype DeletionCodeTimeout - = DeletionCodeTimeout - {fromDeletionCodeTimeout :: Code.Timeout} +newtype DeletionCodeTimeout = DeletionCodeTimeout + {fromDeletionCodeTimeout :: Code.Timeout} deriving (Eq, Show, Generic) instance ToJSON DeleteUser where @@ -831,15 +818,13 @@ newtype NewPasswordReset = NewPasswordReset (Either Email Phone) deriving (Eq, Show, Generic) -- | Opaque identifier per user (SHA256 of the user ID). -newtype PasswordResetKey - = PasswordResetKey - {fromPasswordResetKey :: AsciiBase64Url} +newtype PasswordResetKey = PasswordResetKey + {fromPasswordResetKey :: AsciiBase64Url} deriving (Eq, Show, FromByteString, ToByteString, FromJSON, ToJSON, Generic) -- | Random code, acting as a very short-lived, single-use password. -newtype PasswordResetCode - = PasswordResetCode - {fromPasswordResetCode :: AsciiBase64Url} +newtype PasswordResetCode = PasswordResetCode + {fromPasswordResetCode :: AsciiBase64Url} deriving (Eq, Show, FromByteString, ToByteString, FromJSON, ToJSON, Generic) type PasswordResetPair = (PasswordResetKey, PasswordResetCode) @@ -855,20 +840,18 @@ data PasswordResetIdentity deriving (Eq, Show, Generic) -- | The payload for completing a password reset. -data CompletePasswordReset - = CompletePasswordReset - { cpwrIdent :: !PasswordResetIdentity, - cpwrCode :: !PasswordResetCode, - cpwrPassword :: !PlainTextPassword - } +data CompletePasswordReset = CompletePasswordReset + { cpwrIdent :: !PasswordResetIdentity, + cpwrCode :: !PasswordResetCode, + cpwrPassword :: !PlainTextPassword + } deriving (Eq, Show, Generic) -- | The payload for setting or changing a password. -data PasswordChange - = PasswordChange - { cpOldPassword :: !(Maybe PlainTextPassword), - cpNewPassword :: !PlainTextPassword - } +data PasswordChange = PasswordChange + { cpOldPassword :: !(Maybe PlainTextPassword), + cpNewPassword :: !PlainTextPassword + } deriving (Eq, Show, Generic) instance FromJSON NewPasswordReset where @@ -915,11 +898,10 @@ instance FromJSON PasswordChange where -- DEPRECATED -data PasswordReset - = PasswordReset - { pwrCode :: !PasswordResetCode, - pwrPassword :: !PlainTextPassword - } +data PasswordReset = PasswordReset + { pwrCode :: !PasswordResetCode, + pwrPassword :: !PlainTextPassword + } instance FromJSON PasswordReset where parseJSON = withObject "PasswordReset" $ \o -> diff --git a/libs/brig-types/src/Brig/Types/User/Auth.hs b/libs/brig-types/src/Brig/Types/User/Auth.hs index 682848c0398..deff82cf706 100644 --- a/libs/brig-types/src/Brig/Types/User/Auth.hs +++ b/libs/brig-types/src/Brig/Types/User/Auth.hs @@ -37,31 +37,27 @@ import Imports ----------------------------------------------------------------------------- -- Login / Authentication -data PendingLoginCode - = PendingLoginCode - { pendingLoginCode :: !LoginCode, - pendingLoginTimeout :: !Timeout - } +data PendingLoginCode = PendingLoginCode + { pendingLoginCode :: !LoginCode, + pendingLoginTimeout :: !Timeout + } deriving (Eq) -- | A single-use login code. -newtype LoginCode - = LoginCode - {fromLoginCode :: Text} +newtype LoginCode = LoginCode + {fromLoginCode :: Text} deriving (Eq, FromJSON, ToJSON) -- | A request for sending a 'LoginCode' -data SendLoginCode - = SendLoginCode - { lcPhone :: !Phone, - lcCall :: !Bool, - lcForce :: !Bool - } +data SendLoginCode = SendLoginCode + { lcPhone :: !Phone, + lcCall :: !Bool, + lcForce :: !Bool + } -- | A timeout for a new or pending login code. -newtype LoginCodeTimeout - = LoginCodeTimeout - {fromLoginCodeTimeout :: Timeout} +newtype LoginCodeTimeout = LoginCodeTimeout + {fromLoginCodeTimeout :: Timeout} deriving (Eq, Show) -- | Different kinds of logins. @@ -186,56 +182,50 @@ instance ToJSON LoginCodeTimeout where -- Cookies & Access Tokens -- | A temporary API access token. -data AccessToken - = AccessToken - { user :: !UserId, - access :: !LByteString, -- accessTokenValue - tokenType :: !TokenType, -- accessTokenType - expiresIn :: !Integer -- accessTokenExpiresIn - } +data AccessToken = AccessToken + { user :: !UserId, + access :: !LByteString, -- accessTokenValue + tokenType :: !TokenType, -- accessTokenType + expiresIn :: !Integer -- accessTokenExpiresIn + } data TokenType = Bearer deriving (Show) bearerToken :: UserId -> LByteString -> Integer -> AccessToken bearerToken u a = AccessToken u a Bearer -data RemoveCookies - = RemoveCookies - { rmCookiesPassword :: !PlainTextPassword, - rmCookiesLabels :: [CookieLabel], - rmCookiesIdents :: [CookieId] - } +data RemoveCookies = RemoveCookies + { rmCookiesPassword :: !PlainTextPassword, + rmCookiesLabels :: [CookieLabel], + rmCookiesIdents :: [CookieId] + } -- | A device-specific identifying label for one or more cookies. -- Cookies can be listed and deleted based on their labels. -newtype CookieLabel - = CookieLabel - {cookieLabelText :: Text} +newtype CookieLabel = CookieLabel + {cookieLabelText :: Text} deriving (Eq, Show, Ord, FromJSON, ToJSON, FromByteString, ToByteString, IsString, Generic) -newtype CookieId - = CookieId - {cookieIdNum :: Word32} +newtype CookieId = CookieId + {cookieIdNum :: Word32} deriving (Eq, Show, FromJSON, ToJSON, Generic) -- | A (long-lived) cookie scoped to a specific user for obtaining new -- 'AccessToken's. -data Cookie a - = Cookie - { cookieId :: !CookieId, - cookieType :: !CookieType, - cookieCreated :: !UTCTime, - cookieExpires :: !UTCTime, - cookieLabel :: !(Maybe CookieLabel), - cookieSucc :: !(Maybe CookieId), - cookieValue :: !a - } +data Cookie a = Cookie + { cookieId :: !CookieId, + cookieType :: !CookieType, + cookieCreated :: !UTCTime, + cookieExpires :: !UTCTime, + cookieLabel :: !(Maybe CookieLabel), + cookieSucc :: !(Maybe CookieId), + cookieValue :: !a + } deriving (Eq, Show, Generic) -data CookieList - = CookieList - { cookieList :: [Cookie ()] - } +data CookieList = CookieList + { cookieList :: [Cookie ()] + } data CookieType = -- | A session cookie. These are mainly intended for clients diff --git a/libs/cargohold-types/src/CargoHold/Types/V3.hs b/libs/cargohold-types/src/CargoHold/Types/V3.hs index c7f6d1aa8d7..4d0269cd5d5 100644 --- a/libs/cargohold-types/src/CargoHold/Types/V3.hs +++ b/libs/cargohold-types/src/CargoHold/Types/V3.hs @@ -128,12 +128,11 @@ endMultipartBody = byteString "\r\n--frontier--\r\n" -- AssetHeaders -- | Headers provided during upload. -data AssetHeaders - = AssetHeaders - { hdrType :: MIME.Type, - hdrLength :: Word, - hdrMD5 :: Digest MD5 - } +data AssetHeaders = AssetHeaders + { hdrType :: MIME.Type, + hdrLength :: Word, + hdrMD5 :: Digest MD5 + } mkHeaders :: MIME.Type -> LByteString -> AssetHeaders mkHeaders t b = AssetHeaders t (fromIntegral (LBS.length b)) (hashlazy b) @@ -174,11 +173,10 @@ assetExpiringSeconds :: NominalDiffTime assetExpiringSeconds = 365 * 24 * 3600 -- 365 days -- | Settings provided during upload. -data AssetSettings - = AssetSettings - { _setAssetPublic :: Bool, - _setAssetRetention :: Maybe AssetRetention - } +data AssetSettings = AssetSettings + { _setAssetPublic :: Bool, + _setAssetRetention :: Maybe AssetRetention + } makeLenses ''AssetSettings @@ -243,9 +241,8 @@ newtype AssetToken = AssetToken {assetTokenAscii :: AsciiBase64Url} deriving (Eq, Show, FromByteString, ToByteString, FromJSON, ToJSON) -- | A newly (re)generated token for an existing asset. -newtype NewAssetToken - = NewAssetToken - {newAssetToken :: AssetToken} +newtype NewAssetToken = NewAssetToken + {newAssetToken :: AssetToken} instance FromJSON NewAssetToken where parseJSON = withObject "NewAssetToken" $ \o -> @@ -302,12 +299,11 @@ instance FromJSON AssetKey where -- Asset -- | A newly uploaded asset. -data Asset - = Asset - { _assetKey :: AssetKey, - _assetExpires :: Maybe UTCTime, - _assetToken :: Maybe AssetToken - } +data Asset = Asset + { _assetKey :: AssetKey, + _assetExpires :: Maybe UTCTime, + _assetToken :: Maybe AssetToken + } makeLenses ''Asset diff --git a/libs/cargohold-types/src/CargoHold/Types/V3/Resumable.hs b/libs/cargohold-types/src/CargoHold/Types/V3/Resumable.hs index 6c8256aadb2..2b2dc03cdaf 100644 --- a/libs/cargohold-types/src/CargoHold/Types/V3/Resumable.hs +++ b/libs/cargohold-types/src/CargoHold/Types/V3/Resumable.hs @@ -52,12 +52,11 @@ import Imports -- ResumableSettings -- | Settings for initiating a resumable upload. -data ResumableSettings - = ResumableSettings - { _setResumableRetention :: AssetRetention, - _setResumablePublic :: Bool, - _setResumableType :: MIME.Type - } +data ResumableSettings = ResumableSettings + { _setResumableRetention :: AssetRetention, + _setResumablePublic :: Bool, + _setResumableType :: MIME.Type + } deriving (Show) makeLenses ''ResumableSettings @@ -89,9 +88,8 @@ parseMime v = -------------------------------------------------------------------------------- -- ResumableAsset -newtype TotalSize - = TotalSize - {totalSizeBytes :: Word} +newtype TotalSize = TotalSize + {totalSizeBytes :: Word} deriving ( Eq, Show, @@ -106,9 +104,8 @@ newtype TotalSize ToByteString ) -newtype ChunkSize - = ChunkSize - {chunkSizeBytes :: Word} +newtype ChunkSize = ChunkSize + {chunkSizeBytes :: Word} deriving ( Eq, Show, @@ -123,9 +120,8 @@ newtype ChunkSize ToByteString ) -newtype Offset - = Offset - {offsetBytes :: Word} +newtype Offset = Offset + {offsetBytes :: Word} deriving ( Eq, Show, @@ -140,12 +136,11 @@ newtype Offset ToByteString ) -data ResumableAsset - = ResumableAsset - { _resumableAsset :: Asset, - _resumableExpires :: UTCTime, - _resumableChunkSize :: ChunkSize - } +data ResumableAsset = ResumableAsset + { _resumableAsset :: Asset, + _resumableExpires :: UTCTime, + _resumableChunkSize :: ChunkSize + } makeLenses ''ResumableAsset diff --git a/libs/cassandra-util/src/Cassandra/Schema.hs b/libs/cassandra-util/src/Cassandra/Schema.hs index 6dd310655d9..4ae67ee94d7 100644 --- a/libs/cassandra-util/src/Cassandra/Schema.hs +++ b/libs/cassandra-util/src/Cassandra/Schema.hs @@ -60,21 +60,19 @@ import Options.Applicative hiding (info) -- FUTUREWORK: We could use the System.Logger.Class here in the future, but we don't have a ReaderT IO here (yet) import qualified System.Logger as Log -data Migration - = Migration - { migVersion :: Int32, - migText :: Text, - migAction :: Client () - } +data Migration = Migration + { migVersion :: Int32, + migText :: Text, + migAction :: Client () + } -data MigrationOpts - = MigrationOpts - { migHost :: String, - migPort :: Word16, - migKeyspace :: Text, - migRepl :: ReplicationStrategy, - migReset :: Bool - } +data MigrationOpts = MigrationOpts + { migHost :: String, + migPort :: Word16, + migKeyspace :: Text, + migRepl :: ReplicationStrategy, + migReset :: Bool + } deriving (Eq, Show, Generic) data ReplicationStrategy diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 9bf1887606c..56dfcd3785f 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -106,19 +106,18 @@ import URI.ByteString -- -- Can be produced from the internal one ('Galley.Data.Types.Conversation') -- by using 'Galley.API.Mapping.conversationView'. -data Conversation - = Conversation - { cnvId :: !ConvId, - cnvType :: !ConvType, - cnvCreator :: !UserId, - cnvAccess :: ![Access], - cnvAccessRole :: !AccessRole, - cnvName :: !(Maybe Text), - cnvMembers :: !ConvMembers, - cnvTeam :: !(Maybe TeamId), - cnvMessageTimer :: !(Maybe Milliseconds), - cnvReceiptMode :: !(Maybe ReceiptMode) - } +data Conversation = Conversation + { cnvId :: !ConvId, + cnvType :: !ConvType, + cnvCreator :: !UserId, + cnvAccess :: ![Access], + cnvAccessRole :: !AccessRole, + cnvName :: !(Maybe Text), + cnvMembers :: !ConvMembers, + cnvTeam :: !(Maybe TeamId), + cnvMessageTimer :: !(Maybe Milliseconds), + cnvReceiptMode :: !(Maybe ReceiptMode) + } deriving (Eq, Show) data ConvType @@ -166,82 +165,73 @@ data AccessRole NonActivatedAccessRole deriving (Eq, Ord, Show) -data ConvMembers - = ConvMembers - { cmSelf :: !Member, - cmOthers :: ![OtherMember] - } +data ConvMembers = ConvMembers + { cmSelf :: !Member, + cmOthers :: ![OtherMember] + } deriving (Eq, Show) -data ConversationMeta - = ConversationMeta - { cmId :: !ConvId, - cmType :: !ConvType, - cmCreator :: !UserId, - cmAccess :: ![Access], - cmAccessRole :: !AccessRole, - cmName :: !(Maybe Text), - cmTeam :: !(Maybe TeamId), - cmMessageTimer :: !(Maybe Milliseconds), - cmReceiptMode :: !(Maybe ReceiptMode) - } +data ConversationMeta = ConversationMeta + { cmId :: !ConvId, + cmType :: !ConvType, + cmCreator :: !UserId, + cmAccess :: ![Access], + cmAccessRole :: !AccessRole, + cmName :: !(Maybe Text), + cmTeam :: !(Maybe TeamId), + cmMessageTimer :: !(Maybe Milliseconds), + cmReceiptMode :: !(Maybe ReceiptMode) + } deriving (Eq, Show) -data ConversationList a - = ConversationList - { convList :: [a], - convHasMore :: !Bool - } +data ConversationList a = ConversationList + { convList :: [a], + convHasMore :: !Bool + } deriving (Eq, Show) -newtype ConversationRename - = ConversationRename - { cupName :: Text - } +newtype ConversationRename = ConversationRename + { cupName :: Text + } deriving instance Eq ConversationRename deriving instance Show ConversationRename -data ConversationAccessUpdate - = ConversationAccessUpdate - { cupAccess :: [Access], - cupAccessRole :: AccessRole - } +data ConversationAccessUpdate = ConversationAccessUpdate + { cupAccess :: [Access], + cupAccessRole :: AccessRole + } deriving (Eq, Show) -data ConversationReceiptModeUpdate - = ConversationReceiptModeUpdate - { cruReceiptMode :: !ReceiptMode - } +data ConversationReceiptModeUpdate = ConversationReceiptModeUpdate + { cruReceiptMode :: !ReceiptMode + } deriving (Eq, Show) -data ConversationMessageTimerUpdate - = ConversationMessageTimerUpdate - { -- | New message timer - cupMessageTimer :: !(Maybe Milliseconds) - } +data ConversationMessageTimerUpdate = ConversationMessageTimerUpdate + { -- | New message timer + cupMessageTimer :: !(Maybe Milliseconds) + } deriving (Eq, Show) -data ConvTeamInfo - = ConvTeamInfo - { cnvTeamId :: !TeamId, - cnvManaged :: !Bool - } +data ConvTeamInfo = ConvTeamInfo + { cnvTeamId :: !TeamId, + cnvManaged :: !Bool + } deriving (Eq, Show) -data NewConv - = NewConv - { newConvUsers :: ![OpaqueUserId], - newConvName :: !(Maybe Text), - newConvAccess :: !(Set Access), - newConvAccessRole :: !(Maybe AccessRole), - newConvTeam :: !(Maybe ConvTeamInfo), - newConvMessageTimer :: !(Maybe Milliseconds), - newConvReceiptMode :: !(Maybe ReceiptMode), - -- | Every member except for the creator will have this role - newConvUsersRole :: !RoleName - } +data NewConv = NewConv + { newConvUsers :: ![OpaqueUserId], + newConvName :: !(Maybe Text), + newConvAccess :: !(Set Access), + newConvAccessRole :: !(Maybe AccessRole), + newConvTeam :: !(Maybe ConvTeamInfo), + newConvMessageTimer :: !(Maybe Milliseconds), + newConvReceiptMode :: !(Maybe ReceiptMode), + -- | Every member except for the creator will have this role + newConvUsersRole :: !RoleName + } deriving instance Eq NewConv @@ -286,10 +276,9 @@ error, which is not optimal but it doesn't matter since nobody is trying to create managed conversations anyway. -} -newtype UserClientMap a - = UserClientMap - { userClientMap :: Map OpaqueUserId (Map ClientId a) - } +newtype UserClientMap a = UserClientMap + { userClientMap :: Map OpaqueUserId (Map ClientId a) + } deriving ( Eq, Show, @@ -300,10 +289,9 @@ newtype UserClientMap a Traversable ) -newtype OtrRecipients - = OtrRecipients - { otrRecipientsMap :: UserClientMap Text - } +newtype OtrRecipients = OtrRecipients + { otrRecipientsMap :: UserClientMap Text + } deriving ( Eq, Show, @@ -336,46 +324,42 @@ data OtrFilterMissing OtrReportMissing (Set OpaqueUserId) deriving (Eq, Show, Generic) -data NewOtrMessage - = NewOtrMessage - { newOtrSender :: !ClientId, - newOtrRecipients :: !OtrRecipients, - newOtrNativePush :: !Bool, - newOtrTransient :: !Bool, - newOtrNativePriority :: !(Maybe Priority), - newOtrData :: !(Maybe Text), - newOtrReportMissing :: !(Maybe [OpaqueUserId]) - -- FUTUREWORK: if (and only if) clients can promise this uid list will always exactly - -- be the list of uids we could also extract from the messages' recipients field, we - -- should do the latter, for two reasons: (1) no need for an artificial limit on the - -- body field length, because it'd be just a boolean; (2) less network consumption. - } - -newtype UserClients - = UserClients - { userClients :: Map OpaqueUserId (Set ClientId) - } +data NewOtrMessage = NewOtrMessage + { newOtrSender :: !ClientId, + newOtrRecipients :: !OtrRecipients, + newOtrNativePush :: !Bool, + newOtrTransient :: !Bool, + newOtrNativePriority :: !(Maybe Priority), + newOtrData :: !(Maybe Text), + newOtrReportMissing :: !(Maybe [OpaqueUserId]) + -- FUTUREWORK: if (and only if) clients can promise this uid list will always exactly + -- be the list of uids we could also extract from the messages' recipients field, we + -- should do the latter, for two reasons: (1) no need for an artificial limit on the + -- body field length, because it'd be just a boolean; (2) less network consumption. + } + +newtype UserClients = UserClients + { userClients :: Map OpaqueUserId (Set ClientId) + } deriving (Eq, Show, Semigroup, Monoid, Generic) filterClients :: (Set ClientId -> Bool) -> UserClients -> UserClients filterClients p (UserClients c) = UserClients $ Map.filter p c -data ClientMismatch - = ClientMismatch - { cmismatchTime :: !UTCTime, - -- | Clients that the message /should/ have been encrypted for, but wasn't. - missingClients :: !UserClients, - -- | Clients that the message /should not/ have been encrypted for, but was. - redundantClients :: !UserClients, - deletedClients :: !UserClients - } +data ClientMismatch = ClientMismatch + { cmismatchTime :: !UTCTime, + -- | Clients that the message /should/ have been encrypted for, but wasn't. + missingClients :: !UserClients, + -- | Clients that the message /should not/ have been encrypted for, but was. + redundantClients :: !UserClients, + deletedClients :: !UserClients + } deriving (Eq, Show, Generic) -- | Request payload for accepting a 1-1 conversation. -newtype Accept - = Accept - { aUser :: UserId - } +newtype Accept = Accept + { aUser :: UserId + } deriving (Eq, Show, Generic) -- Members ------------------------------------------------------------------ @@ -385,35 +369,32 @@ newtype Accept newtype MutedStatus = MutedStatus {fromMutedStatus :: Int32} deriving (Eq, Num, Ord, Show, FromJSON, ToJSON, Generic) -data SimpleMember - = SimpleMember - { smId :: !UserId, - smConvRoleName :: !RoleName - } +data SimpleMember = SimpleMember + { smId :: !UserId, + smConvRoleName :: !RoleName + } deriving (Eq, Show, Generic) -data Member - = Member - { memId :: !UserId, - memService :: !(Maybe ServiceRef), - -- | DEPRECATED, remove it once enough clients use `memOtrMutedStatus` - memOtrMuted :: !Bool, - memOtrMutedStatus :: !(Maybe MutedStatus), - memOtrMutedRef :: !(Maybe Text), - memOtrArchived :: !Bool, - memOtrArchivedRef :: !(Maybe Text), - memHidden :: !Bool, - memHiddenRef :: !(Maybe Text), - memConvRoleName :: !RoleName - } +data Member = Member + { memId :: !UserId, + memService :: !(Maybe ServiceRef), + -- | DEPRECATED, remove it once enough clients use `memOtrMutedStatus` + memOtrMuted :: !Bool, + memOtrMutedStatus :: !(Maybe MutedStatus), + memOtrMutedRef :: !(Maybe Text), + memOtrArchived :: !Bool, + memOtrArchivedRef :: !(Maybe Text), + memHidden :: !Bool, + memHiddenRef :: !(Maybe Text), + memConvRoleName :: !RoleName + } deriving (Eq, Show, Generic) -data OtherMember - = OtherMember - { omId :: !UserId, - omService :: !(Maybe ServiceRef), - omConvRoleName :: !RoleName - } +data OtherMember = OtherMember + { omId :: !UserId, + omService :: !(Maybe ServiceRef), + omConvRoleName :: !RoleName + } deriving (Eq, Show, Generic) instance Ord OtherMember where @@ -421,17 +402,16 @@ instance Ord OtherMember where -- | Inbound self member updates. This is what galley expects on its endpoint. See also -- 'MemberUpdateData' - that event is meant to be sent only to the _self_ user. -data MemberUpdate - = MemberUpdate - { mupOtrMute :: !(Maybe Bool), - mupOtrMuteStatus :: !(Maybe MutedStatus), - mupOtrMuteRef :: !(Maybe Text), - mupOtrArchive :: !(Maybe Bool), - mupOtrArchiveRef :: !(Maybe Text), - mupHidden :: !(Maybe Bool), - mupHiddenRef :: !(Maybe Text), - mupConvRoleName :: !(Maybe RoleName) - } +data MemberUpdate = MemberUpdate + { mupOtrMute :: !(Maybe Bool), + mupOtrMuteStatus :: !(Maybe MutedStatus), + mupOtrMuteRef :: !(Maybe Text), + mupOtrArchive :: !(Maybe Bool), + mupOtrArchiveRef :: !(Maybe Text), + mupHidden :: !(Maybe Bool), + mupHiddenRef :: !(Maybe Text), + mupConvRoleName :: !(Maybe RoleName) + } memberUpdate :: MemberUpdate memberUpdate = MemberUpdate Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing @@ -442,21 +422,19 @@ deriving instance Show MemberUpdate -- | Inbound other member updates. This is what galley expects on its endpoint. See also -- 'OtherMemberUpdateData' - that event is meant to be sent to all users in a conversation. -data OtherMemberUpdate - = OtherMemberUpdate - { omuConvRoleName :: !(Maybe RoleName) - } +data OtherMemberUpdate = OtherMemberUpdate + { omuConvRoleName :: !(Maybe RoleName) + } deriving instance Eq OtherMemberUpdate deriving instance Show OtherMemberUpdate -data Invite - = Invite - { invUsers :: !(List1 OpaqueUserId), - -- | This role name is to be applied to all users - invRoleName :: !RoleName - } +data Invite = Invite + { invUsers :: !(List1 OpaqueUserId), + -- | This role name is to be applied to all users + invRoleName :: !RoleName + } newInvite :: List1 OpaqueUserId -> Invite newInvite us = Invite us roleNameWireAdmin @@ -470,14 +448,13 @@ deriving instance Show Invite -- FUTUREWORK(federation, #1213): -- Conversation and user ID can be remote IDs, but the receiver might be on -- another backend, so mapped IDs don't work for them. -data Event - = Event - { evtType :: !EventType, - evtConv :: !ConvId, - evtFrom :: !UserId, - evtTime :: !UTCTime, - evtData :: !(Maybe EventData) - } +data Event = Event + { evtType :: !EventType, + evtConv :: !ConvId, + evtFrom :: !UserId, + evtTime :: !UTCTime, + evtData :: !(Maybe EventData) + } deriving (Eq, Generic) data EventType @@ -515,19 +492,17 @@ data EventData | EdOtrMessage !OtrMessage deriving (Eq, Show, Generic) -data OtrMessage - = OtrMessage - { otrSender :: !ClientId, - otrRecipient :: !ClientId, - otrCiphertext :: !Text, - otrData :: !(Maybe Text) - } +data OtrMessage = OtrMessage + { otrSender :: !ClientId, + otrRecipient :: !ClientId, + otrCiphertext :: !Text, + otrData :: !(Maybe Text) + } deriving (Eq, Show, Generic) -newtype SimpleMembers - = SimpleMembers - { mMembers :: [SimpleMember] - } +newtype SimpleMembers = SimpleMembers + { mMembers :: [SimpleMember] + } deriving (Eq, Show, Generic) -- | This datatype replaces the old `Members` datatype, @@ -535,19 +510,17 @@ newtype SimpleMembers -- needed due to backwards compatible reasons since old -- clients will break if we switch these types. Also, this -- definition represents better what information it carries -newtype UserIdList - = UserIdList - { mUsers :: [UserId] - } +newtype UserIdList = UserIdList + { mUsers :: [UserId] + } deriving (Eq, Show, Generic) -data Connect - = Connect - { cRecipient :: !UserId, - cMessage :: !(Maybe Text), - cName :: !(Maybe Text), - cEmail :: !(Maybe Text) - } +data Connect = Connect + { cRecipient :: !UserId, + cMessage :: !(Maybe Text), + cName :: !(Maybe Text), + cEmail :: !(Maybe Text) + } deriving (Eq, Show, Generic) -- | Outbound member updates. When a user A acts upon a user B, @@ -555,26 +528,24 @@ data Connect -- as misTarget. -- Used for events (sent over the websocket, etc.). See also -- 'MemberUpdate' and 'OtherMemberUpdate'. -data MemberUpdateData - = MemberUpdateData - { -- | Target user of this action, should not be optional anymore. - -- - misTarget :: !(Maybe UserId), - misOtrMuted :: !(Maybe Bool), - misOtrMutedStatus :: !(Maybe MutedStatus), - misOtrMutedRef :: !(Maybe Text), - misOtrArchived :: !(Maybe Bool), - misOtrArchivedRef :: !(Maybe Text), - misHidden :: !(Maybe Bool), - misHiddenRef :: !(Maybe Text), - misConvRoleName :: !(Maybe RoleName) - } +data MemberUpdateData = MemberUpdateData + { -- | Target user of this action, should not be optional anymore. + -- + misTarget :: !(Maybe UserId), + misOtrMuted :: !(Maybe Bool), + misOtrMutedStatus :: !(Maybe MutedStatus), + misOtrMutedRef :: !(Maybe Text), + misOtrArchived :: !(Maybe Bool), + misOtrArchivedRef :: !(Maybe Text), + misHidden :: !(Maybe Bool), + misHiddenRef :: !(Maybe Text), + misConvRoleName :: !(Maybe RoleName) + } deriving (Eq, Show, Generic) -newtype TypingData - = TypingData - { tdStatus :: TypingStatus - } +newtype TypingData = TypingData + { tdStatus :: TypingStatus + } deriving (Eq, Show, Generic) data TypingStatus @@ -582,12 +553,11 @@ data TypingStatus | StoppedTyping deriving (Eq, Ord, Show, Generic) -data ConversationCode - = ConversationCode - { conversationKey :: !Code.Key, - conversationCode :: !Code.Value, - conversationUri :: !(Maybe HttpsUrl) - } +data ConversationCode = ConversationCode + { conversationKey :: !Code.Key, + conversationCode :: !Code.Value, + conversationUri :: !(Maybe HttpsUrl) + } deriving (Eq, Show, Generic) mkConversationCode :: Code.Key -> Code.Value -> HttpsUrl -> ConversationCode @@ -601,11 +571,10 @@ mkConversationCode k v (HttpsUrl prefix) = q = [("key", toByteString' k), ("code", toByteString' v)] link = prefix & (queryL . queryPairsL) .~ q -data CustomBackend - = CustomBackend - { backendConfigJsonUrl :: !HttpsUrl, - backendWebappWelcomeUrl :: !HttpsUrl - } +data CustomBackend = CustomBackend + { backendConfigJsonUrl :: !HttpsUrl, + backendWebappWelcomeUrl :: !HttpsUrl + } deriving (Eq, Show) -- Instances ---------------------------------------------------------------- diff --git a/libs/galley-types/src/Galley/Types/Bot.hs b/libs/galley-types/src/Galley/Types/Bot.hs index bf6acb54186..7c4f2272a15 100644 --- a/libs/galley-types/src/Galley/Types/Bot.hs +++ b/libs/galley-types/src/Galley/Types/Bot.hs @@ -51,13 +51,12 @@ import Imports -- AddBot ---------------------------------------------------------------------- -data AddBot - = AddBot - { _addBotService :: !ServiceRef, - _addBotConv :: !ConvId, - _addBotId :: !BotId, - _addBotClient :: !ClientId - } +data AddBot = AddBot + { _addBotService :: !ServiceRef, + _addBotConv :: !ConvId, + _addBotId :: !BotId, + _addBotClient :: !ClientId + } makeLenses ''AddBot @@ -82,11 +81,10 @@ instance ToJSON AddBot where -- RemoveBot ------------------------------------------------------------------ -data RemoveBot - = RemoveBot - { _rmBotConv :: !ConvId, - _rmBotId :: !BotId - } +data RemoveBot = RemoveBot + { _rmBotConv :: !ConvId, + _rmBotId :: !BotId + } makeLenses ''RemoveBot @@ -108,12 +106,11 @@ instance ToJSON RemoveBot where -- BotConvView ----------------------------------------------------------------- -- | A conversation as seen by a bot. -data BotConvView - = BotConvView - { _botConvId :: !ConvId, - _botConvName :: !(Maybe Text), - _botConvMembers :: ![OtherMember] - } +data BotConvView = BotConvView + { _botConvId :: !ConvId, + _botConvName :: !(Maybe Text), + _botConvMembers :: ![OtherMember] + } deriving (Eq, Show) makeLenses ''BotConvView diff --git a/libs/galley-types/src/Galley/Types/Bot/Service/Internal.hs b/libs/galley-types/src/Galley/Types/Bot/Service/Internal.hs index f28bf53c2f9..63f4ec94179 100644 --- a/libs/galley-types/src/Galley/Types/Bot/Service/Internal.hs +++ b/libs/galley-types/src/Galley/Types/Bot/Service/Internal.hs @@ -33,11 +33,10 @@ import Imports -- ServiceRef ----------------------------------------------------------------- -- | A fully-qualified reference to a service. -data ServiceRef - = ServiceRef - { _serviceRefId :: !ServiceId, - _serviceRefProvider :: !ProviderId - } +data ServiceRef = ServiceRef + { _serviceRefId :: !ServiceId, + _serviceRefProvider :: !ProviderId + } deriving (Ord, Eq, Show, Generic) makeLenses ''ServiceRef @@ -66,14 +65,13 @@ newtype ServiceToken = ServiceToken AsciiBase64Url deriving instance Cql ServiceToken -- | Service connection information that is needed by galley. -data Service - = Service - { _serviceRef :: !ServiceRef, - _serviceUrl :: !HttpsUrl, - _serviceToken :: !ServiceToken, - _serviceFingerprints :: ![Fingerprint Rsa], - _serviceEnabled :: !Bool - } +data Service = Service + { _serviceRef :: !ServiceRef, + _serviceUrl :: !HttpsUrl, + _serviceToken :: !ServiceToken, + _serviceFingerprints :: ![Fingerprint Rsa], + _serviceEnabled :: !Bool + } makeLenses ''Service diff --git a/libs/galley-types/src/Galley/Types/Conversations/Roles.hs b/libs/galley-types/src/Galley/Types/Conversations/Roles.hs index 80e3d696a68..952eb6d7d5b 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/Roles.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/Roles.hs @@ -66,10 +66,9 @@ data Action deriveJSON defaultOptions {constructorTagModifier = camelTo2 '_'} ''Action -newtype Actions - = Actions - { allowedActions :: Set Action - } +newtype Actions = Actions + { allowedActions :: Set Action + } deriving (Eq, Ord, Show, Generic) -- | A conversation role is associated to a user in the scope of a conversation and implies @@ -108,10 +107,9 @@ instance FromJSON ConversationRole where Just cr -> return cr Nothing -> fail ("Failed to parse: " ++ show o) -data ConversationRolesList - = ConversationRolesList - { convRolesList :: [ConversationRole] - } +data ConversationRolesList = ConversationRolesList + { convRolesList :: [ConversationRole] + } deriving (Eq, Show) instance ToJSON ConversationRolesList where diff --git a/libs/galley-types/src/Galley/Types/Proto.hs b/libs/galley-types/src/Galley/Types/Proto.hs index 0d3a62b74c8..8bbe7abab0e 100644 --- a/libs/galley-types/src/Galley/Types/Proto.hs +++ b/libs/galley-types/src/Galley/Types/Proto.hs @@ -69,10 +69,9 @@ import Imports -- UserId ------------------------------------------------------------------- -newtype UserId - = UserId - { _user :: Required 1 (Value Id.OpaqueUserId) - } +newtype UserId = UserId + { _user :: Required 1 (Value Id.OpaqueUserId) + } deriving (Eq, Show, Generic) instance Encode UserId @@ -87,10 +86,9 @@ userId f c = (\x -> c {_user = x}) <$> field f (_user c) -- ClientId ------------------------------------------------------------------ -newtype ClientId - = ClientId - { _client :: Required 1 (Value Word64) - } +newtype ClientId = ClientId + { _client :: Required 1 (Value Word64) + } deriving (Eq, Show, Generic) instance Encode ClientId @@ -115,11 +113,10 @@ fromClientId c = -- ClientEntry -------------------------------------------------------------- -data ClientEntry - = ClientEntry - { _clientId :: !(Required 1 (Message ClientId)), - _clientVal :: !(Required 2 (Value ByteString)) - } +data ClientEntry = ClientEntry + { _clientId :: !(Required 1 (Message ClientId)), + _clientVal :: !(Required 2 (Value ByteString)) + } deriving (Eq, Show, Generic) instance Encode ClientEntry @@ -141,11 +138,10 @@ clientEntryMessage f c = (\x -> c {_clientVal = x}) <$> field f (_clientVal c) -- UserEntry ---------------------------------------------------------------- -data UserEntry - = UserEntry - { _userId :: !(Required 1 (Message UserId)), - _userVal :: !(Repeated 2 (Message ClientEntry)) - } +data UserEntry = UserEntry + { _userId :: !(Required 1 (Message UserId)), + _userVal :: !(Repeated 2 (Message ClientEntry)) + } deriving (Eq, Show, Generic) instance Encode UserEntry @@ -221,16 +217,15 @@ fromPriority Gundeck.HighPriority = HighPriority -- NewOtrMessage ------------------------------------------------------------ -data NewOtrMessage - = NewOtrMessage - { _newOtrSender :: !(Required 1 (Message ClientId)), - _newOtrRecipients :: !(Repeated 2 (Message UserEntry)), - _newOtrNativePush :: !(Optional 3 (Value Bool)), - _newOtrData :: !(Optional 4 (Value ByteString)), - _newOtrNativePriority :: !(Optional 5 (Enumeration Priority)), -- See note [orphans] - _newOtrTransient :: !(Optional 6 (Value Bool)), - _newOtrReportMissing :: !(Repeated 7 (Message UserId)) - } +data NewOtrMessage = NewOtrMessage + { _newOtrSender :: !(Required 1 (Message ClientId)), + _newOtrRecipients :: !(Repeated 2 (Message UserEntry)), + _newOtrNativePush :: !(Optional 3 (Value Bool)), + _newOtrData :: !(Optional 4 (Value ByteString)), + _newOtrNativePriority :: !(Optional 5 (Enumeration Priority)), -- See note [orphans] + _newOtrTransient :: !(Optional 6 (Value Bool)), + _newOtrReportMissing :: !(Repeated 7 (Message UserId)) + } deriving (Eq, Show, Generic) instance Encode NewOtrMessage diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 83fdd024cd2..9f1ec63b628 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -149,13 +149,12 @@ import GHC.TypeLits import Galley.Types.Teams.Internal import Imports -data Event - = Event - { _eventType :: EventType, - _eventTeam :: TeamId, - _eventTime :: UTCTime, - _eventData :: Maybe EventData - } +data Event = Event + { _eventType :: EventType, + _eventTeam :: TeamId, + _eventTime :: UTCTime, + _eventData :: Maybe EventData + } deriving (Eq, Generic) -- Note [whitelist events] @@ -213,28 +212,25 @@ data EventData | EdConvDelete ConvId deriving (Eq, Show, Generic) -data TeamUpdateData - = TeamUpdateData - { _nameUpdate :: Maybe (Range 1 256 Text), - _iconUpdate :: Maybe (Range 1 256 Text), - _iconKeyUpdate :: Maybe (Range 1 256 Text) - } +data TeamUpdateData = TeamUpdateData + { _nameUpdate :: Maybe (Range 1 256 Text), + _iconUpdate :: Maybe (Range 1 256 Text), + _iconKeyUpdate :: Maybe (Range 1 256 Text) + } deriving (Eq, Show, Generic) -data TeamList - = TeamList - { _teamListTeams :: [Team], - _teamListHasMore :: Bool - } +data TeamList = TeamList + { _teamListTeams :: [Team], + _teamListHasMore :: Bool + } deriving (Show, Generic) -data TeamMember - = TeamMember - { _userId :: UserId, - _permissions :: Permissions, - _invitation :: Maybe (UserId, UTCTimeMillis), - _legalHoldStatus :: UserLegalHoldStatus - } +data TeamMember = TeamMember + { _userId :: UserId, + _permissions :: Permissions, + _invitation :: Maybe (UserId, UTCTimeMillis), + _legalHoldStatus :: UserLegalHoldStatus + } deriving (Eq, Ord, Show, Generic) data ListType @@ -242,11 +238,10 @@ data ListType | ListTruncated deriving (Eq, Show, Generic) -data TeamMemberList - = TeamMemberList - { _teamMembers :: [TeamMember], - _teamMemberListType :: ListType - } +data TeamMemberList = TeamMemberList + { _teamMembers :: [TeamMember], + _teamMemberListType :: ListType + } deriving (Generic) type HardTruncationLimit = (2000 :: Nat) @@ -254,22 +249,19 @@ type HardTruncationLimit = (2000 :: Nat) hardTruncationLimit :: Integral a => a hardTruncationLimit = fromIntegral $ natVal (Proxy @HardTruncationLimit) -data TeamConversation - = TeamConversation - { _conversationId :: ConvId, - _managedConversation :: Bool - } - -newtype TeamConversationList - = TeamConversationList - { _teamConversations :: [TeamConversation] - } - -data Permissions - = Permissions - { _self :: Set Perm, - _copy :: Set Perm - } +data TeamConversation = TeamConversation + { _conversationId :: ConvId, + _managedConversation :: Bool + } + +newtype TeamConversationList = TeamConversationList + { _teamConversations :: [TeamConversation] + } + +data Permissions = Permissions + { _self :: Set Perm, + _copy :: Set Perm + } deriving (Eq, Ord, Show, Generic) -- | Team-level permission. Analog to conversation-level 'Action'. @@ -351,32 +343,27 @@ newtype BindingNewTeam = BindingNewTeam (NewTeam ()) newtype NonBindingNewTeam = NonBindingNewTeam (NewTeam (Range 1 127 [TeamMember])) deriving (Eq, Show, Generic) -newtype NewTeamMember - = NewTeamMember - { _ntmNewTeamMember :: TeamMember - } +newtype NewTeamMember = NewTeamMember + { _ntmNewTeamMember :: TeamMember + } -newtype TeamMemberDeleteData - = TeamMemberDeleteData - { _tmdAuthPassword :: Maybe PlainTextPassword - } +newtype TeamMemberDeleteData = TeamMemberDeleteData + { _tmdAuthPassword :: Maybe PlainTextPassword + } -newtype TeamDeleteData - = TeamDeleteData - { _tdAuthPassword :: Maybe PlainTextPassword - } +newtype TeamDeleteData = TeamDeleteData + { _tdAuthPassword :: Maybe PlainTextPassword + } -- This is the cassandra timestamp of writetime(binding) -newtype TeamCreationTime - = TeamCreationTime - { _tcTime :: Int64 - } - -data FeatureFlags - = FeatureFlags - { _flagSSO :: !FeatureSSO, - _flagLegalHold :: !FeatureLegalHold - } +newtype TeamCreationTime = TeamCreationTime + { _tcTime :: Int64 + } + +data FeatureFlags = FeatureFlags + { _flagSSO :: !FeatureSSO, + _flagLegalHold :: !FeatureLegalHold + } deriving (Eq, Show, Generic) data FeatureSSO @@ -541,11 +528,10 @@ data HiddenPerm deriving (Eq, Ord, Show, Enum, Bounded) -- | See Note [hidden team roles] -data HiddenPermissions - = HiddenPermissions - { _hself :: Set HiddenPerm, - _hcopy :: Set HiddenPerm - } +data HiddenPermissions = HiddenPermissions + { _hself :: Set HiddenPerm, + _hcopy :: Set HiddenPerm + } deriving (Eq, Ord, Show) makeLenses ''HiddenPermissions diff --git a/libs/galley-types/src/Galley/Types/Teams/Internal.hs b/libs/galley-types/src/Galley/Types/Teams/Internal.hs index c06c2f21cd6..f16fa677830 100644 --- a/libs/galley-types/src/Galley/Types/Teams/Internal.hs +++ b/libs/galley-types/src/Galley/Types/Teams/Internal.hs @@ -36,24 +36,22 @@ data TeamBinding | NonBinding deriving (Eq, Show, Generic) -data Team - = Team - { _teamId :: TeamId, - _teamCreator :: UserId, - _teamName :: Text, - _teamIcon :: Text, - _teamIconKey :: Maybe Text, - _teamBinding :: TeamBinding - } +data Team = Team + { _teamId :: TeamId, + _teamCreator :: UserId, + _teamName :: Text, + _teamIcon :: Text, + _teamIconKey :: Maybe Text, + _teamBinding :: TeamBinding + } deriving (Eq, Show, Generic) -data NewTeam a - = NewTeam - { _newTeamName :: Range 1 256 Text, - _newTeamIcon :: Range 1 256 Text, - _newTeamIconKey :: Maybe (Range 1 256 Text), - _newTeamMembers :: Maybe a - } +data NewTeam a = NewTeam + { _newTeamName :: Range 1 256 Text, + _newTeamIcon :: Range 1 256 Text, + _newTeamIconKey :: Maybe (Range 1 256 Text), + _newTeamMembers :: Maybe a + } deriving (Eq, Show, Generic) instance ToJSON TeamBinding where diff --git a/libs/galley-types/src/Galley/Types/Teams/Intra.hs b/libs/galley-types/src/Galley/Types/Teams/Intra.hs index 1e0f9f09356..9e78387822e 100644 --- a/libs/galley-types/src/Galley/Types/Teams/Intra.hs +++ b/libs/galley-types/src/Galley/Types/Teams/Intra.hs @@ -51,12 +51,11 @@ instance FromJSON TeamStatus where parseJSON (String "pending_active") = pure PendingActive parseJSON other = fail $ "Unknown TeamStatus: " <> show other -data TeamData - = TeamData - { tdTeam :: !Team, - tdStatus :: !TeamStatus, - tdStatusTime :: !(Maybe UTCTime) -- This needs to be a Maybe due to backwards compatibility - } +data TeamData = TeamData + { tdTeam :: !Team, + tdStatus :: !TeamStatus, + tdStatusTime :: !(Maybe UTCTime) -- This needs to be a Maybe due to backwards compatibility + } deriving (Eq, Show, Generic) instance ToJSON TeamData where @@ -73,12 +72,11 @@ instance FromJSON TeamData where <*> o .: "status" <*> o .:? "status_time" -data TeamStatusUpdate - = TeamStatusUpdate - { tuStatus :: !TeamStatus, - tuCurrency :: !(Maybe Currency.Alpha) - -- TODO: Remove Currency selection once billing supports currency changes after team creation - } +data TeamStatusUpdate = TeamStatusUpdate + { tuStatus :: !TeamStatus, + tuCurrency :: !(Maybe Currency.Alpha) + -- TODO: Remove Currency selection once billing supports currency changes after team creation + } deriving (Eq, Show, Generic) instance FromJSON TeamStatusUpdate where @@ -93,9 +91,8 @@ instance ToJSON TeamStatusUpdate where "currency" .= tuCurrency s ] -newtype TeamName - = TeamName - {tnName :: Text} +newtype TeamName = TeamName + {tnName :: Text} deriving (Eq, Show, Generic) deriveJSON toJSONFieldName ''TeamName diff --git a/libs/galley-types/src/Galley/Types/Teams/SSO.hs b/libs/galley-types/src/Galley/Types/Teams/SSO.hs index 2c1da2697bf..8081d5ed656 100644 --- a/libs/galley-types/src/Galley/Types/Teams/SSO.hs +++ b/libs/galley-types/src/Galley/Types/Teams/SSO.hs @@ -38,10 +38,9 @@ instance FromJSON SSOStatus where "disabled" -> pure SSODisabled x -> fail $ "unexpected status type: " <> T.unpack x -data SSOTeamConfig - = SSOTeamConfig - { ssoTeamConfigStatus :: !SSOStatus - } +data SSOTeamConfig = SSOTeamConfig + { ssoTeamConfigStatus :: !SSOStatus + } deriving stock (Eq, Show, Generic) instance ToJSON SSOTeamConfig where diff --git a/libs/gundeck-types/src/Gundeck/Types/BulkPush.hs b/libs/gundeck-types/src/Gundeck/Types/BulkPush.hs index 40585a42f8b..dd66523e7ea 100644 --- a/libs/gundeck-types/src/Gundeck/Types/BulkPush.hs +++ b/libs/gundeck-types/src/Gundeck/Types/BulkPush.hs @@ -32,11 +32,10 @@ import Data.Id import Gundeck.Types.Notification import Imports -data PushTarget - = PushTarget - { ptUserId :: !UserId, - ptConnId :: !ConnId - } +data PushTarget = PushTarget + { ptUserId :: !UserId, + ptConnId :: !ConnId + } deriving ( Eq, Ord, @@ -51,10 +50,9 @@ instance FromJSON PushTarget where instance ToJSON PushTarget where toJSON (PushTarget u c) = object ["user_id" .= u, "conn_id" .= c] -newtype BulkPushRequest - = BulkPushRequest - { fromBulkPushRequest :: [(Notification, [PushTarget])] - } +newtype BulkPushRequest = BulkPushRequest + { fromBulkPushRequest :: [(Notification, [PushTarget])] + } deriving ( Eq, Show, @@ -78,10 +76,9 @@ data PushStatus = PushStatusOk | PushStatusGone $(deriveJSON (defaultOptions {constructorTagModifier = camelTo2 '_'}) ''PushStatus) -newtype BulkPushResponse - = BulkPushResponse - { fromBulkPushResponse :: [(NotificationId, PushTarget, PushStatus)] - } +newtype BulkPushResponse = BulkPushResponse + { fromBulkPushResponse :: [(NotificationId, PushTarget, PushStatus)] + } deriving ( Eq, Show, diff --git a/libs/gundeck-types/src/Gundeck/Types/Common.hs b/libs/gundeck-types/src/Gundeck/Types/Common.hs index 13627bef82f..e49931dbe84 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Common.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Common.hs @@ -27,10 +27,9 @@ import qualified Data.Text as Text import Imports import qualified Network.URI as Net -newtype CannonId - = CannonId - { cannonId :: Text - } +newtype CannonId = CannonId + { cannonId :: Text + } deriving ( Eq, Ord, @@ -41,10 +40,9 @@ newtype CannonId ToByteString ) -newtype URI - = URI - { fromURI :: Net.URI - } +newtype URI = URI + { fromURI :: Net.URI + } deriving (Eq, Ord, Show) instance FromJSON URI where diff --git a/libs/gundeck-types/src/Gundeck/Types/Notification.hs b/libs/gundeck-types/src/Gundeck/Types/Notification.hs index 5e909f035f8..e4099962375 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Notification.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Notification.hs @@ -53,12 +53,11 @@ import Imports ------------------------------------------------------------------------------- -- Notification -data Notification - = Notification - { ntfId :: !NotificationId, - ntfTransient :: !Bool, - ntfPayload :: !(List1 Object) - } +data Notification = Notification + { ntfId :: !NotificationId, + ntfTransient :: !Bool, + ntfPayload :: !(List1 Object) + } deriving (Eq, Show) type NotificationId = Id Notification @@ -80,11 +79,10 @@ instance ToJSON Notification where -------------------------------------------------------------------------------- -- NotificationTarget -data NotificationTarget - = NotificationTarget - { _targetUser :: !UserId, - _targetClients :: ![ClientId] - } +data NotificationTarget = NotificationTarget + { _targetUser :: !UserId, + _targetClients :: ![ClientId] + } deriving (Eq, Show) makeLenses ''NotificationTarget @@ -107,11 +105,10 @@ instance ToJSON NotificationTarget where -------------------------------------------------------------------------------- -- QueuedNotification -data QueuedNotification - = QueuedNotification - { _queuedNotificationId :: !NotificationId, - _queuedNotificationPayload :: !(List1 Object) - } +data QueuedNotification = QueuedNotification + { _queuedNotificationId :: !NotificationId, + _queuedNotificationPayload :: !(List1 Object) + } deriving (Eq, Show) queuedNotification :: NotificationId -> List1 Object -> QueuedNotification @@ -119,12 +116,11 @@ queuedNotification = QueuedNotification makeLenses ''QueuedNotification -data QueuedNotificationList - = QueuedNotificationList - { _queuedNotifications :: [QueuedNotification], - _queuedHasMore :: !Bool, - _queuedTime :: !(Maybe UTCTime) - } +data QueuedNotificationList = QueuedNotificationList + { _queuedNotifications :: [QueuedNotification], + _queuedHasMore :: !Bool, + _queuedTime :: !(Maybe UTCTime) + } queuedNotificationList :: [QueuedNotification] -> Bool -> Maybe UTCTime -> QueuedNotificationList queuedNotificationList = QueuedNotificationList diff --git a/libs/gundeck-types/src/Gundeck/Types/Presence.hs b/libs/gundeck-types/src/Gundeck/Types/Presence.hs index 23e76a064ca..a1e1cb44170 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Presence.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Presence.hs @@ -33,21 +33,20 @@ import Imports -- | This is created in gundeck by cannon every time the client opens a new websocket connection. -- (That's why we always have a 'ConnId' from the most recent connection by that client.) -data Presence - = Presence - { userId :: !UserId, - connId :: !ConnId, - -- | cannon instance hosting the presence - resource :: !URI, - -- | This is 'Nothing' if either (a) the presence is older - -- than mandatory end-to-end encryption, or (b) the client is - -- operating the team settings pages without the need for - -- end-to-end crypto. - clientId :: !(Maybe ClientId), - createdAt :: !Milliseconds, - -- | REFACTOR: temp. addition to ease migration - __field :: !Lazy.ByteString - } +data Presence = Presence + { userId :: !UserId, + connId :: !ConnId, + -- | cannon instance hosting the presence + resource :: !URI, + -- | This is 'Nothing' if either (a) the presence is older + -- than mandatory end-to-end encryption, or (b) the client is + -- operating the team settings pages without the need for + -- end-to-end crypto. + clientId :: !(Maybe ClientId), + createdAt :: !Milliseconds, + -- | REFACTOR: temp. addition to ease migration + __field :: !Lazy.ByteString + } deriving (Eq, Ord, Show) instance ToJSON Presence where diff --git a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs index 384286a9165..7ffc6867984 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs @@ -108,12 +108,11 @@ instance ToJSON Route where ----------------------------------------------------------------------------- -- Recipient -data Recipient - = Recipient - { _recipientId :: !UserId, - _recipientRoute :: !Route, - _recipientClients :: !RecipientClients - } +data Recipient = Recipient + { _recipientId :: !UserId, + _recipientRoute :: !Route, + _recipientClients :: !RecipientClients + } deriving (Show) instance Eq Recipient where @@ -183,14 +182,13 @@ instance FromJSON ApsPreference where "std" -> pure ApsStdPreference x -> fail $ "Invalid preference: " ++ show x -data ApsData - = ApsData - { _apsLocKey :: !ApsLocKey, - _apsLocArgs :: [Text], - _apsSound :: !(Maybe ApsSound), - _apsPreference :: !(Maybe ApsPreference), - _apsBadge :: !Bool - } +data ApsData = ApsData + { _apsLocKey :: !ApsLocKey, + _apsLocArgs :: [Text], + _apsSound :: !(Maybe ApsSound), + _apsPreference :: !(Maybe ApsPreference), + _apsBadge :: !Bool + } deriving (Eq, Show) makeLenses ''ApsData @@ -246,44 +244,43 @@ instance FromJSON Priority where ----------------------------------------------------------------------------- -- Push -data Push - = Push - { -- | Recipients - -- - -- REFACTOR: '_pushRecipients' should be @Set (Recipient, Maybe (NonEmptySet ConnId))@, and - -- '_pushConnections' should go away. Rationale: the current setup only works under the - -- assumption that no 'ConnId' is used by two 'Recipient's. This is *probably* correct, but - -- not in any contract. (Changing this may require a new version module, since we need to - -- support both the old and the new data type simultaneously during upgrade.) - _pushRecipients :: Range 1 1024 (Set Recipient), - -- | Originating user - -- - -- REFACTOR: where is this required, and for what? or can it be removed? (see also: #531) - _pushOrigin :: !UserId, - -- | Destination connections. If empty, ignore. Otherwise, filter the connections derived - -- from '_pushRecipients' and only push to those contained in this set. - -- - -- REFACTOR: change this to @_pushConnectionWhitelist :: Maybe (Set ConnId)@. - _pushConnections :: !(Set ConnId), - -- | Originating connection, if any. - _pushOriginConnection :: !(Maybe ConnId), - -- | Transient payloads are not forwarded to the notification stream. - _pushTransient :: !Bool, - -- | Whether to send native notifications to other clients - -- of the originating user, if he is among the recipients. - _pushNativeIncludeOrigin :: !Bool, - -- | Should native push payloads be encrypted? - -- - -- REFACTOR: this make no sense any more since native push notifications have no more payload. - -- https://github.com/wireapp/wire-server/pull/546 - _pushNativeEncrypt :: !Bool, - -- | APNs-specific metadata. REFACTOR: can this be removed? - _pushNativeAps :: !(Maybe ApsData), - -- | Native push priority. - _pushNativePriority :: !Priority, - -- | Opaque payload - _pushPayload :: !(List1 Object) - } +data Push = Push + { -- | Recipients + -- + -- REFACTOR: '_pushRecipients' should be @Set (Recipient, Maybe (NonEmptySet ConnId))@, and + -- '_pushConnections' should go away. Rationale: the current setup only works under the + -- assumption that no 'ConnId' is used by two 'Recipient's. This is *probably* correct, but + -- not in any contract. (Changing this may require a new version module, since we need to + -- support both the old and the new data type simultaneously during upgrade.) + _pushRecipients :: Range 1 1024 (Set Recipient), + -- | Originating user + -- + -- REFACTOR: where is this required, and for what? or can it be removed? (see also: #531) + _pushOrigin :: !UserId, + -- | Destination connections. If empty, ignore. Otherwise, filter the connections derived + -- from '_pushRecipients' and only push to those contained in this set. + -- + -- REFACTOR: change this to @_pushConnectionWhitelist :: Maybe (Set ConnId)@. + _pushConnections :: !(Set ConnId), + -- | Originating connection, if any. + _pushOriginConnection :: !(Maybe ConnId), + -- | Transient payloads are not forwarded to the notification stream. + _pushTransient :: !Bool, + -- | Whether to send native notifications to other clients + -- of the originating user, if he is among the recipients. + _pushNativeIncludeOrigin :: !Bool, + -- | Should native push payloads be encrypted? + -- + -- REFACTOR: this make no sense any more since native push notifications have no more payload. + -- https://github.com/wireapp/wire-server/pull/546 + _pushNativeEncrypt :: !Bool, + -- | APNs-specific metadata. REFACTOR: can this be removed? + _pushNativeAps :: !(Maybe ApsData), + -- | Native push priority. + _pushNativePriority :: !Priority, + -- | Opaque payload + _pushPayload :: !(List1 Object) + } deriving (Eq, Show) makeLenses ''Push @@ -378,25 +375,22 @@ instance FromByteString Transport where ----------------------------------------------------------------------------- -- PushToken -newtype Token - = Token - { tokenText :: Text - } +newtype Token = Token + { tokenText :: Text + } deriving (Eq, Ord, Show, FromJSON, ToJSON, FromByteString, ToByteString) -newtype AppName - = AppName - { appNameText :: Text - } +newtype AppName = AppName + { appNameText :: Text + } deriving (Eq, Ord, Show, FromJSON, ToJSON, IsString) -data PushToken - = PushToken - { _tokenTransport :: !Transport, - _tokenApp :: !AppName, - _token :: !Token, - _tokenClient :: !ClientId - } +data PushToken = PushToken + { _tokenTransport :: !Transport, + _tokenApp :: !AppName, + _token :: !Token, + _tokenClient :: !ClientId + } deriving (Eq, Ord, Show) makeLenses ''PushToken @@ -420,10 +414,9 @@ instance FromJSON PushToken where <*> p .: "token" <*> p .: "client" -newtype PushTokenList - = PushTokenList - { pushTokens :: [PushToken] - } +newtype PushTokenList = PushTokenList + { pushTokens :: [PushToken] + } deriving (Eq, Show) instance FromJSON PushTokenList where diff --git a/libs/imports/src/Imports.hs b/libs/imports/src/Imports.hs index a27af8c0cef..85d3c80bffb 100644 --- a/libs/imports/src/Imports.hs +++ b/libs/imports/src/Imports.hs @@ -191,6 +191,7 @@ import UnliftIO.IO hiding (Handle, getMonotonicTime) import UnliftIO.IORef import UnliftIO.MVar import UnliftIO.STM +import qualified Prelude as P import Prelude ( ($!), Bounded (..), @@ -235,7 +236,6 @@ import Prelude subtract, undefined, ) -import qualified Prelude as P ---------------------------------------------------------------------------- -- Type aliases diff --git a/libs/metrics-core/src/Data/Metrics.hs b/libs/metrics-core/src/Data/Metrics.hs index 739d956f0fe..ab3f6d41e2b 100644 --- a/libs/metrics-core/src/Data/Metrics.hs +++ b/libs/metrics-core/src/Data/Metrics.hs @@ -86,10 +86,9 @@ newtype Histogram = Histogram P.Histogram -- NOTE: Until all metrics are fully migrated to Prometheus this should be a valid -- name according to collectd; e.g. @net.resources./teams/invitations/info@ -- All names are converted into valid prometheus names when needed via 'toInfo' -newtype Path - = Path - { _path :: Text - } +newtype Path = Path + { _path :: Text + } deriving (Eq, Show, Hashable, Semigroup, Monoid) -- | Create a path @@ -97,12 +96,11 @@ path :: Text -> Path path = Path -- | Opaque storage of metrics -data Metrics - = Metrics - { counters :: IORef (HashMap Path Counter), - gauges :: IORef (HashMap Path Gauge), - histograms :: IORef (HashMap Path Histogram) - } +data Metrics = Metrics + { counters :: IORef (HashMap Path Counter), + gauges :: IORef (HashMap Path Gauge), + histograms :: IORef (HashMap Path Histogram) + } deriving (Generic) -- Initialize an empty set of metrics @@ -253,11 +251,10 @@ type Bucket = Double type Buckets = [Bucket] -- | Describes a histogram metric -data HistogramInfo - = HistogramInfo - { hiPath :: Path, - hiBuckets :: Buckets - } +data HistogramInfo = HistogramInfo + { hiPath :: Path, + hiBuckets :: Buckets + } deriving (Eq, Show) type RangeStart = Double diff --git a/libs/metrics-wai/src/Data/Metrics/Test.hs b/libs/metrics-wai/src/Data/Metrics/Test.hs index c5065ffbe36..aca25a24b32 100644 --- a/libs/metrics-wai/src/Data/Metrics/Test.hs +++ b/libs/metrics-wai/src/Data/Metrics/Test.hs @@ -26,11 +26,10 @@ import Imports -- | It is an error for one prefix to end in two different capture variables. eg., these two -- routes constitute a confict: "/user/:uid", "/user/:id". There is a show instance that -- explains this better. -data SiteConsistencyError - = SiteConsistencyError - { _siteConsistencyPrefix :: [Text], - _siteConsistencyCaptureVars :: [(Text, Int)] - } +data SiteConsistencyError = SiteConsistencyError + { _siteConsistencyPrefix :: [Text], + _siteConsistencyCaptureVars :: [(Text, Int)] + } deriving (Eq) instance Show SiteConsistencyError where diff --git a/libs/ropes/src/Ropes/Aws.hs b/libs/ropes/src/Ropes/Aws.hs index c2441ed8b1a..1c407d1e951 100644 --- a/libs/ropes/src/Ropes/Aws.hs +++ b/libs/ropes/src/Ropes/Aws.hs @@ -62,9 +62,8 @@ import qualified System.Logger as Logger ------------------------------------------------------------------------------- -- Config -newtype AccessKeyId - = AccessKeyId - {unKey :: ByteString} +newtype AccessKeyId = AccessKeyId + {unKey :: ByteString} deriving (Eq, Show) instance FromJSON AccessKeyId where @@ -72,9 +71,8 @@ instance FromJSON AccessKeyId where withText "Aws.AccessKeyId" $ pure . AccessKeyId . encodeUtf8 -newtype SecretAccessKey - = SecretAccessKey - {unSecret :: ByteString} +newtype SecretAccessKey = SecretAccessKey + {unSecret :: ByteString} deriving (Eq) instance Show SecretAccessKey where @@ -90,12 +88,11 @@ data Auth | TempAuth (IORef Configuration) -- | An environment for executing AWS requests. See 'sendRequest'. -data Env - = Env - { _auth :: !Auth, - -- | Get the HTTP 'Manager' used by an 'Env'ironment. - getManager :: !Manager - } +data Env = Env + { _auth :: !Auth, + -- | Get the HTTP 'Manager' used by an 'Env'ironment. + getManager :: !Manager + } -- | If credentials are supplied to this function, they are used to create the 'Env' -- | Otherwise, it tries to discover AWS credentials by calling the underlying @@ -183,13 +180,12 @@ awsLog lgr l m = Logger.log lgr (level l) (Logger.msg m) level Aws.Warning = Logger.Warn level Aws.Error = Logger.Error -data TempCredentials - = TempCredentials - { _tmpKey :: AccessKeyId, - _tmpSecret :: SecretAccessKey, - _tmpToken :: SessionToken, - _tmpExpiry :: Maybe UTCTime - } +data TempCredentials = TempCredentials + { _tmpKey :: AccessKeyId, + _tmpSecret :: SecretAccessKey, + _tmpToken :: SessionToken, + _tmpExpiry :: Maybe UTCTime + } newtype SessionToken = SessionToken ByteString diff --git a/libs/ropes/src/Ropes/Nexmo.hs b/libs/ropes/src/Ropes/Nexmo.hs index 3bf97801cd9..11cd3a98990 100644 --- a/libs/ropes/src/Ropes/Nexmo.hs +++ b/libs/ropes/src/Ropes/Nexmo.hs @@ -72,11 +72,10 @@ newtype ApiSecret = ApiSecret Text deriving (FromJSON) data Charset = GSM7 | GSM8 | UCS2 deriving (Eq, Show) -data Credentials - = Credentials - { key :: ApiKey, - secret :: ApiSecret - } +data Credentials = Credentials + { key :: ApiKey, + secret :: ApiSecret + } instance FromJSON Credentials where parseJSON = withObject "credentials" $ \o -> @@ -87,13 +86,12 @@ instance FromJSON Credentials where newtype MessageId = MessageId {messageIdText :: Text} deriving (Eq, Show) -data Message - = Message - { msgFrom :: !Text, - msgTo :: !Text, - msgText :: !Text, - msgType :: !Charset - } +data Message = Message + { msgFrom :: !Text, + msgTo :: !Text, + msgText :: !Text, + msgType :: !Charset + } deriving (Eq, Show) newtype MessageResponse = MessageResponse {msgIds :: NonEmpty MessageId} @@ -128,11 +126,10 @@ instance FromJSON MessageErrorStatus where parseJSON "20" = return MessageInvalidMessageClass parseJSON _ = return MessageOther -data MessageErrorResponse - = MessageErrorResponse - { erStatus :: !MessageErrorStatus, - erErrorText :: !(Maybe Text) - } +data MessageErrorResponse = MessageErrorResponse + { erStatus :: !MessageErrorStatus, + erErrorText :: !(Maybe Text) + } deriving (Eq, Show, Typeable) instance Exception MessageErrorResponse @@ -190,14 +187,13 @@ parseMessageResponse = withObject "nexmo-response" $ \o -> do newtype CallId = CallId {callIdText :: Text} deriving (Eq, Show) -data Call - = Call - { callFrom :: !(Maybe Text), - callTo :: !Text, - callText :: !Text, - callLang :: !(Maybe Text), - callRepeat :: !(Maybe Int) - } +data Call = Call + { callFrom :: !(Maybe Text), + callTo :: !Text, + callText :: !Text, + callLang :: !(Maybe Text), + callRepeat :: !(Maybe Int) + } data CallErrorStatus = CallThrottled @@ -220,11 +216,10 @@ instance FromJSON CallErrorStatus where parseJSON "17" = return CallUnroutable parseJSON _ = return CallOther -data CallErrorResponse - = CallErrorResponse - { caStatus :: !CallErrorStatus, - caErrorText :: !(Maybe Text) - } +data CallErrorResponse = CallErrorResponse + { caStatus :: !CallErrorStatus, + caErrorText :: !(Maybe Text) + } deriving (Eq, Show, Typeable) instance Exception CallErrorResponse @@ -250,12 +245,11 @@ parseCallResponse _ = fail "Ropes.Nexmo: response should be an object" -- * Feedback related -data Feedback - = Feedback - { feedbackId :: !(Either CallId MessageId), - feedbackTime :: !UTCTime, - feedbackDelivered :: !Bool - } +data Feedback = Feedback + { feedbackId :: !(Either CallId MessageId), + feedbackTime :: !UTCTime, + feedbackDelivered :: !Bool + } deriving (Eq, Show) data FeedbackErrorResponse = FeedbackErrorResponse Text diff --git a/libs/ropes/src/Ropes/Twilio.hs b/libs/ropes/src/Ropes/Twilio.hs index 50eb5a41224..6f7ac50fe2c 100644 --- a/libs/ropes/src/Ropes/Twilio.hs +++ b/libs/ropes/src/Ropes/Twilio.hs @@ -61,32 +61,29 @@ newtype SID = SID ByteString newtype AccessToken = AccessToken ByteString -data Credentials - = Credentials - { sid :: SID, - token :: AccessToken - } +data Credentials = Credentials + { sid :: SID, + token :: AccessToken + } instance FromJSON Credentials where parseJSON = withObject "credentials" $ \o -> Credentials <$> (SID . encodeUtf8 <$> o .: "sid") <*> (AccessToken . encodeUtf8 <$> o .: "token") -data Message - = Message - { msgFrom :: !Text, - msgTo :: !Text, - msgText :: !Text - } +data Message = Message + { msgFrom :: !Text, + msgTo :: !Text, + msgText :: !Text + } deriving (Eq, Show) -data ErrorResponse - = ErrorResponse - { errStatus :: !Int, - errMessage :: !Text, - errCode :: !(Maybe Int), - errMoreInfo :: !(Maybe Text) - } +data ErrorResponse = ErrorResponse + { errStatus :: !Int, + errMessage :: !Text, + errCode :: !(Maybe Int), + errMoreInfo :: !(Maybe Text) + } deriving (Eq, Show, Typeable) instance Exception ErrorResponse @@ -103,10 +100,9 @@ newtype ParseError = ParseError String instance Exception ParseError -data MessageResponse - = MessageResponse - { msgId :: !MessageId - } +data MessageResponse = MessageResponse + { msgId :: !MessageId + } instance FromJSON MessageResponse where parseJSON = withObject "MessageResponse" $ \o -> @@ -117,17 +113,15 @@ data LookupDetail | LookupCarrier deriving (Eq, Show) -data LookupResult - = LookupResult - { lookupE164 :: !Text, - lookupCarrier :: !(Maybe CarrierInfo) - } - -data CarrierInfo - = CarrierInfo - { carrierName :: !(Maybe Text), - carrierType :: !(Maybe PhoneType) - } +data LookupResult = LookupResult + { lookupE164 :: !Text, + lookupCarrier :: !(Maybe CarrierInfo) + } + +data CarrierInfo = CarrierInfo + { carrierName :: !(Maybe Text), + carrierType :: !(Maybe PhoneType) + } data PhoneType = Landline diff --git a/libs/sodium-crypto-sign/src/Sodium/Crypto/Sign.hsc b/libs/sodium-crypto-sign/src/Sodium/Crypto/Sign.hsc index f4f85ddbc1e..4691ed18831 100644 --- a/libs/sodium-crypto-sign/src/Sodium/Crypto/Sign.hsc +++ b/libs/sodium-crypto-sign/src/Sodium/Crypto/Sign.hsc @@ -18,88 +18,92 @@ -- with this program. If not, see . module Sodium.Crypto.Sign - ( PublicKey (..) - , SecretKey (..) - , Signature (..) - , newKeyPair - , sign - , signature - , signatureLength - , verify - , verifyWith - ) where - -import Imports -import Data.ByteString.Char8 (pack, unpack) + ( PublicKey (..), + SecretKey (..), + Signature (..), + newKeyPair, + sign, + signature, + signatureLength, + verify, + verifyWith, + ) +where + +import qualified Data.ByteString as B import Data.ByteString.Base64.URL +import Data.ByteString.Char8 (pack, unpack) +import qualified Data.ByteString.Internal as I +import qualified Data.ByteString.Unsafe as U import Foreign hiding (void) import Foreign.C +import Imports -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as I -import qualified Data.ByteString.Unsafe as U +newtype PublicKey = PublicKey {pubBytes :: ByteString} deriving (Eq, Ord) + +newtype SecretKey = SecretKey {secBytes :: ByteString} deriving (Eq, Ord) -newtype PublicKey = PublicKey { pubBytes :: ByteString } deriving (Eq, Ord) -newtype SecretKey = SecretKey { secBytes :: ByteString } deriving (Eq, Ord) -newtype Signature = Signature { sigBytes :: ByteString } deriving (Eq, Ord) +newtype Signature = Signature {sigBytes :: ByteString} deriving (Eq, Ord) instance Read PublicKey where - readsPrec _ = either error (\k -> [(PublicKey k, "")]) . decode . pack + readsPrec _ = either error (\k -> [(PublicKey k, "")]) . decode . pack instance Read SecretKey where - readsPrec _ = either error (\k -> [(SecretKey k, "")]) . decode . pack + readsPrec _ = either error (\k -> [(SecretKey k, "")]) . decode . pack instance Read Signature where - readsPrec _ = either error (\k -> [(Signature k, "")]) . decode . pack + readsPrec _ = either error (\k -> [(Signature k, "")]) . decode . pack instance Show PublicKey where - show = unpack . encode . pubBytes + show = unpack . encode . pubBytes instance Show SecretKey where - show = unpack . encode . secBytes + show = unpack . encode . secBytes instance Show Signature where - show = unpack . encode . sigBytes + show = unpack . encode . sigBytes -- | Please note that this function is not thread-safe. newKeyPair :: IO (PublicKey, SecretKey) newKeyPair = do - pl <- fromIntegral <$> publicKeyLength - sl <- fromIntegral <$> secretKeyLength - pk <- I.mallocByteString pl - sk <- I.mallocByteString sl + pl <- fromIntegral <$> publicKeyLength + sl <- fromIntegral <$> secretKeyLength + pk <- I.mallocByteString pl + sk <- I.mallocByteString sl - withForeignPtr pk $ \ppk -> - withForeignPtr sk $ \psk -> - void $ c_crypto_sign_keypair (castPtr ppk) (castPtr psk) + withForeignPtr pk $ \ppk -> + withForeignPtr sk $ \psk -> + void $ c_crypto_sign_keypair (castPtr ppk) (castPtr psk) - return ( PublicKey (I.fromForeignPtr pk 0 pl) - , SecretKey (I.fromForeignPtr sk 0 sl) ) + return + ( PublicKey (I.fromForeignPtr pk 0 pl), + SecretKey (I.fromForeignPtr sk 0 sl) + ) sign :: SecretKey -> ByteString -> IO ByteString sign k b = do - siglen <- fromIntegral <$> signatureLength - U.unsafeUseAsCStringLen b $ \(m, mlen) -> - U.unsafeUseAsCString (secBytes k) $ \sk -> - I.createAndTrim (mlen + siglen) $ \sm -> - alloca $ \smlen -> do - void $ c_crypto_sign (castPtr sm) smlen (castPtr m) (fromIntegral mlen) (castPtr sk) - fromIntegral <$> peek smlen + siglen <- fromIntegral <$> signatureLength + U.unsafeUseAsCStringLen b $ \(m, mlen) -> + U.unsafeUseAsCString (secBytes k) $ \sk -> + I.createAndTrim (mlen + siglen) $ \sm -> + alloca $ \smlen -> do + void $ c_crypto_sign (castPtr sm) smlen (castPtr m) (fromIntegral mlen) (castPtr sk) + fromIntegral <$> peek smlen signature :: SecretKey -> ByteString -> IO Signature signature k m = do - sm <- sign k m - return $ Signature (B.take (B.length sm - B.length m) sm) + sm <- sign k m + return $ Signature (B.take (B.length sm - B.length m) sm) verify :: PublicKey -> ByteString -> IO Bool verify k m = - U.unsafeUseAsCStringLen m $ \(ms, mslen) -> - U.unsafeUseAsCString (pubBytes k) $ \pk -> - alloca $ \pmlen -> do - out <- I.mallocByteString mslen - res <- withForeignPtr out $ \pout -> - c_crypto_sign_open (castPtr pout) pmlen (castPtr ms) (fromIntegral mslen) (castPtr pk) - return (res == 0) + U.unsafeUseAsCStringLen m $ \(ms, mslen) -> + U.unsafeUseAsCString (pubBytes k) $ \pk -> + alloca $ \pmlen -> do + out <- I.mallocByteString mslen + res <- withForeignPtr out $ \pout -> + c_crypto_sign_open (castPtr pout) pmlen (castPtr ms) (fromIntegral mslen) (castPtr pk) + return (res == 0) verifyWith :: PublicKey -> Signature -> ByteString -> IO Bool verifyWith k s m = verify k (sigBytes s <> m) @@ -122,29 +126,31 @@ signatureLength = fromIntegral <$> c_crypto_sign_bytes #include foreign import ccall unsafe "crypto_sign.h crypto_sign_bytes" - c_crypto_sign_bytes :: IO CSize + c_crypto_sign_bytes :: IO CSize foreign import ccall unsafe "crypto_sign.h crypto_sign_publickeybytes" - c_crypto_sign_publickeybytes :: IO CSize + c_crypto_sign_publickeybytes :: IO CSize foreign import ccall unsafe "crypto_sign.h crypto_sign_secretkeybytes" - c_crypto_sign_secretkeybytes :: IO CSize + c_crypto_sign_secretkeybytes :: IO CSize foreign import ccall unsafe "crypto_sign.h crypto_sign_keypair" - c_crypto_sign_keypair :: Ptr CUChar -> Ptr CUChar -> IO CInt + c_crypto_sign_keypair :: Ptr CUChar -> Ptr CUChar -> IO CInt foreign import ccall unsafe "crypto_sign.h crypto_sign" - c_crypto_sign :: Ptr CUChar -- signed message - -> Ptr CULLong -- signed message length - -> Ptr CUChar -- plain text message - -> CULLong -- plain text length - -> Ptr CUChar -- secret key - -> IO CInt + c_crypto_sign :: + Ptr CUChar -> -- signed message + Ptr CULLong -> -- signed message length + Ptr CUChar -> -- plain text message + CULLong -> -- plain text length + Ptr CUChar -> -- secret key + IO CInt foreign import ccall unsafe "crypto_sign.h crypto_sign_open" - c_crypto_sign_open :: Ptr CUChar -- plain text message - -> Ptr CULLong -- plain text message length - -> Ptr CUChar -- signed message - -> CULLong -- signed message length - -> Ptr CUChar -- public key - -> IO CInt + c_crypto_sign_open :: + Ptr CUChar -> -- plain text message + Ptr CULLong -> -- plain text message length + Ptr CUChar -> -- signed message + CULLong -> -- signed message length + Ptr CUChar -> -- public key + IO CInt diff --git a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs index 8b156d31c95..9423da4fcaa 100644 --- a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs +++ b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs @@ -90,12 +90,11 @@ type Cannon = Http.Request -> Http.Request ----------------------------------------------------------------------------- -- WebSockets -data WebSocket - = WebSocket - { wsChan :: TChan Notification, - wsCloseLatch :: MVar (), - wsAppThread :: Async () - } +data WebSocket = WebSocket + { wsChan :: TChan Notification, + wsCloseLatch :: MVar (), + wsAppThread :: Async () + } connect :: MonadIO m => Cannon -> UserId -> ConnId -> m WebSocket connect can uid cid = liftIO $ do @@ -189,10 +188,9 @@ instance Show MatchFailure where Just (HUnitFailure _src msg) -> msg Nothing -> show ex -newtype MatchTimeout - = MatchTimeout - { timeoutFailures :: [MatchFailure] - } +newtype MatchTimeout = MatchTimeout + { timeoutFailures :: [MatchFailure] + } deriving (Typeable) instance Exception MatchTimeout diff --git a/libs/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index 9513abf3053..901e1bab7bd 100644 --- a/libs/types-common/src/Data/Code.hs +++ b/libs/types-common/src/Data/Code.hs @@ -44,9 +44,8 @@ newtype Key = Key {asciiKey :: Range 20 20 AsciiBase64Url} newtype Value = Value {asciiValue :: Range 6 20 AsciiBase64Url} deriving (Eq, Show, FromJSON, ToJSON, FromByteString, ToByteString) -newtype Timeout - = Timeout - {timeoutDiffTime :: NominalDiffTime} +newtype Timeout = Timeout + {timeoutDiffTime :: NominalDiffTime} deriving (Eq, Show, Ord, Enum, Num, Fractional, Real, RealFrac) -- | A 'Timeout' is rendered as an integer representing the number of seconds remaining. @@ -76,11 +75,10 @@ deriving instance Cql Value -- be a "value" but since we use "key" and "code" already in quite a few place in the API -- (but without a type, using plain fields). This will make it easier to re-use a key/value -- pair in the API, keeping "code" in the JSON for backwards compatibility -data KeyValuePair - = KeyValuePair - { kcKey :: !Key, - kcCode :: !Value - } +data KeyValuePair = KeyValuePair + { kcKey :: !Key, + kcCode :: !Value + } deriving (Eq, Generic, Show) deriveJSON toJSONFieldName ''KeyValuePair diff --git a/libs/types-common/src/Data/Domain.hs b/libs/types-common/src/Data/Domain.hs index 095bc0cbe49..6573f9e1a18 100644 --- a/libs/types-common/src/Data/Domain.hs +++ b/libs/types-common/src/Data/Domain.hs @@ -51,8 +51,7 @@ import Util.Attoparsec (takeUpToWhile) -- ::= any one of the ten digits 0 through 9 -- -- The domain will be normalized to lowercase when parsed. -newtype Domain - = Domain {_domainText :: Text} +newtype Domain = Domain {_domainText :: Text} deriving (Eq, Generic, Show) domainText :: Domain -> Text @@ -99,8 +98,7 @@ instance Arbitrary Domain where either (error . ("arbitrary @Domain: " <>)) id . mkDomain . getDomainText <$> arbitrary -- | only for QuickCheck -newtype DomainText - = DomainText {getDomainText :: Text} +newtype DomainText = DomainText {getDomainText :: Text} deriving (Eq, Show) instance Arbitrary DomainText where diff --git a/libs/types-common/src/Data/Handle.hs b/libs/types-common/src/Data/Handle.hs index 9b8132fc6a0..6ee2059a031 100644 --- a/libs/types-common/src/Data/Handle.hs +++ b/libs/types-common/src/Data/Handle.hs @@ -41,9 +41,8 @@ import Util.Attoparsec (takeUpToWhile) -- Handle -- | Also called username. -newtype Handle - = Handle - {fromHandle :: Text} +newtype Handle = Handle + {fromHandle :: Text} deriving stock (Eq, Show, Generic) deriving newtype (ToJSON, ToByteString, Hashable) diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index 60aad0c6cec..783dc214d07 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -122,10 +122,9 @@ data NoId = NoId deriving (Eq, Show, Generic) instance NFData NoId where rnf a = seq a () -newtype Id a - = Id - { toUUID :: UUID - } +newtype Id a = Id + { toUUID :: UUID + } deriving (Eq, Ord, NFData, Hashable, Generic) -- REFACTOR: non-derived, custom show instances break pretty-show and violate the law @@ -208,10 +207,9 @@ instance Arbitrary (Id a) where -- encryption, but there are still situations in which 'ClientId' is not applicable (See also: -- 'Presence'). Used by Cannon and Gundeck to identify a websocket connection, but also in other -- places. -newtype ConnId - = ConnId - { fromConnId :: ByteString - } +newtype ConnId = ConnId + { fromConnId :: ByteString + } deriving ( Eq, Ord, @@ -235,10 +233,9 @@ instance FromJSON ConnId where -- | Handle for a device. Corresponds to the device fingerprints exposed in the UI. It is unique -- only together with a 'UserId', stored in C*, and used as a handle for end-to-end encryption. It -- lives as long as the device is registered. See also: 'ConnId'. -newtype ClientId - = ClientId - { client :: Text - } +newtype ClientId = ClientId + { client :: Text + } deriving (Eq, Ord, Show, ToByteString, Hashable, NFData, ToJSON, ToJSONKey, Generic) newClientId :: Word64 -> ClientId @@ -275,9 +272,8 @@ instance DecodeWire ClientId where -- BotId ----------------------------------------------------------------------- -newtype BotId - = BotId - {botUserId :: UserId} +newtype BotId = BotId + {botUserId :: UserId} deriving ( Eq, Ord, @@ -303,10 +299,9 @@ instance Arbitrary BotId where -- RequestId ------------------------------------------------------------------- -newtype RequestId - = RequestId - { unRequestId :: ByteString - } +newtype RequestId = RequestId + { unRequestId :: ByteString + } deriving ( Eq, Show, diff --git a/libs/types-common/src/Data/IdMapping.hs b/libs/types-common/src/Data/IdMapping.hs index 454c17c4b69..9eed06dcd26 100644 --- a/libs/types-common/src/Data/IdMapping.hs +++ b/libs/types-common/src/Data/IdMapping.hs @@ -39,11 +39,10 @@ partitionMappedOrLocalIds = foldMap $ \case Mapped mapping -> (mempty, [mapping]) Local localId -> ([localId], mempty) -data IdMapping a - = IdMapping - { idMappingLocal :: Id (Mapped a), - idMappingGlobal :: Qualified (Id a) - } +data IdMapping a = IdMapping + { idMappingLocal :: Id (Mapped a), + idMappingGlobal :: Qualified (Id a) + } deriving (Show) ---------------------------------------------------------------------- diff --git a/libs/types-common/src/Data/List1.hs b/libs/types-common/src/Data/List1.hs index c4468a1fc5d..12f349f1582 100644 --- a/libs/types-common/src/Data/List1.hs +++ b/libs/types-common/src/Data/List1.hs @@ -28,10 +28,9 @@ import qualified Data.List.NonEmpty as N import qualified Data.Vector as V import Imports -newtype List1 a - = List1 - { toNonEmpty :: NonEmpty a - } +newtype List1 a = List1 + { toNonEmpty :: NonEmpty a + } deriving ( Monad, Functor, diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index 1f5b129f2d5..08e5944e6a5 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -96,10 +96,9 @@ instance Read IpAddr where instance NFData IpAddr where rnf (IpAddr a) = seq a () -newtype Port - = Port - { portNumber :: Word16 - } +newtype Port = Port + { portNumber :: Word16 + } deriving (Eq, Ord, Show, Real, Enum, Num, Integral, NFData, Generic) instance Read Port where @@ -123,11 +122,10 @@ instance FromJSON Port where -------------------------------------------------------------------------------- -- Location -data Location - = Location - { _latitude :: !Double, - _longitude :: !Double - } +data Location = Location + { _latitude :: !Double, + _longitude :: !Double + } deriving (Eq, Ord, Generic) instance Show Location where @@ -177,10 +175,9 @@ instance Cql Longitude where -------------------------------------------------------------------------------- -- Time -newtype Milliseconds - = Ms - { ms :: Word64 - } +newtype Milliseconds = Ms + { ms :: Word64 + } deriving (Eq, Ord, Show, Num, Generic) -- | Convert milliseconds to 'Int64', with clipping if it doesn't fit. @@ -207,10 +204,9 @@ instance Cql Milliseconds where -------------------------------------------------------------------------------- -- HttpsUrl -newtype HttpsUrl - = HttpsUrl - { httpsUrl :: URIRef Absolute - } +newtype HttpsUrl = HttpsUrl + { httpsUrl :: URIRef Absolute + } deriving (Eq, Generic) mkHttpsUrl :: URIRef Absolute -> Either String HttpsUrl @@ -249,10 +245,9 @@ instance Cql HttpsUrl where -- Tag for Rsa encoded fingerprints data Rsa -newtype Fingerprint a - = Fingerprint - { fingerprintBytes :: ByteString - } +newtype Fingerprint a = Fingerprint + { fingerprintBytes :: ByteString + } deriving (Eq, Show, FromByteString, ToByteString, NFData, Generic) instance FromJSON (Fingerprint Rsa) where @@ -273,9 +268,8 @@ instance Cql (Fingerprint a) where -------------------------------------------------------------------------------- -- Password -newtype PlainTextPassword - = PlainTextPassword - {fromPlainTextPassword :: Text} +newtype PlainTextPassword = PlainTextPassword + {fromPlainTextPassword :: Text} deriving (Eq, ToJSON, Generic) instance Show PlainTextPassword where diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 128ca71a8d0..117971f3403 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -52,11 +52,10 @@ import Test.QuickCheck (Arbitrary (arbitrary)) ---------------------------------------------------------------------- -- OPTIONALLY QUALIFIED -data OptionallyQualified a - = OptionallyQualified - { _oqLocalPart :: a, - _oqDomain :: Maybe Domain - } +data OptionallyQualified a = OptionallyQualified + { _oqLocalPart :: a, + _oqDomain :: Maybe Domain + } deriving (Eq, Show) unqualified :: a -> OptionallyQualified a @@ -89,11 +88,10 @@ instance FromByteString (OptionallyQualified Handle) where ---------------------------------------------------------------------- -- QUALIFIED -data Qualified a - = Qualified - { _qLocalPart :: a, - _qDomain :: Domain - } +data Qualified a = Qualified + { _qLocalPart :: a, + _qDomain :: Domain + } deriving (Eq, Show, Generic) renderQualified :: (a -> Text) -> Qualified a -> Text diff --git a/libs/types-common/src/Data/Range.hs b/libs/types-common/src/Data/Range.hs index 645be3d1630..8d404031a40 100644 --- a/libs/types-common/src/Data/Range.hs +++ b/libs/types-common/src/Data/Range.hs @@ -77,10 +77,9 @@ import Test.QuickCheck (Gen, choose) ----------------------------------------------------------------------------- -newtype Range (n :: Nat) (m :: Nat) a - = Range - { fromRange :: a - } +newtype Range (n :: Nat) (m :: Nat) a = Range + { fromRange :: a + } deriving (Eq, Ord, Show) instance NFData (Range n m a) where rnf (Range a) = seq a () diff --git a/libs/types-common/src/Util/Options.hs b/libs/types-common/src/Util/Options.hs index 6a166265c10..bcf8d315e60 100644 --- a/libs/types-common/src/Util/Options.hs +++ b/libs/types-common/src/Util/Options.hs @@ -37,12 +37,11 @@ import System.IO (hPutStrLn, stderr) import URI.ByteString import Util.Options.Common -data AWSEndpoint - = AWSEndpoint - { _awsHost :: !ByteString, - _awsSecure :: !Bool, - _awsPort :: !Int - } +data AWSEndpoint = AWSEndpoint + { _awsHost :: !ByteString, + _awsSecure :: !Bool, + _awsPort :: !Int + } deriving (Eq, Show) instance FromByteString AWSEndpoint where @@ -77,22 +76,20 @@ urlPort u = do makeLenses ''AWSEndpoint -data Endpoint - = Endpoint - { _epHost :: !Text, - _epPort :: !Word16 - } +data Endpoint = Endpoint + { _epHost :: !Text, + _epPort :: !Word16 + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Endpoint makeLenses ''Endpoint -data CassandraOpts - = CassandraOpts - { _casEndpoint :: !Endpoint, - _casKeyspace :: !Text - } +data CassandraOpts = CassandraOpts + { _casEndpoint :: !Endpoint, + _casKeyspace :: !Text + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''CassandraOpts diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs index c7ded3aa812..799e8cefceb 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs @@ -26,12 +26,11 @@ import Data.Text.Lazy.Encoding (decodeUtf8) import Imports import Network.HTTP.Types -data Error - = Error - { code :: !Status, - label :: !LText, - message :: !LText - } +data Error = Error + { code :: !Status, + label :: !LText, + message :: !LText + } deriving (Show, Typeable) instance Exception Error diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 03671801e69..ff3965477f2 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -83,14 +83,13 @@ import qualified System.Posix.Signals as Sig -------------------------------------------------------------------------------- -- Server Setup -data Server - = Server - { serverHost :: String, - serverPort :: Word16, - serverLogger :: Logger, - serverMetrics :: Metrics, - serverTimeout :: Maybe Int - } +data Server = Server + { serverHost :: String, + serverPort :: Word16, + serverLogger :: Logger, + serverMetrics :: Metrics, + serverTimeout :: Maybe Int + } defaultServer :: String -> Word16 -> Logger -> Metrics -> Server defaultServer h p l m = Server h p l m Nothing diff --git a/libs/zauth/main/Main.hs b/libs/zauth/main/Main.hs index 61cff33e7bf..5c58885a800 100644 --- a/libs/zauth/main/Main.hs +++ b/libs/zauth/main/Main.hs @@ -52,14 +52,13 @@ data Mode | GenKeyPair deriving (Eq, Show, Enum) -data ZOpts - = ZOpts - { _dur :: !Integer, - _skey :: !ByteString, - _idx :: !Int, - _mode :: !Mode, - _dat :: [ByteString] - } +data ZOpts = ZOpts + { _dur :: !Integer, + _skey :: !ByteString, + _idx :: !Int, + _mode :: !Mode, + _dat :: [ByteString] + } deriving (Eq, Show) makeLenses ''ZOpts diff --git a/libs/zauth/src/Data/ZAuth/Creation.hs b/libs/zauth/src/Data/ZAuth/Creation.hs index 233f76c7d3b..389e6b38a8b 100644 --- a/libs/zauth/src/Data/ZAuth/Creation.hs +++ b/libs/zauth/src/Data/ZAuth/Creation.hs @@ -60,17 +60,15 @@ import Imports import Sodium.Crypto.Sign import System.Random.MWC -data Env - = Env - { keyIdx :: Int, - zSign :: Vector (Strict.ByteString -> IO Signature), - randGen :: GenIO - } - -newtype Create a - = Create - { zauth :: ReaderT Env IO a - } +data Env = Env + { keyIdx :: Int, + zSign :: Vector (Strict.ByteString -> IO Signature), + randGen :: GenIO + } + +newtype Create a = Create + { zauth :: ReaderT Env IO a + } deriving ( Functor, Applicative, diff --git a/libs/zauth/src/Data/ZAuth/Token.hs b/libs/zauth/src/Data/ZAuth/Token.hs index 85fc7dff4e3..45b1772917d 100644 --- a/libs/zauth/src/Data/ZAuth/Token.hs +++ b/libs/zauth/src/Data/ZAuth/Token.hs @@ -105,66 +105,58 @@ data Type -- FUTUREWORK: rename 'S' to 'SessionTag' for clarity data Tag = S deriving (Eq, Show) -data Token a - = Token - { _signature :: !Signature, - _header :: !Header, - _body :: !a - } +data Token a = Token + { _signature :: !Signature, + _header :: !Header, + _body :: !a + } deriving (Eq, Show) -- FUTUREWORK: maybe refactor to -- data Header (t :: Type) = -- Header { ... everything except _typ ...} ? -data Header - = Header - { _version :: !Int, - _key :: !Int, - _time :: !Integer, - _typ :: !Type, - _tag :: Maybe Tag - } +data Header = Header + { _version :: !Int, + _key :: !Int, + _time :: !Integer, + _typ :: !Type, + _tag :: Maybe Tag + } deriving (Eq, Show) -data Access - = Access - { _userId :: !UUID, - -- | 'ConnId' is derived from this. - _connection :: !Word64 - } +data Access = Access + { _userId :: !UUID, + -- | 'ConnId' is derived from this. + _connection :: !Word64 + } deriving (Eq, Show) -data User - = User - { _user :: !UUID, - _rand :: !Word32 - } +data User = User + { _user :: !UUID, + _rand :: !Word32 + } deriving (Eq, Show) -data Bot - = Bot - { _prov :: !UUID, - _bot :: !UUID, - _conv :: !UUID - } +data Bot = Bot + { _prov :: !UUID, + _bot :: !UUID, + _conv :: !UUID + } deriving (Eq, Show) -newtype Provider - = Provider - { _provider :: UUID - } +newtype Provider = Provider + { _provider :: UUID + } deriving (Eq, Show) -newtype LegalHoldUser - = LegalHoldUser - { _legalHoldUser :: User - } +newtype LegalHoldUser = LegalHoldUser + { _legalHoldUser :: User + } deriving (Eq, Show) -newtype LegalHoldAccess - = LegalHoldAccess - { _legalHoldAccess :: Access - } +newtype LegalHoldAccess = LegalHoldAccess + { _legalHoldAccess :: Access + } deriving (Eq, Show) type Properties = [(LByteString, LByteString)] diff --git a/libs/zauth/src/Data/ZAuth/Validation.hs b/libs/zauth/src/Data/ZAuth/Validation.hs index 71d29dcccf0..ae2812ba5e4 100644 --- a/libs/zauth/src/Data/ZAuth/Validation.hs +++ b/libs/zauth/src/Data/ZAuth/Validation.hs @@ -56,14 +56,12 @@ data Failure instance Exception Failure -newtype Env - = Env - {verifyFns :: Vector (Signature -> Strict.ByteString -> IO Bool)} - -newtype Validate a - = Validate - { valid :: ExceptT Failure (ReaderT Env IO) a - } +newtype Env = Env + {verifyFns :: Vector (Signature -> Strict.ByteString -> IO Bool)} + +newtype Validate a = Validate + { valid :: ExceptT Failure (ReaderT Env IO) a + } deriving ( Functor, Applicative, diff --git a/services/brig/index/src/Brig/Index/Migrations/Types.hs b/services/brig/index/src/Brig/Index/Migrations/Types.hs index 56f18dc7e64..790fa033b87 100644 --- a/services/brig/index/src/Brig/Index/Migrations/Types.hs +++ b/services/brig/index/src/Brig/Index/Migrations/Types.hs @@ -32,12 +32,11 @@ import Numeric.Natural (Natural) import qualified System.Logger as Logger import System.Logger.Class (MonadLogger (..)) -data Migration - = Migration - { version :: MigrationVersion, - text :: Text, - action :: MigrationActionT IO () - } +data Migration = Migration + { version :: MigrationVersion, + text :: Text, + action :: MigrationActionT IO () + } newtype MigrationVersion = MigrationVersion {migrationVersion :: Natural} deriving (Show, Eq, Ord) @@ -48,8 +47,7 @@ instance ToJSON MigrationVersion where instance FromJSON MigrationVersion where parseJSON = withObject "MigrationVersion" $ \o -> MigrationVersion <$> o .: "migration_version" -newtype MigrationActionT m a - = MigrationActionT {unMigrationAction :: ReaderT Env m a} +newtype MigrationActionT m a = MigrationActionT {unMigrationAction :: ReaderT Env m a} deriving ( Functor, Applicative, @@ -80,14 +78,13 @@ instance MonadIO m => Search.MonadIndexIO (MigrationActionT m) where instance MonadIO m => ES.MonadBH (MigrationActionT m) where getBHEnv = bhEnv <$> ask -data Env - = Env - { bhEnv :: ES.BHEnv, - cassandraClientState :: C.ClientState, - logger :: Logger.Logger, - metrics :: Metrics, - searchIndex :: ES.IndexName - } +data Env = Env + { bhEnv :: ES.BHEnv, + cassandraClientState :: C.ClientState, + logger :: Logger.Logger, + metrics :: Metrics, + searchIndex :: ES.IndexName + } runMigrationAction :: Env -> MigrationActionT m a -> m a runMigrationAction env action = diff --git a/services/brig/index/src/Brig/Index/Options.hs b/services/brig/index/src/Brig/Index/Options.hs index a4ab48e59f6..a7992a49d14 100644 --- a/services/brig/index/src/Brig/Index/Options.hs +++ b/services/brig/index/src/Brig/Index/Options.hs @@ -59,22 +59,20 @@ data Command | Migrate ElasticSettings CassandraSettings deriving (Show) -data ElasticSettings - = ElasticSettings - { _esServer :: URIRef Absolute, - _esIndex :: ES.IndexName, - _esIndexShardCount :: Int, - _esIndexReplicas :: ES.ReplicaCount, - _esIndexRefreshInterval :: NominalDiffTime - } +data ElasticSettings = ElasticSettings + { _esServer :: URIRef Absolute, + _esIndex :: ES.IndexName, + _esIndexShardCount :: Int, + _esIndexReplicas :: ES.ReplicaCount, + _esIndexRefreshInterval :: NominalDiffTime + } deriving (Show) -data CassandraSettings - = CassandraSettings - { _cHost :: String, - _cPort :: Word16, - _cKeyspace :: C.Keyspace - } +data CassandraSettings = CassandraSettings + { _cHost :: String, + _cPort :: Word16, + _cKeyspace :: C.Keyspace + } deriving (Show) makeLenses ''ElasticSettings diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 9f2088b28e2..ef381afbebc 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -41,29 +41,27 @@ import Brig.Types.Code (Timeout) import Brig.Types.Intra import Brig.User.Auth.Cookie (RetryAfter (..)) import Data.Id -import qualified Network.Wai.Utilities.Error as Wai import Imports +import qualified Network.Wai.Utilities.Error as Wai ------------------------------------------------------------------------------- -- Successes -data CreateUserResult - = CreateUserResult - { -- | The newly created user account. - createdAccount :: !UserAccount, - -- | Activation data for the registered email address, if any. - createdEmailActivation :: !(Maybe Activation), - -- | Activation data for the registered phone number, if any. - createdPhoneActivation :: !(Maybe Activation), - -- | Info of a team just created/joined - createdUserTeam :: !(Maybe CreateUserTeam) - } - -data CreateUserTeam - = CreateUserTeam - { createdTeamId :: !TeamId, - createdTeamName :: !Text - } +data CreateUserResult = CreateUserResult + { -- | The newly created user account. + createdAccount :: !UserAccount, + -- | Activation data for the registered email address, if any. + createdEmailActivation :: !(Maybe Activation), + -- | Activation data for the registered phone number, if any. + createdPhoneActivation :: !(Maybe Activation), + -- | Info of a team just created/joined + createdUserTeam :: !(Maybe CreateUserTeam) + } + +data CreateUserTeam = CreateUserTeam + { createdTeamId :: !TeamId, + createdTeamName :: !Text + } data ConnectionResult = ConnectionCreated !UserConnection diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index c7ea60b7d09..d28f0e0d919 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -238,7 +238,9 @@ createUser new@NewUser {..} = do handleTeam :: Maybe NewTeamUser -> Maybe UserKey -> - ExceptT CreateUserError AppIO + ExceptT + CreateUserError + AppIO ( Maybe BindingNewTeamUser, Maybe (Team.Invitation, Team.InvitationInfo), Maybe TeamId diff --git a/services/brig/src/Brig/AWS.hs b/services/brig/src/Brig/AWS.hs index a5cd283af46..14d6b02ef18 100644 --- a/services/brig/src/Brig/AWS.hs +++ b/services/brig/src/Brig/AWS.hs @@ -76,21 +76,19 @@ import UnliftIO.Async import UnliftIO.Exception import Util.Options -data Env - = Env - { _logger :: !Logger, - _sesQueue :: !(Maybe Text), - _userJournalQueue :: !(Maybe Text), - _prekeyTable :: !Text, - _amazonkaEnv :: !AWS.Env - } +data Env = Env + { _logger :: !Logger, + _sesQueue :: !(Maybe Text), + _userJournalQueue :: !(Maybe Text), + _prekeyTable :: !Text, + _amazonkaEnv :: !AWS.Env + } makeLenses ''Env -newtype Amazon a - = Amazon - { unAmazon :: ReaderT Env (ResourceT IO) a - } +newtype Amazon a = Amazon + { unAmazon :: ReaderT Env (ResourceT IO) a + } deriving ( Functor, Applicative, diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 394bcf41b4b..acc1de65979 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -132,38 +132,37 @@ schemaVersion = 58 ------------------------------------------------------------------------------- -- Environment -data Env - = Env - { _cargohold :: RPC.Request, - _galley :: RPC.Request, - _gundeck :: RPC.Request, - _casClient :: Cas.ClientState, - _smtpEnv :: Maybe SMTP.SMTP, - _awsEnv :: AWS.Env, - _stompEnv :: Maybe Stomp.Env, - _metrics :: Metrics, - _applog :: Logger, - _internalEvents :: Queue, - _requestId :: RequestId, - _usrTemplates :: Localised UserTemplates, - _provTemplates :: Localised ProviderTemplates, - _tmTemplates :: Localised TeamTemplates, - _templateBranding :: TemplateBranding, - _httpManager :: Manager, - _extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()), - _settings :: Settings, - _nexmoCreds :: Nexmo.Credentials, - _twilioCreds :: Twilio.Credentials, - _geoDb :: Maybe (IORef GeoIp.GeoDB), - _fsWatcher :: FS.WatchManager, - _turnEnv :: IORef TURN.Env, - _turnEnvV2 :: IORef TURN.Env, - _currentTime :: IO UTCTime, - _zauthEnv :: ZAuth.Env, - _digestSHA256 :: Digest, - _digestMD5 :: Digest, - _indexEnv :: IndexEnv - } +data Env = Env + { _cargohold :: RPC.Request, + _galley :: RPC.Request, + _gundeck :: RPC.Request, + _casClient :: Cas.ClientState, + _smtpEnv :: Maybe SMTP.SMTP, + _awsEnv :: AWS.Env, + _stompEnv :: Maybe Stomp.Env, + _metrics :: Metrics, + _applog :: Logger, + _internalEvents :: Queue, + _requestId :: RequestId, + _usrTemplates :: Localised UserTemplates, + _provTemplates :: Localised ProviderTemplates, + _tmTemplates :: Localised TeamTemplates, + _templateBranding :: TemplateBranding, + _httpManager :: Manager, + _extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()), + _settings :: Settings, + _nexmoCreds :: Nexmo.Credentials, + _twilioCreds :: Twilio.Credentials, + _geoDb :: Maybe (IORef GeoIp.GeoDB), + _fsWatcher :: FS.WatchManager, + _turnEnv :: IORef TURN.Env, + _turnEnvV2 :: IORef TURN.Env, + _currentTime :: IO UTCTime, + _zauthEnv :: ZAuth.Env, + _digestSHA256 :: Digest, + _digestMD5 :: Digest, + _indexEnv :: IndexEnv + } makeLenses ''Env @@ -413,10 +412,9 @@ closeEnv e = do ------------------------------------------------------------------------------- -- App Monad -newtype AppT m a - = AppT - { unAppT :: ReaderT Env m a - } +newtype AppT m a = AppT + { unAppT :: ReaderT Env m a + } deriving newtype ( Functor, Applicative, diff --git a/services/brig/src/Brig/Budget.hs b/services/brig/src/Brig/Budget.hs index 54c601eea3d..38be47e7011 100644 --- a/services/brig/src/Brig/Budget.hs +++ b/services/brig/src/Brig/Budget.hs @@ -32,11 +32,10 @@ import Cassandra import Data.Time.Clock import Imports -data Budget - = Budget - { budgetTimeout :: !NominalDiffTime, - budgetValue :: !Int32 - } +data Budget = Budget + { budgetTimeout :: !NominalDiffTime, + budgetValue :: !Int32 + } deriving (Eq, Show, Generic) data Budgeted a diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs index 428b8947790..e2e091bea9c 100644 --- a/services/brig/src/Brig/Code.hs +++ b/services/brig/src/Brig/Code.hs @@ -77,16 +77,15 @@ import Text.Printf (printf) -------------------------------------------------------------------------------- -- Code -data Code - = Code - { codeKey :: !Key, - codeScope :: !Scope, - codeValue :: !Value, - codeRetries :: !Retries, - codeTTL :: !Timeout, - codeFor :: !CodeFor, - codeAccount :: !(Maybe UUID) - } +data Code = Code + { codeKey :: !Key, + codeScope :: !Scope, + codeValue :: !Value, + codeRetries :: !Retries, + codeTTL :: !Timeout, + codeFor :: !CodeFor, + codeAccount :: !(Maybe UUID) + } deriving (Eq, Show) data CodeFor @@ -145,12 +144,11 @@ instance Cql Retries where -- | A contextual string that is hashed into the key to yield distinct keys in -- different contexts for the same email address or phone number. -- TODO: newtype KeyContext = KeyContext ByteString -data Gen - = Gen - { genFor :: !CodeFor, - genKey :: !Key, -- Note [Unique keys] - genValue :: IO Value - } +data Gen = Gen + { genFor :: !CodeFor, + genKey :: !Key, -- Note [Unique keys] + genValue :: IO Value + } -- | Initialise a 'Code' 'Gen'erator for a given natural key. mkGen :: MonadIO m => CodeFor -> m Gen diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index 837c4bd1e58..027a8462d78 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -50,13 +50,12 @@ import OpenSSL.EVP.Digest (digestBS, getDigestByName) import Text.Printf (printf) -- | The information associated with the pending activation of a 'UserKey'. -data Activation - = Activation - { -- | An opaque key for the original 'UserKey' pending activation. - activationKey :: !ActivationKey, - -- | The confidential activation code. - activationCode :: !ActivationCode - } +data Activation = Activation + { -- | An opaque key for the original 'UserKey' pending activation. + activationKey :: !ActivationKey, + -- | The confidential activation code. + activationCode :: !ActivationCode + } deriving (Eq) data ActivationError diff --git a/services/brig/src/Brig/Email.hs b/services/brig/src/Brig/Email.hs index ce886892926..648917af983 100644 --- a/services/brig/src/Brig/Email.hs +++ b/services/brig/src/Brig/Email.hs @@ -91,11 +91,10 @@ validateEmail (fromEmail -> e) = -- Unique Keys -- | An 'EmailKey' is an 'Email' in a form that serves as a unique lookup key. -data EmailKey - = EmailKey - { emailKeyUniq :: !Text, - emailKeyOrig :: !Email - } +data EmailKey = EmailKey + { emailKeyUniq :: !Text, + emailKeyOrig :: !Email + } instance Show EmailKey where showsPrec _ = shows . emailKeyUniq diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 6ac48ae87f9..aa56344d5f1 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -683,7 +683,7 @@ checkUserCanJoinTeam tid = do rs <- galleyRequest GET req return $ case Bilge.statusCode rs of 200 -> Nothing - _ -> case decodeBody "galley" rs of + _ -> case decodeBody "galley" rs of Just (e :: Wai.Error) -> return e Nothing -> error ("Invalid response from galley: " <> show rs) where diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 1c0eff02e5e..927fa05891e 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -39,10 +39,9 @@ import Imports import System.Logger.Extended (Level, LogFormat) import Util.Options -newtype Timeout - = Timeout - { timeoutDiff :: NominalDiffTime - } +newtype Timeout = Timeout + { timeoutDiff :: NominalDiffTime + } deriving newtype (Eq, Enum, Ord, Num, Real, Fractional, RealFrac, Show) instance Read Timeout where @@ -51,169 +50,157 @@ instance Read Timeout where [(x :: Int, s')] -> [(Timeout (fromIntegral x), s')] _ -> [] -data ElasticSearchOpts - = ElasticSearchOpts - { -- | ElasticSearch URL - url :: !Text, - -- | The name of the ElasticSearch user index - index :: !Text - } +data ElasticSearchOpts = ElasticSearchOpts + { -- | ElasticSearch URL + url :: !Text, + -- | The name of the ElasticSearch user index + index :: !Text + } deriving (Show, Generic) instance FromJSON ElasticSearchOpts -data AWSOpts - = AWSOpts - { -- | Event journal queue for user events - -- (e.g. user deletion) - userJournalQueue :: !(Maybe Text), - -- | Dynamo table for storing prekey data - prekeyTable :: !Text, - -- | AWS SQS endpoint - sqsEndpoint :: !AWSEndpoint, - -- | DynamoDB endpoint - dynamoDBEndpoint :: !AWSEndpoint - } +data AWSOpts = AWSOpts + { -- | Event journal queue for user events + -- (e.g. user deletion) + userJournalQueue :: !(Maybe Text), + -- | Dynamo table for storing prekey data + prekeyTable :: !Text, + -- | AWS SQS endpoint + sqsEndpoint :: !AWSEndpoint, + -- | DynamoDB endpoint + dynamoDBEndpoint :: !AWSEndpoint + } deriving (Show, Generic) instance FromJSON AWSOpts -data EmailAWSOpts - = EmailAWSOpts - { -- | Event feedback queue for SES - -- (e.g. for email bounces and complaints) - sesQueue :: !Text, - -- | AWS SES endpoint - sesEndpoint :: !AWSEndpoint - } +data EmailAWSOpts = EmailAWSOpts + { -- | Event feedback queue for SES + -- (e.g. for email bounces and complaints) + sesQueue :: !Text, + -- | AWS SES endpoint + sesEndpoint :: !AWSEndpoint + } deriving (Show, Generic) instance FromJSON EmailAWSOpts -data EmailSMTPCredentials - = EmailSMTPCredentials - { -- | Username to authenticate - -- against the SMTP server - smtpUsername :: !Text, - -- | File containing password to - -- authenticate against the SMTP server - smtpPassword :: !FilePathSecrets - } +data EmailSMTPCredentials = EmailSMTPCredentials + { -- | Username to authenticate + -- against the SMTP server + smtpUsername :: !Text, + -- | File containing password to + -- authenticate against the SMTP server + smtpPassword :: !FilePathSecrets + } deriving (Show, Generic) instance FromJSON EmailSMTPCredentials -data EmailSMTPOpts - = EmailSMTPOpts - { -- | Hostname of the SMTP server to connect to - smtpEndpoint :: !Endpoint, - smtpCredentials :: !(Maybe EmailSMTPCredentials), - -- | Which type of connection to use - -- against the SMTP server {tls,ssl,plain} - smtpConnType :: !SMTPConnType - } +data EmailSMTPOpts = EmailSMTPOpts + { -- | Hostname of the SMTP server to connect to + smtpEndpoint :: !Endpoint, + smtpCredentials :: !(Maybe EmailSMTPCredentials), + -- | Which type of connection to use + -- against the SMTP server {tls,ssl,plain} + smtpConnType :: !SMTPConnType + } deriving (Show, Generic) instance FromJSON EmailSMTPOpts -data StompOpts - = StompOpts - { stompHost :: !Text, - stompPort :: !Int, - stompTls :: !Bool - } +data StompOpts = StompOpts + { stompHost :: !Text, + stompPort :: !Int, + stompTls :: !Bool + } deriving (Show, Generic) instance FromJSON StompOpts -data InternalEventsOpts - = InternalEventsOpts - { internalEventsQueue :: !Queue - } +data InternalEventsOpts = InternalEventsOpts + { internalEventsQueue :: !Queue + } deriving (Show) instance FromJSON InternalEventsOpts where parseJSON = Y.withObject "InternalEventsOpts" $ \o -> InternalEventsOpts <$> parseJSON (Y.Object o) -data EmailSMSGeneralOpts - = EmailSMSGeneralOpts - { -- | Email, SMS, ... template directory - templateDir :: !FilePath, - -- | Email sender address - emailSender :: !Email, - -- | Twilio sender identifier (number or - -- messaging service ID) - smsSender :: !Text, - -- | Customizable branding text for - -- emails/sms/calls - templateBranding :: !BrandingOpts - } +data EmailSMSGeneralOpts = EmailSMSGeneralOpts + { -- | Email, SMS, ... template directory + templateDir :: !FilePath, + -- | Email sender address + emailSender :: !Email, + -- | Twilio sender identifier (number or + -- messaging service ID) + smsSender :: !Text, + -- | Customizable branding text for + -- emails/sms/calls + templateBranding :: !BrandingOpts + } deriving (Show, Generic) instance FromJSON EmailSMSGeneralOpts -data BrandingOpts - = BrandingOpts - { brand :: !Text, - brandUrl :: !Text, - brandLabelUrl :: !Text, - brandLogoUrl :: !Text, - brandService :: !Text, - copyright :: !Text, - misuse :: !Text, - legal :: !Text, - forgot :: !Text, - support :: !Text - } +data BrandingOpts = BrandingOpts + { brand :: !Text, + brandUrl :: !Text, + brandLabelUrl :: !Text, + brandLogoUrl :: !Text, + brandService :: !Text, + copyright :: !Text, + misuse :: !Text, + legal :: !Text, + forgot :: !Text, + support :: !Text + } deriving (Show, Generic) instance FromJSON BrandingOpts -data EmailUserOpts - = EmailUserOpts - { -- | Activation URL template - activationUrl :: !Text, - -- | SMS activation URL template - smsActivationUrl :: !Text, - -- | Password reset URL template - passwordResetUrl :: !Text, - -- | Deletion URL template - deletionUrl :: !Text - } +data EmailUserOpts = EmailUserOpts + { -- | Activation URL template + activationUrl :: !Text, + -- | SMS activation URL template + smsActivationUrl :: !Text, + -- | Password reset URL template + passwordResetUrl :: !Text, + -- | Deletion URL template + deletionUrl :: !Text + } deriving (Show, Generic) instance FromJSON EmailUserOpts -- | Provider settings -data ProviderOpts - = ProviderOpts - { -- | Homepage URL - homeUrl :: !Text, - -- | Activation URL template - providerActivationUrl :: !Text, - -- | Approval URL template - approvalUrl :: !Text, - -- | Approval email recipient - approvalTo :: !Email, - -- | Password reset URL template - providerPwResetUrl :: !Text - } +data ProviderOpts = ProviderOpts + { -- | Homepage URL + homeUrl :: !Text, + -- | Activation URL template + providerActivationUrl :: !Text, + -- | Approval URL template + approvalUrl :: !Text, + -- | Approval email recipient + approvalTo :: !Email, + -- | Password reset URL template + providerPwResetUrl :: !Text + } deriving (Show, Generic) instance FromJSON ProviderOpts -data TeamOpts - = TeamOpts - { -- | Team Invitation URL template - tInvitationUrl :: !Text, - -- | Team Activation URL template - tActivationUrl :: !Text, - -- | Team Creator Welcome URL - tCreatorWelcomeUrl :: !Text, - -- | Team Member Welcome URL - tMemberWelcomeUrl :: !Text - } +data TeamOpts = TeamOpts + { -- | Team Invitation URL template + tInvitationUrl :: !Text, + -- | Team Activation URL template + tActivationUrl :: !Text, + -- | Team Creator Welcome URL + tCreatorWelcomeUrl :: !Text, + -- | Team Member Welcome URL + tMemberWelcomeUrl :: !Text + } deriving (Show, Generic) instance FromJSON TeamOpts @@ -228,14 +215,13 @@ instance FromJSON EmailOpts where EmailAWS <$> parseJSON o <|> EmailSMTP <$> parseJSON o -data EmailSMSOpts - = EmailSMSOpts - { email :: !EmailOpts, - general :: !EmailSMSGeneralOpts, - user :: !EmailUserOpts, - provider :: !ProviderOpts, - team :: !TeamOpts - } +data EmailSMSOpts = EmailSMSOpts + { email :: !EmailOpts, + general :: !EmailSMSGeneralOpts, + user :: !EmailUserOpts, + provider :: !ProviderOpts, + team :: !TeamOpts + } deriving (Show, Generic) instance FromJSON EmailSMSOpts @@ -247,60 +233,56 @@ instance FromJSON EmailSMSOpts -- -- If in doubt, do not ues retry options and worry about encouraging / enforcing a good -- password policy. -data LimitFailedLogins - = LimitFailedLogins - { -- | Time the user is blocked when retry limit is reached (in - -- seconds mostly for making it easier to write a fast-ish - -- integration test.) - timeout :: !Timeout, - -- | Maximum number of failed login attempts for one user. - retryLimit :: !Int - } +data LimitFailedLogins = LimitFailedLogins + { -- | Time the user is blocked when retry limit is reached (in + -- seconds mostly for making it easier to write a fast-ish + -- integration test.) + timeout :: !Timeout, + -- | Maximum number of failed login attempts for one user. + retryLimit :: !Int + } deriving (Eq, Show, Generic) instance FromJSON LimitFailedLogins -data SuspendInactiveUsers - = SuspendInactiveUsers - { suspendTimeout :: !Timeout - } +data SuspendInactiveUsers = SuspendInactiveUsers + { suspendTimeout :: !Timeout + } deriving (Eq, Show, Generic) instance FromJSON SuspendInactiveUsers -- | ZAuth options -data ZAuthOpts - = ZAuthOpts - { -- | Private key file - privateKeys :: !FilePath, - -- | Public key file - publicKeys :: !FilePath, - -- | Other settings - authSettings :: !ZAuth.Settings - } +data ZAuthOpts = ZAuthOpts + { -- | Private key file + privateKeys :: !FilePath, + -- | Public key file + publicKeys :: !FilePath, + -- | Other settings + authSettings :: !ZAuth.Settings + } deriving (Show, Generic) instance FromJSON ZAuthOpts -- | TURN server options -data TurnOpts - = TurnOpts - { -- | Line separated file with IP addresses of - -- available TURN servers supporting UDP - servers :: !FilePath, - -- | Line separated file with hostnames of all - -- available TURN servers with all protocols - -- and transports - serversV2 :: !FilePath, - -- | TURN shared secret file path - secret :: !FilePath, - -- | For how long TURN credentials should be - -- valid, in seconds - tokenTTL :: !Word32, - -- | How long until a new TURN configuration - -- should be fetched, in seconds - configTTL :: !Word32 - } +data TurnOpts = TurnOpts + { -- | Line separated file with IP addresses of + -- available TURN servers supporting UDP + servers :: !FilePath, + -- | Line separated file with hostnames of all + -- available TURN servers with all protocols + -- and transports + serversV2 :: !FilePath, + -- | TURN shared secret file path + secret :: !FilePath, + -- | For how long TURN credentials should be + -- valid, in seconds + tokenTTL :: !Word32, + -- | How long until a new TURN configuration + -- should be fetched, in seconds + configTTL :: !Word32 + } deriving (Show, Generic) instance FromJSON TurnOpts @@ -334,136 +316,134 @@ instance ToJSON EmailVisibility where toJSON EmailVisibleToSelf = "visible_to_self" -- | Options that are consumed on startup -data Opts - = Opts - -- services - { -- | Host and port to bind to - brig :: !Endpoint, - -- | Cargohold address - cargohold :: !Endpoint, - -- | Galley address - galley :: !Endpoint, - -- | Gundeck address - gundeck :: !Endpoint, - -- external - - -- | Cassandra settings - cassandra :: !CassandraOpts, - -- | ElasticSearch settings - elasticsearch :: !ElasticSearchOpts, - -- | AWS settings - aws :: !AWSOpts, - -- | STOMP broker settings - stomp :: !(Maybe StompOpts), - -- Email & SMS - - -- | Email and SMS settings - emailSMS :: !EmailSMSOpts, - -- ZAuth - - -- | ZAuth settings - zauth :: !ZAuthOpts, - -- Misc. - - -- | Disco URL - discoUrl :: !(Maybe Text), - -- | GeoDB file path - geoDb :: !(Maybe FilePath), - -- | Event queue for - -- Brig-generated events (e.g. - -- user deletion) - internalEvents :: !InternalEventsOpts, - -- Logging - - -- | Log level (Debug, Info, etc) - logLevel :: !Level, - -- | Use netstrings encoding (see - -- ) - logNetStrings :: !(Maybe (Last Bool)), - -- | Logformat to use - -- TURN - logFormat :: !(Maybe (Last LogFormat)), - -- | TURN server settings - turn :: !TurnOpts, - -- Runtime settings - - -- | Runtime settings - optSettings :: !Settings - } +data Opts = Opts + -- services + { -- | Host and port to bind to + brig :: !Endpoint, + -- | Cargohold address + cargohold :: !Endpoint, + -- | Galley address + galley :: !Endpoint, + -- | Gundeck address + gundeck :: !Endpoint, + -- external + + -- | Cassandra settings + cassandra :: !CassandraOpts, + -- | ElasticSearch settings + elasticsearch :: !ElasticSearchOpts, + -- | AWS settings + aws :: !AWSOpts, + -- | STOMP broker settings + stomp :: !(Maybe StompOpts), + -- Email & SMS + + -- | Email and SMS settings + emailSMS :: !EmailSMSOpts, + -- ZAuth + + -- | ZAuth settings + zauth :: !ZAuthOpts, + -- Misc. + + -- | Disco URL + discoUrl :: !(Maybe Text), + -- | GeoDB file path + geoDb :: !(Maybe FilePath), + -- | Event queue for + -- Brig-generated events (e.g. + -- user deletion) + internalEvents :: !InternalEventsOpts, + -- Logging + + -- | Log level (Debug, Info, etc) + logLevel :: !Level, + -- | Use netstrings encoding (see + -- ) + logNetStrings :: !(Maybe (Last Bool)), + -- | Logformat to use + -- TURN + logFormat :: !(Maybe (Last LogFormat)), + -- | TURN server settings + turn :: !TurnOpts, + -- Runtime settings + + -- | Runtime settings + optSettings :: !Settings + } deriving (Show, Generic) -- | Options that persist as runtime settings. -data Settings - = Settings - { -- | Activation timeout, in seconds - setActivationTimeout :: !Timeout, - -- | Team invitation timeout, in seconds - setTeamInvitationTimeout :: !Timeout, - -- | Twilio credentials - setTwilio :: !FilePathSecrets, - -- | Nexmo credentials - setNexmo :: !FilePathSecrets, - -- | STOMP broker credentials - setStomp :: !(Maybe FilePathSecrets), - -- | Whitelist of allowed emails/phones - setWhitelist :: !(Maybe Whitelist), - -- | Max. number of sent/accepted - -- connections per user - setUserMaxConnections :: !Int64, - -- | Max. number of permanent clients per user - setUserMaxPermClients :: !(Maybe Int), - -- | The domain to restrict cookies to - setCookieDomain :: !Text, - -- | Whether to allow plain HTTP transmission - -- of cookies (for testing purposes only) - setCookieInsecure :: !Bool, - -- | Minimum age of a user cookie before - -- it is renewed during token refresh - setUserCookieRenewAge :: !Integer, - -- | Max. # of cookies per user and cookie type - setUserCookieLimit :: !Int, - -- | Throttling settings (not to be confused - -- with 'LoginRetryOpts') - setUserCookieThrottle :: !CookieThrottle, - -- | Block user from logging in - -- for m minutes after n failed - -- logins - setLimitFailedLogins :: !(Maybe LimitFailedLogins), - -- | If last cookie renewal is too long ago, - -- suspend the user. - setSuspendInactiveUsers :: !(Maybe SuspendInactiveUsers), - -- | Max size of rich info (number of chars in - -- field names and values), should be in sync - -- with Spar - setRichInfoLimit :: !Int, - -- | Default locale to use - -- (e.g. when selecting templates) - setDefaultLocale :: !Locale, - -- | Max. # of members in a team. - -- NOTE: This must be in sync with galley - setMaxTeamSize :: !Word16, - -- | Max. # of members in a conversation. - -- NOTE: This must be in sync with galley - setMaxConvSize :: !Word16, - -- | Filter ONLY services with - -- the given provider id - setProviderSearchFilter :: !(Maybe ProviderId), - -- | Whether to expose user emails and to whom - setEmailVisibility :: !EmailVisibility, - setPropertyMaxKeyLen :: !(Maybe Int64), - setPropertyMaxValueLen :: !(Maybe Int64), - -- | How long, in milliseconds, to wait - -- in between processing delete events - -- from the internal delete queue - setDeleteThrottleMillis :: !(Maybe Int), - -- | When true, search only - -- returns users from the same team - setSearchSameTeamOnly :: !(Maybe Bool), - -- | When false, assume there are no other backends and IDs are always local. - -- This means we don't run any queries on federation-related tables and don't - -- make any calls to the federator service. - setEnableFederation :: !(Maybe Bool) - } +data Settings = Settings + { -- | Activation timeout, in seconds + setActivationTimeout :: !Timeout, + -- | Team invitation timeout, in seconds + setTeamInvitationTimeout :: !Timeout, + -- | Twilio credentials + setTwilio :: !FilePathSecrets, + -- | Nexmo credentials + setNexmo :: !FilePathSecrets, + -- | STOMP broker credentials + setStomp :: !(Maybe FilePathSecrets), + -- | Whitelist of allowed emails/phones + setWhitelist :: !(Maybe Whitelist), + -- | Max. number of sent/accepted + -- connections per user + setUserMaxConnections :: !Int64, + -- | Max. number of permanent clients per user + setUserMaxPermClients :: !(Maybe Int), + -- | The domain to restrict cookies to + setCookieDomain :: !Text, + -- | Whether to allow plain HTTP transmission + -- of cookies (for testing purposes only) + setCookieInsecure :: !Bool, + -- | Minimum age of a user cookie before + -- it is renewed during token refresh + setUserCookieRenewAge :: !Integer, + -- | Max. # of cookies per user and cookie type + setUserCookieLimit :: !Int, + -- | Throttling settings (not to be confused + -- with 'LoginRetryOpts') + setUserCookieThrottle :: !CookieThrottle, + -- | Block user from logging in + -- for m minutes after n failed + -- logins + setLimitFailedLogins :: !(Maybe LimitFailedLogins), + -- | If last cookie renewal is too long ago, + -- suspend the user. + setSuspendInactiveUsers :: !(Maybe SuspendInactiveUsers), + -- | Max size of rich info (number of chars in + -- field names and values), should be in sync + -- with Spar + setRichInfoLimit :: !Int, + -- | Default locale to use + -- (e.g. when selecting templates) + setDefaultLocale :: !Locale, + -- | Max. # of members in a team. + -- NOTE: This must be in sync with galley + setMaxTeamSize :: !Word16, + -- | Max. # of members in a conversation. + -- NOTE: This must be in sync with galley + setMaxConvSize :: !Word16, + -- | Filter ONLY services with + -- the given provider id + setProviderSearchFilter :: !(Maybe ProviderId), + -- | Whether to expose user emails and to whom + setEmailVisibility :: !EmailVisibility, + setPropertyMaxKeyLen :: !(Maybe Int64), + setPropertyMaxValueLen :: !(Maybe Int64), + -- | How long, in milliseconds, to wait + -- in between processing delete events + -- from the internal delete queue + setDeleteThrottleMillis :: !(Maybe Int), + -- | When true, search only + -- returns users from the same team + setSearchSameTeamOnly :: !(Maybe Bool), + -- | When false, assume there are no other backends and IDs are always local. + -- This means we don't run any queries on federation-related tables and don't + -- make any calls to the federator service. + setEnableFederation :: !(Maybe Bool) + } deriving (Show, Generic) defMaxKeyLen :: Int64 diff --git a/services/brig/src/Brig/Password.hs b/services/brig/src/Brig/Password.hs index 5c8faa0d7cd..1b782ac74c6 100644 --- a/services/brig/src/Brig/Password.hs +++ b/services/brig/src/Brig/Password.hs @@ -33,9 +33,8 @@ import Imports import OpenSSL.Random (randBytes) -- | A derived, stretched password that can be safely stored. -newtype Password - = Password - {fromPassword :: EncryptedPass} +newtype Password = Password + {fromPassword :: EncryptedPass} instance Show Password where show _ = "" diff --git a/services/brig/src/Brig/Phone.hs b/services/brig/src/Brig/Phone.hs index 6abf7ffe162..d1c32501459 100644 --- a/services/brig/src/Brig/Phone.hs +++ b/services/brig/src/Brig/Phone.hs @@ -60,12 +60,11 @@ import System.Logger.Message (field, msg, val, (~~)) ------------------------------------------------------------------------------- -- Sending SMS and Voice Calls -data SMSMessage - = SMSMessage - { smsFrom :: !Text, - smsTo :: !Text, - smsText :: !Text - } +data SMSMessage = SMSMessage + { smsFrom :: !Text, + smsTo :: !Text, + smsText :: !Text + } data PhoneException = PhoneNumberUnreachable @@ -269,13 +268,12 @@ withCallBudget phone go = do -------------------------------------------------------------------------------- -- Unique Keys -data PhoneKey - = PhoneKey - { -- | canonical form of 'phoneKeyOrig', without whitespace. - phoneKeyUniq :: !Text, - -- | phone number with whitespace. - phoneKeyOrig :: !Phone - } +data PhoneKey = PhoneKey + { -- | canonical form of 'phoneKeyOrig', without whitespace. + phoneKeyUniq :: !Text, + -- | phone number with whitespace. + phoneKeyOrig :: !Phone + } instance Show PhoneKey where showsPrec _ = shows . phoneKeyUniq diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index 71968ef9a43..44e30b5b427 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -207,7 +207,8 @@ insertService pid name summary descr url token key fprint assets tags = do return sid where cql :: - PrepQuery W + PrepQuery + W ( ProviderId, ServiceId, Name, @@ -239,7 +240,9 @@ lookupService pid sid = $ params Quorum (pid, sid) where cql :: - PrepQuery R (ProviderId, ServiceId) + PrepQuery + R + (ProviderId, ServiceId) (Name, Maybe Text, Text, HttpsUrl, List1 ServiceToken, List1 ServiceKey, [Asset], C.Set ServiceTag, Bool) cql = "SELECT name, summary, descr, base_url, auth_tokens, pubkeys, assets, tags, enabled \ @@ -258,7 +261,9 @@ listServices p = $ params Quorum (Identity p) where cql :: - PrepQuery R (Identity ProviderId) + PrepQuery + R + (Identity ProviderId) (ServiceId, Name, Maybe Text, Text, HttpsUrl, List1 ServiceToken, List1 ServiceKey, [Asset], C.Set ServiceTag, Bool) cql = "SELECT id, name, summary, descr, base_url, auth_tokens, pubkeys, assets, tags, enabled \ @@ -370,7 +375,9 @@ listServiceProfiles p = $ params One (Identity p) where cql :: - PrepQuery R (Identity ProviderId) + PrepQuery + R + (Identity ProviderId) (ServiceId, Name, Maybe Text, Text, [Asset], C.Set ServiceTag, Bool) cql = "SELECT id, name, summary, descr, assets, tags, enabled \ @@ -382,15 +389,14 @@ listServiceProfiles p = -------------------------------------------------------------------------------- -- Service Connection Data -data ServiceConn - = ServiceConn - { sconProvider :: !ProviderId, - sconService :: !ServiceId, - sconBaseUrl :: !HttpsUrl, - sconAuthTokens :: !(List1 ServiceToken), - sconFingerprints :: !(List1 (Fingerprint Rsa)), - sconEnabled :: !Bool - } +data ServiceConn = ServiceConn + { sconProvider :: !ProviderId, + sconService :: !ServiceId, + sconBaseUrl :: !HttpsUrl, + sconAuthTokens :: !(List1 ServiceToken), + sconFingerprints :: !(List1 (Fingerprint Rsa)), + sconEnabled :: !Bool + } -- | Lookup the connection information of a service. lookupServiceConn :: diff --git a/services/brig/src/Brig/Provider/Email.hs b/services/brig/src/Brig/Provider/Email.hs index 41fc8a772af..3b4e2f0fc66 100644 --- a/services/brig/src/Brig/Provider/Email.hs +++ b/services/brig/src/Brig/Provider/Email.hs @@ -54,13 +54,12 @@ sendActivationMail name email key code update = do selectTemplate True = activationEmailUpdate selectTemplate False = activationEmail -data ActivationEmail - = ActivationEmail - { acmTo :: !Email, - acmName :: !Name, - acmKey :: !Code.Key, - acmCode :: !Code.Value - } +data ActivationEmail = ActivationEmail + { acmTo :: !Email, + acmName :: !Name, + acmKey :: !Code.Key, + acmCode :: !Code.Value + } renderActivationMail :: ActivationEmail -> ActivationEmailTemplate -> TemplateBranding -> Mail renderActivationMail ActivationEmail {..} ActivationEmailTemplate {..} branding = @@ -104,15 +103,14 @@ sendApprovalRequestMail name email url descr key val = do let mail = ApprovalRequestEmail email name url descr key val sendMail $ renderApprovalRequestMail mail tpl branding -data ApprovalRequestEmail - = ApprovalRequestEmail - { aprTo :: !Email, - aprName :: !Name, - aprUrl :: !HttpsUrl, - aprDescr :: !Text, - aprKey :: !Code.Key, - aprCode :: !Code.Value - } +data ApprovalRequestEmail = ApprovalRequestEmail + { aprTo :: !Email, + aprName :: !Name, + aprUrl :: !HttpsUrl, + aprDescr :: !Text, + aprKey :: !Code.Key, + aprCode :: !Code.Value + } renderApprovalRequestMail :: ApprovalRequestEmail -> ApprovalRequestEmailTemplate -> TemplateBranding -> Mail renderApprovalRequestMail ApprovalRequestEmail {..} ApprovalRequestEmailTemplate {..} branding = @@ -156,11 +154,10 @@ sendApprovalConfirmMail name email = do let mail = ApprovalConfirmEmail email name sendMail $ renderApprovalConfirmMail mail tpl branding -data ApprovalConfirmEmail - = ApprovalConfirmEmail - { apcTo :: !Email, - apcName :: !Name - } +data ApprovalConfirmEmail = ApprovalConfirmEmail + { apcTo :: !Email, + apcName :: !Name + } renderApprovalConfirmMail :: ApprovalConfirmEmail -> ApprovalConfirmEmailTemplate -> TemplateBranding -> Mail renderApprovalConfirmMail ApprovalConfirmEmail {..} ApprovalConfirmEmailTemplate {..} branding = @@ -193,12 +190,11 @@ sendPasswordResetMail to key code = do let mail = PasswordResetEmail to key code sendMail $ renderPwResetMail mail tpl branding -data PasswordResetEmail - = PasswordResetEmail - { pwrTo :: !Email, - pwrKey :: !Code.Key, - pwrCode :: !Code.Value - } +data PasswordResetEmail = PasswordResetEmail + { pwrTo :: !Email, + pwrKey :: !Code.Key, + pwrCode :: !Code.Value + } renderPwResetMail :: PasswordResetEmail -> PasswordResetEmailTemplate -> TemplateBranding -> Mail renderPwResetMail PasswordResetEmail {..} PasswordResetEmailTemplate {..} branding = diff --git a/services/brig/src/Brig/Provider/Template.hs b/services/brig/src/Brig/Provider/Template.hs index a6bd6d702dd..579a0149e6d 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/services/brig/src/Brig/Provider/Template.hs @@ -39,55 +39,50 @@ import Data.Misc (HttpsUrl) import Data.Text.Encoding (encodeUtf8) import Imports -data ProviderTemplates - = ProviderTemplates - { activationEmail :: !ActivationEmailTemplate, - activationEmailUpdate :: !ActivationEmailTemplate, - approvalRequestEmail :: !ApprovalRequestEmailTemplate, - approvalConfirmEmail :: !ApprovalConfirmEmailTemplate, - passwordResetEmail :: !PasswordResetEmailTemplate - } +data ProviderTemplates = ProviderTemplates + { activationEmail :: !ActivationEmailTemplate, + activationEmailUpdate :: !ActivationEmailTemplate, + approvalRequestEmail :: !ApprovalRequestEmailTemplate, + approvalConfirmEmail :: !ApprovalConfirmEmailTemplate, + passwordResetEmail :: !PasswordResetEmailTemplate + } -data ActivationEmailTemplate - = ActivationEmailTemplate - { activationEmailUrl :: !Template, - activationEmailSubject :: !Template, - activationEmailBodyText :: !Template, - activationEmailBodyHtml :: !Template, - activationEmailSender :: !Email, - activationEmailSenderName :: !Text - } +data ActivationEmailTemplate = ActivationEmailTemplate + { activationEmailUrl :: !Template, + activationEmailSubject :: !Template, + activationEmailBodyText :: !Template, + activationEmailBodyHtml :: !Template, + activationEmailSender :: !Email, + activationEmailSenderName :: !Text + } -data ApprovalRequestEmailTemplate - = ApprovalRequestEmailTemplate - { approvalRequestEmailUrl :: !Template, - approvalRequestEmailSubject :: !Template, - approvalRequestEmailBodyText :: !Template, - approvalRequestEmailBodyHtml :: !Template, - approvalRequestEmailSender :: !Email, - approvalRequestEmailSenderName :: !Text, - approvalRequestEmailTo :: !Email - } +data ApprovalRequestEmailTemplate = ApprovalRequestEmailTemplate + { approvalRequestEmailUrl :: !Template, + approvalRequestEmailSubject :: !Template, + approvalRequestEmailBodyText :: !Template, + approvalRequestEmailBodyHtml :: !Template, + approvalRequestEmailSender :: !Email, + approvalRequestEmailSenderName :: !Text, + approvalRequestEmailTo :: !Email + } -data ApprovalConfirmEmailTemplate - = ApprovalConfirmEmailTemplate - { approvalConfirmEmailSubject :: !Template, - approvalConfirmEmailBodyText :: !Template, - approvalConfirmEmailBodyHtml :: !Template, - approvalConfirmEmailSender :: !Email, - approvalConfirmEmailSenderName :: !Text, - approvalConfirmEmailHomeUrl :: !HttpsUrl - } +data ApprovalConfirmEmailTemplate = ApprovalConfirmEmailTemplate + { approvalConfirmEmailSubject :: !Template, + approvalConfirmEmailBodyText :: !Template, + approvalConfirmEmailBodyHtml :: !Template, + approvalConfirmEmailSender :: !Email, + approvalConfirmEmailSenderName :: !Text, + approvalConfirmEmailHomeUrl :: !HttpsUrl + } -data PasswordResetEmailTemplate - = PasswordResetEmailTemplate - { passwordResetEmailUrl :: !Template, - passwordResetEmailSubject :: !Template, - passwordResetEmailBodyText :: !Template, - passwordResetEmailBodyHtml :: !Template, - passwordResetEmailSender :: !Email, - passwordResetEmailSenderName :: !Text - } +data PasswordResetEmailTemplate = PasswordResetEmailTemplate + { passwordResetEmailUrl :: !Template, + passwordResetEmailSubject :: !Template, + passwordResetEmailBodyText :: !Template, + passwordResetEmailBodyHtml :: !Template, + passwordResetEmailSender :: !Email, + passwordResetEmailSenderName :: !Text + } -- TODO -- data NewServiceEmailTemplate = NewServiceEmailTemplate diff --git a/services/brig/src/Brig/Queue/Stomp.hs b/services/brig/src/Brig/Queue/Stomp.hs index 0bf9ddc67da..cbb1d3b698b 100644 --- a/services/brig/src/Brig/Queue/Stomp.hs +++ b/services/brig/src/Brig/Queue/Stomp.hs @@ -40,30 +40,27 @@ import Network.Mom.Stompl.Client.Queue hiding (try) import System.Logger.Class as Log import UnliftIO (MonadUnliftIO, throwIO, withRunInIO) -data Env - = Env - { -- | STOMP broker that we're using - broker :: Broker - } - -data Broker - = Broker - { -- | Broker URL - host :: Text, - -- | Port - port :: Int, - -- | Username and password - auth :: Maybe Credentials, - -- | Whether to use TLS - tls :: Bool - } +data Env = Env + { -- | STOMP broker that we're using + broker :: Broker + } + +data Broker = Broker + { -- | Broker URL + host :: Text, + -- | Port + port :: Int, + -- | Username and password + auth :: Maybe Credentials, + -- | Whether to use TLS + tls :: Bool + } deriving (Show) -data Credentials - = Credentials - { user :: Text, - pass :: Text - } +data Credentials = Credentials + { user :: Text, + pass :: Text + } deriving (Eq, Show, Generic) instance FromJSON Credentials diff --git a/services/brig/src/Brig/RPC.hs b/services/brig/src/Brig/RPC.hs index 94a25548fc4..9dca1c62ebd 100644 --- a/services/brig/src/Brig/RPC.hs +++ b/services/brig/src/Brig/RPC.hs @@ -89,11 +89,10 @@ serviceRequest nm svc m r = do rpc' nm service (method m . r) -- | Failed to parse a response from another service. -data ParseException - = ParseException - { _parseExceptionRemote :: !Text, - _parseExceptionMsg :: String - } +data ParseException = ParseException + { _parseExceptionRemote :: !Text, + _parseExceptionMsg :: String + } instance Show ParseException where show (ParseException r m) = diff --git a/services/brig/src/Brig/SMTP.hs b/services/brig/src/Brig/SMTP.hs index b4313ea18d6..86d5eb0022e 100644 --- a/services/brig/src/Brig/SMTP.hs +++ b/services/brig/src/Brig/SMTP.hs @@ -35,10 +35,9 @@ newtype Username = Username Text newtype Password = Password Text -data SMTP - = SMTP - { _pool :: !(Pool SMTP.SMTPConnection) - } +data SMTP = SMTP + { _pool :: !(Pool SMTP.SMTPConnection) + } data SMTPConnType = Plain diff --git a/services/brig/src/Brig/TURN.hs b/services/brig/src/Brig/TURN.hs index 9e2951bc45f..0c95068938e 100644 --- a/services/brig/src/Brig/TURN.hs +++ b/services/brig/src/Brig/TURN.hs @@ -24,15 +24,14 @@ import Imports import OpenSSL.EVP.Digest (Digest) import System.Random.MWC (GenIO, createSystemRandom) -data Env - = Env - { _turnServers :: List1 TurnURI, - _turnTokenTTL :: Word32, - _turnConfigTTL :: Word32, - _turnSecret :: ByteString, - _turnSHA512 :: Digest, - _turnPrng :: GenIO - } +data Env = Env + { _turnServers :: List1 TurnURI, + _turnTokenTTL :: Word32, + _turnConfigTTL :: Word32, + _turnSecret :: ByteString, + _turnSHA512 :: Digest, + _turnPrng :: GenIO + } makeLenses ''Env diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index 828e38789e8..eea225586a3 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -61,12 +61,11 @@ mkInvitationCode = InvitationCode . encodeBase64Url <$> randBytes 24 mkInvitationId :: IO InvitationId mkInvitationId = Id <$> nextRandom -data InvitationInfo - = InvitationInfo - { iiCode :: InvitationCode, - iiTeam :: TeamId, - iiInvId :: InvitationId - } +data InvitationInfo = InvitationInfo + { iiCode :: InvitationCode, + iiTeam :: TeamId, + iiInvId :: InvitationId + } deriving (Eq, Show) insertInvitation :: diff --git a/services/brig/src/Brig/Team/Email.hs b/services/brig/src/Brig/Team/Email.hs index 36d1e2e98da..83759249f69 100644 --- a/services/brig/src/Brig/Team/Email.hs +++ b/services/brig/src/Brig/Team/Email.hs @@ -66,13 +66,12 @@ sendMemberWelcomeMail to tid teamName loc = do ------------------------------------------------------------------------------- -- Invitation Email -data InvitationEmail - = InvitationEmail - { invTo :: !Email, - invTeamId :: !TeamId, - invInvCode :: !InvitationCode, - invInviter :: !Email - } +data InvitationEmail = InvitationEmail + { invTo :: !Email, + invTeamId :: !TeamId, + invInvCode :: !InvitationCode, + invInviter :: !Email + } renderInvitationEmail :: InvitationEmail -> InvitationEmailTemplate -> TemplateBranding -> Mail renderInvitationEmail InvitationEmail {..} InvitationEmailTemplate {..} branding = @@ -107,12 +106,11 @@ renderInvitationUrl t tid (InvitationCode c) branding = ------------------------------------------------------------------------------- -- Creator Welcome Email -data CreatorWelcomeEmail - = CreatorWelcomeEmail - { cwTo :: !Email, - cwTid :: !TeamId, - cwTeamName :: !Text - } +data CreatorWelcomeEmail = CreatorWelcomeEmail + { cwTo :: !Email, + cwTid :: !TeamId, + cwTeamName :: !Text + } renderCreatorWelcomeMail :: CreatorWelcomeEmail -> CreatorWelcomeEmailTemplate -> TemplateBranding -> Mail renderCreatorWelcomeMail CreatorWelcomeEmail {..} CreatorWelcomeEmailTemplate {..} branding = @@ -139,12 +137,11 @@ renderCreatorWelcomeMail CreatorWelcomeEmail {..} CreatorWelcomeEmailTemplate {. ------------------------------------------------------------------------------- -- Member Welcome Email -data MemberWelcomeEmail - = MemberWelcomeEmail - { mwTo :: !Email, - mwTid :: !TeamId, - mwTeamName :: !Text - } +data MemberWelcomeEmail = MemberWelcomeEmail + { mwTo :: !Email, + mwTid :: !TeamId, + mwTeamName :: !Text + } renderMemberWelcomeMail :: MemberWelcomeEmail -> MemberWelcomeEmailTemplate -> TemplateBranding -> Mail renderMemberWelcomeMail MemberWelcomeEmail {..} MemberWelcomeEmailTemplate {..} branding = diff --git a/services/brig/src/Brig/Team/Template.hs b/services/brig/src/Brig/Team/Template.hs index dd70a46d292..35946a1404b 100644 --- a/services/brig/src/Brig/Team/Template.hs +++ b/services/brig/src/Brig/Team/Template.hs @@ -34,42 +34,38 @@ import Brig.Template import Brig.Types import Imports -data InvitationEmailTemplate - = InvitationEmailTemplate - { invitationEmailUrl :: !Template, - invitationEmailSubject :: !Template, - invitationEmailBodyText :: !Template, - invitationEmailBodyHtml :: !Template, - invitationEmailSender :: !Email, - invitationEmailSenderName :: !Text - } +data InvitationEmailTemplate = InvitationEmailTemplate + { invitationEmailUrl :: !Template, + invitationEmailSubject :: !Template, + invitationEmailBodyText :: !Template, + invitationEmailBodyHtml :: !Template, + invitationEmailSender :: !Email, + invitationEmailSenderName :: !Text + } -data CreatorWelcomeEmailTemplate - = CreatorWelcomeEmailTemplate - { creatorWelcomeEmailUrl :: !Text, - creatorWelcomeEmailSubject :: !Template, - creatorWelcomeEmailBodyText :: !Template, - creatorWelcomeEmailBodyHtml :: !Template, - creatorWelcomeEmailSender :: !Email, - creatorWelcomeEmailSenderName :: !Text - } +data CreatorWelcomeEmailTemplate = CreatorWelcomeEmailTemplate + { creatorWelcomeEmailUrl :: !Text, + creatorWelcomeEmailSubject :: !Template, + creatorWelcomeEmailBodyText :: !Template, + creatorWelcomeEmailBodyHtml :: !Template, + creatorWelcomeEmailSender :: !Email, + creatorWelcomeEmailSenderName :: !Text + } -data MemberWelcomeEmailTemplate - = MemberWelcomeEmailTemplate - { memberWelcomeEmailUrl :: !Text, - memberWelcomeEmailSubject :: !Template, - memberWelcomeEmailBodyText :: !Template, - memberWelcomeEmailBodyHtml :: !Template, - memberWelcomeEmailSender :: !Email, - memberWelcomeEmailSenderName :: !Text - } +data MemberWelcomeEmailTemplate = MemberWelcomeEmailTemplate + { memberWelcomeEmailUrl :: !Text, + memberWelcomeEmailSubject :: !Template, + memberWelcomeEmailBodyText :: !Template, + memberWelcomeEmailBodyHtml :: !Template, + memberWelcomeEmailSender :: !Email, + memberWelcomeEmailSenderName :: !Text + } -data TeamTemplates - = TeamTemplates - { invitationEmail :: !InvitationEmailTemplate, - creatorWelcomeEmail :: !CreatorWelcomeEmailTemplate, - memberWelcomeEmail :: !MemberWelcomeEmailTemplate - } +data TeamTemplates = TeamTemplates + { invitationEmail :: !InvitationEmailTemplate, + creatorWelcomeEmail :: !CreatorWelcomeEmailTemplate, + memberWelcomeEmail :: !MemberWelcomeEmailTemplate + } loadTeamTemplates :: Opts -> IO (Localised TeamTemplates) loadTeamTemplates o = readLocalesDir defLocale (templateDir gOptions) "team" $ \fp -> diff --git a/services/brig/src/Brig/Template.hs b/services/brig/src/Brig/Template.hs index fc3b5023fc8..1751143e23c 100644 --- a/services/brig/src/Brig/Template.hs +++ b/services/brig/src/Brig/Template.hs @@ -58,11 +58,10 @@ import System.IO.Error (isDoesNotExistError) type TemplateBranding = Text -> Text -- | Localised templates. -data Localised a - = Localised - { locDefault :: !(Locale, a), - locOther :: !(Map Locale a) - } +data Localised a = Localised + { locDefault :: !(Locale, a), + locOther :: !(Map Locale a) + } readLocalesDir :: -- | Default locale. diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index 721dee3d941..49a9926f8c7 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -292,7 +292,9 @@ renew = \case tokenRequest :: forall r. (HasCookies r, HasHeaders r, HasQuery r) => - Predicate r P.Error + Predicate + r + P.Error ( Maybe (Either ZAuth.UserToken ZAuth.LegalHoldUserToken) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) ) diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index dc829206a8c..f3e5544b4d1 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -69,11 +69,10 @@ import Network.Wai.Utilities.Error ((!>>)) import System.Logger (field, msg, val, (~~)) import qualified System.Logger.Class as Log -data Access u - = Access - { accessToken :: !AccessToken, - accessCookie :: !(Maybe (Cookie (ZAuth.Token u))) - } +data Access u = Access + { accessToken :: !AccessToken, + accessCookie :: !(Maybe (Cookie (ZAuth.Token u))) + } sendLoginCode :: Phone -> Bool -> Bool -> ExceptT SendLoginCodeError AppIO PendingLoginCode sendLoginCode phone call force = do diff --git a/services/brig/src/Brig/User/Auth/Cookie/Limit.hs b/services/brig/src/Brig/User/Auth/Cookie/Limit.hs index d6cc0907910..77ca9c71507 100644 --- a/services/brig/src/Brig/User/Auth/Cookie/Limit.hs +++ b/services/brig/src/Brig/User/Auth/Cookie/Limit.hs @@ -29,9 +29,8 @@ import qualified Statistics.Sample as Stats -------------------------------------------------------------------------------- -- Quantitive Limiting -newtype CookieLimit - = CookieLimit - {cookieLimitTotal :: Int} +newtype CookieLimit = CookieLimit + {cookieLimitTotal :: Int} -- | Limit the given list of cookies, returning those excess -- cookies which should be evicted. Based on the following order @@ -73,9 +72,8 @@ data CookieThrottle newtype StdDev = StdDev Double deriving (Eq, Ord, Show, Generic) -newtype RetryAfter - = RetryAfter - {retryAfterSeconds :: Int64} +newtype RetryAfter = RetryAfter + {retryAfterSeconds :: Int64} deriving (Eq, Show) instance FromJSON StdDev diff --git a/services/brig/src/Brig/User/Email.hs b/services/brig/src/Brig/User/Email.hs index aa3f139d93c..2fbc9c8b5a5 100644 --- a/services/brig/src/Brig/User/Email.hs +++ b/services/brig/src/Brig/User/Email.hs @@ -93,13 +93,12 @@ sendTeamActivationMail to name pair loc team = do ------------------------------------------------------------------------------- -- New Client Email -data NewClientEmail - = NewClientEmail - { nclLocale :: !Locale, - nclTo :: !Email, - nclName :: !Name, - nclClient :: !Client - } +data NewClientEmail = NewClientEmail + { nclLocale :: !Locale, + nclTo :: !Email, + nclName :: !Name, + nclClient :: !Client + } renderNewClientEmail :: NewClientEmailTemplate -> NewClientEmail -> TemplateBranding -> Mail renderNewClientEmail NewClientEmailTemplate {..} NewClientEmail {..} branding = @@ -130,13 +129,12 @@ renderNewClientEmail NewClientEmailTemplate {..} NewClientEmail {..} branding = ------------------------------------------------------------------------------- -- Deletion Email -data DeletionEmail - = DeletionEmail - { delTo :: !Email, - delName :: !Name, - delKey :: !Code.Key, - delCode :: !Code.Value - } +data DeletionEmail = DeletionEmail + { delTo :: !Email, + delName :: !Name, + delKey :: !Code.Key, + delCode :: !Code.Value + } renderDeletionEmail :: DeletionEmailTemplate -> DeletionEmail -> TemplateBranding -> Mail renderDeletionEmail DeletionEmailTemplate {..} DeletionEmail {..} branding = @@ -169,11 +167,10 @@ renderDeletionEmail DeletionEmailTemplate {..} DeletionEmail {..} branding = ------------------------------------------------------------------------------- -- Verification Email -data VerificationEmail - = VerificationEmail - { vfTo :: !Email, - vfPair :: !ActivationPair - } +data VerificationEmail = VerificationEmail + { vfTo :: !Email, + vfPair :: !ActivationPair + } renderVerificationMail :: VerificationEmail -> VerificationEmailTemplate -> TemplateBranding -> Mail renderVerificationMail VerificationEmail {..} VerificationEmailTemplate {..} branding = @@ -202,12 +199,11 @@ renderVerificationMail VerificationEmail {..} VerificationEmailTemplate {..} bra ------------------------------------------------------------------------------- -- Activation Email -data ActivationEmail - = ActivationEmail - { acmTo :: !Email, - acmName :: !Name, - acmPair :: !ActivationPair - } +data ActivationEmail = ActivationEmail + { acmTo :: !Email, + acmName :: !Name, + acmPair :: !ActivationPair + } renderActivationMail :: ActivationEmail -> ActivationEmailTemplate -> TemplateBranding -> Mail renderActivationMail ActivationEmail {..} ActivationEmailTemplate {..} branding = @@ -246,13 +242,12 @@ renderActivationUrl t (ActivationKey k, ActivationCode c) branding = ------------------------------------------------------------------------------- -- Team Activation Email -data TeamActivationEmail - = TeamActivationEmail - { tacmTo :: !Email, - tacmName :: !Name, - tacmTeamName :: !Text, - tacmPair :: !ActivationPair - } +data TeamActivationEmail = TeamActivationEmail + { tacmTo :: !Email, + tacmName :: !Name, + tacmTeamName :: !Text, + tacmPair :: !ActivationPair + } renderTeamActivationMail :: TeamActivationEmail -> TeamActivationEmailTemplate -> TemplateBranding -> Mail renderTeamActivationMail TeamActivationEmail {..} TeamActivationEmailTemplate {..} branding = @@ -282,11 +277,10 @@ renderTeamActivationMail TeamActivationEmail {..} TeamActivationEmailTemplate {. ------------------------------------------------------------------------------- -- Password Reset Email -data PasswordResetEmail - = PasswordResetEmail - { pwrTo :: !Email, - pwrPair :: !PasswordResetPair - } +data PasswordResetEmail = PasswordResetEmail + { pwrTo :: !Email, + pwrPair :: !PasswordResetPair + } renderPwResetMail :: PasswordResetEmail -> PasswordResetEmailTemplate -> TemplateBranding -> Mail renderPwResetMail PasswordResetEmail {..} PasswordResetEmailTemplate {..} branding = diff --git a/services/brig/src/Brig/User/Event.hs b/services/brig/src/Brig/User/Event.hs index a7b1a479827..2941f57d279 100644 --- a/services/brig/src/Brig/User/Event.hs +++ b/services/brig/src/Brig/User/Event.hs @@ -68,12 +68,11 @@ data UserEvent | UserLegalHoldEnabled !UserId | LegalHoldClientRequested LegalHoldClientRequestedData -data ConnectionEvent - = ConnectionUpdated - { ucConn :: !UserConnection, - ucPrev :: !(Maybe Relation), - ucName :: !(Maybe Name) - } +data ConnectionEvent = ConnectionUpdated + { ucConn :: !UserConnection, + ucPrev :: !(Maybe Relation), + ucName :: !(Maybe Name) + } data PropertyEvent = PropertySet !UserId !PropertyKey !PropertyValue @@ -84,12 +83,11 @@ data ClientEvent = ClientAdded !UserId !Client | ClientRemoved !UserId !Client -data LegalHoldClientRequestedData - = LegalHoldClientRequestedData - { lhcTargetUser :: !UserId, - lhcLastPrekey :: !LastPrekey, - lhcClientId :: !ClientId - } +data LegalHoldClientRequestedData = LegalHoldClientRequestedData + { lhcTargetUser :: !UserId, + lhcLastPrekey :: !LastPrekey, + lhcClientId :: !ClientId + } deriving stock (Show) emailRemoved :: UserId -> Email -> UserEvent diff --git a/services/brig/src/Brig/User/Phone.hs b/services/brig/src/Brig/User/Phone.hs index a746025cea6..f7b355bdd18 100644 --- a/services/brig/src/Brig/User/Phone.hs +++ b/services/brig/src/Brig/User/Phone.hs @@ -91,11 +91,10 @@ sendLoginCall to c loc = do ------------------------------------------------------------------------------- -- Activation SMS -data ActivationSms - = ActivationSms - { actSmsTo :: !Phone, - actSmsCode :: !ActivationCode - } +data ActivationSms = ActivationSms + { actSmsTo :: !Phone, + actSmsCode :: !ActivationCode + } renderActivationSms :: ActivationSms -> ActivationSmsTemplate -> TemplateBranding -> SMSMessage renderActivationSms ActivationSms {..} (ActivationSmsTemplate url t from) branding = @@ -109,11 +108,10 @@ renderActivationSms ActivationSms {..} (ActivationSmsTemplate url t from) brandi ------------------------------------------------------------------------------- -- Password Reset SMS -data PasswordResetSms - = PasswordResetSms - { pwrSmsTo :: !Phone, - pwrSmsCode :: !PasswordResetCode - } +data PasswordResetSms = PasswordResetSms + { pwrSmsTo :: !Phone, + pwrSmsCode :: !PasswordResetCode + } renderPasswordResetSms :: PasswordResetSms -> PasswordResetSmsTemplate -> TemplateBranding -> SMSMessage renderPasswordResetSms PasswordResetSms {..} (PasswordResetSmsTemplate t from) branding = @@ -125,11 +123,10 @@ renderPasswordResetSms PasswordResetSms {..} (PasswordResetSmsTemplate t from) b ------------------------------------------------------------------------------- -- Login SMS -data LoginSms - = LoginSms - { loginSmsTo :: !Phone, - loginSmsCode :: !LoginCode - } +data LoginSms = LoginSms + { loginSmsTo :: !Phone, + loginSmsCode :: !LoginCode + } renderLoginSms :: LoginSms -> LoginSmsTemplate -> TemplateBranding -> SMSMessage renderLoginSms LoginSms {..} (LoginSmsTemplate url t from) branding = @@ -142,12 +139,11 @@ renderLoginSms LoginSms {..} (LoginSmsTemplate url t from) branding = ------------------------------------------------------------------------------- -- Deletion SMS -data DeletionSms - = DeletionSms - { delSmsTo :: !Phone, - delSmsKey :: !Code.Key, - delSmsCode :: !Code.Value - } +data DeletionSms = DeletionSms + { delSmsTo :: !Phone, + delSmsKey :: !Code.Key, + delSmsCode :: !Code.Value + } renderDeletionSms :: DeletionSms -> DeletionSmsTemplate -> TemplateBranding -> SMSMessage renderDeletionSms DeletionSms {..} (DeletionSmsTemplate url txt from) branding = @@ -163,11 +159,10 @@ renderDeletionSms DeletionSms {..} (DeletionSmsTemplate url txt from) branding = ------------------------------------------------------------------------------- -- Activation Call -data ActivationCall - = ActivationCall - { actCallTo :: !Phone, - actCallCode :: !ActivationCode - } +data ActivationCall = ActivationCall + { actCallTo :: !Phone, + actCallCode :: !ActivationCode + } renderActivationCall :: ActivationCall -> ActivationCallTemplate -> Locale -> TemplateBranding -> Nexmo.Call renderActivationCall ActivationCall {..} (ActivationCallTemplate t) loc branding = @@ -184,11 +179,10 @@ renderActivationCall ActivationCall {..} (ActivationCallTemplate t) loc branding ------------------------------------------------------------------------------- -- Login Call -data LoginCall - = LoginCall - { loginCallTo :: !Phone, - loginCallCode :: !LoginCode - } +data LoginCall = LoginCall + { loginCallTo :: !Phone, + loginCallCode :: !LoginCode + } renderLoginCall :: LoginCall -> LoginCallTemplate -> Locale -> TemplateBranding -> Nexmo.Call renderLoginCall LoginCall {..} (LoginCallTemplate t) loc branding = diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs index f2f5b55a9c4..d01554b72d3 100644 --- a/services/brig/src/Brig/User/Search/Index.hs +++ b/services/brig/src/Brig/User/Search/Index.hs @@ -95,14 +95,13 @@ import System.Logger.Class -------------------------------------------------------------------------------- -- IndexIO Monad -data IndexEnv - = IndexEnv - { idxMetrics :: Metrics, - idxLogger :: Logger, - idxElastic :: ES.BHEnv, - idxRequest :: Maybe RequestId, - idxName :: ES.IndexName - } +data IndexEnv = IndexEnv + { idxMetrics :: Metrics, + idxLogger :: Logger, + idxElastic :: ES.BHEnv, + idxRequest :: Maybe RequestId, + idxName :: ES.IndexName + } newtype IndexIO a = IndexIO (ReaderT IndexEnv IO a) deriving diff --git a/services/brig/src/Brig/User/Search/Index/Types.hs b/services/brig/src/Brig/User/Search/Index/Types.hs index 16f8dac2914..251c4f468bc 100644 --- a/services/brig/src/Brig/User/Search/Index/Types.hs +++ b/services/brig/src/Brig/User/Search/Index/Types.hs @@ -39,15 +39,14 @@ data IndexUpdate -- | Represents the ES *index*, ie. the attributes of a user searchable in ES. See also: -- 'UserDoc'. -data IndexUser - = IndexUser - { _iuUserId :: UserId, - _iuVersion :: IndexVersion, - _iuTeam :: Maybe TeamId, - _iuName :: Maybe Name, - _iuHandle :: Maybe Handle, - _iuColourId :: Maybe ColourId - } +data IndexUser = IndexUser + { _iuUserId :: UserId, + _iuVersion :: IndexVersion, + _iuTeam :: Maybe TeamId, + _iuName :: Maybe Name, + _iuHandle :: Maybe Handle, + _iuColourId :: Maybe ColourId + } data IndexQuery r = IndexQuery Query Filter @@ -67,15 +66,14 @@ newtype IndexVersion = IndexVersion {docVersion :: DocVersion} -- If a user is not searchable, e.g. because the account got -- suspended, all fields except for the user id are set to 'Nothing' and -- consequently removed from the index. -data UserDoc - = UserDoc - { udId :: UserId, - udTeam :: Maybe TeamId, - udName :: Maybe Name, - udNormalized :: Maybe Text, - udHandle :: Maybe Handle, - udColourId :: Maybe ColourId - } +data UserDoc = UserDoc + { udId :: UserId, + udTeam :: Maybe TeamId, + udName :: Maybe Name, + udNormalized :: Maybe Text, + udHandle :: Maybe Handle, + udColourId :: Maybe ColourId + } deriving (Eq, Show) instance ToJSON UserDoc where diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs index dc5e7e5cb7d..60d1b5cab1c 100644 --- a/services/brig/src/Brig/User/Template.hs +++ b/services/brig/src/Brig/User/Template.hs @@ -43,118 +43,105 @@ import Brig.Template import Brig.Types import Imports -data UserTemplates - = UserTemplates - { activationSms :: !ActivationSmsTemplate, - activationCall :: !ActivationCallTemplate, - verificationEmail :: !VerificationEmailTemplate, - activationEmail :: !ActivationEmailTemplate, - activationEmailUpdate :: !ActivationEmailTemplate, - teamActivationEmail :: !TeamActivationEmailTemplate, - passwordResetSms :: !PasswordResetSmsTemplate, - passwordResetEmail :: !PasswordResetEmailTemplate, - loginSms :: !LoginSmsTemplate, - loginCall :: !LoginCallTemplate, - deletionSms :: !DeletionSmsTemplate, - deletionEmail :: !DeletionEmailTemplate, - newClientEmail :: !NewClientEmailTemplate - } - -data ActivationSmsTemplate - = ActivationSmsTemplate - { activationSmslUrl :: !Template, - activationSmsText :: !Template, - activationSmsSender :: !Text - } - -data ActivationCallTemplate - = ActivationCallTemplate - { activationCallText :: !Template - } - -data VerificationEmailTemplate - = VerificationEmailTemplate - { verificationEmailUrl :: !Template, - verificationEmailSubject :: !Template, - verificationEmailBodyText :: !Template, - verificationEmailBodyHtml :: !Template, - verificationEmailSender :: !Email, - verificationEmailSenderName :: !Text - } - -data ActivationEmailTemplate - = ActivationEmailTemplate - { activationEmailUrl :: !Template, - activationEmailSubject :: !Template, - activationEmailBodyText :: !Template, - activationEmailBodyHtml :: !Template, - activationEmailSender :: !Email, - activationEmailSenderName :: !Text - } - -data TeamActivationEmailTemplate - = TeamActivationEmailTemplate - { teamActivationEmailUrl :: !Template, - teamActivationEmailSubject :: !Template, - teamActivationEmailBodyText :: !Template, - teamActivationEmailBodyHtml :: !Template, - teamActivationEmailSender :: !Email, - teamActivationEmailSenderName :: !Text - } - -data DeletionEmailTemplate - = DeletionEmailTemplate - { deletionEmailUrl :: !Template, - deletionEmailSubject :: !Template, - deletionEmailBodyText :: !Template, - deletionEmailBodyHtml :: !Template, - deletionEmailSender :: !Email, - deletionEmailSenderName :: !Text - } - -data PasswordResetEmailTemplate - = PasswordResetEmailTemplate - { passwordResetEmailUrl :: !Template, - passwordResetEmailSubject :: !Template, - passwordResetEmailBodyText :: !Template, - passwordResetEmailBodyHtml :: !Template, - passwordResetEmailSender :: !Email, - passwordResetEmailSenderName :: !Text - } - -data PasswordResetSmsTemplate - = PasswordResetSmsTemplate - { passwordResetSmsText :: !Template, - passwordResetSmsSender :: !Text - } - -data LoginSmsTemplate - = LoginSmsTemplate - { loginSmsUrl :: !Template, - loginSmsText :: !Template, - loginSmsSender :: !Text - } - -data LoginCallTemplate - = LoginCallTemplate - { loginCallText :: !Template - } - -data DeletionSmsTemplate - = DeletionSmsTemplate - { deletionSmsUrl :: !Template, - deletionSmsText :: !Template, - deletionSmsSender :: !Text - } - -data NewClientEmailTemplate - = NewClientEmailTemplate - { newClientEmailSubject :: !Template, - newClientEmailBodyText :: !Template, - newClientEmailBodyHtml :: !Template, - newClientEmailSender :: !Email, - newClientEmailSenderName :: !Text - } +data UserTemplates = UserTemplates + { activationSms :: !ActivationSmsTemplate, + activationCall :: !ActivationCallTemplate, + verificationEmail :: !VerificationEmailTemplate, + activationEmail :: !ActivationEmailTemplate, + activationEmailUpdate :: !ActivationEmailTemplate, + teamActivationEmail :: !TeamActivationEmailTemplate, + passwordResetSms :: !PasswordResetSmsTemplate, + passwordResetEmail :: !PasswordResetEmailTemplate, + loginSms :: !LoginSmsTemplate, + loginCall :: !LoginCallTemplate, + deletionSms :: !DeletionSmsTemplate, + deletionEmail :: !DeletionEmailTemplate, + newClientEmail :: !NewClientEmailTemplate + } + +data ActivationSmsTemplate = ActivationSmsTemplate + { activationSmslUrl :: !Template, + activationSmsText :: !Template, + activationSmsSender :: !Text + } + +data ActivationCallTemplate = ActivationCallTemplate + { activationCallText :: !Template + } + +data VerificationEmailTemplate = VerificationEmailTemplate + { verificationEmailUrl :: !Template, + verificationEmailSubject :: !Template, + verificationEmailBodyText :: !Template, + verificationEmailBodyHtml :: !Template, + verificationEmailSender :: !Email, + verificationEmailSenderName :: !Text + } + +data ActivationEmailTemplate = ActivationEmailTemplate + { activationEmailUrl :: !Template, + activationEmailSubject :: !Template, + activationEmailBodyText :: !Template, + activationEmailBodyHtml :: !Template, + activationEmailSender :: !Email, + activationEmailSenderName :: !Text + } + +data TeamActivationEmailTemplate = TeamActivationEmailTemplate + { teamActivationEmailUrl :: !Template, + teamActivationEmailSubject :: !Template, + teamActivationEmailBodyText :: !Template, + teamActivationEmailBodyHtml :: !Template, + teamActivationEmailSender :: !Email, + teamActivationEmailSenderName :: !Text + } + +data DeletionEmailTemplate = DeletionEmailTemplate + { deletionEmailUrl :: !Template, + deletionEmailSubject :: !Template, + deletionEmailBodyText :: !Template, + deletionEmailBodyHtml :: !Template, + deletionEmailSender :: !Email, + deletionEmailSenderName :: !Text + } + +data PasswordResetEmailTemplate = PasswordResetEmailTemplate + { passwordResetEmailUrl :: !Template, + passwordResetEmailSubject :: !Template, + passwordResetEmailBodyText :: !Template, + passwordResetEmailBodyHtml :: !Template, + passwordResetEmailSender :: !Email, + passwordResetEmailSenderName :: !Text + } + +data PasswordResetSmsTemplate = PasswordResetSmsTemplate + { passwordResetSmsText :: !Template, + passwordResetSmsSender :: !Text + } + +data LoginSmsTemplate = LoginSmsTemplate + { loginSmsUrl :: !Template, + loginSmsText :: !Template, + loginSmsSender :: !Text + } + +data LoginCallTemplate = LoginCallTemplate + { loginCallText :: !Template + } + +data DeletionSmsTemplate = DeletionSmsTemplate + { deletionSmsUrl :: !Template, + deletionSmsText :: !Template, + deletionSmsSender :: !Text + } + +data NewClientEmailTemplate = NewClientEmailTemplate + { newClientEmailSubject :: !Template, + newClientEmailBodyText :: !Template, + newClientEmailBodyHtml :: !Template, + newClientEmailSender :: !Email, + newClientEmailSenderName :: !Text + } loadUserTemplates :: Opt.Opts -> IO (Localised UserTemplates) loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> diff --git a/services/brig/src/Brig/Whitelist.hs b/services/brig/src/Brig/Whitelist.hs index 51dedd604e6..a61e7838844 100644 --- a/services/brig/src/Brig/Whitelist.hs +++ b/services/brig/src/Brig/Whitelist.hs @@ -38,15 +38,14 @@ import Imports import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), parseRequest) -- | A service providing a whitelist of allowed email addresses and phone numbers -data Whitelist - = Whitelist - { -- | Service URL - whitelistUrl :: !Text, - -- | Username - whitelistUser :: !Text, - -- | Password - whitelistPass :: !Text - } +data Whitelist = Whitelist + { -- | Service URL + whitelistUrl :: !Text, + -- | Username + whitelistUser :: !Text, + -- | Password + whitelistPass :: !Text + } deriving (Show, Generic) instance FromJSON Whitelist diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index 34f8230c264..1ce133b3814 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -119,24 +119,23 @@ instance MonadZAuth ZAuth where runZAuth :: MonadIO m => Env -> ZAuth a -> m a runZAuth e za = liftIO $ runReaderT (unZAuth za) e -data Settings - = Settings - { -- | Secret key index to use - -- for token creation - _keyIndex :: !Int, - -- | User token validity timeout - _userTokenTimeout :: !UserTokenTimeout, - -- | Session token validity timeout - _sessionTokenTimeout :: !SessionTokenTimeout, - -- | Access token validity timeout - _accessTokenTimeout :: !AccessTokenTimeout, - -- | Proider token validity timeout - _providerTokenTimeout :: !ProviderTokenTimeout, - -- | Legal Hold User token validity timeout - _legalHoldUserTokenTimeout :: !LegalHoldUserTokenTimeout, - -- | Legal Hold Access token validity timeout - _legalHoldAccessTokenTimeout :: !LegalHoldAccessTokenTimeout - } +data Settings = Settings + { -- | Secret key index to use + -- for token creation + _keyIndex :: !Int, + -- | User token validity timeout + _userTokenTimeout :: !UserTokenTimeout, + -- | Session token validity timeout + _sessionTokenTimeout :: !SessionTokenTimeout, + -- | Access token validity timeout + _accessTokenTimeout :: !AccessTokenTimeout, + -- | Proider token validity timeout + _providerTokenTimeout :: !ProviderTokenTimeout, + -- | Legal Hold User token validity timeout + _legalHoldUserTokenTimeout :: !LegalHoldUserTokenTimeout, + -- | Legal Hold Access token validity timeout + _legalHoldAccessTokenTimeout :: !LegalHoldAccessTokenTimeout + } deriving (Show, Generic) defSettings :: Settings @@ -150,12 +149,11 @@ defSettings = (LegalHoldUserTokenTimeout (60 * 60 * 24 * 56)) -- 56 days (LegalHoldAccessTokenTimeout (60 * 15)) -- 15 minutes -data Env - = Env - { _private :: !ZC.Env, - _public :: !ZV.Env, - _settings :: !Settings - } +data Env = Env + { _private :: !ZC.Env, + _public :: !ZV.Env, + _settings :: !Settings + } type AccessToken = Token Access @@ -169,34 +167,28 @@ type LegalHoldUserToken = Token LegalHoldUser type LegalHoldAccessToken = Token LegalHoldAccess -newtype UserTokenTimeout - = UserTokenTimeout - {_userTokenTimeoutSeconds :: Integer} +newtype UserTokenTimeout = UserTokenTimeout + {_userTokenTimeoutSeconds :: Integer} deriving (Show, Generic) -newtype SessionTokenTimeout - = SessionTokenTimeout - {sessionTokenTimeoutSeconds :: Integer} +newtype SessionTokenTimeout = SessionTokenTimeout + {sessionTokenTimeoutSeconds :: Integer} deriving (Show, Generic) -newtype AccessTokenTimeout - = AccessTokenTimeout - {_accessTokenTimeoutSeconds :: Integer} +newtype AccessTokenTimeout = AccessTokenTimeout + {_accessTokenTimeoutSeconds :: Integer} deriving (Show, Generic) -newtype ProviderTokenTimeout - = ProviderTokenTimeout - {providerTokenTimeoutSeconds :: Integer} +newtype ProviderTokenTimeout = ProviderTokenTimeout + {providerTokenTimeoutSeconds :: Integer} deriving (Show, Generic) -newtype LegalHoldUserTokenTimeout - = LegalHoldUserTokenTimeout - {_legalHoldUserTokenTimeoutSeconds :: Integer} +newtype LegalHoldUserTokenTimeout = LegalHoldUserTokenTimeout + {_legalHoldUserTokenTimeoutSeconds :: Integer} deriving (Show, Generic) -newtype LegalHoldAccessTokenTimeout - = LegalHoldAccessTokenTimeout - {_legalHoldAccessTokenTimeoutSeconds :: Integer} +newtype LegalHoldAccessTokenTimeout = LegalHoldAccessTokenTimeout + {_legalHoldAccessTokenTimeoutSeconds :: Integer} deriving (Show, Generic) instance FromJSON UserTokenTimeout diff --git a/services/brig/test/integration/API/Metrics.hs b/services/brig/test/integration/API/Metrics.hs index 2ba635e53a1..268806b567d 100644 --- a/services/brig/test/integration/API/Metrics.hs +++ b/services/brig/test/integration/API/Metrics.hs @@ -78,6 +78,7 @@ testMetricsEndpoint brig = do parseCount endpoint = manyTill anyChar (string ("http_request_duration_seconds_count{handler=\"" <> endpoint <> "\",method=\"GET\",status_code=\"200\"} ")) *> decimal + -- FUTUREWORK: check whether prometheus metrics are correct regarding timings: -- Do we have a bug here? diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 0a1343b33d5..75cb70dec60 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -158,14 +158,13 @@ tests mbConf p db b c g = do ---------------------------------------------------------------------------- -- Config -data Config - = Config - { privateKey :: FilePath, - publicKey :: FilePath, - cert :: FilePath, - botHost :: Text, - botPort :: Int - } +data Config = Config + { privateKey :: FilePath, + publicKey :: FilePath, + cert :: FilePath, + botHost :: Text, + botPort :: Int + } deriving (Show, Generic) instance FromJSON Config @@ -1605,17 +1604,16 @@ runService config mkApp go = do $ mkApp buf go buf `finally` liftIO (Async.cancel srv) -data TestBot - = TestBot - { testBotId :: !BotId, - testBotClient :: !ClientId, - testBotConv :: !Ext.BotConvView, - testBotToken :: !Text, - testBotLastPrekey :: !LastPrekey, - testBotPrekeys :: ![Prekey], - testBotLocale :: !Locale, - testBotOrigin :: !Ext.BotUserView - } +data TestBot = TestBot + { testBotId :: !BotId, + testBotClient :: !ClientId, + testBotConv :: !Ext.BotConvView, + testBotToken :: !Text, + testBotLastPrekey :: !LastPrekey, + testBotPrekeys :: ![Prekey], + testBotLocale :: !Locale, + testBotOrigin :: !Ext.BotUserView + } deriving (Eq, Show) data TestBotEvent diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index d7459e7dac8..213637d7123 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -693,6 +693,7 @@ testDeleteUserSSO brig galley = do -- delete second owner now, we don't enforce existence of emails in the backend updatePermissions user3 tid (creator', Team.rolePermissions Team.RoleMember) galley deleteUser creator' (Just defPassword) brig !!! const 200 === statusCode + -- TODO: -- add sso service. (we'll need a name for that now.) -- brig needs to notify the sso service about deletions! diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs index 091aa7efe1d..bccd24e2ab3 100644 --- a/services/brig/test/integration/Main.hs +++ b/services/brig/test/integration/Main.hs @@ -55,17 +55,16 @@ import Util.Options import Util.Options.Common import Util.Test -data Config - = Config - -- internal endpoints - { brig :: Endpoint, - cannon :: Endpoint, - cargohold :: Endpoint, - galley :: Endpoint, - nginz :: Endpoint, - -- external provider - provider :: Provider.Config - } +data Config = Config + -- internal endpoints + { brig :: Endpoint, + cannon :: Endpoint, + cargohold :: Endpoint, + galley :: Endpoint, + nginz :: Endpoint, + -- external provider + provider :: Provider.Config + } deriving (Show, Generic) instance FromJSON Config diff --git a/services/cannon/src/Cannon/Dict.hs b/services/cannon/src/Cannon/Dict.hs index 7fd8e7ad403..3e214743ed0 100644 --- a/services/cannon/src/Cannon/Dict.hs +++ b/services/cannon/src/Cannon/Dict.hs @@ -34,9 +34,8 @@ import Data.Vector ((!), Vector) import qualified Data.Vector as V import Imports hiding (lookup) -newtype Dict a b - = Dict - {_map :: Vector (IORef (SizedHashMap a b))} +newtype Dict a b = Dict + {_map :: Vector (IORef (SizedHashMap a b))} size :: MonadIO m => Dict a b -> m Int size d = liftIO $ sum <$> mapM (\r -> SHM.size <$> readIORef r) (_map d) diff --git a/services/cannon/src/Cannon/Options.hs b/services/cannon/src/Cannon/Options.hs index ca985281a3a..723bdaabafa 100644 --- a/services/cannon/src/Cannon/Options.hs +++ b/services/cannon/src/Cannon/Options.hs @@ -37,38 +37,35 @@ import Data.Aeson.APIFieldJsonTH import Imports import System.Logger.Extended (Level, LogFormat) -data Cannon - = Cannon - { _cannonHost :: !String, - _cannonPort :: !Word16, - _cannonExternalHost :: !(Maybe Text), - _cannonExternalHostFile :: !(Maybe FilePath) - } +data Cannon = Cannon + { _cannonHost :: !String, + _cannonPort :: !Word16, + _cannonExternalHost :: !(Maybe Text), + _cannonExternalHostFile :: !(Maybe FilePath) + } deriving (Eq, Show, Generic) makeFields ''Cannon deriveApiFieldJSON ''Cannon -data Gundeck - = Gundeck - { _gundeckHost :: !Text, - _gundeckPort :: !Word16 - } +data Gundeck = Gundeck + { _gundeckHost :: !Text, + _gundeckPort :: !Word16 + } deriving (Eq, Show, Generic) makeFields ''Gundeck deriveApiFieldJSON ''Gundeck -data Opts - = Opts - { _optsCannon :: !Cannon, - _optsGundeck :: !Gundeck, - _optsLogLevel :: !Level, - _optsLogNetStrings :: !(Maybe (Last Bool)), - _optsLogFormat :: !(Maybe (Last LogFormat)) - } +data Opts = Opts + { _optsCannon :: !Cannon, + _optsGundeck :: !Gundeck, + _optsLogLevel :: !Level, + _optsLogNetStrings :: !(Maybe (Last Bool)), + _optsLogFormat :: !(Maybe (Last LogFormat)) + } deriving (Eq, Show, Generic) makeFields ''Opts diff --git a/services/cannon/src/Cannon/Types.hs b/services/cannon/src/Cannon/Types.hs index 521b63f19f4..0d4a598d83f 100644 --- a/services/cannon/src/Cannon/Types.hs +++ b/services/cannon/src/Cannon/Types.hs @@ -58,20 +58,18 @@ import System.Random.MWC (GenIO) ----------------------------------------------------------------------------- -- Cannon monad -data Env - = Env - { mon :: !Metrics, - opts :: !Opts, - applog :: !Logger, - dict :: !(Dict Key Websocket), - reqId :: !RequestId, - env :: !WS.Env - } - -newtype Cannon a - = Cannon - { unCannon :: ReaderT Env IO a - } +data Env = Env + { mon :: !Metrics, + opts :: !Opts, + applog :: !Logger, + dict :: !(Dict Key Websocket), + reqId :: !RequestId, + env :: !WS.Env + } + +newtype Cannon a = Cannon + { unCannon :: ReaderT Env IO a + } deriving ( Functor, Applicative, diff --git a/services/cannon/src/Cannon/WS.hs b/services/cannon/src/Cannon/WS.hs index 691ae8ec50f..db53f1293cb 100644 --- a/services/cannon/src/Cannon/WS.hs +++ b/services/cannon/src/Cannon/WS.hs @@ -75,10 +75,9 @@ import System.Random.MWC (GenIO, uniform) ----------------------------------------------------------------------------- -- Key -newtype Key - = Key - { _key :: (ByteString, ByteString) - } +newtype Key = Key + { _key :: (ByteString, ByteString) + } deriving (Eq, Show, Hashable) mkKey :: UserId -> ConnId -> Key @@ -96,11 +95,10 @@ keyConnBytes = snd . _key ----------------------------------------------------------------------------- -- Websocket -data Websocket - = Websocket - { connection :: Connection, - connIdent :: !Word - } +data Websocket = Websocket + { connection :: Connection, + connIdent :: !Word + } mkWebSocket :: Connection -> WS Websocket mkWebSocket c = do @@ -132,26 +130,24 @@ getTime (Clock r) = readIORef r ----------------------------------------------------------------------------- -- WS Monad -data Env - = Env - { externalHostname :: !ByteString, - portnum :: !Word16, - upstream :: !Request, - reqId :: !RequestId, - logg :: !Logger, - manager :: !Manager, - dict :: !(Dict Key Websocket), - rand :: !GenIO, - clock :: !Clock - } +data Env = Env + { externalHostname :: !ByteString, + portnum :: !Word16, + upstream :: !Request, + reqId :: !RequestId, + logg :: !Logger, + manager :: !Manager, + dict :: !(Dict Key Websocket), + rand :: !GenIO, + clock :: !Clock + } setRequestId :: RequestId -> Env -> Env setRequestId rid e = e {reqId = rid} -newtype WS a - = WS - { _conn :: ReaderT Env IO a - } +newtype WS a = WS + { _conn :: ReaderT Env IO a + } deriving ( Functor, Applicative, diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index acf85568e8b..9745abf08e5 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -77,26 +77,24 @@ import Util.Options ------------------------------------------------------------------------------- -- Environment -data Env - = Env - { _aws :: AwsEnv, - _metrics :: Metrics, - _appLogger :: Logger, - _httpManager :: Manager, - _requestId :: RequestId, - _settings :: Opt.Settings - } - -data AwsEnv - = AwsEnv - { awsEnv :: Aws.Env, - -- | Needed for presigned, S3 requests (Only works with GET) - s3UriOnly :: Aws.S3Configuration Aws.UriOnlyQuery, - -- | For all other requests - s3Config :: Aws.S3Configuration Aws.NormalQuery, - s3Bucket :: Text, - cloudFront :: Maybe CloudFront - } +data Env = Env + { _aws :: AwsEnv, + _metrics :: Metrics, + _appLogger :: Logger, + _httpManager :: Manager, + _requestId :: RequestId, + _settings :: Opt.Settings + } + +data AwsEnv = AwsEnv + { awsEnv :: Aws.Env, + -- | Needed for presigned, S3 requests (Only works with GET) + s3UriOnly :: Aws.S3Configuration Aws.UriOnlyQuery, + -- | For all other requests + s3Config :: Aws.S3Configuration Aws.NormalQuery, + s3Bucket :: Text, + cloudFront :: Maybe CloudFront + } makeLenses ''Env diff --git a/services/cargohold/src/CargoHold/CloudFront.hs b/services/cargohold/src/CargoHold/CloudFront.hs index 61240cedfa5..d7ec53d2892 100644 --- a/services/cargohold/src/CargoHold/CloudFront.hs +++ b/services/cargohold/src/CargoHold/CloudFront.hs @@ -48,14 +48,13 @@ newtype KeyPairId = KeyPairId Text newtype Domain = Domain Text deriving (Eq, Show, ToByteString, Generic, FromJSON) -data CloudFront - = CloudFront - { _baseUrl :: URI, - _keyPairId :: KeyPairId, - _ttl :: Word, - _clock :: IO POSIXTime, - _func :: ByteString -> IO ByteString - } +data CloudFront = CloudFront + { _baseUrl :: URI, + _keyPairId :: KeyPairId, + _ttl :: Word, + _clock :: IO POSIXTime, + _func :: ByteString -> IO ByteString + } initCloudFront :: MonadIO m => FilePath -> KeyPairId -> Word -> Domain -> m CloudFront initCloudFront kfp kid ttl (Domain dom) = diff --git a/services/cargohold/src/CargoHold/Options.hs b/services/cargohold/src/CargoHold/Options.hs index da287096d93..540a1e56864 100644 --- a/services/cargohold/src/CargoHold/Options.hs +++ b/services/cargohold/src/CargoHold/Options.hs @@ -29,74 +29,70 @@ import Util.Options import Util.Options.Common -- | AWS CloudFront settings. -data CloudFrontOpts - = CloudFrontOpts - { -- | Domain - _cfDomain :: Domain, - -- | Keypair ID - _cfKeyPairId :: KeyPairId, - -- | Path to private key - _cfPrivateKey :: FilePath - } +data CloudFrontOpts = CloudFrontOpts + { -- | Domain + _cfDomain :: Domain, + -- | Keypair ID + _cfKeyPairId :: KeyPairId, + -- | Path to private key + _cfPrivateKey :: FilePath + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''CloudFrontOpts makeLenses ''CloudFrontOpts -data AWSOpts - = AWSOpts - { -- | Key ID; if 'Nothing', will be taken from the environment or from instance metadata - -- (when running on an AWS instance) - _awsKeyId :: !(Maybe Aws.AccessKeyId), - -- | Secret key - _awsSecretKey :: !(Maybe Aws.SecretAccessKey), - -- | S3 endpoint - _awsS3Endpoint :: !AWSEndpoint, - -- | S3 endpoint for generating download links. Useful if Cargohold is configured to use - -- an S3 replacement running inside the internal network (in which case internally we - -- would use one hostname for S3, and when generating an asset link for a client app, we - -- would use another hostname). - _awsS3DownloadEndpoint :: !(Maybe AWSEndpoint), - -- | S3 bucket name - _awsS3Bucket :: !Text, - -- | AWS CloudFront options - _awsCloudFront :: !(Maybe CloudFrontOpts) - } +data AWSOpts = AWSOpts + { -- | Key ID; if 'Nothing', will be taken from the environment or from instance metadata + -- (when running on an AWS instance) + _awsKeyId :: !(Maybe Aws.AccessKeyId), + -- | Secret key + _awsSecretKey :: !(Maybe Aws.SecretAccessKey), + -- | S3 endpoint + _awsS3Endpoint :: !AWSEndpoint, + -- | S3 endpoint for generating download links. Useful if Cargohold is configured to use + -- an S3 replacement running inside the internal network (in which case internally we + -- would use one hostname for S3, and when generating an asset link for a client app, we + -- would use another hostname). + _awsS3DownloadEndpoint :: !(Maybe AWSEndpoint), + -- | S3 bucket name + _awsS3Bucket :: !Text, + -- | AWS CloudFront options + _awsCloudFront :: !(Maybe CloudFrontOpts) + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''AWSOpts makeLenses ''AWSOpts -data Settings - = Settings - { -- | Maximum allowed size for uploads, in bytes - _setMaxTotalBytes :: !Int, - -- | TTL for download links, in seconds - _setDownloadLinkTTL :: !Word - } +data Settings = Settings + { -- | Maximum allowed size for uploads, in bytes + _setMaxTotalBytes :: !Int, + -- | TTL for download links, in seconds + _setDownloadLinkTTL :: !Word + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Settings makeLenses ''Settings -data Opts - = Opts - { -- | Hostname and port to bind to - _optCargohold :: !Endpoint, - _optAws :: !AWSOpts, - _optSettings :: !Settings, - -- Logging - - -- | Log level (Debug, Info, etc) - _optLogLevel :: !Level, - -- | Use netstrings encoding: - -- - _optLogNetStrings :: !(Maybe (Last Bool)), - _optLogFormat :: !(Maybe (Last LogFormat)) --- ^ Log format - } +data Opts = Opts + { -- | Hostname and port to bind to + _optCargohold :: !Endpoint, + _optAws :: !AWSOpts, + _optSettings :: !Settings, + -- Logging + + -- | Log level (Debug, Info, etc) + _optLogLevel :: !Level, + -- | Use netstrings encoding: + -- + _optLogNetStrings :: !(Maybe (Last Bool)), + _optLogFormat :: !(Maybe (Last LogFormat)) --- ^ Log format + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Opts diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index 46121c6459c..bdbcba4ccb5 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -98,12 +98,11 @@ newtype S3AssetKey = S3AssetKey {s3Key :: Text} deriving (Eq, Show, ToByteString) -- | Asset metadata tracked in S3. -data S3AssetMeta - = S3AssetMeta - { v3AssetOwner :: V3.Principal, - v3AssetToken :: Maybe V3.AssetToken, - v3AssetType :: MIME.Type - } +data S3AssetMeta = S3AssetMeta + { v3AssetOwner :: V3.Principal, + v3AssetToken :: Maybe V3.AssetToken, + v3AssetType :: MIME.Type + } uploadV3 :: V3.Principal -> @@ -221,41 +220,39 @@ newtype S3ChunkNr = S3ChunkNr Word newtype S3ETag = S3ETag {s3ETag :: Text} deriving (Eq, Show, ToByteString, FromByteString) -data S3Resumable - = S3Resumable - { -- | The resumable asset key. - resumableKey :: S3ResumableKey, - -- | The final asset key. - resumableAsset :: V3.AssetKey, - -- | The creator (i.e. owner). - resumableOwner :: V3.Principal, - -- | Size of each chunk. - resumableChunkSize :: V3.ChunkSize, - -- | Size of the final asset. - resumableTotalSize :: V3.TotalSize, - -- | MIME type of the final asset. - resumableType :: MIME.Type, - -- | Token of the final asset. - resumableToken :: Maybe V3.AssetToken, - -- | Expiry of the resumable upload. - resumableExpires :: UTCTime, - -- | S3 multipart upload ID, if any. - resumableUploadId :: Maybe Text, - resumableChunks :: Seq S3Chunk - } +data S3Resumable = S3Resumable + { -- | The resumable asset key. + resumableKey :: S3ResumableKey, + -- | The final asset key. + resumableAsset :: V3.AssetKey, + -- | The creator (i.e. owner). + resumableOwner :: V3.Principal, + -- | Size of each chunk. + resumableChunkSize :: V3.ChunkSize, + -- | Size of the final asset. + resumableTotalSize :: V3.TotalSize, + -- | MIME type of the final asset. + resumableType :: MIME.Type, + -- | Token of the final asset. + resumableToken :: Maybe V3.AssetToken, + -- | Expiry of the resumable upload. + resumableExpires :: UTCTime, + -- | S3 multipart upload ID, if any. + resumableUploadId :: Maybe Text, + resumableChunks :: Seq S3Chunk + } deriving (Show) -data S3Chunk - = S3Chunk - { -- | Sequence nr. - chunkNr :: S3ChunkNr, - -- | Offset of the first byte. - chunkOffset :: V3.Offset, - -- | (Actual) Size of the chunk. - chunkSize :: Word, - -- | S3 ETag. - chunkETag :: S3ETag - } +data S3Chunk = S3Chunk + { -- | Sequence nr. + chunkNr :: S3ChunkNr, + -- | Offset of the first byte. + chunkOffset :: V3.Offset, + -- | (Actual) Size of the chunk. + chunkSize :: Word, + -- | S3 ETag. + chunkETag :: S3ETag + } deriving (Show) mkChunkNr :: S3Resumable -> V3.Offset -> S3ChunkNr @@ -770,11 +767,10 @@ newtype HeadObjectX = HeadObjectX HeadObject headObjectX :: Text -> Text -> HeadObjectX headObjectX bucket key = HeadObjectX (headObject bucket key) -data HeadObjectResponseX - = HeadObjectResponseX - { horxContentType :: Maybe ByteString, - horxMetadata :: Maybe ObjectMetadata - } +data HeadObjectResponseX = HeadObjectResponseX + { horxContentType :: Maybe ByteString, + horxMetadata :: Maybe ObjectMetadata + } instance ResponseConsumer HeadObjectX HeadObjectResponseX where type ResponseMetadata HeadObjectResponseX = S3Metadata @@ -795,24 +791,21 @@ instance SignQuery HeadObjectX where -- have our own minimal implementation. This should no longer be necessary -- once cargohold is migrated to use 'amazonka'. -data ListParts - = ListParts - { lpUploadId :: Text, - lpBucket :: Text, - lpObject :: Text - } - -newtype ListPartsResponse - = ListPartsResponse - { lprsParts :: Maybe [PartInfo] - } - -data PartInfo - = PartInfo - { piNr :: Word, - piETag :: Text, - piSize :: Word - } +data ListParts = ListParts + { lpUploadId :: Text, + lpBucket :: Text, + lpObject :: Text + } + +newtype ListPartsResponse = ListPartsResponse + { lprsParts :: Maybe [PartInfo] + } + +data PartInfo = PartInfo + { piNr :: Word, + piETag :: Text, + piSize :: Word + } instance SignQuery ListParts where type ServiceConfiguration ListParts = S3Configuration diff --git a/services/cargohold/test/integration/Main.hs b/services/cargohold/test/integration/Main.hs index 62c2a889c28..f4f5a61662c 100644 --- a/services/cargohold/test/integration/Main.hs +++ b/services/cargohold/test/integration/Main.hs @@ -44,11 +44,10 @@ import Util.Options import Util.Options.Common import Util.Test -data IntegrationConfig - = IntegrationConfig - -- internal endpoint - { cargohold :: Endpoint - } +data IntegrationConfig = IntegrationConfig + -- internal endpoint + { cargohold :: Endpoint + } deriving (Show, Generic) instance FromJSON IntegrationConfig diff --git a/services/cargohold/test/integration/TestSetup.hs b/services/cargohold/test/integration/TestSetup.hs index 45624def270..0eb3e69dd5e 100644 --- a/services/cargohold/test/integration/TestSetup.hs +++ b/services/cargohold/test/integration/TestSetup.hs @@ -36,11 +36,10 @@ type CargoHold = Request -> Request type TestSignature a = CargoHold -> Http a -data TestSetup - = TestSetup - { _tsManager :: Manager, - _tsCargohold :: CargoHold - } +data TestSetup = TestSetup + { _tsManager :: Manager, + _tsCargohold :: CargoHold + } makeLenses ''TestSetup diff --git a/services/federator/src/Federator/API.hs b/services/federator/src/Federator/API.hs index 227f9270909..68fd49ca6f0 100644 --- a/services/federator/src/Federator/API.hs +++ b/services/federator/src/Federator/API.hs @@ -32,23 +32,22 @@ import Servant.API import Servant.API.Generic import Test.QuickCheck -data API route - = API - { _gapiSearch :: - route - :- "i" - :> "search" - -- QUESTION: what exactly should the query be? text + domain? - :> QueryParam' [Required, Strict] "q" (Qualified Handle) - :> Get '[JSON] FUser, - _gapiPrekeys :: - route - :- "i" - :> "users" - :> Capture "fqu" (Qualified UserId) - :> "prekeys" - :> Get '[JSON] PrekeyBundle - } +data API route = API + { _gapiSearch :: + route + :- "i" + :> "search" + -- QUESTION: what exactly should the query be? text + domain? + :> QueryParam' [Required, Strict] "q" (Qualified Handle) + :> Get '[JSON] FUser, + _gapiPrekeys :: + route + :- "i" + :> "users" + :> Capture "fqu" (Qualified UserId) + :> "prekeys" + :> Get '[JSON] PrekeyBundle + } deriving (Generic) -- curl http://localhost:8097/i/search?q=wef@a.com; curl http://localhost:8097/i/users/`uuid`@example.com/prekeys @@ -59,11 +58,10 @@ data API route -- TODO: the client ids in the 'PrekeyBundle' aren't really needed here. do we want to make a -- new type for that, then? -data FUser - = FUser - { _fuGlobalHandle :: !(Qualified Handle), - _fuFQU :: !(Qualified UserId) - } +data FUser = FUser + { _fuGlobalHandle :: !(Qualified Handle), + _fuFQU :: !(Qualified UserId) + } deriving (Eq, Show, Generic) deriveJSON (wireJsonOptions "_fu") ''FUser diff --git a/services/federator/src/Federator/Options.hs b/services/federator/src/Federator/Options.hs index 215c9b7f2ad..1e88dfff860 100644 --- a/services/federator/src/Federator/Options.hs +++ b/services/federator/src/Federator/Options.hs @@ -25,17 +25,16 @@ import Imports import System.Logger.Extended import Util.Options -data Opts - = Opts - { -- | Host and port - federator :: Endpoint, - -- | Log level (Debug, Info, etc) - logLevel :: Level, - -- | Use netstrings encoding (see ) - logNetStrings :: Maybe (Last Bool), - -- | Logformat to use - logFormat :: !(Maybe (Last LogFormat)) - } +data Opts = Opts + { -- | Host and port + federator :: Endpoint, + -- | Log level (Debug, Info, etc) + logLevel :: Level, + -- | Use netstrings encoding (see ) + logNetStrings :: Maybe (Last Bool), + -- | Logformat to use + logFormat :: !(Maybe (Last LogFormat)) + } deriving (Show, Generic) instance FromJSON Opts diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 684ed5ab380..e2f05c10252 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -88,10 +88,9 @@ closeEnv e = do -- FUTUREWORK: this code re-occurs in every service. introduce 'MkAppT' in types-common that -- takes 'Env' as one more argument. -newtype AppT m a - = AppT - { unAppT :: ReaderT Env m a - } +newtype AppT m a = AppT + { unAppT :: ReaderT Env m a + } deriving ( Functor, Applicative, diff --git a/services/federator/src/Federator/Types.hs b/services/federator/src/Federator/Types.hs index b60f4e4bcbf..ac67f2d35e3 100644 --- a/services/federator/src/Federator/Types.hs +++ b/services/federator/src/Federator/Types.hs @@ -25,11 +25,10 @@ import Control.Lens (makeLenses) import Data.Metrics (Metrics) import qualified System.Logger.Class as LC -data Env - = Env - { _metrics :: Metrics, - _applog :: LC.Logger, - _requestId :: RequestId - } +data Env = Env + { _metrics :: Metrics, + _applog :: LC.Logger, + _requestId :: RequestId + } makeLenses ''Env diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index b73be5aafaa..cebc34b3ff0 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -710,8 +710,8 @@ ensureNotTooLargeForLegalHold tid mems = do limit <- fromIntegral . fromRange <$> fanoutLimit when (length (mems ^. teamMembers) >= limit) $ do lhEnabled <- isLegalHoldEnabled tid - when lhEnabled - $ throwM tooManyTeamMembersOnTeamWithLegalhold + when lhEnabled $ + throwM tooManyTeamMembersOnTeamWithLegalhold addTeamMemberInternal :: TeamId -> Maybe UserId -> Maybe ConnId -> NewTeamMember -> TeamMemberList -> Galley TeamSize addTeamMemberInternal tid origin originConn newMem memList = do @@ -773,13 +773,13 @@ canUserJoinTeam tid = do lhEnabled <- isLegalHoldEnabled tid when (lhEnabled) $ checkTeamSize - where - checkTeamSize = do - (TeamSize size) <- BrigTeam.getSize tid - limit <- fromIntegral . fromRange <$> fanoutLimit - -- Teams larger than fanout limit cannot use legalhold - when (size >= limit) $ do - throwM tooManyTeamMembersOnTeamWithLegalhold + where + checkTeamSize = do + (TeamSize size) <- BrigTeam.getSize tid + limit <- fromIntegral . fromRange <$> fanoutLimit + -- Teams larger than fanout limit cannot use legalhold + when (size >= limit) $ do + throwM tooManyTeamMembersOnTeamWithLegalhold -- Public endpoints for feature checks @@ -874,12 +874,12 @@ setLegalholdStatusInternal tid legalHoldTeamConfig = do -- FUTUREWORK: We cannot enable legalhold on large teams right now LegalHoldEnabled -> checkTeamSize LegalHoldData.setLegalHoldTeamConfig tid legalHoldTeamConfig - where - checkTeamSize = do - (TeamSize size) <- BrigTeam.getSize tid - limit <- fromIntegral . fromRange <$> fanoutLimit - when (size > limit) $ do - throwM cannotEnableLegalHoldServiceLargeTeam + where + checkTeamSize = do + (TeamSize size) <- BrigTeam.getSize tid + limit <- fromIntegral . fromRange <$> fanoutLimit + when (size > limit) $ do + throwM cannotEnableLegalHoldServiceLargeTeam userIsTeamOwnerH :: TeamId ::: UserId ::: JSON -> Galley Response userIsTeamOwnerH (tid ::: uid ::: _) = do diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 93fd5f9fc55..274ad9301b5 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -893,8 +893,8 @@ withValidOtrBroadcastRecipients :: withValidOtrBroadcastRecipients usr clt rcps val now go = Teams.withBindingTeam usr $ \tid -> do limit <- fromIntegral . fromRange <$> fanoutLimit -- If we are going to fan this out to more than limit, we want to fail early - unless ((Map.size $ userClientMap (otrRecipientsMap rcps)) <= limit) - $ throwM broadcastLimitExceeded + unless ((Map.size $ userClientMap (otrRecipientsMap rcps)) <= limit) $ + throwM broadcastLimitExceeded -- In large teams, we may still use the broadcast endpoint but only if `report_missing` -- is used and length `report_missing` < limit since we cannot fetch larger teams than -- that. @@ -918,13 +918,13 @@ withValidOtrBroadcastRecipients usr clt rcps val now go = Teams.withBindingTeam (localUserIdsInRcps, _remoteUserIdsInRcps) <- partitionMappedOrLocalIds <$> traverse resolveOpaqueUserId (Map.keys $ userClientMap (otrRecipientsMap rcps)) -- Put them in a single list, and ensure it's smaller than the max size let localUserIdsToLookup = Set.toList $ Set.union (Set.fromList localUserIdsInFilter) (Set.fromList localUserIdsInRcps) - unless (length localUserIdsToLookup <= limit) - $ throwM broadcastLimitExceeded + unless (length localUserIdsToLookup <= limit) $ + throwM broadcastLimitExceeded Data.teamMembersLimited tid localUserIdsToLookup maybeFetchAllMembersInTeam tid = do mems <- Data.teamMembersForFanout tid - when (mems ^. teamMemberListType == ListTruncated) - $ throwM broadcastLimitExceeded + when (mems ^. teamMemberListType == ListTruncated) $ + throwM broadcastLimitExceeded pure (mems ^. teamMembers) withValidOtrRecipients :: diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index b8cac1d5dda..ed4e32da2bc 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -93,34 +93,31 @@ data DeleteItem = TeamItem TeamId UserId (Maybe ConnId) deriving (Eq, Ord, Show) -- | Main application environment. -data Env - = Env - { _reqId :: RequestId, - _monitor :: Metrics, - _options :: Opts, - _applog :: Logger, - _manager :: Manager, - _cstate :: ClientState, - _deleteQueue :: Q.Queue DeleteItem, - _extEnv :: ExtEnv, - _aEnv :: Maybe Aws.Env - } +data Env = Env + { _reqId :: RequestId, + _monitor :: Metrics, + _options :: Opts, + _applog :: Logger, + _manager :: Manager, + _cstate :: ClientState, + _deleteQueue :: Q.Queue DeleteItem, + _extEnv :: ExtEnv, + _aEnv :: Maybe Aws.Env + } -- | Environment specific to the communication with external -- service providers. -data ExtEnv - = ExtEnv - { _extGetManager :: (Manager, [Fingerprint Rsa] -> Ssl.SSL -> IO ()) - } +data ExtEnv = ExtEnv + { _extGetManager :: (Manager, [Fingerprint Rsa] -> Ssl.SSL -> IO ()) + } makeLenses ''Env makeLenses ''ExtEnv -newtype Galley a - = Galley - { unGalley :: ReaderT Env Client a - } +newtype Galley a = Galley + { unGalley :: ReaderT Env Client a + } deriving ( Functor, Applicative, @@ -148,14 +145,14 @@ validateOptions l o = do let settings = view optSettings o optFanoutLimit = fromIntegral . fromRange $ currentFanoutLimit o when ((isJust $ o ^. optJournal) && (settings ^. setMaxTeamSize > optFanoutLimit)) $ - Logger.warn - l - ( msg . - val $ - "Your journaling events for teams larger than " <> toByteString' optFanoutLimit <> - " may have some admin user ids missing. \ - \ This is fine for testing purposes but NOT for production use!!" - ) + Logger.warn + l + ( msg + . val + $ "Your journaling events for teams larger than " <> toByteString' optFanoutLimit + <> " may have some admin user ids missing. \ + \ This is fine for testing purposes but NOT for production use!!" + ) when (settings ^. setMaxConvSize > optFanoutLimit) $ error "setMaxConvSize cannot be > setTruncationLimit" when (settings ^. setMaxTeamSize < optFanoutLimit) $ diff --git a/services/galley/src/Galley/Aws.hs b/services/galley/src/Galley/Aws.hs index 893c2cd54e0..f0d86c1882a 100644 --- a/services/galley/src/Galley/Aws.hs +++ b/services/galley/src/Galley/Aws.hs @@ -71,19 +71,17 @@ deriving instance Typeable Error instance Exception Error -data Env - = Env - { _awsEnv :: !AWS.Env, - _logger :: !Logger, - _eventQueue :: !QueueUrl - } +data Env = Env + { _awsEnv :: !AWS.Env, + _logger :: !Logger, + _eventQueue :: !QueueUrl + } makeLenses ''Env -newtype Amazon a - = Amazon - { unAmazon :: ReaderT Env (ResourceT IO) a - } +newtype Amazon a = Amazon + { unAmazon :: ReaderT Env (ResourceT IO) a + } deriving ( Functor, Applicative, diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index 6c66c794a3f..60207c61ecc 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -62,7 +62,9 @@ selectTeamConvsFrom :: PrepQuery R (TeamId, OpaqueConvId) (ConvId, Bool) selectTeamConvsFrom = "select conv, managed from team_conv where team = ? and conv > ? order by conv" selectTeamMember :: - PrepQuery R (TeamId, UserId) + PrepQuery + R + (TeamId, UserId) ( Permissions, Maybe UserId, Maybe UTCTimeMillis, @@ -72,7 +74,9 @@ selectTeamMember = "select perms, invited_by, invited_at, legalhold_status from -- | This query fetches **all** members of a team, it should always be paginated selectTeamMembers :: - PrepQuery R (Identity TeamId) + PrepQuery + R + (Identity TeamId) ( UserId, Permissions, Maybe UserId, @@ -87,7 +91,9 @@ selectTeamMembers = |] selectTeamMembersFrom :: - PrepQuery R (TeamId, UserId) + PrepQuery + R + (TeamId, UserId) ( UserId, Permissions, Maybe UserId, @@ -102,7 +108,9 @@ selectTeamMembersFrom = |] selectTeamMembers' :: - PrepQuery R (TeamId, [UserId]) + PrepQuery + R + (TeamId, [UserId]) ( UserId, Permissions, Maybe UserId, diff --git a/services/galley/src/Galley/Data/Types.hs b/services/galley/src/Galley/Data/Types.hs index 45bb0abcb42..88334a1d22e 100644 --- a/services/galley/src/Galley/Data/Types.hs +++ b/services/galley/src/Galley/Data/Types.hs @@ -48,21 +48,20 @@ import OpenSSL.Random (randBytes) -- | Internal conversation type, corresponding directly to database schema. -- Should never be sent to users (and therefore doesn't have 'FromJSON' or -- 'ToJSON' instances). -data Conversation - = Conversation - { convId :: ConvId, - convType :: ConvType, - convCreator :: UserId, - convName :: Maybe Text, - convAccess :: [Access], - convAccessRole :: AccessRole, - convMembers :: [Member], - convTeam :: Maybe TeamId, - convDeleted :: Maybe Bool, - -- | Global message timer - convMessageTimer :: Maybe Milliseconds, - convReceiptMode :: Maybe ReceiptMode - } +data Conversation = Conversation + { convId :: ConvId, + convType :: ConvType, + convCreator :: UserId, + convName :: Maybe Text, + convAccess :: [Access], + convAccessRole :: AccessRole, + convMembers :: [Member], + convTeam :: Maybe TeamId, + convDeleted :: Maybe Bool, + -- | Global message timer + convMessageTimer :: Maybe Milliseconds, + convReceiptMode :: Maybe ReceiptMode + } deriving (Eq, Show, Generic) isSelfConv :: Conversation -> Bool @@ -83,14 +82,13 @@ selfConv uid = Id (toUUID uid) -------------------------------------------------------------------------------- -- Code -data Code - = Code - { codeKey :: !Key, - codeValue :: !Value, - codeTTL :: !Timeout, - codeConversation :: !ConvId, - codeScope :: !Scope - } +data Code = Code + { codeKey :: !Key, + codeValue :: !Value, + codeTTL :: !Timeout, + codeConversation :: !ConvId, + codeScope :: !Scope + } deriving (Eq, Show, Generic) data Scope = ReusableCode diff --git a/services/galley/src/Galley/External/LegalHoldService.hs b/services/galley/src/Galley/External/LegalHoldService.hs index 30d95a25287..39d0bb270c7 100644 --- a/services/galley/src/Galley/External/LegalHoldService.hs +++ b/services/galley/src/Galley/External/LegalHoldService.hs @@ -239,8 +239,7 @@ validateServiceKey pem = liftIO $ -- it's error-prone useless extra work to parse and render them from JSON over and over again. -- We'll just wrap them with this to give some level of typesafety and a reasonable JSON -- instance -newtype OpaqueAuthToken - = OpaqueAuthToken - { opaqueAuthTokenToText :: Text - } +newtype OpaqueAuthToken = OpaqueAuthToken + { opaqueAuthTokenToText :: Text + } deriving newtype (Eq, Show, FromJSON, ToJSON, ToByteString) diff --git a/services/galley/src/Galley/Intra/Push.hs b/services/galley/src/Galley/Intra/Push.hs index 14ee71d60e0..a0e5448c639 100644 --- a/services/galley/src/Galley/Intra/Push.hs +++ b/services/galley/src/Galley/Intra/Push.hs @@ -84,11 +84,10 @@ pushEventJson :: PushEvent -> Object pushEventJson (ConvEvent e) = toJSONObject e pushEventJson (TeamEvent e) = toJSONObject e -data Recipient - = Recipient - { _recipientUserId :: UserId, - _recipientClients :: RecipientClients - } +data Recipient = Recipient + { _recipientUserId :: UserId, + _recipientClients :: RecipientClients + } makeLenses ''Recipient @@ -98,18 +97,17 @@ recipient m = Recipient (memId m) RecipientClientsAll userRecipient :: UserId -> Recipient userRecipient u = Recipient u RecipientClientsAll -data Push - = Push - { _pushConn :: Maybe ConnId, - _pushTransient :: Bool, - _pushRoute :: Gundeck.Route, - _pushNativePriority :: Maybe Gundeck.Priority, - _pushAsync :: Bool, - pushOrigin :: UserId, - pushRecipients :: List1 Recipient, - pushJson :: Object, - pushRecipientListType :: Teams.ListType - } +data Push = Push + { _pushConn :: Maybe ConnId, + _pushTransient :: Bool, + _pushRoute :: Gundeck.Route, + _pushNativePriority :: Maybe Gundeck.Priority, + _pushAsync :: Bool, + pushOrigin :: UserId, + pushRecipients :: List1 Recipient, + pushJson :: Object, + pushRecipientListType :: Teams.ListType + } makeLenses ''Push diff --git a/services/galley/src/Galley/Options.hs b/services/galley/src/Galley/Options.hs index cad3e28670d..57c51f11dfd 100644 --- a/services/galley/src/Galley/Options.hs +++ b/services/galley/src/Galley/Options.hs @@ -27,33 +27,32 @@ import System.Logger.Extended (Level, LogFormat) import Util.Options import Util.Options.Common -data Settings - = Settings - { -- | Number of connections for the HTTP client pool - _setHttpPoolSize :: !Int, - -- | Max number of members in a team. NOTE: This must be in sync with Brig - _setMaxTeamSize :: !Word16, - -- | Max number of team members users to fanout events to. For teams larger than - -- this value, team events and user updates will no longer be sent to team users. - -- This defaults to setMaxTeamSize and cannot be > HardTruncationLimit. Useful - -- to tune mainly for testing purposes. - _setMaxFanoutSize :: !(Maybe (Range 1 HardTruncationLimit Int32)), - -- | Max number of members in a conversation. NOTE: This must be in sync with Brig - _setMaxConvSize :: !Word16, - -- | Whether to call Brig for device listing - _setIntraListing :: !Bool, - -- | URI prefix for conversations with access mode @code@ - _setConversationCodeURI :: !HttpsUrl, - -- | Throttling: limits to concurrent deletion events - _setConcurrentDeletionEvents :: !(Maybe Int), - -- | Throttling: delay between sending events upon team deletion - _setDeleteConvThrottleMillis :: !(Maybe Int), - -- | When false, assume there are no other backends and IDs are always local. - -- This means we don't run any queries on federation-related tables and don't - -- make any calls to the federator service. - _setEnableFederation :: !(Maybe Bool), - _setFeatureFlags :: !FeatureFlags - } +data Settings = Settings + { -- | Number of connections for the HTTP client pool + _setHttpPoolSize :: !Int, + -- | Max number of members in a team. NOTE: This must be in sync with Brig + _setMaxTeamSize :: !Word16, + -- | Max number of team members users to fanout events to. For teams larger than + -- this value, team events and user updates will no longer be sent to team users. + -- This defaults to setMaxTeamSize and cannot be > HardTruncationLimit. Useful + -- to tune mainly for testing purposes. + _setMaxFanoutSize :: !(Maybe (Range 1 HardTruncationLimit Int32)), + -- | Max number of members in a conversation. NOTE: This must be in sync with Brig + _setMaxConvSize :: !Word16, + -- | Whether to call Brig for device listing + _setIntraListing :: !Bool, + -- | URI prefix for conversations with access mode @code@ + _setConversationCodeURI :: !HttpsUrl, + -- | Throttling: limits to concurrent deletion events + _setConcurrentDeletionEvents :: !(Maybe Int), + -- | Throttling: delay between sending events upon team deletion + _setDeleteConvThrottleMillis :: !(Maybe Int), + -- | When false, assume there are no other backends and IDs are always local. + -- This means we don't run any queries on federation-related tables and don't + -- make any calls to the federator service. + _setEnableFederation :: !(Maybe Bool), + _setFeatureFlags :: !FeatureFlags + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Settings @@ -72,47 +71,45 @@ defFanoutLimit = unsafeRange hardTruncationLimit defEnableFederation :: Bool defEnableFederation = False -data JournalOpts - = JournalOpts - { -- | SQS queue name to send team events - _awsQueueName :: !Text, - -- | AWS endpoint - _awsEndpoint :: !AWSEndpoint - } +data JournalOpts = JournalOpts + { -- | SQS queue name to send team events + _awsQueueName :: !Text, + -- | AWS endpoint + _awsEndpoint :: !AWSEndpoint + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''JournalOpts makeLenses ''JournalOpts -data Opts - = Opts - { -- | Host and port to bind to - _optGalley :: !Endpoint, - -- | Cassandra settings - _optCassandra :: !CassandraOpts, - -- | Brig endpoint - _optBrig :: !Endpoint, - -- | Gundeck endpoint - _optGundeck :: !Endpoint, - -- | Spar endpoint - _optSpar :: !Endpoint, - -- | Disco URL - _optDiscoUrl :: !(Maybe Text), - -- | Other settings - _optSettings :: !Settings, - -- | Journaling options ('Nothing' - -- disables journaling) - -- Logging - _optJournal :: !(Maybe JournalOpts), - -- | Log level (Debug, Info, etc) - _optLogLevel :: !Level, - -- | Use netstrings encoding - -- - _optLogNetStrings :: !(Maybe (Last Bool)), - -- | What log format to use - _optLogFormat :: !(Maybe (Last LogFormat)) - } +data Opts = Opts + { -- | Host and port to bind to + _optGalley :: !Endpoint, + -- | Cassandra settings + _optCassandra :: !CassandraOpts, + -- | Brig endpoint + _optBrig :: !Endpoint, + -- | Gundeck endpoint + _optGundeck :: !Endpoint, + -- | Spar endpoint + _optSpar :: !Endpoint, + -- | Disco URL + _optDiscoUrl :: !(Maybe Text), + -- | Other settings + _optSettings :: !Settings, + -- | Journaling options ('Nothing' + -- disables journaling) + -- Logging + _optJournal :: !(Maybe JournalOpts), + -- | Log level (Debug, Info, etc) + _optLogLevel :: !Level, + -- | Use netstrings encoding + -- + _optLogNetStrings :: !(Maybe (Last Bool)), + -- | What log format to use + _optLogFormat :: !(Maybe (Last LogFormat)) + } deriveFromJSON toOptionFieldName ''Opts diff --git a/services/galley/src/Galley/Queue.hs b/services/galley/src/Galley/Queue.hs index 623834d44ff..f143dadae73 100644 --- a/services/galley/src/Galley/Queue.hs +++ b/services/galley/src/Galley/Queue.hs @@ -30,11 +30,10 @@ import qualified Control.Concurrent.STM as Stm import Imports import Numeric.Natural (Natural) -data Queue a - = Queue - { _len :: Stm.TVar Word, - _queue :: Stm.TBQueue a - } +data Queue a = Queue + { _len :: Stm.TVar Word, + _queue :: Stm.TBQueue a + } new :: MonadIO m => Natural -> m (Queue a) new n = liftIO $ Queue <$> Stm.newTVarIO 0 <*> Stm.newTBQueueIO n diff --git a/services/galley/src/Galley/Types/Clients.hs b/services/galley/src/Galley/Types/Clients.hs index 1c091aeefa0..af0cf1e860a 100644 --- a/services/galley/src/Galley/Types/Clients.hs +++ b/services/galley/src/Galley/Types/Clients.hs @@ -44,10 +44,9 @@ import qualified Data.Set as Set import Galley.Types (UserClients (..)) import Imports hiding (filter, toList) -newtype Clients - = Clients - { clients :: UserClients - } +newtype Clients = Clients + { clients :: UserClients + } deriving (Eq, Show, Semigroup, Monoid) instance Bounds Clients where diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index a1a20868da9..ff4f96bcd82 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -624,10 +624,11 @@ renewToken tok = do putEnabled :: HasCallStack => TeamId -> LegalHoldStatus -> TestM () putEnabled tid enabled = void $ putEnabled' expect2xx tid enabled -putEnabled' :: HasCallStack => (Bilge.Request -> Bilge.Request) ->TeamId -> LegalHoldStatus -> TestM ResponseLBS +putEnabled' :: HasCallStack => (Bilge.Request -> Bilge.Request) -> TeamId -> LegalHoldStatus -> TestM ResponseLBS putEnabled' extra tid enabled = do g <- view tsGalley - put $ g + put $ + g . paths ["i", "teams", toByteString' tid, "features", "legalhold"] . json (LegalHoldTeamConfig enabled) . extra @@ -878,12 +879,11 @@ data ClientEvent | ClientRemoved !ClientId deriving (Generic) -data LegalHoldClientRequestedData - = LegalHoldClientRequestedData - { lhcTargetUser :: !UserId, - lhcLastPrekey :: !LastPrekey, - lhcClientId :: !ClientId - } +data LegalHoldClientRequestedData = LegalHoldClientRequestedData + { lhcTargetUser :: !UserId, + lhcLastPrekey :: !LastPrekey, + lhcClientId :: !ClientId + } deriving stock (Show) instance FromJSON ClientEvent where diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index f52b0d52255..5f3225a6009 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -85,7 +85,7 @@ createBindingTeam = do createBindingTeamWithMembers :: HasCallStack => Int -> TestM (TeamId, UserId, [UserId]) createBindingTeamWithMembers numUsers = do (owner, tid) <- createBindingTeam - members <- forM [2..numUsers] $ \n -> do + members <- forM [2 .. numUsers] $ \n -> do mem <- addUserToTeam owner tid SQS.assertQueue "add member" $ SQS.tUpdate (fromIntegral n) [owner] refreshIndex @@ -284,11 +284,12 @@ addUserToTeamWithRole' role inviter tid = do invResponse <- postInvitation tid inviter invite inv <- responseJsonError invResponse Just inviteeCode <- getInvitationCode tid (inInvitation inv) - r <- post - ( brig . path "/register" - . contentJson - . body (acceptInviteBody name inviteeEmail inviteeCode) - ) + r <- + post + ( brig . path "/register" + . contentJson + . body (acceptInviteBody name inviteeEmail inviteeCode) + ) return (inv, r) addUserToTeamWithSSO :: HasCallStack => Bool -> TeamId -> TestM TeamMember diff --git a/services/galley/test/integration/TestSetup.hs b/services/galley/test/integration/TestSetup.hs index 3e9f148cc99..090124ddfd5 100644 --- a/services/galley/test/integration/TestSetup.hs +++ b/services/galley/test/integration/TestSetup.hs @@ -52,48 +52,44 @@ type BrigR = Request -> Request type CannonR = Request -> Request -data IntegrationConfig - = IntegrationConfig - -- internal endpoints - { galley :: Endpoint, - brig :: Endpoint, - cannon :: Endpoint, - provider :: LegalHoldConfig - } +data IntegrationConfig = IntegrationConfig + -- internal endpoints + { galley :: Endpoint, + brig :: Endpoint, + cannon :: Endpoint, + provider :: LegalHoldConfig + } deriving (Show, Generic) instance FromJSON IntegrationConfig -- FUTUREWORK: reduce duplication (copied from brig/Provider.hs) -data LegalHoldConfig - = LegalHoldConfig - { privateKey :: FilePath, - publicKey :: FilePath, - cert :: FilePath, - botHost :: Text, - botPort :: Int - } +data LegalHoldConfig = LegalHoldConfig + { privateKey :: FilePath, + publicKey :: FilePath, + cert :: FilePath, + botHost :: Text, + botPort :: Int + } deriving (Show, Generic) instance FromJSON LegalHoldConfig -data TestSetup - = TestSetup - { _tsGConf :: Opts, - _tsIConf :: IntegrationConfig, - _tsManager :: Manager, - _tsGalley :: GalleyR, - _tsBrig :: BrigR, - _tsCannon :: CannonR, - _tsAwsEnv :: Maybe Aws.Env, - _tsMaxConvSize :: Word16, - _tsCass :: Cql.ClientState - } +data TestSetup = TestSetup + { _tsGConf :: Opts, + _tsIConf :: IntegrationConfig, + _tsManager :: Manager, + _tsGalley :: GalleyR, + _tsBrig :: BrigR, + _tsCannon :: CannonR, + _tsAwsEnv :: Maybe Aws.Env, + _tsMaxConvSize :: Word16, + _tsCass :: Cql.ClientState + } makeLenses ''TestSetup -newtype TestM a - = TestM {runTestM :: ReaderT TestSetup IO a} +newtype TestM a = TestM {runTestM :: ReaderT TestSetup IO a} deriving ( Functor, Applicative, diff --git a/services/gundeck/schema/src/V5.hs b/services/gundeck/schema/src/V5.hs index 4a76276b5ce..f7572f69ef1 100644 --- a/services/gundeck/schema/src/V5.hs +++ b/services/gundeck/schema/src/V5.hs @@ -28,4 +28,5 @@ migration :: Migration migration = Migration 5 "Add user_push.fallback column" $ schema' [r| alter columnfamily user_push add fallback int; |] + -- TODO: fallback is deprecated as of https://github.com/wireapp/wire-server/pull/531 diff --git a/services/gundeck/schema/src/V6.hs b/services/gundeck/schema/src/V6.hs index 2819fd9e960..b912c868d06 100644 --- a/services/gundeck/schema/src/V6.hs +++ b/services/gundeck/schema/src/V6.hs @@ -37,4 +37,5 @@ migration = Migration 6 "Add fallback_cancel table" $ do ) with compaction = { 'class' : 'LeveledCompactionStrategy' } and gc_grace_seconds = 0; |] + -- TODO: fallback is deprecated as of https://github.com/wireapp/wire-server/pull/531 diff --git a/services/gundeck/src/Gundeck/Aws.hs b/services/gundeck/src/Gundeck/Aws.hs index 7496123330c..5d805d55a29 100644 --- a/services/gundeck/src/Gundeck/Aws.hs +++ b/services/gundeck/src/Gundeck/Aws.hs @@ -106,31 +106,28 @@ instance Exception Error newtype QueueUrl = QueueUrl Text deriving (Show) -data Env - = Env - { _awsEnv :: !AWS.Env, - _logger :: !Logger, - _eventQueue :: !QueueUrl, - _region :: !Region, - _account :: !Account - } - -data SNSEndpoint - = SNSEndpoint - { _endpointToken :: !Push.Token, - _endpointEnabled :: !Bool, - _endpointUsers :: !(Set UserId) - } +data Env = Env + { _awsEnv :: !AWS.Env, + _logger :: !Logger, + _eventQueue :: !QueueUrl, + _region :: !Region, + _account :: !Account + } + +data SNSEndpoint = SNSEndpoint + { _endpointToken :: !Push.Token, + _endpointEnabled :: !Bool, + _endpointUsers :: !(Set UserId) + } deriving (Show) makeLenses ''Env makeLenses ''SNSEndpoint -newtype Amazon a - = Amazon - { unAmazon :: ReaderT Env (ResourceT IO) a - } +newtype Amazon a = Amazon + { unAmazon :: ReaderT Env (ResourceT IO) a + } deriving ( Functor, Applicative, @@ -348,10 +345,9 @@ data PublishError | InvalidEndpoint !EndpointArn | PayloadTooLarge !EndpointArn -newtype Attributes - = Attributes - { setAttributes :: Endo (HashMap Text SNS.MessageAttributeValue) - } +newtype Attributes = Attributes + { setAttributes :: Endo (HashMap Text SNS.MessageAttributeValue) + } deriving (Semigroup, Monoid) -- Note [VoIP TTLs] diff --git a/services/gundeck/src/Gundeck/Aws/Arn.hs b/services/gundeck/src/Gundeck/Aws/Arn.hs index c67cfae73bd..ec9927f4b01 100644 --- a/services/gundeck/src/Gundeck/Aws/Arn.hs +++ b/services/gundeck/src/Gundeck/Aws/Arn.hs @@ -65,30 +65,27 @@ newtype Account = Account {fromAccount :: Text} deriving (Eq, Ord, Show, ToText, newtype EndpointId = EndpointId Text deriving (Eq, Ord, Show, ToText) -data SnsArn a - = SnsArn - { _snsAsText :: !Text, - _snsRegion :: !Region, - _snsAccount :: !Account, - _snsTopic :: !a - } +data SnsArn a = SnsArn + { _snsAsText :: !Text, + _snsRegion :: !Region, + _snsAccount :: !Account, + _snsTopic :: !a + } deriving (Eq, Ord, Show) -data AppTopic - = AppTopic - { _appAsText :: !Text, - _appTransport :: !Transport, - _appName :: !AppName - } +data AppTopic = AppTopic + { _appAsText :: !Text, + _appTransport :: !Transport, + _appName :: !AppName + } deriving (Eq, Show) -data EndpointTopic - = EndpointTopic - { _endpointAsText :: !Text, - _endpointTransport :: !Transport, - _endpointAppName :: !AppName, - _endpointId :: !EndpointId - } +data EndpointTopic = EndpointTopic + { _endpointAsText :: !Text, + _endpointTransport :: !Transport, + _endpointAppName :: !AppName, + _endpointId :: !EndpointId + } deriving (Eq, Ord, Show) type AppArn = SnsArn AppTopic diff --git a/services/gundeck/src/Gundeck/Aws/Sns.hs b/services/gundeck/src/Gundeck/Aws/Sns.hs index 5b297d2ca41..187fb793734 100644 --- a/services/gundeck/src/Gundeck/Aws/Sns.hs +++ b/services/gundeck/src/Gundeck/Aws/Sns.hs @@ -48,11 +48,10 @@ data DeliveryFailure | DeliveryUnknownFailure !Text deriving (Eq, Show) -data Event - = Event - { _evType :: !EventType, - _evEndpoint :: !EndpointArn - } +data Event = Event + { _evType :: !EventType, + _evEndpoint :: !EndpointArn + } deriving (Show) makeLenses ''Event diff --git a/services/gundeck/src/Gundeck/Env.hs b/services/gundeck/src/Gundeck/Env.hs index 1490060d03b..781d610f813 100644 --- a/services/gundeck/src/Gundeck/Env.hs +++ b/services/gundeck/src/Gundeck/Env.hs @@ -39,19 +39,18 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified System.Logger.Extended as Logger import Util.Options -data Env - = Env - { _reqId :: !RequestId, - _monitor :: !Metrics, - _options :: !Opts, - _applog :: !Logger.Logger, - _manager :: !Manager, - _cstate :: !ClientState, - _rstate :: !Redis.Pool, - _awsEnv :: !Aws.Env, - _time :: !(IO Milliseconds), - _threadBudgetState :: !(Maybe ThreadBudgetState) - } +data Env = Env + { _reqId :: !RequestId, + _monitor :: !Metrics, + _options :: !Opts, + _applog :: !Logger.Logger, + _manager :: !Manager, + _cstate :: !ClientState, + _rstate :: !Redis.Pool, + _awsEnv :: !Aws.Env, + _time :: !(IO Milliseconds), + _threadBudgetState :: !(Maybe ThreadBudgetState) + } makeLenses ''Env diff --git a/services/gundeck/src/Gundeck/Monad.hs b/services/gundeck/src/Gundeck/Monad.hs index b029561b8e4..dd07d342028 100644 --- a/services/gundeck/src/Gundeck/Monad.hs +++ b/services/gundeck/src/Gundeck/Monad.hs @@ -58,10 +58,9 @@ import System.Logger.Class hiding (Error, info) -- | TODO: 'Client' already has an 'Env'. Why do we need two? How does this even work? We should -- probably explain this here. -newtype Gundeck a - = Gundeck - { unGundeck :: ReaderT Env Client a - } +newtype Gundeck a = Gundeck + { unGundeck :: ReaderT Env Client a + } deriving ( Functor, Applicative, diff --git a/services/gundeck/src/Gundeck/Notification.hs b/services/gundeck/src/Gundeck/Notification.hs index 9b40a02a10b..55bab330d7f 100644 --- a/services/gundeck/src/Gundeck/Notification.hs +++ b/services/gundeck/src/Gundeck/Notification.hs @@ -34,11 +34,10 @@ import qualified Gundeck.Notification.Data as Data import Gundeck.Types.Notification import Imports hiding (getLast) -data PaginateResult - = PaginateResult - { paginateResultGap :: Bool, - paginateResultPage :: QueuedNotificationList - } +data PaginateResult = PaginateResult + { paginateResultGap :: Bool, + paginateResultPage :: QueuedNotificationList + } paginate :: UserId -> Maybe NotificationId -> Maybe ClientId -> Range 100 10000 Int32 -> Gundeck PaginateResult paginate uid since clt size = do diff --git a/services/gundeck/src/Gundeck/Notification/Data.hs b/services/gundeck/src/Gundeck/Notification/Data.hs index 74ac9a773f9..cea89377fb0 100644 --- a/services/gundeck/src/Gundeck/Notification/Data.hs +++ b/services/gundeck/src/Gundeck/Notification/Data.hs @@ -38,18 +38,17 @@ import Gundeck.Types.Notification import Imports import UnliftIO (pooledForConcurrentlyN_) -data ResultPage - = ResultPage - { -- | A sequence of notifications. - resultSeq :: Seq QueuedNotification, - -- | Whether there might be more notifications that can be - -- obtained through another query, starting the the ID of the - -- last notification in 'resultSeq'. - resultHasMore :: !Bool, - -- | Whether there might be a gap in the 'resultSeq'. This is 'True' - -- iff a start ID ('since') has been given which could not be found. - resultGap :: !Bool - } +data ResultPage = ResultPage + { -- | A sequence of notifications. + resultSeq :: Seq QueuedNotification, + -- | Whether there might be more notifications that can be + -- obtained through another query, starting the the ID of the + -- last notification in 'resultSeq'. + resultHasMore :: !Bool, + -- | Whether there might be a gap in the 'resultSeq'. This is 'True' + -- iff a start ID ('since') has been given which could not be found. + resultGap :: !Bool + } -- FUTUREWORK: the magic 32 should be made configurable, so it can be tuned add :: diff --git a/services/gundeck/src/Gundeck/Options.hs b/services/gundeck/src/Gundeck/Options.hs index 490acd7f811..990b32ad339 100644 --- a/services/gundeck/src/Gundeck/Options.hs +++ b/services/gundeck/src/Gundeck/Options.hs @@ -28,55 +28,51 @@ import System.Logger.Extended (Level, LogFormat) import Util.Options import Util.Options.Common -newtype NotificationTTL - = NotificationTTL - {notificationTTLSeconds :: Word32} +newtype NotificationTTL = NotificationTTL + {notificationTTLSeconds :: Word32} deriving (Eq, Ord, Show, Generic, FromJSON) -data AWSOpts - = AWSOpts - { -- | AWS account - _awsAccount :: !Account, - -- | AWS region name - _awsRegion :: !Region, - -- | Environment name to scope ARNs to - _awsArnEnv :: !ArnEnv, - -- | SQS queue name - _awsQueueName :: !Text, - _awsSqsEndpoint :: !AWSEndpoint, - _awsSnsEndpoint :: !AWSEndpoint - } +data AWSOpts = AWSOpts + { -- | AWS account + _awsAccount :: !Account, + -- | AWS region name + _awsRegion :: !Region, + -- | Environment name to scope ARNs to + _awsArnEnv :: !ArnEnv, + -- | SQS queue name + _awsQueueName :: !Text, + _awsSqsEndpoint :: !AWSEndpoint, + _awsSnsEndpoint :: !AWSEndpoint + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''AWSOpts makeLenses ''AWSOpts -data Settings - = Settings - { -- | Number of connections to keep open in the http-client pool - _setHttpPoolSize :: !Int, - -- | TTL (seconds) of stored notifications - _setNotificationTTL :: !NotificationTTL, - -- | Use this option to group push notifications and send them in bulk to Cannon, instead - -- of in individual requests - _setBulkPush :: !Bool, - -- | Maximum number of concurrent threads calling SNS. - _setMaxConcurrentNativePushes :: !(Maybe MaxConcurrentNativePushes), - -- | Maximum number of parallel requests to SNS and cassandra - -- during native push processing (per incoming push request) - -- defaults to unbounded, if unset. - _setPerNativePushConcurrency :: !(Maybe Int) - } +data Settings = Settings + { -- | Number of connections to keep open in the http-client pool + _setHttpPoolSize :: !Int, + -- | TTL (seconds) of stored notifications + _setNotificationTTL :: !NotificationTTL, + -- | Use this option to group push notifications and send them in bulk to Cannon, instead + -- of in individual requests + _setBulkPush :: !Bool, + -- | Maximum number of concurrent threads calling SNS. + _setMaxConcurrentNativePushes :: !(Maybe MaxConcurrentNativePushes), + -- | Maximum number of parallel requests to SNS and cassandra + -- during native push processing (per incoming push request) + -- defaults to unbounded, if unset. + _setPerNativePushConcurrency :: !(Maybe Int) + } deriving (Show, Generic) -data MaxConcurrentNativePushes - = MaxConcurrentNativePushes - { -- | more than this number of threads will not be allowed - _limitHard :: !(Maybe Int), - -- | more than this number of threads will be warned about - _limitSoft :: !(Maybe Int) - } +data MaxConcurrentNativePushes = MaxConcurrentNativePushes + { -- | more than this number of threads will not be allowed + _limitHard :: !(Maybe Int), + -- | more than this number of threads will be warned about + _limitSoft :: !(Maybe Int) + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Settings @@ -87,24 +83,23 @@ deriveFromJSON toOptionFieldName ''MaxConcurrentNativePushes makeLenses ''MaxConcurrentNativePushes -data Opts - = Opts - { -- | Hostname and port to bind to - _optGundeck :: !Endpoint, - _optCassandra :: !CassandraOpts, - _optRedis :: !Endpoint, - _optAws :: !AWSOpts, - _optDiscoUrl :: !(Maybe Text), - _optSettings :: !Settings, - -- Logging - - -- | Log level (Debug, Info, etc) - _optLogLevel :: !Level, - -- | Use netstrings encoding: - -- - _optLogNetStrings :: !(Maybe (Last Bool)), - _optLogFormat :: !(Maybe (Last LogFormat)) - } +data Opts = Opts + { -- | Hostname and port to bind to + _optGundeck :: !Endpoint, + _optCassandra :: !CassandraOpts, + _optRedis :: !Endpoint, + _optAws :: !AWSOpts, + _optDiscoUrl :: !(Maybe Text), + _optSettings :: !Settings, + -- Logging + + -- | Log level (Debug, Info, etc) + _optLogLevel :: !Level, + -- | Use netstrings encoding: + -- + _optLogNetStrings :: !(Maybe (Last Bool)), + _optLogFormat :: !(Maybe (Last LogFormat)) + } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Opts diff --git a/services/gundeck/src/Gundeck/Push/Native/Types.hs b/services/gundeck/src/Gundeck/Push/Native/Types.hs index f345c704e5e..3787c238dd1 100644 --- a/services/gundeck/src/Gundeck/Push/Native/Types.hs +++ b/services/gundeck/src/Gundeck/Push/Native/Types.hs @@ -48,13 +48,12 @@ import Gundeck.Types.Push.V2 (PushToken) import Imports -- | Native push address information of a device. -data Address - = Address - { _addrUser :: !UserId, - _addrEndpoint :: !EndpointArn, - _addrConn :: !ConnId, - _addrPushToken :: !PushToken - } +data Address = Address + { _addrUser :: !UserId, + _addrEndpoint :: !EndpointArn, + _addrConn :: !ConnId, + _addrPushToken :: !PushToken + } deriving (Eq, Ord) makeLenses ''Address @@ -104,9 +103,8 @@ data Failure | PushException !SomeException deriving (Show) -data NativePush - = NativePush - { npNotificationid :: NotificationId, - npPriority :: Priority, - npApsData :: Maybe ApsData - } +data NativePush = NativePush + { npNotificationid :: NotificationId, + npPriority :: Priority, + npApsData :: Maybe ApsData + } diff --git a/services/gundeck/src/Gundeck/Push/Websocket.hs b/services/gundeck/src/Gundeck/Push/Websocket.hs index 81e34cd3cc8..1c9f26e5e1f 100644 --- a/services/gundeck/src/Gundeck/Push/Websocket.hs +++ b/services/gundeck/src/Gundeck/Push/Websocket.hs @@ -201,14 +201,13 @@ bulkSend' uri (encode -> jsbody) = do -- | NOTE: 'PushTarget's may occur several times both in the "lost" and in the "delivered" list. -- This happens iff there are several 'Notifcation's for the same 'PushTarget', and some of them are -- delivered while others aren't. -data FlowBack - = FlowBack - { -- | list of cannons that failed to respond with status 200 - flowBackBadCannons :: [(URI, SomeException)], - -- | 401 inside the body (for one presence) - flowBackLostPrcs :: [PushTarget], - flowBackDelivered :: [(NotificationId, PushTarget)] - } +data FlowBack = FlowBack + { -- | list of cannons that failed to respond with status 200 + flowBackBadCannons :: [(URI, SomeException)], + -- | 401 inside the body (for one presence) + flowBackLostPrcs :: [PushTarget], + flowBackDelivered :: [(NotificationId, PushTarget)] + } flowBack :: [(URI, Either SomeException BulkPushResponse)] -> FlowBack flowBack rawresps = FlowBack broken gone delivered diff --git a/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs b/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs index bc89e14d5b1..8d66e207cc5 100644 --- a/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs +++ b/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs @@ -33,19 +33,17 @@ import qualified System.Logger.Class as LC import UnliftIO.Async import UnliftIO.Exception (finally) -data ThreadBudgetState - = ThreadBudgetState - { threadBudgetLimits :: MaxConcurrentNativePushes, - _threadBudgetRunning :: IORef BudgetMap - } +data ThreadBudgetState = ThreadBudgetState + { threadBudgetLimits :: MaxConcurrentNativePushes, + _threadBudgetRunning :: IORef BudgetMap + } deriving (Generic) -- | Store all handles for cleanup in 'watchThreadBudgetState'. -data BudgetMap - = BudgetMap - { bspent :: Int, - bmap :: HashMap UUID (Int, Maybe (Async ())) - } +data BudgetMap = BudgetMap + { bspent :: Int, + bmap :: HashMap UUID (Int, Maybe (Async ())) + } deriving (Eq, Generic) -- | Instead of taking the pre-computed total budget spent of the 'BudgetMap' (O(1)), this diff --git a/services/gundeck/src/Gundeck/Util/DelayQueue.hs b/services/gundeck/src/Gundeck/Util/DelayQueue.hs index 6e4a30d5c78..0e9013ac87b 100644 --- a/services/gundeck/src/Gundeck/Util/DelayQueue.hs +++ b/services/gundeck/src/Gundeck/Util/DelayQueue.hs @@ -35,13 +35,12 @@ import qualified Data.OrdPSQ as PSQ import Data.Tuple (swap) import Imports hiding (length) -data DelayQueue k v - = DelayQueue - { _queue :: IORef (OrdPSQ k Word64 v), - _clock :: Clock, - delay :: !Delay, - limit :: !Limit - } +data DelayQueue k v = DelayQueue + { _queue :: IORef (OrdPSQ k Word64 v), + _clock :: Clock, + delay :: !Delay, + limit :: !Limit + } newtype Clock = Clock {getTime :: IO Word64} diff --git a/services/gundeck/test/integration/Main.hs b/services/gundeck/test/integration/Main.hs index 3bfdb1fd462..21d4ea80a1b 100644 --- a/services/gundeck/test/integration/Main.hs +++ b/services/gundeck/test/integration/Main.hs @@ -45,14 +45,13 @@ import Util.Options import Util.Options.Common import Util.Test -data IntegrationConfig - = IntegrationConfig - -- internal endpoints - { gundeck :: Endpoint, - cannon :: Endpoint, - cannon2 :: Endpoint, - brig :: Endpoint - } +data IntegrationConfig = IntegrationConfig + -- internal endpoints + { gundeck :: Endpoint, + cannon :: Endpoint, + cannon2 :: Endpoint, + brig :: Endpoint + } deriving (Show, Generic) instance FromJSON IntegrationConfig diff --git a/services/gundeck/test/integration/TestSetup.hs b/services/gundeck/test/integration/TestSetup.hs index c3127a2f97e..3c7947850ed 100644 --- a/services/gundeck/test/integration/TestSetup.hs +++ b/services/gundeck/test/integration/TestSetup.hs @@ -45,10 +45,9 @@ import qualified System.Logger as Log import Test.Tasty (TestName, TestTree) import Test.Tasty.HUnit (Assertion, testCase) -newtype TestM a - = TestM - { runTestM :: ReaderT TestSetup (HttpT IO) a - } +newtype TestM a = TestM + { runTestM :: ReaderT TestSetup (HttpT IO) a + } deriving ( Functor, Applicative, @@ -69,16 +68,15 @@ newtype CannonR = CannonR {runCannonR :: Request -> Request} newtype GundeckR = GundeckR {runGundeckR :: Request -> Request} -data TestSetup - = TestSetup - { _tsManager :: Manager, - _tsGundeck :: GundeckR, - _tsCannon :: CannonR, - _tsCannon2 :: CannonR, - _tsBrig :: BrigR, - _tsCass :: Cql.ClientState, - _tsLogger :: Log.Logger - } +data TestSetup = TestSetup + { _tsManager :: Manager, + _tsGundeck :: GundeckR, + _tsCannon :: CannonR, + _tsCannon2 :: CannonR, + _tsBrig :: BrigR, + _tsCass :: Cql.ClientState, + _tsLogger :: Log.Logger + } makeLenses ''TestSetup diff --git a/services/gundeck/test/unit/MockGundeck.hs b/services/gundeck/test/unit/MockGundeck.hs index 7b305f69368..2f65c2178d9 100644 --- a/services/gundeck/test/unit/MockGundeck.hs +++ b/services/gundeck/test/unit/MockGundeck.hs @@ -81,29 +81,26 @@ import Test.QuickCheck.Instances () -- code, so in the end it is more awkward than nice. type Payload = List1 Aeson.Object -data ClientInfo - = ClientInfo - { _ciNativeAddress :: Maybe (Address, Bool {- reachable -}), - _ciWSReachable :: Bool - } +data ClientInfo = ClientInfo + { _ciNativeAddress :: Maybe (Address, Bool {- reachable -}), + _ciWSReachable :: Bool + } deriving (Eq, Show) -newtype MockEnv - = MockEnv - { _meClientInfos :: Map UserId (Map ClientId ClientInfo) - } +newtype MockEnv = MockEnv + { _meClientInfos :: Map UserId (Map ClientId ClientInfo) + } deriving (Eq, Show) -data MockState - = MockState - { -- | A record of notifications that have been pushed via websockets. - _msWSQueue :: NotifQueue, - -- | A record of notifications that have been pushed via native push. - _msNativeQueue :: NotifQueue, - -- | Non-transient notifications that are stored in the database first thing before - -- delivery (so clients can always come back and pick them up later until they expire). - _msCassQueue :: NotifQueue - } +data MockState = MockState + { -- | A record of notifications that have been pushed via websockets. + _msWSQueue :: NotifQueue, + -- | A record of notifications that have been pushed via native push. + _msNativeQueue :: NotifQueue, + -- | Non-transient notifications that are stored in the database first thing before + -- delivery (so clients can always come back and pick them up later until they expire). + _msCassQueue :: NotifQueue + } deriving (Eq) -- | For each client we store the set of notifications they are scheduled to receive. Notification @@ -401,9 +398,8 @@ shrinkNotifs = shrinkList (\(notif, prcs) -> (notif,) <$> shrinkList (const []) ---------------------------------------------------------------------- -- monad type and instances -newtype MockGundeck a - = MockGundeck - {fromMockGundeck :: ReaderT MockEnv (StateT MockState (RandT StdGen Identity)) a} +newtype MockGundeck a = MockGundeck + {fromMockGundeck :: ReaderT MockEnv (StateT MockState (RandT StdGen Identity)) a} deriving (Functor, Applicative, Monad, MonadReader MockEnv, MonadState MockState, MonadRandom) runMockGundeck :: MockEnv -> MockGundeck a -> (a, MockState) diff --git a/services/gundeck/test/unit/Native.hs b/services/gundeck/test/unit/Native.hs index fb8d0f9dfe9..9c54651f8af 100644 --- a/services/gundeck/test/unit/Native.hs +++ b/services/gundeck/test/unit/Native.hs @@ -60,11 +60,10 @@ serialiseOkProp t = ioProperty $ do ----------------------------------------------------------------------------- -- Types -data SnsNotification - = SnsNotification - { snsNotifTransport :: !Transport, - snsNotifData :: !SnsData - } +data SnsNotification = SnsNotification + { snsNotifTransport :: !Transport, + snsNotifData :: !SnsData + } deriving (Eq, Show) instance FromJSON SnsNotification where @@ -94,11 +93,10 @@ snsNotifBundle n = case snsNotifData n of SnsGcmData d -> gcmBundle d SnsApnsData d -> apnsBundle d -data GcmData - = GcmData - { gcmPriority :: !Text, - gcmBundle :: !Bundle - } +data GcmData = GcmData + { gcmPriority :: !Text, + gcmBundle :: !Bundle + } deriving (Eq, Show) instance FromJSON GcmData where @@ -106,11 +104,10 @@ instance FromJSON GcmData where GcmData <$> o .: "priority" <*> o .: "data" -data ApnsData - = ApnsData - { apnsMeta :: !Object, - apnsBundle :: !Bundle - } +data ApnsData = ApnsData + { apnsMeta :: !Object, + apnsBundle :: !Bundle + } deriving (Eq, Show) instance FromJSON ApnsData where @@ -129,11 +126,10 @@ instance FromJSON Bundle where _ -> mempty _ -> mempty -data PlainData - = PlainData - { plainNotif :: !Notification, - plainUser :: !(Maybe UserId) - } +data PlainData = PlainData + { plainNotif :: !Notification, + plainUser :: !(Maybe UserId) + } deriving (Eq, Show) instance FromJSON PlainData where diff --git a/services/proxy/src/Proxy/Env.hs b/services/proxy/src/Proxy/Env.hs index 688f49b9fcf..8fb7f38ef4f 100644 --- a/services/proxy/src/Proxy/Env.hs +++ b/services/proxy/src/Proxy/Env.hs @@ -40,16 +40,15 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import Proxy.Options import qualified System.Logger.Extended as Logger -data Env - = Env - { _reqId :: !RequestId, - _monitor :: !Metrics, - _options :: !Opts, - _applog :: !Logger.Logger, - _manager :: !Manager, - _secrets :: !Config, - _loader :: !ThreadId - } +data Env = Env + { _reqId :: !RequestId, + _monitor :: !Metrics, + _options :: !Opts, + _applog :: !Logger.Logger, + _manager :: !Manager, + _secrets :: !Config, + _loader :: !ThreadId + } makeLenses ''Env diff --git a/services/proxy/src/Proxy/Options.hs b/services/proxy/src/Proxy/Options.hs index 0b9ca2d79fc..3bdb39e36f3 100644 --- a/services/proxy/src/Proxy/Options.hs +++ b/services/proxy/src/Proxy/Options.hs @@ -35,26 +35,25 @@ import Data.Aeson.TH import Imports import System.Logger.Extended (Level (Debug), LogFormat) -data Opts - = Opts - { -- | Host to listen on - _host :: !String, - -- | Port to listen on - _port :: !Word16, - -- | File containing upstream secrets - _secretsConfig :: !FilePath, - -- | Number of connections for the HTTP pool - _httpPoolSize :: !Int, - -- | Maximum number of incoming connections - -- Logging - _maxConns :: !Int, - -- | Log level (Debug, Info, etc) - _logLevel :: !Level, - -- | Use netstrings encoding - _logNetStrings :: !(Maybe (Last Bool)), - -- | choose Encoding - _logFormat :: !(Maybe (Last LogFormat)) - } +data Opts = Opts + { -- | Host to listen on + _host :: !String, + -- | Port to listen on + _port :: !Word16, + -- | File containing upstream secrets + _secretsConfig :: !FilePath, + -- | Number of connections for the HTTP pool + _httpPoolSize :: !Int, + -- | Maximum number of incoming connections + -- Logging + _maxConns :: !Int, + -- | Log level (Debug, Info, etc) + _logLevel :: !Level, + -- | Use netstrings encoding + _logNetStrings :: !(Maybe (Last Bool)), + -- | choose Encoding + _logFormat :: !(Maybe (Last LogFormat)) + } deriving (Show, Generic) makeLenses ''Opts diff --git a/services/proxy/src/Proxy/Proxy.hs b/services/proxy/src/Proxy/Proxy.hs index 25536554a75..a7bb6fdd3de 100644 --- a/services/proxy/src/Proxy/Proxy.hs +++ b/services/proxy/src/Proxy/Proxy.hs @@ -35,10 +35,9 @@ import Proxy.Env import qualified System.Logger as Logger import System.Logger.Class hiding (Error, info) -newtype Proxy a - = Proxy - { unProxy :: ReaderT Env IO a - } +newtype Proxy a = Proxy + { unProxy :: ReaderT Env IO a + } deriving ( Functor, Applicative, diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index d422a99fd3f..30cfdd07c70 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -72,16 +72,15 @@ import Web.Cookie (SetCookie, renderSetCookie) newtype Spar a = Spar {fromSpar :: ReaderT Env (ExceptT SparError IO) a} deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env, MonadError SparError) -data Env - = Env - { sparCtxOpts :: Opts, - sparCtxLogger :: Log.Logger, - sparCtxCas :: Cas.ClientState, - sparCtxHttpManager :: Bilge.Manager, - sparCtxHttpBrig :: Bilge.Request, - sparCtxHttpGalley :: Bilge.Request, - sparCtxRequestId :: RequestId - } +data Env = Env + { sparCtxOpts :: Opts, + sparCtxLogger :: Log.Logger, + sparCtxCas :: Cas.ClientState, + sparCtxHttpManager :: Bilge.Manager, + sparCtxHttpBrig :: Bilge.Request, + sparCtxHttpGalley :: Bilge.Request, + sparCtxRequestId :: RequestId + } instance HasConfig Spar where getConfig = asks (saml . sparCtxOpts) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index 08848c72575..f5a58ac27b8 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -113,12 +113,11 @@ schemaVersion = 8 -- | Carry some time constants we do not want to pull from Options, IO, respectively. This way the -- functions in this module need fewer effects. See 'wrapMonadClientWithEnv' (as opposed to -- 'wrapMonadClient' where we don't need an 'Env'). -data Env - = Env - { dataEnvNow :: UTCTime, - dataEnvMaxTTLAuthRequests :: TTL "authreq", - dataEnvMaxTTLAssertions :: TTL "authresp" - } +data Env = Env + { dataEnvNow :: UTCTime, + dataEnvMaxTTLAuthRequests :: TTL "authreq", + dataEnvMaxTTLAssertions :: TTL "authresp" + } deriving (Eq, Show) mkEnv :: Opts -> UTCTime -> Env diff --git a/services/spar/src/Spar/Scim/Types.hs b/services/spar/src/Spar/Scim/Types.hs index ff838c4226d..dae21cf2d41 100644 --- a/services/spar/src/Spar/Scim/Types.hs +++ b/services/spar/src/Spar/Scim/Types.hs @@ -130,20 +130,17 @@ instance Scim.Auth.AuthTypes SparTag where -- where the instance typechecks, and non-injectivity errors are raised when checking the -- constraint that "calls" the instance. :) -newtype WrappedScimStoredUser tag - = WrappedScimStoredUser - {fromWrappedScimStoredUser :: Scim.User.StoredUser tag} +newtype WrappedScimStoredUser tag = WrappedScimStoredUser + {fromWrappedScimStoredUser :: Scim.User.StoredUser tag} -- | See 'WrappedScimStoredUser'. -newtype WrappedScimUser tag - = WrappedScimUser - {fromWrappedScimUser :: Scim.User.User tag} +newtype WrappedScimUser tag = WrappedScimUser + {fromWrappedScimUser :: Scim.User.User tag} -- | Extra Wire-specific data contained in a SCIM user profile. -data ScimUserExtra - = ScimUserExtra - { _sueRichInfo :: RichInfo - } +data ScimUserExtra = ScimUserExtra + { _sueRichInfo :: RichInfo + } deriving (Eq, Show) makeLenses ''ScimUserExtra @@ -193,20 +190,19 @@ instance Scim.Patchable ScimUserExtra where -- Data contained in '_vsuHandle' and '_vsuName' is guaranteed to a) correspond to the data in -- the 'Scim.User.User' and b) be valid in regard to our own user schema requirements (only -- certain characters allowed in handles, etc). -data ValidScimUser - = ValidScimUser - { _vsuUser :: Scim.User.User SparTag, - -- SAML SSO - - -- | (In the future, we may make this a 'Maybe' and allow for - -- SCIM users without a SAML SSO identity.) - _vsuSAMLUserRef :: SAML.UserRef, - _vsuIdp :: IdP, - -- mapping to 'Brig.User' - _vsuHandle :: Handle, - _vsuName :: Maybe Name, - _vsuRichInfo :: RichInfo - } +data ValidScimUser = ValidScimUser + { _vsuUser :: Scim.User.User SparTag, + -- SAML SSO + + -- | (In the future, we may make this a 'Maybe' and allow for + -- SCIM users without a SAML SSO identity.) + _vsuSAMLUserRef :: SAML.UserRef, + _vsuIdp :: IdP, + -- mapping to 'Brig.User' + _vsuHandle :: Handle, + _vsuName :: Maybe Name, + _vsuRichInfo :: RichInfo + } deriving (Eq, Show) makeLenses ''ValidScimUser @@ -215,13 +211,12 @@ makeLenses ''ValidScimUser -- Request and response types -- | Type used for request parameters to 'APIScimTokenCreate'. -data CreateScimToken - = CreateScimToken - { -- | Token description (as memory aid for whoever is creating the token) - createScimTokenDescr :: !Text, - -- | User password, which we ask for because creating a token is a "powerful" operation - createScimTokenPassword :: !(Maybe PlainTextPassword) - } +data CreateScimToken = CreateScimToken + { -- | Token description (as memory aid for whoever is creating the token) + createScimTokenDescr :: !Text, + -- | User password, which we ask for because creating a token is a "powerful" operation + createScimTokenPassword :: !(Maybe PlainTextPassword) + } deriving (Eq, Show) instance FromJSON CreateScimToken where @@ -239,11 +234,10 @@ instance ToJSON CreateScimToken where # [] -- | Type used for the response of 'APIScimTokenCreate'. -data CreateScimTokenResponse - = CreateScimTokenResponse - { createScimTokenResponseToken :: ScimToken, - createScimTokenResponseInfo :: ScimTokenInfo - } +data CreateScimTokenResponse = CreateScimTokenResponse + { createScimTokenResponseToken :: ScimToken, + createScimTokenResponseInfo :: ScimTokenInfo + } deriving (Eq, Show) -- Used for integration tests @@ -264,10 +258,9 @@ instance ToJSON CreateScimTokenResponse where -- Wrapped into an object to allow extensibility later on. -- -- We don't show tokens once they have been created – only their metadata. -data ScimTokenList - = ScimTokenList - { scimTokenListTokens :: [ScimTokenInfo] - } +data ScimTokenList = ScimTokenList + { scimTokenListTokens :: [ScimTokenInfo] + } deriving (Eq, Show) instance FromJSON ScimTokenList where @@ -292,17 +285,16 @@ type ScimSiteAPI tag = ToServantApi (ScimSite tag) -- | This is similar to 'Scim.Site', but does not include the 'Scim.GroupAPI', -- as we don't support it (we don't implement 'Web.Scim.Class.Group.GroupDB'). -data ScimSite tag route - = ScimSite - { config :: - route - :- ToServantApi Scim.Meta.ConfigSite, - users :: - route - :- Header "Authorization" (Scim.Auth.AuthData tag) - :> "Users" - :> ToServantApi (Scim.User.UserSite tag) - } +data ScimSite tag route = ScimSite + { config :: + route + :- ToServantApi Scim.Meta.ConfigSite, + users :: + route + :- Header "Authorization" (Scim.Auth.AuthData tag) + :> "Users" + :> ToServantApi (Scim.User.UserSite tag) + } deriving (Generic) type APIScimToken = diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 42fc1e55598..6c6e6c6fcde 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -578,13 +578,12 @@ assertHandleNotUsedElsewhere hndl uid = do assertHandleUnused' "userName does not match UserId" hndl uid -- | The information needed to synthesize a Scim user. -data NeededInfo - = NeededInfo - { neededHandle :: Handle, - neededName :: Name, - neededExternalId :: Text, - neededRichInfo :: RichInfo - } +data NeededInfo = NeededInfo + { neededHandle :: Handle, + neededName :: Name, + neededExternalId :: Text, + neededRichInfo :: RichInfo + } synthesizeScimUser :: NeededInfo -> Scim.User SparTag synthesizeScimUser info = @@ -632,6 +631,7 @@ getOrCreateScimUser stiTeam brigUser = do . toExternalId toScimStoredUser'' uid = lift . lift . toScimStoredUser uid insertScimUser' uid = lift . lift . wrapMonadClient . Data.insertScimUser uid + {- TODO: might be useful later. ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/services/spar/src/Spar/Types.hs b/services/spar/src/Spar/Types.hs index 60aeabc9b19..76999608a11 100644 --- a/services/spar/src/Spar/Types.hs +++ b/services/spar/src/Spar/Types.hs @@ -71,18 +71,17 @@ setBindCookieValue = BindCookie . cs . setCookieValue . SAML.fromSimpleSetCookie -- | The identity provider type used in Spar. type IdP = IdPConfig WireIdP -data WireIdP - = WireIdP - { _wiTeam :: TeamId, - -- | list of issuer names that this idp has replaced, most recent first. this is used - -- for finding users that are still stored under the old issuer, see - -- 'findUserWithOldIssuer', 'moveUserToNewIssuer'. - _wiOldIssuers :: [SAML.Issuer], - -- | the issuer that has replaced this one. this is set iff a new issuer is created - -- with the @"replaces"@ query parameter, and it is used to decide whether users not - -- existing on this IdP can be auto-provisioned (if 'isJust', they can't). - _wiReplacedBy :: Maybe SAML.IdPId - } +data WireIdP = WireIdP + { _wiTeam :: TeamId, + -- | list of issuer names that this idp has replaced, most recent first. this is used + -- for finding users that are still stored under the old issuer, see + -- 'findUserWithOldIssuer', 'moveUserToNewIssuer'. + _wiOldIssuers :: [SAML.Issuer], + -- | the issuer that has replaced this one. this is set iff a new issuer is created + -- with the @"replaces"@ query parameter, and it is used to decide whether users not + -- existing on this IdP can be auto-provisioned (if 'isJust', they can't). + _wiReplacedBy :: Maybe SAML.IdPId + } deriving (Eq, Show, Generic) makeLenses ''WireIdP @@ -91,10 +90,9 @@ deriveJSON deriveJSONOptions ''WireIdP -- | A list of 'IdP's, returned by some endpoints. Wrapped into an object to -- allow extensibility later on. -data IdPList - = IdPList - { _idplProviders :: [IdP] - } +data IdPList = IdPList + { _idplProviders :: [IdP] + } deriving (Eq, Show, Generic) makeLenses ''IdPList @@ -147,20 +145,19 @@ newtype ScimToken = ScimToken {fromScimToken :: Text} deriving (Eq, Show, FromJSON, ToJSON, FromByteString, ToByteString) -- | Metadata that we store about each token. -data ScimTokenInfo - = ScimTokenInfo - { -- | Which team can be managed with the token - stiTeam :: !TeamId, - -- | Token ID, can be used to eg. delete the token - stiId :: !ScimTokenId, - -- | Time of token creation - stiCreatedAt :: !UTCTime, - -- | IdP that created users will "belong" to - stiIdP :: !(Maybe IdPId), - -- | Free-form token description, can be set - -- by the token creator as a mental aid - stiDescr :: !Text - } +data ScimTokenInfo = ScimTokenInfo + { -- | Which team can be managed with the token + stiTeam :: !TeamId, + -- | Token ID, can be used to eg. delete the token + stiId :: !ScimTokenId, + -- | Time of token creation + stiCreatedAt :: !UTCTime, + -- | IdP that created users will "belong" to + stiIdP :: !(Maybe IdPId), + -- | Free-form token description, can be set + -- by the token creator as a mental aid + stiDescr :: !Text + } deriving (Eq, Show) instance FromHttpApiData ScimToken where @@ -231,36 +228,34 @@ substituteVar' var val = ST.intercalate val . ST.splitOn var type Opts = Opts' DerivedOpts -data Opts' a - = Opts - { saml :: !SAML.Config, - brig :: !Endpoint, - galley :: !Endpoint, - cassandra :: !CassandraOpts, - maxttlAuthreq :: !(TTL "authreq"), - maxttlAuthresp :: !(TTL "authresp"), - -- | The maximum number of SCIM tokens that we will allow teams to have. - maxScimTokens :: !Int, - -- | The maximum size of rich info. Should be in sync with 'Brig.Types.richInfoLimit'. - richInfoLimit :: !Int, - -- | Wire/AWS specific; optional; used to discover Cassandra instance - -- IPs using describe-instances. - discoUrl :: !(Maybe Text), - logNetStrings :: !(Maybe (Last Bool)), - logFormat :: !(Maybe (Last LogFormat)), - -- , optSettings :: !Settings -- (nothing yet; see other services for what belongs in here.) - derivedOpts :: !a - } +data Opts' a = Opts + { saml :: !SAML.Config, + brig :: !Endpoint, + galley :: !Endpoint, + cassandra :: !CassandraOpts, + maxttlAuthreq :: !(TTL "authreq"), + maxttlAuthresp :: !(TTL "authresp"), + -- | The maximum number of SCIM tokens that we will allow teams to have. + maxScimTokens :: !Int, + -- | The maximum size of rich info. Should be in sync with 'Brig.Types.richInfoLimit'. + richInfoLimit :: !Int, + -- | Wire/AWS specific; optional; used to discover Cassandra instance + -- IPs using describe-instances. + discoUrl :: !(Maybe Text), + logNetStrings :: !(Maybe (Last Bool)), + logFormat :: !(Maybe (Last LogFormat)), + -- , optSettings :: !Settings -- (nothing yet; see other services for what belongs in here.) + derivedOpts :: !a + } deriving (Functor, Show, Generic) instance FromJSON (Opts' (Maybe ())) -data DerivedOpts - = DerivedOpts - { derivedOptsBindCookiePath :: !SBS, - derivedOptsBindCookieDomain :: !SBS, - derivedOptsScimBaseURI :: !URI - } +data DerivedOpts = DerivedOpts + { derivedOptsBindCookiePath :: !SBS, + derivedOptsBindCookieDomain :: !SBS, + derivedOptsScimBaseURI :: !URI + } deriving (Show, Generic) -- | (seconds) @@ -282,10 +277,9 @@ ttlToNominalDiffTime (TTL i32) = fromIntegral i32 maxttlAuthreqDiffTime :: Opts -> NominalDiffTime maxttlAuthreqDiffTime = ttlToNominalDiffTime . maxttlAuthreq -data SsoSettings - = SsoSettings - { defaultSsoCode :: !(Maybe IdPId) - } +data SsoSettings = SsoSettings + { defaultSsoCode :: !(Maybe IdPId) + } deriving (Generic, Show) instance FromJSON SsoSettings where diff --git a/services/spar/test-integration/Test/MetricsSpec.hs b/services/spar/test-integration/Test/MetricsSpec.hs index 38d84ea6af0..700dc25f289 100644 --- a/services/spar/test-integration/Test/MetricsSpec.hs +++ b/services/spar/test-integration/Test/MetricsSpec.hs @@ -50,6 +50,7 @@ spec = describe "metrics" . it "works" $ do "status_code=", "le=" ] + {- sample value: # HELP http_request_duration_seconds The HTTP request latencies in seconds. # TYPE http_request_duration_seconds histogram diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 122b2ceec33..0014bbe7c95 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -1196,6 +1196,7 @@ specSsoSettings = do Nothing -> Aeson.Null Just code -> Aeson.toJSON (SAML.fromIdPId code) ] + -- TODO: go through DataSpec, APISpec and check that all the tests still make sense with the new implicit mock idp. -- TODO: what else needs to be tested, beyond the pending tests listed here? -- TODO: what tests can go to saml2-web-sso package? diff --git a/services/spar/test-integration/Util/Types.hs b/services/spar/test-integration/Util/Types.hs index aabb4f2493c..66ba4e80da7 100644 --- a/services/spar/test-integration/Util/Types.hs +++ b/services/spar/test-integration/Util/Types.hs @@ -66,28 +66,26 @@ instance MonadRandom TestSpar where getRandomBytes = lift . getRandomBytes -- | See 'mkEnv' about what's in here. -data TestEnv - = TestEnv - { _teMgr :: Manager, - _teCql :: Cas.ClientState, - _teBrig :: BrigReq, - _teGalley :: GalleyReq, - _teSpar :: SparReq, - _teSparEnv :: Spar.Env, - -- | spar config - _teOpts :: Opts, - -- | integration test config - _teTstOpts :: IntegrationConfig - } +data TestEnv = TestEnv + { _teMgr :: Manager, + _teCql :: Cas.ClientState, + _teBrig :: BrigReq, + _teGalley :: GalleyReq, + _teSpar :: SparReq, + _teSparEnv :: Spar.Env, + -- | spar config + _teOpts :: Opts, + -- | integration test config + _teTstOpts :: IntegrationConfig + } type Select = TestEnv -> (Request -> Request) -data IntegrationConfig - = IntegrationConfig - { cfgBrig :: Endpoint, - cfgGalley :: Endpoint, - cfgSpar :: Endpoint - } +data IntegrationConfig = IntegrationConfig + { cfgBrig :: Endpoint, + cfgGalley :: Endpoint, + cfgSpar :: Endpoint + } deriving (Show, Generic) deriveFromJSON deriveJSONOptions ''IntegrationConfig diff --git a/stack.yaml b/stack.yaml index 8810b884759..426a8b2f5b0 100644 --- a/stack.yaml +++ b/stack.yaml @@ -62,8 +62,6 @@ extra-deps: commit: 80ecd2e7e01d5c1c17303e81f75fd37e41ee3da4 # master (Apr 16, 2020) - git: https://github.com/wireapp/hscim commit: 2909c81a0aa4bd4c2c21acafa64b2f744f787df6 # master (Mar 27, 2020) -- ormolu-0.0.3.1 -- ghc-lib-parser-8.8.2.20200205@sha256:343f889f7b29f5ec07cf0d18d2a53f250fa5c002b6468a6a05b385d0191b8d34,8408 # for ormolu-0.0.3.1 - git: https://github.com/kim/hs-collectd commit: 885da222be2375f78c7be36127620ed772b677c9 @@ -169,3 +167,10 @@ extra-deps: # Not latest as latst one breaks wai-routing - wai-route-0.4.0 + +############################################################ +# Development tools +############################################################ + +- ormolu-0.0.5.0 +- ghc-lib-parser-8.10.1.20200412@sha256:b0517bb150a02957d7180f131f5b94abd2a7f58a7d1532a012e71618282339c2,8751 # for ormolu-0.0.5.0 diff --git a/stack.yaml.lock b/stack.yaml.lock index b80894af0cd..d0e5346fba4 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -55,20 +55,6 @@ packages: original: git: https://github.com/wireapp/hscim commit: 2909c81a0aa4bd4c2c21acafa64b2f744f787df6 -- completed: - hackage: ormolu-0.0.3.1@sha256:d8ae7f63b4ae0d55ad21f189652b9b912de118eeb671af1e7a2e7173231535df,7980 - pantry-tree: - size: 64583 - sha256: aafd93fb839fda7b294a199048817517337df5e59258034006dfd1d7bb992af7 - original: - hackage: ormolu-0.0.3.1 -- completed: - hackage: ghc-lib-parser-8.8.2.20200205@sha256:343f889f7b29f5ec07cf0d18d2a53f250fa5c002b6468a6a05b385d0191b8d34,8408 - pantry-tree: - size: 18102 - sha256: 3749da93f98300b35fe20e4947478a9ec081405e700e48d9d1998718c55e7eb2 - original: - hackage: ghc-lib-parser-8.8.2.20200205@sha256:343f889f7b29f5ec07cf0d18d2a53f250fa5c002b6468a6a05b385d0191b8d34,8408 - completed: cabal-file: size: 912 @@ -552,6 +538,20 @@ packages: sha256: d98288879d370d53e741f0dafaad96de2a58f84556ce4a835322d4029e529b9d original: hackage: wai-route-0.4.0 +- completed: + hackage: ormolu-0.0.5.0@sha256:e5f49c51c6ebd8b3cd16113e585312de7315c1e1561fbb599988cebc61c14f4e,7956 + pantry-tree: + size: 66187 + sha256: fd591a96bb129610f89d23d2986b1b11dad8c1c41e23ea1c6f03340b7265b617 + original: + hackage: ormolu-0.0.5.0 +- completed: + hackage: ghc-lib-parser-8.10.1.20200412@sha256:b0517bb150a02957d7180f131f5b94abd2a7f58a7d1532a012e71618282339c2,8751 + pantry-tree: + size: 19497 + sha256: b11275740480138dd1fce4a22a2aa8835cddfecaa8da58a153f130b4575f9df5 + original: + hackage: ghc-lib-parser-8.10.1.20200412@sha256:b0517bb150a02957d7180f131f5b94abd2a7f58a7d1532a012e71618282339c2,8751 snapshots: - completed: size: 524996 diff --git a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs index fe794312019..0f9cc6b6810 100644 --- a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs +++ b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs @@ -135,12 +135,11 @@ instance Serialize BotMessage where 2 -> BotAssetMessage <$> get _ -> fail $ "Unexpected message type: " ++ show t -data AssetInfo - = AssetInfo - { assetInfoKey :: !AssetKey, - assetInfoToken :: !(Maybe AssetToken), - assetInfoKeys :: !SymmetricKeys - } +data AssetInfo = AssetInfo + { assetInfoKey :: !AssetKey, + assetInfoToken :: !(Maybe AssetToken), + assetInfoKeys :: !SymmetricKeys + } deriving (Eq, Show) instance Serialize AssetInfo where diff --git a/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs b/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs index eea129fdb55..594c41c0722 100644 --- a/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs +++ b/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs @@ -183,15 +183,14 @@ runBot ls s@BotState {..} = do l <- between (assetMinSize ls) (assetMaxSize ls) return $ BS.replicate (fromIntegral l) 42 -data BotState - = BotState - { botClient :: !BotClient, -- "main" client (sends messages, etc) - botOtherClients :: ![BotClient], -- other clients (just sit around) - botConv :: !ConvId, - botConvMembers :: [Bot], - messagesLeft :: !Int, - assetsLeft :: !Int - } +data BotState = BotState + { botClient :: !BotClient, -- "main" client (sends messages, etc) + botOtherClients :: ![BotClient], -- other clients (just sit around) + botConv :: !ConvId, + botConvMembers :: [Bot], + messagesLeft :: !Int, + assetsLeft :: !Int + } deriving (Eq) ------------------------------------------------------------------------------- @@ -199,28 +198,27 @@ data BotState data RampType = RampStep Int | RampTotal Int deriving (Eq, Show) -data LoadTestSettings - = LoadTestSettings - { ltsBotNetSettings :: !BotNetSettings, - conversationRamp :: !(Maybe RampType), - conversationsTotal :: !Int, - conversationMinActiveMembers :: !Int, - conversationMaxActiveMembers :: !Int, - conversationMinPassiveMembers :: !Int, - conversationMaxPassiveMembers :: !Int, - clientsMin :: !Int, - clientsMax :: !Int, - messagesMin :: !Int, - messagesMax :: !Int, - messageMinLength :: !Int, - messageMaxLength :: !Int, - assetsMin :: !Int, - assetsMax :: !Int, - assetMinSize :: !Int, - assetMaxSize :: !Int, - stepDelay :: !Int, - parallelRequests :: !Int - } +data LoadTestSettings = LoadTestSettings + { ltsBotNetSettings :: !BotNetSettings, + conversationRamp :: !(Maybe RampType), + conversationsTotal :: !Int, + conversationMinActiveMembers :: !Int, + conversationMaxActiveMembers :: !Int, + conversationMinPassiveMembers :: !Int, + conversationMaxPassiveMembers :: !Int, + clientsMin :: !Int, + clientsMax :: !Int, + messagesMin :: !Int, + messagesMax :: !Int, + messageMinLength :: !Int, + messageMaxLength :: !Int, + assetsMin :: !Int, + assetsMax :: !Int, + assetMinSize :: !Int, + assetMaxSize :: !Int, + stepDelay :: !Int, + parallelRequests :: !Int + } deriving (Eq, Show) ------------------------------------------------------------------------------- diff --git a/tools/bonanza/main/KibanaRaw.hs b/tools/bonanza/main/KibanaRaw.hs index 852682c5513..ef4a938b882 100644 --- a/tools/bonanza/main/KibanaRaw.hs +++ b/tools/bonanza/main/KibanaRaw.hs @@ -41,12 +41,11 @@ import Options.Applicative hiding (action) import Paths_bonanza (version) import System.Clock -data Opts - = Opts - { optKibanaType :: String, - optKibanaIndex :: String, - optNull :: Bool - } +data Opts = Opts + { optKibanaType :: String, + optKibanaIndex :: String, + optNull :: Bool + } deriving (Show) parseOpts :: IO Opts diff --git a/tools/bonanza/main/Kibanana.hs b/tools/bonanza/main/Kibanana.hs index c3f7a0b751a..de5abe0700c 100644 --- a/tools/bonanza/main/Kibanana.hs +++ b/tools/bonanza/main/Kibanana.hs @@ -42,13 +42,12 @@ import Network.HTTP.Client.TLS import Options.Applicative import Paths_bonanza (version) -data Opts - = Opts - { url :: String, - maxBulkSize :: !Int, - maxBufferSize :: !Int, - concurrency :: !Int - } +data Opts = Opts + { url :: String, + maxBulkSize :: !Int, + maxBufferSize :: !Int, + concurrency :: !Int + } deriving (Show) parseOpts :: Parser Opts diff --git a/tools/bonanza/src/Bonanza/App.hs b/tools/bonanza/src/Bonanza/App.hs index 94efbb9d24c..b2b2d8832a7 100644 --- a/tools/bonanza/src/Bonanza/App.hs +++ b/tools/bonanza/src/Bonanza/App.hs @@ -59,24 +59,22 @@ instance Show Compression where show GZip = "gzip" show Snappy = "snappy" -data CommonOpts - = CommonOpts - { parser :: !String, - geo :: [String], - geodat :: !FilePath, - anon :: [String], - quiet :: !Bool, - debug :: !Bool, - decomp :: !(Maybe Compression), - comp :: !(Maybe Compression) - } +data CommonOpts = CommonOpts + { parser :: !String, + geo :: [String], + geodat :: !FilePath, + anon :: [String], + quiet :: !Bool, + debug :: !Bool, + decomp :: !(Maybe Compression), + comp :: !(Maybe Compression) + } deriving (Show) -data KibanaOpts - = KibanaOpts - { print0 :: !Bool, - idxPrefix :: !Text - } +data KibanaOpts = KibanaOpts + { print0 :: !Bool, + idxPrefix :: !Text + } deriving (Show) data Command diff --git a/tools/bonanza/src/Bonanza/Metrics.hs b/tools/bonanza/src/Bonanza/Metrics.hs index d72d03ac31e..ba11f05403f 100644 --- a/tools/bonanza/src/Bonanza/Metrics.hs +++ b/tools/bonanza/src/Bonanza/Metrics.hs @@ -35,14 +35,13 @@ import Data.Time import Imports import System.IO -data Stats - = Stats - { sBytesIn :: !Int64, - sBytesOut :: !Int64, - sCPUTime :: !DiffTime, - sWallTime :: !NominalDiffTime, - sEventsIn :: !Int64 - } +data Stats = Stats + { sBytesIn :: !Int64, + sBytesOut :: !Int64, + sCPUTime :: !DiffTime, + sWallTime :: !NominalDiffTime, + sEventsIn :: !Int64 + } deriving (Eq, Show) dumpStderr :: Stats -> IO () diff --git a/tools/bonanza/src/Bonanza/Parser/CommonLog.hs b/tools/bonanza/src/Bonanza/Parser/CommonLog.hs index 3642a4f3fd8..288f50a876e 100644 --- a/tools/bonanza/src/Bonanza/Parser/CommonLog.hs +++ b/tools/bonanza/src/Bonanza/Parser/CommonLog.hs @@ -52,20 +52,18 @@ import Network.HTTP.Types.Method data CommonLogField = CEmpty | CField !TagValue deriving (Eq, Show) -data CommonLogRecord - = CommonLogRecord - { cTime :: !UTCTime, - cFields :: [(Text, TagValue)], - cRequest :: !HttpRequest - } +data CommonLogRecord = CommonLogRecord + { cTime :: !UTCTime, + cFields :: [(Text, TagValue)], + cRequest :: !HttpRequest + } deriving (Eq, Show) -data HttpRequest - = HttpRequest - { httpMethod :: !StdMethod, - httpPath :: !Text, - httpQuery :: Maybe Text - } +data HttpRequest = HttpRequest + { httpMethod :: !StdMethod, + httpPath :: !Text, + httpQuery :: Maybe Text + } deriving (Eq, Show) instance ToLogEvent CommonLogRecord where diff --git a/tools/bonanza/src/Bonanza/Parser/Journald.hs b/tools/bonanza/src/Bonanza/Parser/Journald.hs index 174fe5d64b8..eb25ed1be30 100644 --- a/tools/bonanza/src/Bonanza/Parser/Journald.hs +++ b/tools/bonanza/src/Bonanza/Parser/Journald.hs @@ -34,13 +34,12 @@ import Imports -- []: <... message ...> -data JournaldLogRecord a - = JournaldLogRecord - { jdTime :: !(Maybe UTCTime), - jdProcess :: Text, - jdPid :: Int, - jdMessage :: !a - } +data JournaldLogRecord a = JournaldLogRecord + { jdTime :: !(Maybe UTCTime), + jdProcess :: Text, + jdPid :: Int, + jdMessage :: !a + } deriving (Eq, Show) instance ToLogEvent a => ToLogEvent (JournaldLogRecord a) where diff --git a/tools/bonanza/src/Bonanza/Parser/Rkt.hs b/tools/bonanza/src/Bonanza/Parser/Rkt.hs index 1627e547b20..f094ca22b16 100644 --- a/tools/bonanza/src/Bonanza/Parser/Rkt.hs +++ b/tools/bonanza/src/Bonanza/Parser/Rkt.hs @@ -36,13 +36,12 @@ import Imports -- [] []: -data RktLogRecord - = RktLogRecord - { rktUptime :: !Double, - rktService :: !Text, - rktTags :: [(Text, Text)], - rktMessage :: !Text - } +data RktLogRecord = RktLogRecord + { rktUptime :: !Double, + rktService :: !Text, + rktTags :: [(Text, Text)], + rktMessage :: !Text + } deriving (Eq, Show) instance ToLogEvent RktLogRecord where diff --git a/tools/bonanza/src/Bonanza/Parser/Socklog.hs b/tools/bonanza/src/Bonanza/Parser/Socklog.hs index db768802b50..8e6a8d0db85 100644 --- a/tools/bonanza/src/Bonanza/Parser/Socklog.hs +++ b/tools/bonanza/src/Bonanza/Parser/Socklog.hs @@ -43,13 +43,12 @@ import qualified Data.Text.Lazy.Builder.Int as T import Data.Time (UTCTime) import Imports -data SockLogRecord a - = SockLogRecord - { sockTime :: !UTCTime, - sockOrigin :: Maybe Host, - sockTags :: [(Text, Text)], - sockMessage :: !a - } +data SockLogRecord a = SockLogRecord + { sockTime :: !UTCTime, + sockOrigin :: Maybe Host, + sockTags :: [(Text, Text)], + sockMessage :: !a + } deriving (Eq, Show) instance ToLogEvent a => ToLogEvent (SockLogRecord a) where diff --git a/tools/bonanza/src/Bonanza/Parser/Svlogd.hs b/tools/bonanza/src/Bonanza/Parser/Svlogd.hs index 983fa3c57fa..ec6971dc0fc 100644 --- a/tools/bonanza/src/Bonanza/Parser/Svlogd.hs +++ b/tools/bonanza/src/Bonanza/Parser/Svlogd.hs @@ -39,12 +39,11 @@ import Data.Text (strip) import Data.Time (UTCTime (..)) import Imports -data SvLogRecord a - = SvLogRecord - { svTime :: !(Maybe UTCTime), - svTags :: [(Text, Text)], - svMessage :: !a - } +data SvLogRecord a = SvLogRecord + { svTime :: !(Maybe UTCTime), + svTags :: [(Text, Text)], + svMessage :: !a + } deriving (Eq, Show) instance ToLogEvent a => ToLogEvent (SvLogRecord a) where diff --git a/tools/bonanza/src/Bonanza/Parser/Tinylog.hs b/tools/bonanza/src/Bonanza/Parser/Tinylog.hs index aee65aa108f..907e904123c 100644 --- a/tools/bonanza/src/Bonanza/Parser/Tinylog.hs +++ b/tools/bonanza/src/Bonanza/Parser/Tinylog.hs @@ -39,13 +39,12 @@ import Data.HashMap.Strict (fromList) import qualified Data.Text as T import Imports hiding (isDigit) -data TinyLogRecord - = TinyLogRecord - { tDate :: !(Maybe Text), - tLevel :: !Char, - tFields :: [(Text, Text)], - tMessage :: !Text - } +data TinyLogRecord = TinyLogRecord + { tDate :: !(Maybe Text), + tLevel :: !Char, + tFields :: [(Text, Text)], + tMessage :: !Text + } deriving (Eq, Show) instance ToLogEvent TinyLogRecord where diff --git a/tools/bonanza/src/Bonanza/Streaming/Kibana.hs b/tools/bonanza/src/Bonanza/Streaming/Kibana.hs index b7ebb96010f..46576aee03c 100644 --- a/tools/bonanza/src/Bonanza/Streaming/Kibana.hs +++ b/tools/bonanza/src/Bonanza/Streaming/Kibana.hs @@ -51,12 +51,11 @@ import Network.BSD (getHostName) import Network.Socket import System.IO.Unsafe (unsafePerformIO) -data BulkAction - = Index - { _index :: !IndexName, - _type :: !Text, - _id :: !(Maybe Text) - } +data BulkAction = Index + { _index :: !IndexName, + _type :: !Text, + _id :: !(Maybe Text) + } deriving (Eq, Show) instance ToJSON BulkAction where @@ -74,13 +73,12 @@ newtype IndexName = IndexName Text instance ToJSON IndexName -data KibanaEvent - = KibanaEvent - { esTimestamp :: !ZonedTime, - esOrigin :: !Host, - esTags :: !Tags, - esMessage :: !Text - } +data KibanaEvent = KibanaEvent + { esTimestamp :: !ZonedTime, + esOrigin :: !Host, + esTags :: !Tags, + esMessage :: !Text + } deriving (Eq, Show, Generic) deriving instance Eq ZonedTime diff --git a/tools/bonanza/src/Bonanza/Types.hs b/tools/bonanza/src/Bonanza/Types.hs index a5eb10beb4a..3a02dbf8866 100644 --- a/tools/bonanza/src/Bonanza/Types.hs +++ b/tools/bonanza/src/Bonanza/Types.hs @@ -59,13 +59,12 @@ import Data.Time import Imports hiding (stripPrefix) -- | Canonical representation of a log record / event -data LogEvent - = LogEvent - { _logTime :: Maybe UTCTime, - _logOrigin :: Maybe Host, - _logTags :: !Tags, - _logMessage :: Maybe Text - } +data LogEvent = LogEvent + { _logTime :: Maybe UTCTime, + _logOrigin :: Maybe Host, + _logTags :: !Tags, + _logMessage :: Maybe Text + } deriving (Eq, Show, Generic) instance ToJSON LogEvent where @@ -131,12 +130,11 @@ instance FromJSON Host where parseJSON (String t) = pure $ Host t parseJSON _ = mzero -data Geo - = Geo - { geoCountry :: Maybe Text, - geoCity :: Maybe Text, - geoLocation :: !Coordinate - } +data Geo = Geo + { geoCountry :: Maybe Text, + geoCity :: Maybe Text, + geoLocation :: !Coordinate + } deriving (Eq, Show, Generic) instance ToJSON Geo where @@ -153,11 +151,10 @@ instance FromJSON Geo where { Aeson.omitNothingFields = True } -data Coordinate - = Coordinate - { lat :: !Double, - lon :: !Double - } +data Coordinate = Coordinate + { lat :: !Double, + lon :: !Double + } deriving (Eq, Show, Generic) instance ToJSON Coordinate diff --git a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs index a3c0461dba4..9b7dc38f89c 100644 --- a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs +++ b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs @@ -504,10 +504,9 @@ newtype TaggedValue = TaggedValue {taggedValue :: ByteString} instance Arbitrary TaggedValue where arbitrary = TaggedValue <$> arbitrary `suchThat` (/= "=") -newtype TaggedNetstring - = TaggedNetstring - { taggedNetstring :: [(Maybe TaggedValue, TaggedValue)] - } +newtype TaggedNetstring = TaggedNetstring + { taggedNetstring :: [(Maybe TaggedValue, TaggedValue)] + } deriving (Eq, Show) instance Arbitrary TaggedNetstring where diff --git a/tools/db/auto-whitelist/src/Options.hs b/tools/db/auto-whitelist/src/Options.hs index c00c968a048..5fff7cdf246 100644 --- a/tools/db/auto-whitelist/src/Options.hs +++ b/tools/db/auto-whitelist/src/Options.hs @@ -33,18 +33,16 @@ import Data.Text.Strict.Lens import Imports import Options.Applicative -data MigratorSettings - = MigratorSettings - { _setCasBrig :: !CassandraSettings - } +data MigratorSettings = MigratorSettings + { _setCasBrig :: !CassandraSettings + } deriving (Show) -data CassandraSettings - = CassandraSettings - { _cHosts :: !String, - _cPort :: !Word16, - _cKeyspace :: !C.Keyspace - } +data CassandraSettings = CassandraSettings + { _cHosts :: !String, + _cPort :: !Word16, + _cKeyspace :: !C.Keyspace + } deriving (Show) makeLenses ''MigratorSettings diff --git a/tools/db/migrate-sso-feature-flag/src/Options.hs b/tools/db/migrate-sso-feature-flag/src/Options.hs index 3ae4f6f8f10..b8f1dd18201 100644 --- a/tools/db/migrate-sso-feature-flag/src/Options.hs +++ b/tools/db/migrate-sso-feature-flag/src/Options.hs @@ -34,19 +34,17 @@ import Data.Text.Strict.Lens import Imports import Options.Applicative -data MigratorSettings - = MigratorSettings - { _setCasSpar :: !CassandraSettings, - _setCasGalley :: !CassandraSettings - } +data MigratorSettings = MigratorSettings + { _setCasSpar :: !CassandraSettings, + _setCasGalley :: !CassandraSettings + } deriving (Show) -data CassandraSettings - = CassandraSettings - { _cHosts :: !String, - _cPort :: !Word16, - _cKeyspace :: !C.Keyspace - } +data CassandraSettings = CassandraSettings + { _cHosts :: !String, + _cPort :: !Word16, + _cKeyspace :: !C.Keyspace + } deriving (Show) makeLenses ''MigratorSettings diff --git a/tools/db/service-backfill/src/Options.hs b/tools/db/service-backfill/src/Options.hs index db9447e56ef..8cb2bbbcf12 100644 --- a/tools/db/service-backfill/src/Options.hs +++ b/tools/db/service-backfill/src/Options.hs @@ -34,19 +34,17 @@ import Data.Text.Strict.Lens import Imports import Options.Applicative -data MigratorSettings - = MigratorSettings - { _setCasBrig :: !CassandraSettings, - _setCasGalley :: !CassandraSettings - } +data MigratorSettings = MigratorSettings + { _setCasBrig :: !CassandraSettings, + _setCasGalley :: !CassandraSettings + } deriving (Show) -data CassandraSettings - = CassandraSettings - { _cHosts :: !String, - _cPort :: !Word16, - _cKeyspace :: !C.Keyspace - } +data CassandraSettings = CassandraSettings + { _cHosts :: !String, + _cPort :: !Word16, + _cKeyspace :: !C.Keyspace + } deriving (Show) makeLenses ''MigratorSettings diff --git a/tools/makedeb/src/System/MakeDeb.hs b/tools/makedeb/src/System/MakeDeb.hs index 052b6f4a81c..8211c7000a9 100644 --- a/tools/makedeb/src/System/MakeDeb.hs +++ b/tools/makedeb/src/System/MakeDeb.hs @@ -36,15 +36,14 @@ import Options.Applicative import Shelly import System.MakeDeb.FileUtils -data MakeDebOpts - = MakeDebOpts - { name :: !Text, - version :: !Text, - build :: !Text, - arch :: !Text, - deb :: !FilePath, - out :: !FilePath - } +data MakeDebOpts = MakeDebOpts + { name :: !Text, + version :: !Text, + build :: !Text, + arch :: !Text, + deb :: !FilePath, + out :: !FilePath + } deriving (Eq, Show) options :: Parser MakeDebOpts diff --git a/tools/ormolu.sh b/tools/ormolu.sh index 6e0ffcbd117..631eba9612b 100755 --- a/tools/ormolu.sh +++ b/tools/ormolu.sh @@ -70,7 +70,7 @@ echo "language extensions: $LANGUAGE_EXTS" FAILURES=0 -for hsfile in $(git grep -L "LANGUAGE CPP" | grep '\.hsc\?$'); do +for hsfile in $(git ls-files | grep '\.hsc\?$'); do FAILED=0 ormolu --mode $ARG_ORMOLU_MODE --check-idempotency $LANGUAGE_EXTS "$hsfile" || FAILED=1 if [ "$FAILED" == "1" ]; then diff --git a/tools/stern/src/Stern/App.hs b/tools/stern/src/Stern/App.hs index e341c7220c4..0127a4c9863 100644 --- a/tools/stern/src/Stern/App.hs +++ b/tools/stern/src/Stern/App.hs @@ -55,18 +55,17 @@ import qualified System.Logger.Class as LC import qualified System.Logger.Extended as Log import Util.Options -data Env - = Env - { _brig :: !Bilge.Request, - _galley :: !Bilge.Request, - _gundeck :: !Bilge.Request, - _ibis :: !Bilge.Request, - _galeb :: !Bilge.Request, - _applog :: !Logger, - _metrics :: !Metrics.Metrics, - _requestId :: !Bilge.RequestId, - _httpManager :: !Bilge.Manager - } +data Env = Env + { _brig :: !Bilge.Request, + _galley :: !Bilge.Request, + _gundeck :: !Bilge.Request, + _ibis :: !Bilge.Request, + _galeb :: !Bilge.Request, + _applog :: !Logger, + _metrics :: !Metrics.Metrics, + _requestId :: !Bilge.RequestId, + _httpManager :: !Bilge.Manager + } makeLenses ''Env diff --git a/tools/stern/src/Stern/Options.hs b/tools/stern/src/Stern/Options.hs index 5ad2031ccb7..f1185c56e20 100644 --- a/tools/stern/src/Stern/Options.hs +++ b/tools/stern/src/Stern/Options.hs @@ -27,21 +27,20 @@ import System.Logger.Extended (Level, LogFormat) import Util.Options -- | Options that are consumed on startup -data Opts - = Opts - { stern :: !Endpoint, - brig :: !Endpoint, - galley :: !Endpoint, - gundeck :: !Endpoint, - -- TODO: Both ibis and galeb should be made optional - -- for installations where these services are not available - ibis :: !Endpoint, - galeb :: !Endpoint, - -- Logging - logLevel :: !Level, - logNetStrings :: !(Maybe (Last Bool)), - logFormat :: !(Maybe (Last LogFormat)) - } +data Opts = Opts + { stern :: !Endpoint, + brig :: !Endpoint, + galley :: !Endpoint, + gundeck :: !Endpoint, + -- TODO: Both ibis and galeb should be made optional + -- for installations where these services are not available + ibis :: !Endpoint, + galeb :: !Endpoint, + -- Logging + logLevel :: !Level, + logNetStrings :: !(Maybe (Last Bool)), + logFormat :: !(Maybe (Last LogFormat)) + } deriving (Show, Generic) instance FromJSON Opts diff --git a/tools/stern/src/Stern/Types.hs b/tools/stern/src/Stern/Types.hs index dad9dbb0fce..4d8aa0abd21 100644 --- a/tools/stern/src/Stern/Types.hs +++ b/tools/stern/src/Stern/Types.hs @@ -45,19 +45,17 @@ instance ToJSON TeamMemberInfo where $ M.insert "can_view_billing" (Bool (hasPermission m GetBilling)) $ o -data TeamInfo - = TeamInfo - { tiData :: TeamData, - tiMembers :: [TeamMemberInfo] - } - -data TeamAdminInfo - = TeamAdminInfo - { taData :: TeamData, - taOwners :: [TeamMemberInfo], - taAdmins :: [TeamMemberInfo], - taMembers :: Int - } +data TeamInfo = TeamInfo + { tiData :: TeamData, + tiMembers :: [TeamMemberInfo] + } + +data TeamAdminInfo = TeamAdminInfo + { taData :: TeamData, + taOwners :: [TeamMemberInfo], + taAdmins :: [TeamMemberInfo], + taMembers :: Int + } toAdminInfo :: TeamInfo -> TeamAdminInfo toAdminInfo (TeamInfo d members) = @@ -91,10 +89,9 @@ instance ToJSON TeamAdminInfo where "total_members" .= m ] -newtype UserProperties - = UserProperties - { unUserProperties :: M.HashMap PropertyKey PropertyValue - } +newtype UserProperties = UserProperties + { unUserProperties :: M.HashMap PropertyKey PropertyValue + } deriving (Eq, Show, ToJSON) -- | NOTE: The following datatypes are defined by services used only internally at Wire @@ -108,53 +105,48 @@ newtype UserProperties -- Note that we define them simply as JSON objects since we use them as a read-only and all info is to -- be displayed to clients. Thus, it seems harmless (and easier) to just consume the whole object and -- simply use whatever galeb's JSON object looks like -newtype ConsentLog - = ConsentLog - { unConsentLog :: Object - } +newtype ConsentLog = ConsentLog + { unConsentLog :: Object + } deriving (Eq, Show, ToJSON, FromJSON) -newtype ConsentValue - = ConsentValue - { unConsentValue :: Object - } +newtype ConsentValue = ConsentValue + { unConsentValue :: Object + } deriving (Eq, Show, ToJSON, FromJSON) -newtype MarketoResult - = MarketoResult - { unMarketoResult :: Object - } +newtype MarketoResult = MarketoResult + { unMarketoResult :: Object + } deriving (Eq, Show, ToJSON, FromJSON) newtype InvoiceId = InvoiceId {unInvoiceId :: Text} deriving (Eq, Show, ToByteString, FromByteString, ToJSON, FromJSON) -data TeamBillingInfo - = TeamBillingInfo - { tbiFirstname :: Text, - tbiLastname :: Text, - tbiStreet :: Text, - tbiZip :: Text, - tbiCity :: Text, - tbiCountry :: Text, - tbiCompany :: Maybe Text, - tbiState :: Maybe Text - } +data TeamBillingInfo = TeamBillingInfo + { tbiFirstname :: Text, + tbiLastname :: Text, + tbiStreet :: Text, + tbiZip :: Text, + tbiCity :: Text, + tbiCountry :: Text, + tbiCompany :: Maybe Text, + tbiState :: Maybe Text + } deriving (Eq, Show) deriveJSON toJSONFieldName ''TeamBillingInfo -data TeamBillingInfoUpdate - = TeamBillingInfoUpdate - { tbiuFirstname :: Maybe (Range 1 256 Text), - tbiuLastname :: Maybe (Range 1 256 Text), - tbiuStreet :: Maybe (Range 1 256 Text), - tbiuZip :: Maybe (Range 1 16 Text), - tbiuCity :: Maybe (Range 1 256 Text), - tbiuCountry :: Maybe (Range 1 256 Text), - tbiuCompany :: Maybe (Range 1 256 Text), - tbiuState :: Maybe (Range 1 256 Text) - } +data TeamBillingInfoUpdate = TeamBillingInfoUpdate + { tbiuFirstname :: Maybe (Range 1 256 Text), + tbiuLastname :: Maybe (Range 1 256 Text), + tbiuStreet :: Maybe (Range 1 256 Text), + tbiuZip :: Maybe (Range 1 16 Text), + tbiuCity :: Maybe (Range 1 256 Text), + tbiuCountry :: Maybe (Range 1 256 Text), + tbiuCompany :: Maybe (Range 1 256 Text), + tbiuState :: Maybe (Range 1 256 Text) + } deriving (Eq, Show) deriveJSON toJSONFieldName ''TeamBillingInfoUpdate