From c280daf4c1e1fdd44918314e6d72941e7ce988b2 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Oct 2022 09:50:22 +0200 Subject: [PATCH 01/43] Servant Cookie combinator --- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 106 ++++++++++++++++++ .../src/Wire/API/Routes/Public/Brig.hs | 32 ++++++ libs/wire-api/wire-api.cabal | 2 + services/brig/src/Brig/API/Public.hs | 11 +- services/brig/src/Brig/User/API/Auth.hs | 46 ++++---- 5 files changed, 173 insertions(+), 24 deletions(-) create mode 100644 libs/wire-api/src/Wire/API/Routes/Cookies.hs diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs new file mode 100644 index 0000000000..00775e9f99 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -0,0 +1,106 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Routes.Cookies where + +import Control.Error.Util +import Data.List.NonEmpty (NonEmpty) +import qualified Data.Map as M +import Data.Metrics.Servant +import Data.SOP +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import GHC.TypeLits +import Imports +import Servant +import Servant.Swagger +import Web.Cookie (parseCookies) + +data (:::) a b + +data Cookies (cs :: [*]) + +type CookieHeader cs = Header' '[Required] "Cookie" (CookieTuple cs) + +type CookieType = NonEmpty + +type family CookieTypes (cs :: [*]) :: [*] + +type instance CookieTypes '[] = '[] + +type instance CookieTypes ((lbl ::: x) ': cs) = (CookieType x ': CookieTypes cs) + +newtype CookieTuple cs = CookieTuple {unCookieTuple :: NP I (CookieTypes cs)} + +type CookieMap = Map ByteString (NonEmpty ByteString) + +instance HasSwagger api => HasSwagger (Cookies cs :> api) where + -- TODO + toSwagger _ = toSwagger (Proxy @api) + +class CookieArgs (cs :: [*]) where + type AddArgs cs a :: * + + addArgs :: AddArgs cs a -> CookieTuple cs -> a + mapArgs :: (a -> b) -> AddArgs cs a -> AddArgs cs b + mkTuple :: CookieMap -> Either Text (CookieTuple cs) + +instance CookieArgs '[] where + type AddArgs '[] a = a + addArgs a _ = a + mapArgs h = h + mkTuple _ = pure (CookieTuple Nil) + +instance + ( CookieArgs cs, + KnownSymbol lbl, + FromHttpApiData x + ) => + CookieArgs ((lbl ::: (x :: *)) ': cs) + where + type AddArgs ((lbl ::: x) ': cs) a = CookieType x -> AddArgs cs a + addArgs f (CookieTuple (I x :* xs)) = addArgs @cs (f x) (CookieTuple xs) + mapArgs h f = mapArgs @cs h . f + mkTuple m = do + let k = T.pack (symbolVal (Proxy @lbl)) + bs <- note ("Missing cookie: " <> k) $ M.lookup (T.encodeUtf8 k) m + vs <- traverse parseHeader bs + CookieTuple t <- mkTuple @cs m + pure (CookieTuple (I vs :* t)) + +mkCookieMap :: [(ByteString, ByteString)] -> CookieMap +mkCookieMap = foldr (\(k, v) -> M.insertWith (<>) k (pure v)) mempty + +instance CookieArgs cs => FromHttpApiData (CookieTuple cs) where + parseHeader = mkTuple . mkCookieMap . parseCookies + parseUrlPiece = parseHeader . T.encodeUtf8 + +instance + ( HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters, + CookieArgs cs, + HasServer api ctx + ) => + HasServer (Cookies cs :> api) ctx + where + type ServerT (Cookies cs :> api) m = AddArgs cs (ServerT api m) + + route _ ctx action = + route (Proxy @(CookieHeader cs :> api)) ctx (fmap addArgs action) + hoistServerWithContext _ ctx f = mapArgs @cs (hoistServerWithContext (Proxy @api) ctx f) + +instance RoutesToPaths api => RoutesToPaths (Cookies cs :> api) where + getRoutes = getRoutes @api diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 9fa9ad01c4..778010066a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -20,6 +20,7 @@ module Wire.API.Routes.Public.Brig where import qualified Data.Aeson as A (FromJSON, ToJSON, Value) +import Data.Bifunctor import Data.ByteString.Conversion import Data.Code (Timeout) import Data.CommaSeparatedList (CommaSeparatedList) @@ -34,6 +35,9 @@ import Data.SOP import Data.Schema as Schema import Data.Swagger hiding (Contact, Header, Schema, ToSchema) import qualified Data.Swagger as S +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.ZAuth.Token as ZAuth import qualified Generics.SOP as GSOP import Imports hiding (head) import Network.Wai.Utilities @@ -48,6 +52,7 @@ import Wire.API.Error.Empty import Wire.API.MLS.KeyPackage import Wire.API.MLS.Servant import Wire.API.Properties +import Wire.API.Routes.Cookies import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named import Wire.API.Routes.Public @@ -1138,6 +1143,32 @@ type SearchAPI = type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) +data SomeUserToken + = UserToken (ZAuth.Token ZAuth.User) + | LHUserToken (ZAuth.Token ZAuth.LegalHoldUser) + deriving (Show) + +instance FromHttpApiData SomeUserToken where + parseHeader h = + first T.pack $ + fmap UserToken (runParser parser h) + <|> fmap LHUserToken (runParser parser h) + parseUrlPiece = parseHeader . T.encodeUtf8 + +type AuthAPI = + Named + "access" + ( "access" + :> Summary "Obtain an access tokens for a cookie" + :> Description + "You can provide only a cookie or a cookie and token.\ + \ Every other combination is invalid.\ + \ Access tokens can be given as query parameter or authorisation\ + \ header, with the latter being preferred." + :> Cookies '["zuid" ::: SomeUserToken] + :> MultiVerb1 'POST '[JSON] (Respond 201 "TODO" Text) + ) + type BrigAPI = UserAPI :<|> SelfAPI @@ -1150,6 +1181,7 @@ type BrigAPI = :<|> MLSAPI :<|> UserHandleAPI :<|> SearchAPI + :<|> AuthAPI brigSwagger :: Swagger brigSwagger = toSwagger (Proxy @BrigAPI) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 126ac7d697..b8c0c47eb0 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -69,6 +69,7 @@ library Wire.API.Routes.API Wire.API.Routes.AssetBody Wire.API.Routes.ClientAlgebra + Wire.API.Routes.Cookies Wire.API.Routes.CSV Wire.API.Routes.Internal.Brig Wire.API.Routes.Internal.Brig.Connection @@ -263,6 +264,7 @@ library , websockets , wire-message-proto-lens , x509 + , zauth default-language: Haskell2010 diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 029594b6e4..c4a5d33d94 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -82,6 +82,7 @@ import Data.Domain import Data.FileEmbed import Data.Handle (Handle, parseHandle) import Data.Id as Id +import Data.List.NonEmpty (NonEmpty) import qualified Data.Map.Strict as Map import Data.Misc (IpAddr (..)) import Data.Nonce (Nonce, randomNonce) @@ -89,6 +90,7 @@ import Data.Qualified import Data.Range import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc +import qualified Data.Text as T import qualified Data.Text as Text import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (decodeLatin1) @@ -177,7 +179,7 @@ servantSitemap :: ] r => ServerT BrigAPI (Handler r) -servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekeyAPI :<|> userClientAPI :<|> connectionAPI :<|> propertiesAPI :<|> mlsAPI :<|> userHandleAPI :<|> searchAPI +servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekeyAPI :<|> userClientAPI :<|> connectionAPI :<|> propertiesAPI :<|> mlsAPI :<|> userHandleAPI :<|> searchAPI :<|> authAPI where userAPI :: ServerT UserAPI (Handler r) userAPI = @@ -285,6 +287,13 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey searchAPI = Named @"browse-team" teamUserSearch + authAPI :: ServerT AuthAPI (Handler r) + authAPI = + Named @"access" access + where + access :: NonEmpty SomeUserToken -> Handler r Text + access = pure . T.pack . show + -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling -- CheckUserExists[Un]Qualified, see 'Brig.API.User.userGC'. diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index 2d66ea2736..c3fd238649 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -76,27 +76,27 @@ routesPublic :: routesPublic = do -- Note: this endpoint should always remain available at its unversioned -- path, since the login cookie hardcodes @/access@ as a path. - post "/access" (continue renewH) $ - accept "application" "json" - .&. tokenRequest - document "POST" "newAccessToken" $ do - Doc.summary "Obtain an access tokens for a cookie." - Doc.notes - "You can provide only a cookie or a cookie and token. \ - \Every other combination is invalid. \ - \Access tokens can be given as query parameter or authorisation \ - \header, with the latter being preferred." - Doc.returns (Doc.ref Public.modelAccessToken) - Doc.parameter Doc.Header "cookie" Doc.bytes' $ do - Doc.description "The 'zuid' cookie header" - Doc.optional - Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do - Doc.description "The access-token as 'Authorization' header." - Doc.optional - Doc.parameter Doc.Query "access_token" Doc.bytes' $ do - Doc.description "The access-token as query parameter." - Doc.optional - Doc.errorResponse (errorToWai @'E.BadCredentials) + -- post "/access" (continue renewH) $ + -- accept "application" "json" + -- .&. tokenRequest + -- document "POST" "newAccessToken" $ do + -- Doc.summary "Obtain an access tokens for a cookie." + -- Doc.notes + -- "You can provide only a cookie or a cookie and token. \ + -- \Every other combination is invalid. \ + -- \Access tokens can be given as query parameter or authorisation \ + -- \header, with the latter being preferred." + -- Doc.returns (Doc.ref Public.modelAccessToken) + -- Doc.parameter Doc.Header "cookie" Doc.bytes' $ do + -- Doc.description "The 'zuid' cookie header" + -- Doc.optional + -- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do + -- Doc.description "The access-token as 'Authorization' header." + -- Doc.optional + -- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do + -- Doc.description "The access-token as query parameter." + -- Doc.optional + -- Doc.errorResponse (errorToWai @'E.BadCredentials) post "/login/send" (continue sendLoginCodeH) $ jsonRequest @Public.SendLoginCode @@ -371,8 +371,8 @@ rmCookies :: UserId -> Public.RemoveCookies -> (Handler r) () rmCookies uid (Public.RemoveCookies pw lls ids) = wrapClientE (Auth.revokeAccess uid pw ids lls) !>> authError -renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response -renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at +_renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response +_renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at -- | renew access for either: -- * a user with user token and optional access token, or From aa28e1ad51add676422ef63cde3c72f68a890abc Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Oct 2022 11:00:50 +0200 Subject: [PATCH 02/43] Parse authorization header --- libs/wire-api/src/Wire/API/Routes/Bearer.hs | 55 +++++++++++++++++++ libs/wire-api/src/Wire/API/Routes/Cookies.hs | 10 ++-- .../src/Wire/API/Routes/Public/Brig.hs | 14 +++++ libs/wire-api/wire-api.cabal | 1 + services/brig/brig.cabal | 1 + services/brig/src/Brig/API/Auth.hs | 30 ++++++++++ services/brig/src/Brig/API/Public.hs | 6 +- 7 files changed, 108 insertions(+), 9 deletions(-) create mode 100644 libs/wire-api/src/Wire/API/Routes/Bearer.hs create mode 100644 services/brig/src/Brig/API/Auth.hs diff --git a/libs/wire-api/src/Wire/API/Routes/Bearer.hs b/libs/wire-api/src/Wire/API/Routes/Bearer.hs new file mode 100644 index 0000000000..0d643495c9 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Bearer.hs @@ -0,0 +1,55 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Routes.Bearer where + +import qualified Data.ByteString as BS +import Data.Metrics.Servant +import qualified Data.Text.Encoding as T +import Imports +import Servant +import Servant.Swagger + +newtype Bearer a = Bearer {unBearer :: a} + +instance FromHttpApiData a => FromHttpApiData (Bearer a) where + parseHeader h = case BS.splitAt 7 h of + ("Bearer ", suffix) -> Bearer <$> parseHeader suffix + _ -> Left "Invalid authorization scheme" + parseUrlPiece = parseHeader . T.encodeUtf8 + +type BearerHeader a = Header "Authorization" (Bearer a) + +instance HasSwagger api => HasSwagger (Bearer a :> api) where + -- TODO + toSwagger _ = toSwagger (Proxy @api) + +instance RoutesToPaths api => RoutesToPaths (Bearer a :> api) where + getRoutes = getRoutes @api + +instance + ( HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters, + FromHttpApiData a, + HasServer api ctx + ) => + HasServer (Bearer a :> api) ctx + where + type ServerT (Bearer a :> api) m = Maybe a -> ServerT api m + + route _ ctx action = + route (Proxy @(BearerHeader a :> api)) ctx (fmap (. (fmap unBearer)) action) + hoistServerWithContext _ ctx f h = hoistServerWithContext (Proxy @api) ctx f . h diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index 00775e9f99..2762383158 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -38,6 +38,7 @@ type CookieHeader cs = Header' '[Required] "Cookie" (CookieTuple cs) type CookieType = NonEmpty +-- CookieTypes = map snd type family CookieTypes (cs :: [*]) :: [*] type instance CookieTypes '[] = '[] @@ -53,15 +54,16 @@ instance HasSwagger api => HasSwagger (Cookies cs :> api) where toSwagger _ = toSwagger (Proxy @api) class CookieArgs (cs :: [*]) where + -- example: AddArgs ["foo" :: Foo, "bar" :: Bar] a = Foo -> Bar -> a type AddArgs cs a :: * - addArgs :: AddArgs cs a -> CookieTuple cs -> a + uncurryArgs :: AddArgs cs a -> CookieTuple cs -> a mapArgs :: (a -> b) -> AddArgs cs a -> AddArgs cs b mkTuple :: CookieMap -> Either Text (CookieTuple cs) instance CookieArgs '[] where type AddArgs '[] a = a - addArgs a _ = a + uncurryArgs a _ = a mapArgs h = h mkTuple _ = pure (CookieTuple Nil) @@ -73,7 +75,7 @@ instance CookieArgs ((lbl ::: (x :: *)) ': cs) where type AddArgs ((lbl ::: x) ': cs) a = CookieType x -> AddArgs cs a - addArgs f (CookieTuple (I x :* xs)) = addArgs @cs (f x) (CookieTuple xs) + uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) mapArgs h f = mapArgs @cs h . f mkTuple m = do let k = T.pack (symbolVal (Proxy @lbl)) @@ -99,7 +101,7 @@ instance type ServerT (Cookies cs :> api) m = AddArgs cs (ServerT api m) route _ ctx action = - route (Proxy @(CookieHeader cs :> api)) ctx (fmap addArgs action) + route (Proxy @(CookieHeader cs :> api)) ctx (fmap uncurryArgs action) hoistServerWithContext _ ctx f = mapArgs @cs (hoistServerWithContext (Proxy @api) ctx f) instance RoutesToPaths api => RoutesToPaths (Cookies cs :> api) where diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 778010066a..b973f12631 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -52,6 +52,7 @@ import Wire.API.Error.Empty import Wire.API.MLS.KeyPackage import Wire.API.MLS.Servant import Wire.API.Properties +import Wire.API.Routes.Bearer import Wire.API.Routes.Cookies import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named @@ -1155,6 +1156,18 @@ instance FromHttpApiData SomeUserToken where <|> fmap LHUserToken (runParser parser h) parseUrlPiece = parseHeader . T.encodeUtf8 +data SomeAccessToken + = AccessToken (ZAuth.Token ZAuth.Access) + | LHAccessToken (ZAuth.Token ZAuth.LegalHoldAccess) + deriving (Show) + +instance FromHttpApiData SomeAccessToken where + parseHeader h = + first T.pack $ + fmap AccessToken (runParser parser h) + <|> fmap LHAccessToken (runParser parser h) + parseUrlPiece = parseHeader . T.encodeUtf8 + type AuthAPI = Named "access" @@ -1166,6 +1179,7 @@ type AuthAPI = \ Access tokens can be given as query parameter or authorisation\ \ header, with the latter being preferred." :> Cookies '["zuid" ::: SomeUserToken] + :> Bearer SomeAccessToken :> MultiVerb1 'POST '[JSON] (Respond 201 "TODO" Text) ) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index b8c0c47eb0..fb41f37bdb 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -68,6 +68,7 @@ library Wire.API.RawJson Wire.API.Routes.API Wire.API.Routes.AssetBody + Wire.API.Routes.Bearer Wire.API.Routes.ClientAlgebra Wire.API.Routes.Cookies Wire.API.Routes.CSV diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 85054b8f96..0655272c90 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -18,6 +18,7 @@ library -- cabal-fmt: expand src exposed-modules: Brig.API + Brig.API.Auth Brig.API.Client Brig.API.Connection Brig.API.Connection.Remote diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs new file mode 100644 index 0000000000..6e21d38a07 --- /dev/null +++ b/services/brig/src/Brig/API/Auth.hs @@ -0,0 +1,30 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Brig.API.Auth where + +import Brig.API.Handler +import Data.List.NonEmpty (NonEmpty) +import Debug.Trace +import Imports +import Wire.API.Routes.Public.Brig + +access :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r Text +access ut at = do + traceM $ "user tokens: " <> show ut + traceM $ "access token: " <> show at + pure "OK" diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index c4a5d33d94..396186eb69 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -27,6 +27,7 @@ module Brig.API.Public ) where +import Brig.API.Auth import qualified Brig.API.Client as API import qualified Brig.API.Connection as API import Brig.API.Error @@ -82,7 +83,6 @@ import Data.Domain import Data.FileEmbed import Data.Handle (Handle, parseHandle) import Data.Id as Id -import Data.List.NonEmpty (NonEmpty) import qualified Data.Map.Strict as Map import Data.Misc (IpAddr (..)) import Data.Nonce (Nonce, randomNonce) @@ -90,7 +90,6 @@ import Data.Qualified import Data.Range import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc -import qualified Data.Text as T import qualified Data.Text as Text import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (decodeLatin1) @@ -290,9 +289,6 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey authAPI :: ServerT AuthAPI (Handler r) authAPI = Named @"access" access - where - access :: NonEmpty SomeUserToken -> Handler r Text - access = pure . T.pack . show -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling From edfcde53596834fbd0b6665702bc9d1122901fcd Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Oct 2022 11:53:11 +0200 Subject: [PATCH 03/43] Remove confusing type synonyms --- services/brig/src/Brig/Provider/API.hs | 5 +- services/brig/src/Brig/User/API/Auth.hs | 65 ++++++++++------------ services/brig/src/Brig/User/Auth/Cookie.hs | 1 - services/brig/src/Brig/ZAuth.hs | 52 ++++++----------- 4 files changed, 50 insertions(+), 73 deletions(-) diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index c533f636ea..90d4ed862e 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -77,6 +77,7 @@ import qualified Data.Set as Set import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text.Ascii as Ascii import qualified Data.Text.Encoding as Text +import qualified Data.ZAuth.Token as ZAuth import Imports import Network.HTTP.Types.Status import Network.Wai (Response) @@ -440,7 +441,7 @@ loginH req = do tok <- login =<< parseJsonBody req setProviderCookie tok empty -login :: Public.ProviderLogin -> (Handler r) ZAuth.ProviderToken +login :: Public.ProviderLogin -> Handler r (ZAuth.Token ZAuth.Provider) login l = do pid <- wrapClientE (DB.lookupKey (mkEmailKey (providerLoginEmail l))) >>= maybeBadCredentials pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials @@ -1169,7 +1170,7 @@ mkBotUserView u = Ext.botUserViewTeam = userTeam u } -setProviderCookie :: ZAuth.ProviderToken -> Response -> (Handler r) Response +setProviderCookie :: ZAuth.Token ZAuth.Provider -> Response -> (Handler r) Response setProviderCookie t r = do s <- view settings let hdr = toByteString' (Cookie.renderSetCookie (cookie s)) diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index c3fd238649..05d8e262c5 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -39,7 +39,6 @@ import Control.Monad.Except import Control.Monad.Trans.Except (throwE) import qualified Data.ByteString as BS import Data.ByteString.Conversion -import Data.Either.Combinators (leftToMaybe, rightToMaybe) import Data.Id import Data.List1 (List1) import qualified Data.List1 as List1 @@ -308,13 +307,13 @@ legalHoldLogin l = do let typ = PersistentCookie -- Session cookie isn't a supported use case here Auth.legalHoldLogin l typ !>> legalHoldLoginError -logoutH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response +logoutH :: JSON ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> (Handler r) Response logoutH (_ ::: ut ::: at) = empty <$ logout ut at -- TODO: add legalhold test checking cookies are revoked (/access/logout is called) when legalhold device is deleted. logout :: - Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) -> - Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> + Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) -> + Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> (Handler r) () logout Nothing Nothing = throwStd authMissingCookieAndToken logout Nothing (Just _) = throwStd authMissingCookie @@ -328,8 +327,8 @@ changeSelfEmailH :: Member BlacklistStore r => JSON ::: JsonRequest Public.EmailUpdate - ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) - ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> + ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) + ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> (Handler r) Response changeSelfEmailH (_ ::: req ::: ckies ::: toks) = do usr <- validateCredentials ckies toks @@ -338,10 +337,6 @@ changeSelfEmailH (_ ::: req ::: ckies ::: toks) = do ChangeEmailResponseIdempotent -> pure (WaiResp.setStatus status204 empty) ChangeEmailResponseNeedsActivation -> pure (WaiResp.setStatus status202 empty) where - validateCredentials :: - Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) -> - Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> - (Handler r) UserId validateCredentials = \case Nothing -> const $ throwStd authMissingCookie @@ -371,35 +366,35 @@ rmCookies :: UserId -> Public.RemoveCookies -> (Handler r) () rmCookies uid (Public.RemoveCookies pw lls ids) = wrapClientE (Auth.revokeAccess uid pw ids lls) !>> authError -_renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response -_renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at +-- _renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response +-- _renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at -- | renew access for either: -- * a user with user token and optional access token, or -- * a legalhold user with legalhold user token and optional legalhold access token. -- -- Other combinations of provided inputs will cause an error to be raised. -renew :: - Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) -> - Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> - (Handler r) (Either (Auth.Access ZAuth.User) (Auth.Access ZAuth.LegalHoldUser)) -renew = \case - Nothing -> - const $ throwStd authMissingCookie - (Just (Left userTokens)) -> - -- normal UserToken, so we want a normal AccessToken - fmap Left . wrapHttpClientE . renewAccess userTokens <=< matchingOrNone leftToMaybe - (Just (Right legalholdUserTokens)) -> - -- LegalholdUserToken, so we want a LegalholdAccessToken - fmap Right . wrapHttpClientE . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe - where - renewAccess uts mat = - Auth.renewAccess uts mat !>> zauthError - matchingOrNone :: (a -> Maybe b) -> Maybe a -> (Handler r) (Maybe b) - matchingOrNone matching = traverse $ \accessToken -> - case matching accessToken of - Just m -> pure m - Nothing -> throwStd authTokenMismatch +-- renew :: +-- Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) -> +-- Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> +-- (Handler r) (Either (Auth.Access ZAuth.User) (Auth.Access ZAuth.LegalHoldUser)) +-- renew = \case +-- Nothing -> +-- const $ throwStd authMissingCookie +-- (Just (Left userTokens)) -> +-- -- normal UserToken, so we want a normal AccessToken +-- fmap Left . wrapHttpClientE . renewAccess userTokens <=< matchingOrNone leftToMaybe +-- (Just (Right legalholdUserTokens)) -> +-- -- LegalholdUserToken, so we want a LegalholdAccessToken +-- fmap Right . wrapHttpClientE . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe +-- where +-- renewAccess uts mat = +-- Auth.renewAccess uts mat !>> zauthError +-- matchingOrNone :: (a -> Maybe b) -> Maybe a -> (Handler r) (Maybe b) +-- matchingOrNone matching = traverse $ \accessToken -> +-- case matching accessToken of +-- Just m -> pure m +-- Nothing -> throwStd authTokenMismatch -- Utilities -- @@ -411,8 +406,8 @@ tokenRequest :: Predicate r P.Error - ( Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) - ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) + ( Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) + ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) ) tokenRequest = opt (userToken ||| legalHoldUserToken) .&. opt (accessToken ||| legalHoldAccessToken) where diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs index 05f24ff8c7..0ab37164ea 100644 --- a/services/brig/src/Brig/User/Auth/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/Cookie.hs @@ -37,7 +37,6 @@ module Brig.User.Auth.Cookie -- * Re-exports Cookie (..), AccessToken (..), - ZAuth.UserToken, ) where diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index e5579aa1cd..2dc2e2c9fd 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -49,12 +49,6 @@ module Brig.ZAuth -- * Token Creation Token, - UserToken, - AccessToken, - ProviderToken, - BotToken, - LegalHoldUserToken, - LegalHoldAccessToken, mkUserToken, newUserToken, newSessionToken, @@ -156,18 +150,6 @@ data Env = Env _settings :: !Settings } -type AccessToken = Token Access - -type UserToken = Token User - -type ProviderToken = Token Provider - -type BotToken = Token Bot - -type LegalHoldUserToken = Token LegalHoldUser - -type LegalHoldAccessToken = Token LegalHoldAccess - newtype UserTokenTimeout = UserTokenTimeout {_userTokenTimeoutSeconds :: Integer} deriving (Show, Generic) @@ -290,14 +272,14 @@ instance UserTokenLike LegalHoldUser where userTTL _ = legalHoldUserTokenTimeout . legalHoldUserTokenTimeoutSeconds zauthType = LU -mkUserToken' :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m UserToken +mkUserToken' :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m (Token User) mkUserToken' u r t = liftZAuth $ do z <- ask liftIO $ ZC.runCreate (z ^. private) (z ^. settings . keyIndex) $ ZC.newToken (utcTimeToPOSIXSeconds t) U Nothing (mkUser (toUUID u) r) -newUserToken' :: MonadZAuth m => UserId -> m UserToken +newUserToken' :: MonadZAuth m => UserId -> m (Token User) newUserToken' u = liftZAuth $ do z <- ask r <- liftIO randomValue @@ -306,7 +288,7 @@ newUserToken' u = liftZAuth $ do let UserTokenTimeout ttl = z ^. settings . userTokenTimeout in ZC.userToken ttl (toUUID u) r -newSessionToken' :: MonadZAuth m => UserId -> m UserToken +newSessionToken' :: MonadZAuth m => UserId -> m (Token User) newSessionToken' u = liftZAuth $ do z <- ask r <- liftIO randomValue @@ -315,7 +297,7 @@ newSessionToken' u = liftZAuth $ do let SessionTokenTimeout ttl = z ^. settings . sessionTokenTimeout in ZC.sessionToken ttl (toUUID u) r -newAccessToken' :: MonadZAuth m => UserToken -> m AccessToken +newAccessToken' :: MonadZAuth m => Token User -> m (Token Access) newAccessToken' xt = liftZAuth $ do z <- ask liftIO $ @@ -323,7 +305,7 @@ newAccessToken' xt = liftZAuth $ do let AccessTokenTimeout ttl = z ^. settings . accessTokenTimeout in ZC.accessToken1 ttl (xt ^. body . user) -renewAccessToken' :: MonadZAuth m => AccessToken -> m AccessToken +renewAccessToken' :: MonadZAuth m => Token Access -> m (Token Access) renewAccessToken' old = liftZAuth $ do z <- ask liftIO $ @@ -331,14 +313,14 @@ renewAccessToken' old = liftZAuth $ do let AccessTokenTimeout ttl = z ^. settings . accessTokenTimeout in ZC.renewToken ttl old -newBotToken :: MonadZAuth m => ProviderId -> BotId -> ConvId -> m BotToken +newBotToken :: MonadZAuth m => ProviderId -> BotId -> ConvId -> m (Token Bot) newBotToken pid bid cid = liftZAuth $ do z <- ask liftIO $ ZC.runCreate (z ^. private) (z ^. settings . keyIndex) $ ZC.botToken (toUUID pid) (toUUID (botUserId bid)) (toUUID cid) -newProviderToken :: MonadZAuth m => ProviderId -> m ProviderToken +newProviderToken :: MonadZAuth m => ProviderId -> m (Token Provider) newProviderToken pid = liftZAuth $ do z <- ask liftIO $ @@ -352,14 +334,14 @@ newProviderToken pid = liftZAuth $ do -- 2) (mkLegalHoldUser uid r) / (mkUser uid r) -- Possibly some duplication could be removed. -- See https://github.com/wireapp/wire-server/pull/761/files#r318612423 -mkLegalHoldUserToken :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m LegalHoldUserToken +mkLegalHoldUserToken :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m (Token LegalHoldUser) mkLegalHoldUserToken u r t = liftZAuth $ do z <- ask liftIO $ ZC.runCreate (z ^. private) (z ^. settings . keyIndex) $ ZC.newToken (utcTimeToPOSIXSeconds t) LU Nothing (mkLegalHoldUser (toUUID u) r) -newLegalHoldUserToken :: MonadZAuth m => UserId -> m LegalHoldUserToken +newLegalHoldUserToken :: MonadZAuth m => UserId -> m (Token LegalHoldUser) newLegalHoldUserToken u = liftZAuth $ do z <- ask r <- liftIO randomValue @@ -368,7 +350,7 @@ newLegalHoldUserToken u = liftZAuth $ do let LegalHoldUserTokenTimeout ttl = z ^. settings . legalHoldUserTokenTimeout in ZC.legalHoldUserToken ttl (toUUID u) r -newLegalHoldAccessToken :: MonadZAuth m => LegalHoldUserToken -> m LegalHoldAccessToken +newLegalHoldAccessToken :: MonadZAuth m => (Token LegalHoldUser) -> m (Token LegalHoldAccess) newLegalHoldAccessToken xt = liftZAuth $ do z <- ask liftIO $ @@ -376,7 +358,7 @@ newLegalHoldAccessToken xt = liftZAuth $ do let LegalHoldAccessTokenTimeout ttl = z ^. settings . legalHoldAccessTokenTimeout in ZC.legalHoldAccessToken1 ttl (xt ^. body . legalHoldUser . user) -renewLegalHoldAccessToken :: MonadZAuth m => LegalHoldAccessToken -> m LegalHoldAccessToken +renewLegalHoldAccessToken :: MonadZAuth m => Token LegalHoldAccess -> m (Token LegalHoldAccess) renewLegalHoldAccessToken old = liftZAuth $ do z <- ask liftIO $ @@ -392,22 +374,22 @@ validateToken t = liftZAuth $ do z <- ask void <$> ZV.runValidate (z ^. public) (ZV.check t) -accessTokenOf' :: AccessToken -> UserId +accessTokenOf' :: Token Access -> UserId accessTokenOf' t = Id (t ^. body . userId) -userTokenOf' :: UserToken -> UserId +userTokenOf' :: Token User -> UserId userTokenOf' t = Id (t ^. body . user) -legalHoldAccessTokenOf :: LegalHoldAccessToken -> UserId +legalHoldAccessTokenOf :: Token LegalHoldAccess -> UserId legalHoldAccessTokenOf t = Id (t ^. body . legalHoldAccess . userId) -legalHoldUserTokenOf :: LegalHoldUserToken -> UserId +legalHoldUserTokenOf :: Token LegalHoldUser -> UserId legalHoldUserTokenOf t = Id (t ^. body . legalHoldUser . user) -userTokenRand' :: UserToken -> Word32 +userTokenRand' :: Token User -> Word32 userTokenRand' t = t ^. body . rand -legalHoldUserTokenRand :: LegalHoldUserToken -> Word32 +legalHoldUserTokenRand :: Token LegalHoldUser -> Word32 legalHoldUserTokenRand t = t ^. body . legalHoldUser . rand tokenKeyIndex :: Token a -> Int From 8ab2b10a99e446c716985b85dd3ee4cafa5ba511 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 5 Oct 2022 13:24:48 +0200 Subject: [PATCH 04/43] access endpoint wip --- services/brig/src/Brig/API/Auth.hs | 59 +++++++++++++++++++++++++++--- services/brig/src/Brig/ZAuth.hs | 2 +- 2 files changed, 54 insertions(+), 7 deletions(-) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 6e21d38a07..7b36131b5c 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -17,14 +17,61 @@ module Brig.API.Auth where +import Brig.API.Error (authMissingCookie, throwStd) import Brig.API.Handler -import Data.List.NonEmpty (NonEmpty) -import Debug.Trace +import qualified Brig.ZAuth as ZAuth +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Data.List.NonEmpty as NE +import qualified Data.ZAuth.Token as ZAuth import Imports -import Wire.API.Routes.Public.Brig +import Wire.API.Routes.Public.Brig (SomeUserToken) +import Wire.API.Routes.Public.Brig hiding (SomeUserToken) access :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r Text -access ut at = do - traceM $ "user tokens: " <> show ut - traceM $ "access token: " <> show at +access ut mat = do + tokens <- partitionTokens ut + case (tokens, mat) of + (Left userTokens, Just (AccessToken mat)) -> + error "TODO" + + -- traceM $ "user tokens: " <> show ut + -- traceM $ "access token: " <> show at pure "OK" + where + renewAccess uts mat = error "TODO" + +partitionTokens :: + NonEmpty SomeUserToken -> + Handler + r + ( Either + (NonEmpty (ZAuth.Token ZAuth.User)) + (NonEmpty (ZAuth.Token ZAuth.LegalHoldUser)) + ) +partitionTokens tokens = + case partitionEithers (map toEither (NE.toList tokens)) of + (at : ats, []) -> pure (Left (at :| ats)) + ([], lt : lts) -> pure (Right (lt :| lts)) + ([], []) -> throwStd authMissingCookie -- impossible + (_ats, _rts) -> throwStd authMissingCookie + where + toEither :: SomeUserToken -> Either (ZAuth.Token ZAuth.User) (ZAuth.Token ZAuth.LegalHoldUser) + toEither = error "TODO" + +-- renew = \case +-- Nothing -> +-- const $ throwStd authMissingCookie +-- (Just (Left userTokens)) -> +-- -- normal UserToken, so we want a normal AccessToken +-- fmap Left . wrapHttpClientE . renewAccess userTokens <=< matchingOrNone leftToMaybe +-- (Just (Right legalholdUserTokens)) -> +-- -- LegalholdUserToken, so we want a LegalholdAccessToken +-- fmap Right . wrapHttpClientE . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe +-- where +-- renewAccess uts mat = +-- Auth.renewAccess uts mat !>> zauthError +-- matchingOrNone :: (a -> Maybe b) -> Maybe a -> (Handler r) (Maybe b) +-- matchingOrNone matching = traverse $ \accessToken -> +-- case matching accessToken of +-- Just m -> pure m +-- Nothing -> throwStd authTokenMismatch diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index 2dc2e2c9fd..167f386eb1 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -350,7 +350,7 @@ newLegalHoldUserToken u = liftZAuth $ do let LegalHoldUserTokenTimeout ttl = z ^. settings . legalHoldUserTokenTimeout in ZC.legalHoldUserToken ttl (toUUID u) r -newLegalHoldAccessToken :: MonadZAuth m => (Token LegalHoldUser) -> m (Token LegalHoldAccess) +newLegalHoldAccessToken :: MonadZAuth m => Token LegalHoldUser -> m (Token LegalHoldAccess) newLegalHoldAccessToken xt = liftZAuth $ do z <- ask liftIO $ From 3bb229c7adc49d0ca823b2aa99e77be9b2fd05fa Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 5 Oct 2022 15:47:03 +0200 Subject: [PATCH 05/43] wip cont'd --- services/brig/src/Brig/API/Auth.hs | 69 ++++++++++++++---------------- 1 file changed, 31 insertions(+), 38 deletions(-) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 7b36131b5c..51be93827a 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -17,61 +17,54 @@ module Brig.API.Auth where -import Brig.API.Error (authMissingCookie, throwStd) +import Brig.API.Error (authTokenMismatch, internalServerError, throwStd, zauthError) import Brig.API.Handler +import Brig.App (wrapHttpClientE) +import Brig.User.Auth (Access) +import qualified Brig.User.Auth as Auth import qualified Brig.ZAuth as ZAuth import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE +import Data.List1 (List1 (..)) import qualified Data.ZAuth.Token as ZAuth import Imports +import Network.Wai.Utilities ((!>>)) import Wire.API.Routes.Public.Brig (SomeUserToken) import Wire.API.Routes.Public.Brig hiding (SomeUserToken) -access :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r Text +access :: forall r. NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r Text access ut mat = do - tokens <- partitionTokens ut - case (tokens, mat) of - (Left userTokens, Just (AccessToken mat)) -> - error "TODO" - - -- traceM $ "user tokens: " <> show ut - -- traceM $ "access token: " <> show at - pure "OK" + partitionTokens ut mat >>= either (uncurry renew) (uncurry renew) where - renewAccess uts mat = error "TODO" + renew t mt = mkResponse <$> wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError + +mkResponse :: Access u -> Text +mkResponse _ = error "TODO" partitionTokens :: NonEmpty SomeUserToken -> + Maybe SomeAccessToken -> Handler r ( Either - (NonEmpty (ZAuth.Token ZAuth.User)) - (NonEmpty (ZAuth.Token ZAuth.LegalHoldUser)) + (NonEmpty (ZAuth.Token ZAuth.User), Maybe (ZAuth.Token ZAuth.Access)) + (NonEmpty (ZAuth.Token ZAuth.LegalHoldUser), Maybe (ZAuth.Token ZAuth.LegalHoldAccess)) ) -partitionTokens tokens = - case partitionEithers (map toEither (NE.toList tokens)) of - (at : ats, []) -> pure (Left (at :| ats)) - ([], lt : lts) -> pure (Right (lt :| lts)) - ([], []) -> throwStd authMissingCookie -- impossible - (_ats, _rts) -> throwStd authMissingCookie +partitionTokens tokens mat = + case (partitionEithers (map toEither (NE.toList tokens)), mat) of + -- only PlainUserToken + ((at : ats, []), Nothing) -> pure (Left (at :| ats, Nothing)) + ((at : ats, []), Just (AccessToken a)) -> pure (Left (at :| ats, Just a)) + ((_t : _ts, []), Just (LHAccessToken _)) -> throwStd authTokenMismatch + -- only LHUserToken tokens + (([], lt : lts), Nothing) -> pure (Right (lt :| lts, Nothing)) + (([], _t : _ts), Just (AccessToken _)) -> throwStd authTokenMismatch + (([], lt : lts), Just (LHAccessToken l)) -> pure (Right (lt :| lts, Just l)) + -- impossible + (([], []), _) -> throwStd internalServerError + -- mixed PlainUserToken and LHUserToken + ((_ats, _lts), _) -> throwStd authTokenMismatch where toEither :: SomeUserToken -> Either (ZAuth.Token ZAuth.User) (ZAuth.Token ZAuth.LegalHoldUser) - toEither = error "TODO" - --- renew = \case --- Nothing -> --- const $ throwStd authMissingCookie --- (Just (Left userTokens)) -> --- -- normal UserToken, so we want a normal AccessToken --- fmap Left . wrapHttpClientE . renewAccess userTokens <=< matchingOrNone leftToMaybe --- (Just (Right legalholdUserTokens)) -> --- -- LegalholdUserToken, so we want a LegalholdAccessToken --- fmap Right . wrapHttpClientE . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe --- where --- renewAccess uts mat = --- Auth.renewAccess uts mat !>> zauthError --- matchingOrNone :: (a -> Maybe b) -> Maybe a -> (Handler r) (Maybe b) --- matchingOrNone matching = traverse $ \accessToken -> --- case matching accessToken of --- Just m -> pure m --- Nothing -> throwStd authTokenMismatch + toEither (UserToken ut) = Left ut + toEither (LHUserToken lt) = Right lt From 38b7a17667c8fe7c70b595af8ba0dcd0fb0e83b5 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Oct 2022 15:18:55 +0200 Subject: [PATCH 06/43] Create schemas for Wire.API.User.Auth types --- libs/wire-api/src/Wire/API/Swagger.hs | 8 - libs/wire-api/src/Wire/API/User/Auth.hs | 465 +++++++++++------------ libs/wire-api/src/Wire/API/User/Auth2.hs | 65 ---- libs/wire-api/wire-api.cabal | 1 - 4 files changed, 216 insertions(+), 323 deletions(-) delete mode 100644 libs/wire-api/src/Wire/API/User/Auth2.hs diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 20aaddca84..afc5720fe1 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -36,7 +36,6 @@ import qualified Wire.API.Team.Conversation as Team.Conversation import qualified Wire.API.Team.Invitation as Team.Invitation import qualified Wire.API.Team.Permission as Team.Permission import qualified Wire.API.User as User -import qualified Wire.API.User.Auth as User.Auth import qualified Wire.API.User.Client as User.Client import qualified Wire.API.User.Client.Prekey as User.Client.Prekey import qualified Wire.API.User.Handle as User.Handle @@ -100,13 +99,6 @@ models = User.modelUser, User.modelEmailUpdate, User.modelDelete, - User.Auth.modelSendLoginCode, - User.Auth.modelLoginCodeResponse, - User.Auth.modelLogin, - User.Auth.modelRemoveCookies, - User.Auth.modelCookie, - User.Auth.modelCookieList, - User.Auth.modelAccessToken, User.Client.modelOtrClientMap, User.Client.modelUserClients, User.Client.modelNewClient, diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index c38537045a..c787ee207e 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} -- This file is part of the Wire Server implementation. -- @@ -40,102 +41,67 @@ module Wire.API.User.Auth AccessToken (..), bearerToken, TokenType (..), - - -- * Swagger - modelSendLoginCode, - modelLoginCodeResponse, - modelLogin, - modelRemoveCookies, - modelCookie, - modelCookieList, - modelAccessToken, ) where -import Data.Aeson -import qualified Data.Aeson.Types as Aeson +import Control.Applicative +import Control.Lens ((?~)) +import Control.Lens.TH +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Aeson.Types as A import Data.ByteString.Conversion +import qualified Data.ByteString.Lazy as LBS import Data.Code as Code +import Data.Handle (Handle) import Data.Id (UserId) +import Data.Json.Util import Data.Misc (PlainTextPassword (..)) -import Data.Schema (ToSchema) +import Data.Schema import qualified Data.Swagger as S -import qualified Data.Swagger.Build.Api as Doc -import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8) +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy.Encoding as LT import Data.Time.Clock (UTCTime) +import Data.Tuple.Extra import Imports -import Wire.API.User.Auth2 -import Wire.API.User.Identity (Phone) +import Wire.API.User.Identity (Email, Phone) import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) -------------------------------------------------------------------------------- --- Login +-- LoginId --- | Different kinds of logins. -data Login - = PasswordLogin LoginId PlainTextPassword (Maybe CookieLabel) (Maybe Code.Value) - | SmsLogin Phone LoginCode (Maybe CookieLabel) +data LoginId + = LoginByEmail Email + | LoginByPhone Phone + | LoginByHandle Handle deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform Login) - -modelLogin :: Doc.Model -modelLogin = Doc.defineModel "Login" $ do - Doc.description "Payload for performing a login." - Doc.property "email" Doc.string' $ do - Doc.description "The email address for a password login." - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "The phone number for a password or SMS login." - Doc.optional - Doc.property "handle" Doc.string' $ do - Doc.description "The handle for a password login." - Doc.optional - Doc.property "password" Doc.string' $ do - Doc.description "The password for a password login." - Doc.optional - Doc.property "code" Doc.string' $ do - Doc.description "The login code for an SMS login." - Doc.optional - Doc.property "label" Doc.string' $ do - Doc.description - "A label to associate with the returned cookie. \ - \Every client should have a unique and stable (persistent) label \ - \to allow targeted revocation of all cookies granted to that \ - \specific client." - Doc.optional - Doc.property "verification_code" Doc.string' $ do - Doc.description "The login verification code for 2nd factor authentication. Required only if SndFactorPasswordChallenge is enabled for the team/server." - Doc.optional - -instance ToJSON Login where - toJSON (SmsLogin p c l) = object ["phone" .= p, "code" .= c, "label" .= l] - toJSON (PasswordLogin login password label mbCode) = - object - [ "password" .= password, - "label" .= label, - loginIdPair login, - "verification_code" .= mbCode - ] - -instance FromJSON Login where - parseJSON = withObject "Login" $ \o -> do - passw <- o .:? "password" - case passw of - Nothing -> - SmsLogin <$> o .: "phone" <*> o .: "code" <*> o .:? "label" - Just pw -> do - loginId <- parseJSON (Object o) - PasswordLogin loginId pw <$> (o .:? "label") <*> (o .:? "verification_code") - -loginLabel :: Login -> Maybe CookieLabel -loginLabel (PasswordLogin _ _ l _) = l -loginLabel (SmsLogin _ _ l) = l - -loginIdPair :: LoginId -> Aeson.Pair -loginIdPair = \case - LoginByEmail s -> "email" .= s - LoginByPhone s -> "phone" .= s - LoginByHandle s -> "handle" .= s + deriving (Arbitrary) via (GenericUniform LoginId) + +$(makePrisms ''LoginId) + +-- NB. this should fail if (e.g.) the email is present but unparseable even if the JSON contains a valid phone number or handle. +-- See tests in `Test.Wire.API.User.Auth`. +instance ToSchema LoginId where + schema = object "LoginId" $ loginObjectSchema + +loginObjectSchema :: ObjectSchema SwaggerDoc LoginId +loginObjectSchema = + fromLoginId .= tupleSchema `withParser` validate + where + fromLoginId :: LoginId -> (Maybe Email, Maybe Phone, Maybe Handle) + fromLoginId = \case + LoginByEmail e -> (Just e, Nothing, Nothing) + LoginByPhone p -> (Nothing, Just p, Nothing) + LoginByHandle h -> (Nothing, Nothing, Just h) + tupleSchema :: ObjectSchema SwaggerDoc (Maybe Email, Maybe Phone, Maybe Handle) + tupleSchema = + (,,) + <$> fst3 .= maybe_ (optField "email" schema) + <*> snd3 .= maybe_ (optField "phone" schema) + <*> thd3 .= maybe_ (optField "handle" schema) + validate :: (Maybe Email, Maybe Phone, Maybe Handle) -> A.Parser LoginId + validate (mEmail, mPhone, mHandle) = + maybe (fail "'email', 'phone' or 'handle' required") pure $ + (LoginByEmail <$> mEmail) <|> (LoginByPhone <$> mPhone) <|> (LoginByHandle <$> mHandle) -------------------------------------------------------------------------------- -- LoginCode @@ -144,7 +110,11 @@ loginIdPair = \case newtype LoginCode = LoginCode {fromLoginCode :: Text} deriving stock (Eq, Show) - deriving newtype (FromJSON, ToJSON, Arbitrary) + deriving newtype (Arbitrary) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema LoginCode + +instance ToSchema LoginCode where + schema = LoginCode <$> fromLoginCode .= text "LoginCode" -- | Used for internal endpoint only. data PendingLoginCode = PendingLoginCode @@ -154,16 +124,12 @@ data PendingLoginCode = PendingLoginCode deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform PendingLoginCode) -instance ToJSON PendingLoginCode where - toJSON (PendingLoginCode c t) = - object - ["code" .= c, "expires_in" .= t] - -instance FromJSON PendingLoginCode where - parseJSON = withObject "PendingLoginCode" $ \o -> - PendingLoginCode - <$> o .: "code" - <*> o .: "expires_in" +instance ToSchema PendingLoginCode where + schema = + object "PendingLoginCode" $ + PendingLoginCode + <$> pendingLoginCode .= field "code" schema + <*> pendingLoginTimeout .= field "expires_in" schema -------------------------------------------------------------------------------- -- SendLoginCode @@ -177,29 +143,26 @@ data SendLoginCode = SendLoginCode deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SendLoginCode) -modelSendLoginCode :: Doc.Model -modelSendLoginCode = Doc.defineModel "SendLoginCode" $ do - Doc.description "Payload for requesting a login code to be sent." - Doc.property "phone" Doc.string' $ - Doc.description "E.164 phone number to send the code to." - Doc.property "voice_call" Doc.bool' $ do - Doc.description "Request the code with a call instead (default is SMS)." - Doc.optional - -instance ToJSON SendLoginCode where - toJSON (SendLoginCode p c f) = - object - [ "phone" .= p, - "voice_call" .= c, - "force" .= f - ] - -instance FromJSON SendLoginCode where - parseJSON = withObject "SendLoginCode" $ \o -> - SendLoginCode - <$> o .: "phone" - <*> o .:? "voice_call" .!= False - <*> o .:? "force" .!= True +instance ToSchema SendLoginCode where + schema = + objectWithDocModifier + "SendLoginCode" + (description ?~ "Payload for requesting a login code to be sent") + $ SendLoginCode + <$> lcPhone + .= fieldWithDocModifier + "phone" + (description ?~ "E.164 phone number to send the code to") + (unnamed schema) + <*> lcCall + .= fmap + (fromMaybe False) + ( optFieldWithDocModifier + "voice_call" + (description ?~ "Request the code with a call instead (default is SMS)") + schema + ) + <*> lcForce .= fmap (fromMaybe True) (optField "force" schema) -------------------------------------------------------------------------------- -- LoginCodeTimeout @@ -210,18 +173,17 @@ newtype LoginCodeTimeout = LoginCodeTimeout deriving stock (Eq, Show) deriving newtype (Arbitrary) -modelLoginCodeResponse :: Doc.Model -modelLoginCodeResponse = Doc.defineModel "LoginCodeResponse" $ do - Doc.description "A response for a successfully sent login code." - Doc.property "expires_in" Doc.int32' $ - Doc.description "Number of seconds before the login code expires." - -instance ToJSON LoginCodeTimeout where - toJSON (LoginCodeTimeout t) = object ["expires_in" .= t] - -instance FromJSON LoginCodeTimeout where - parseJSON = withObject "LoginCodeTimeout" $ \o -> - LoginCodeTimeout <$> o .: "expires_in" +instance ToSchema LoginCodeTimeout where + schema = + objectWithDocModifier + "LoginCodeTimeout" + (description ?~ "A response for a successfully sent login code") + $ LoginCodeTimeout + <$> fromLoginCodeTimeout + .= fieldWithDocModifier + "expires_in" + (description ?~ "Number of seconds before the login code expires") + (unnamed schema) -------------------------------------------------------------------------------- -- Cookie @@ -232,17 +194,13 @@ data CookieList = CookieList deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform CookieList) -modelCookieList :: Doc.Model -modelCookieList = Doc.defineModel "CookieList" $ do - Doc.description "List of cookie information" - Doc.property "cookies" (Doc.array (Doc.ref modelCookie)) Doc.end - -instance ToJSON CookieList where - toJSON c = object ["cookies" .= cookieList c] - -instance FromJSON CookieList where - parseJSON = withObject "CookieList" $ \o -> - CookieList <$> o .: "cookies" +instance ToSchema CookieList where + schema = + objectWithDocModifier + "CookieList" + (description ?~ "List of cookie information") + $ CookieList + <$> cookieList .= field "cookies" (array schema) -- | A (long-lived) cookie scoped to a specific user for obtaining new -- 'AccessToken's. @@ -258,41 +216,17 @@ data Cookie a = Cookie deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform (Cookie a)) -modelCookie :: Doc.Model -modelCookie = Doc.defineModel "Cookie" $ do - Doc.description "Cookie information" - Doc.property "id" Doc.int32' $ - Doc.description "The primary cookie identifier" - Doc.property "type" modelTypeCookieType $ - Doc.description "The cookie's type" - Doc.property "created" Doc.dateTime' $ - Doc.description "The cookie's creation time" - Doc.property "expires" Doc.dateTime' $ - Doc.description "The cookie's expiration time" - Doc.property "label" Doc.bytes' $ - Doc.description "The cookie's label" - -instance ToJSON (Cookie ()) where - toJSON c = - object - [ "id" .= cookieId c, - "created" .= cookieCreated c, - "expires" .= cookieExpires c, - "label" .= cookieLabel c, - "type" .= cookieType c, - "successor" .= cookieSucc c - ] - -instance FromJSON (Cookie ()) where - parseJSON = withObject "cookie" $ \o -> - Cookie - <$> o .: "id" - <*> o .: "type" - <*> o .: "created" - <*> o .: "expires" - <*> o .:? "label" - <*> o .:? "successor" - <*> pure () +instance ToSchema (Cookie ()) where + schema = + object "Cookie" $ + Cookie + <$> cookieId .= field "id" schema + <*> cookieType .= field "type" schema + <*> cookieCreated .= field "created" utcTimeSchema + <*> cookieExpires .= field "expires" utcTimeSchema + <*> cookieLabel .= optField "label" (maybeWithDefault A.Null schema) + <*> cookieSucc .= optField "successor" (maybeWithDefault A.Null schema) + <*> cookieValue .= empty -- | A device-specific identifying label for one or more cookies. -- Cookies can be listed and deleted based on their labels. @@ -313,7 +247,7 @@ newtype CookieLabel = CookieLabel newtype CookieId = CookieId {cookieIdNum :: Word32} deriving stock (Eq, Show, Generic) - deriving newtype (FromJSON, ToJSON, Arbitrary) + deriving newtype (ToSchema, FromJSON, ToJSON, Arbitrary) data CookieType = -- | A session cookie. These are mainly intended for clients @@ -329,22 +263,65 @@ data CookieType deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform CookieType) -modelTypeCookieType :: Doc.DataType -modelTypeCookieType = - Doc.string $ - Doc.enum - [ "session", - "persistent" - ] +instance ToSchema CookieType where + schema = + enum @Text "CookieType" $ + element "session" SessionCookie + <> element "persistent" PersistentCookie -instance ToJSON CookieType where - toJSON SessionCookie = "session" - toJSON PersistentCookie = "persistent" +-------------------------------------------------------------------------------- +-- Login -instance FromJSON CookieType where - parseJSON (String "session") = pure SessionCookie - parseJSON (String "persistent") = pure PersistentCookie - parseJSON _ = fail "Invalid cookie type" +-- | Different kinds of logins. +data Login + = PasswordLogin PasswordLoginData + | SmsLogin SmsLoginData + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform Login) + +data PasswordLoginData = PasswordLoginData + { plId :: LoginId, + plPassword :: PlainTextPassword, + plLabel :: Maybe CookieLabel, + plCode :: Maybe Code.Value + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform PasswordLoginData) + +passwordLoginSchema :: ObjectSchema SwaggerDoc PasswordLoginData +passwordLoginSchema = + PasswordLoginData + <$> plId .= loginObjectSchema + <*> plPassword .= field "password" schema + <*> plLabel .= maybe_ (optField "label" schema) + <*> plCode .= maybe_ (optField "verification_code" schema) + +data SmsLoginData = SmsLoginData + { slPhone :: Phone, + slCode :: LoginCode, + slLabel :: Maybe CookieLabel + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform SmsLoginData) + +smsLoginSchema :: ObjectSchema SwaggerDoc SmsLoginData +smsLoginSchema = + SmsLoginData + <$> slPhone .= field "phone" schema + <*> slCode .= field "code" schema + <*> slLabel .= maybe_ (optField "label" schema) + +$(makePrisms ''Login) + +instance ToSchema Login where + schema = + object "Login" $ + tag _PasswordLogin passwordLoginSchema + <> tag _SmsLogin smsLoginSchema + +loginLabel :: Login -> Maybe CookieLabel +loginLabel (PasswordLogin pl) = plLabel pl +loginLabel (SmsLogin sl) = slLabel sl -------------------------------------------------------------------------------- -- RemoveCookies @@ -357,32 +334,33 @@ data RemoveCookies = RemoveCookies deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RemoveCookies) -modelRemoveCookies :: Doc.Model -modelRemoveCookies = Doc.defineModel "RemoveCookies" $ do - Doc.description "Data required to remove cookies" - Doc.property "password" Doc.bytes' $ - Doc.description "The user's password" - Doc.property "labels" (Doc.array Doc.bytes') $ do - Doc.description "A list of cookie labels for which to revoke the cookies." - Doc.optional - Doc.property "ids" (Doc.array Doc.int32') $ do - Doc.description "A list of cookie IDs to revoke." - Doc.optional - -instance ToJSON RemoveCookies where - toJSON (RemoveCookies password labels ids) = - object - [ "password" .= password, - "labels" .= labels, - "ids" .= ids - ] - -instance FromJSON RemoveCookies where - parseJSON = withObject "remove" $ \o -> - RemoveCookies - <$> o .: "password" - <*> o .:? "labels" .!= [] - <*> o .:? "ids" .!= [] +instance ToSchema RemoveCookies where + schema = + objectWithDocModifier + "RemoveCookies" + (description ?~ "Data required to remove cookies") + $ RemoveCookies + <$> rmCookiesPassword + .= fieldWithDocModifier + "password" + (description ?~ "The user's password") + schema + <*> rmCookiesLabels + .= fmap + fold + ( optFieldWithDocModifier + "labels" + (description ?~ "A list of cookie labels for which to revoke the cookies") + (array schema) + ) + <*> rmCookiesIdents + .= fmap + fold + ( optFieldWithDocModifier + "ids" + (description ?~ "A list of cookie IDs to revoke") + (array schema) + ) -------------------------------------------------------------------------------- -- Cookies & Access Tokens @@ -397,42 +375,35 @@ data AccessToken = AccessToken } deriving stock (Eq, Show, Generic) -bearerToken :: UserId -> LByteString -> Integer -> AccessToken -bearerToken u a = AccessToken u a Bearer - -modelAccessToken :: Doc.Model -modelAccessToken = Doc.defineModel "AccessToken" $ do - Doc.description "An API access token." - Doc.property "access_token" Doc.bytes' $ - Doc.description "The opaque access token string." - Doc.property "token_type" (Doc.string $ Doc.enum ["Bearer"]) $ - Doc.description "The type of the access token." - Doc.property "expires_in" Doc.int64' $ - Doc.description "The number of seconds this token is valid." - -instance ToJSON AccessToken where - toJSON (AccessToken u t tt e) = - object - [ "user" .= u, +instance ToSchema AccessToken where + schema = + object "AccessToken" $ + AccessToken + <$> user .= field "user" schema + <*> -- FUTUREWORK: if we assume it's valid UTF-8, why not make it 'Text'? - "access_token" .= decodeUtf8 t, - "token_type" .= tt, - "expires_in" .= e - ] + access + .= fieldWithDocModifier + "access_token" + (description ?~ "The opaque access token string") + ( (LBS.fromStrict . T.encodeUtf8) <$> (T.decodeUtf8 . LBS.toStrict) + .= schema + ) + <*> tokenType .= field "token_type" schema + <*> expiresIn + .= fieldWithDocModifier + "expires_in" + (description ?~ "The number of seconds this token is valid") + schema -instance FromJSON AccessToken where - parseJSON = withObject "AccessToken" $ \o -> - AccessToken - <$> o .: "user" - <*> (encodeUtf8 <$> o .: "access_token") - <*> o .: "token_type" - <*> o .: "expires_in" +bearerToken :: UserId -> LByteString -> Integer -> AccessToken +bearerToken u a = AccessToken u a Bearer instance Arbitrary AccessToken where arbitrary = AccessToken <$> arbitrary - <*> (encodeUtf8 <$> arbitrary) + <*> (LT.encodeUtf8 <$> arbitrary) <*> arbitrary <*> arbitrary @@ -440,9 +411,5 @@ data TokenType = Bearer deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform TokenType) -instance ToJSON TokenType where - toJSON Bearer = toJSON ("Bearer" :: Text) - -instance FromJSON TokenType where - parseJSON (String "Bearer") = pure Bearer - parseJSON _ = fail "Invalid token type" +instance ToSchema TokenType where + schema = enum @Text "TokenType" $ element "Bearer" Bearer diff --git a/libs/wire-api/src/Wire/API/User/Auth2.hs b/libs/wire-api/src/Wire/API/User/Auth2.hs deleted file mode 100644 index 5183c38210..0000000000 --- a/libs/wire-api/src/Wire/API/User/Auth2.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE StrictData #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- FUTUREWORK: replace `Wire.API.User.Auth` with this module once everything in `Auth` is migrated to schema-profunctor -module Wire.API.User.Auth2 where - -import Data.Aeson (FromJSON (..), ToJSON (..)) -import qualified Data.Aeson.Types as A -import Data.Handle (Handle) -import Data.Schema -import qualified Data.Swagger as S -import Data.Tuple.Extra (fst3, snd3, thd3) -import Imports -import Wire.API.User.Identity (Email, Phone) -import Wire.Arbitrary (Arbitrary, GenericUniform (..)) - --------------------------------------------------------------------------------- --- LoginId - -data LoginId - = LoginByEmail Email - | LoginByPhone Phone - | LoginByHandle Handle - deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform LoginId) - deriving (ToJSON, FromJSON, S.ToSchema) via (Schema LoginId) - --- NB. this should fail if (e.g.) the email is present but unparseable even if the JSON contains a valid phone number or handle. --- See tests in `Test.Wire.API.User.Auth`. -instance ToSchema LoginId where - schema = - object "LoginId" $ - fromLoginId .= tupleSchema `withParser` validate - where - fromLoginId :: LoginId -> (Maybe Email, Maybe Phone, Maybe Handle) - fromLoginId = \case - LoginByEmail e -> (Just e, Nothing, Nothing) - LoginByPhone p -> (Nothing, Just p, Nothing) - LoginByHandle h -> (Nothing, Nothing, Just h) - tupleSchema :: ObjectSchema SwaggerDoc (Maybe Email, Maybe Phone, Maybe Handle) - tupleSchema = - (,,) - <$> fst3 .= maybe_ (optField "email" schema) - <*> snd3 .= maybe_ (optField "phone" schema) - <*> thd3 .= maybe_ (optField "handle" schema) - validate :: (Maybe Email, Maybe Phone, Maybe Handle) -> A.Parser LoginId - validate (mEmail, mPhone, mHandle) = - maybe (fail "'email', 'phone' or 'handle' required") pure $ - (LoginByEmail <$> mEmail) <|> (LoginByPhone <$> mPhone) <|> (LoginByHandle <$> mHandle) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index fb41f37bdb..e581cf6e6d 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -113,7 +113,6 @@ library Wire.API.User Wire.API.User.Activation Wire.API.User.Auth - Wire.API.User.Auth2 Wire.API.User.Client Wire.API.User.Client.DPoPAccessToken Wire.API.User.Client.Prekey From 1287a0c4cee5e5d8b0448e7819f01d365a681eab Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Oct 2022 15:43:52 +0200 Subject: [PATCH 07/43] Fix build and golden tests --- libs/api-bot/src/Network/Wire/Bot/Monad.hs | 2 +- libs/wire-api/src/Wire/API/User/Auth.hs | 33 +- .../Wire/API/Golden/Generated/Login_user.hs | 199 +++-- services/brig/src/Brig/User/API/Auth.hs | 802 ++++++++---------- services/brig/src/Brig/User/Auth.hs | 4 +- .../brig/test/integration/API/User/Account.hs | 8 +- .../brig/test/integration/API/User/Auth.hs | 64 +- .../brig/test/integration/API/User/Client.hs | 8 +- .../integration/API/User/PasswordReset.hs | 5 +- .../brig/test/integration/API/User/Util.hs | 3 +- services/brig/test/integration/Util.hs | 5 +- services/spar/test-integration/Util/Email.hs | 4 +- 12 files changed, 575 insertions(+), 562 deletions(-) diff --git a/libs/api-bot/src/Network/Wire/Bot/Monad.hs b/libs/api-bot/src/Network/Wire/Bot/Monad.hs index 6e36bc8efb..bab19b4368 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Monad.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Monad.hs @@ -691,7 +691,7 @@ mkBot :: BotTag -> User -> PlainTextPassword -> BotNet Bot mkBot tag user pw = do log Info $ botLogFields (userId user) tag . msg (val "Login") let ident = fromMaybe (error "No email") (userEmail user) - let cred = PasswordLogin (LoginByEmail ident) pw Nothing Nothing + let cred = PasswordLogin (PasswordLoginData (LoginByEmail ident) pw Nothing Nothing) auth <- login cred >>= maybe (throwM LoginFailed) pure aref <- nextAuthRefresh auth env <- BotNet ask diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index c787ee207e..af16c70f1f 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -22,6 +22,8 @@ module Wire.API.User.Auth ( -- * Login Login (..), + PasswordLoginData (..), + SmsLoginData (..), loginLabel, LoginCode (..), LoginId (..), @@ -75,8 +77,7 @@ data LoginId | LoginByHandle Handle deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform LoginId) - -$(makePrisms ''LoginId) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema LoginId -- NB. this should fail if (e.g.) the email is present but unparseable even if the JSON contains a valid phone number or handle. -- See tests in `Test.Wire.API.User.Auth`. @@ -123,6 +124,7 @@ data PendingLoginCode = PendingLoginCode } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform PendingLoginCode) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema PendingLoginCode instance ToSchema PendingLoginCode where schema = @@ -142,6 +144,7 @@ data SendLoginCode = SendLoginCode } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SendLoginCode) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema SendLoginCode instance ToSchema SendLoginCode where schema = @@ -172,6 +175,7 @@ newtype LoginCodeTimeout = LoginCodeTimeout {fromLoginCodeTimeout :: Code.Timeout} deriving stock (Eq, Show) deriving newtype (Arbitrary) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema LoginCodeTimeout instance ToSchema LoginCodeTimeout where schema = @@ -193,6 +197,7 @@ data CookieList = CookieList } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform CookieList) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema CookieList instance ToSchema CookieList where schema = @@ -226,7 +231,13 @@ instance ToSchema (Cookie ()) where <*> cookieExpires .= field "expires" utcTimeSchema <*> cookieLabel .= optField "label" (maybeWithDefault A.Null schema) <*> cookieSucc .= optField "successor" (maybeWithDefault A.Null schema) - <*> cookieValue .= empty + <*> cookieValue .= pure () + +deriving via Schema (Cookie ()) instance FromJSON (Cookie ()) + +deriving via Schema (Cookie ()) instance ToJSON (Cookie ()) + +deriving via Schema (Cookie ()) instance S.ToSchema (Cookie ()) -- | A device-specific identifying label for one or more cookies. -- Cookies can be listed and deleted based on their labels. @@ -262,6 +273,7 @@ data CookieType PersistentCookie deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform CookieType) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema CookieType instance ToSchema CookieType where schema = @@ -293,8 +305,8 @@ passwordLoginSchema = PasswordLoginData <$> plId .= loginObjectSchema <*> plPassword .= field "password" schema - <*> plLabel .= maybe_ (optField "label" schema) - <*> plCode .= maybe_ (optField "verification_code" schema) + <*> plLabel .= optField "label" (maybeWithDefault A.Null schema) + <*> plCode .= optField "verification_code" (maybeWithDefault A.Null schema) data SmsLoginData = SmsLoginData { slPhone :: Phone, @@ -309,7 +321,7 @@ smsLoginSchema = SmsLoginData <$> slPhone .= field "phone" schema <*> slCode .= field "code" schema - <*> slLabel .= maybe_ (optField "label" schema) + <*> slLabel .= optField "label" (maybeWithDefault A.Null schema) $(makePrisms ''Login) @@ -319,6 +331,12 @@ instance ToSchema Login where tag _PasswordLogin passwordLoginSchema <> tag _SmsLogin smsLoginSchema +deriving via Schema Login instance FromJSON Login + +deriving via Schema Login instance ToJSON Login + +deriving via Schema Login instance S.ToSchema Login + loginLabel :: Login -> Maybe CookieLabel loginLabel (PasswordLogin pl) = plLabel pl loginLabel (SmsLogin sl) = slLabel sl @@ -333,6 +351,7 @@ data RemoveCookies = RemoveCookies } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RemoveCookies) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema RemoveCookies instance ToSchema RemoveCookies where schema = @@ -374,6 +393,7 @@ data AccessToken = AccessToken expiresIn :: Integer } deriving stock (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema AccessToken instance ToSchema AccessToken where schema = @@ -410,6 +430,7 @@ instance Arbitrary AccessToken where data TokenType = Bearer deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform TokenType) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema TokenType instance ToSchema TokenType where schema = enum @Text "TokenType" $ element "Bearer" Bearer diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs index 666fb76261..802503a39a 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs @@ -25,175 +25,206 @@ import Data.Text.Ascii (AsciiChars (validate)) import Imports (Maybe (Just, Nothing), fromRight, undefined) import Wire.API.User (Email (Email, emailDomain, emailLocal), Phone (Phone, fromPhone)) import Wire.API.User.Auth - ( CookieLabel (CookieLabel, cookieLabelText), - Login (..), - LoginCode (LoginCode, fromLoginCode), - LoginId (LoginByEmail, LoginByHandle, LoginByPhone), - ) testObject_Login_user_1 :: Login testObject_Login_user_1 = PasswordLogin - (LoginByEmail (Email {emailLocal = "4\1069339\vEaP", emailDomain = "\ENQ\n\FS\ESC\997356i03!"})) - ( PlainTextPassword - "\b5Ta\61971\150647\186716fa&\1047748o!ov\SI\1100133i\DC4\ETXY\SOR\991323\1086159Ta^s\ETB\SI[\189068\988899\26508\CAN6\STXp\1069462-9\983823&\NAK\1052068]^\13044;>-Z$Z\NAK\r\1101550a\RS%\NUL:\188721\47674\157548?e]\ETX \142608 C\SOH\SIS%8m\1091987V\147131[\1006262\&6\171610\1011219\164656SX\n%\1061259*>\t+\132427Y\989558\993346\GSU\1067541\&6TU!*\40114\&90\1055516\RSV\162483N\t*\EOT{I<\1084278\SOH\183116!c\\\n\1107501\183146\DC1,-xX\EMV?\t\168648\1054239\DC2\DEL1\SOHu\SOH\63459\53061\SO+h\ACK::\RS\21356_g,\SO*\v\DC4\1093710HFF\188918\1081075fF\ESC2\SOHT\DC1)\fc\35905l\1061547\f#~\STX]\1035086/Or)kY\1031423\SOHNCk\1067954\&5\1083470x=H\NUL\23760\1058646\1099097E/$\DELpbi\137522\FSKi\15676\1018134\t7\"OL\54208\7516\&5\43466\NUL(\1030852\166514\SOH\149343\994835\25513C==\GSTV3\DELl6\999006.Z)$\16723|\172732\1090303J;O\GSbw\vI\1101024I\SYN\DC2^\149630\STX3%i\EMW\138614\DC4\1113619tsL5\147087W\96700(_,\1091179*\1041287rckx\SOH\SIs\SOHJd\140574\SYNev.\DC4\DLE\99082.\1106785\996992\143448\US_\ETBf\STX\SO\DC3\1043748\&6O\DC1Q\SOH'\GS,|]W\SIa\62568\151062.\v\aH&-L\DC2+\147179\1095524\EOTm)\19925\181147\183368!\185223\142946m\DC4\DC3\1034282m\GS\185509>>\"NDw\1076877hY\1033831sFKz^ \1108187\&5Qec\NAK}|\1108194.Q\173114imb\1027220 p;\1089082\SYN\1065748kF\1102854r8o\DC1" + ( PasswordLoginData + (LoginByEmail (Email {emailLocal = "4\1069339\vEaP", emailDomain = "\ENQ\n\FS\ESC\997356i03!"})) + ( PlainTextPassword + "\b5Ta\61971\150647\186716fa&\1047748o!ov\SI\1100133i\DC4\ETXY\SOR\991323\1086159Ta^s\ETB\SI[\189068\988899\26508\CAN6\STXp\1069462-9\983823&\NAK\1052068]^\13044;>-Z$Z\NAK\r\1101550a\RS%\NUL:\188721\47674\157548?e]\ETX \142608 C\SOH\SIS%8m\1091987V\147131[\1006262\&6\171610\1011219\164656SX\n%\1061259*>\t+\132427Y\989558\993346\GSU\1067541\&6TU!*\40114\&90\1055516\RSV\162483N\t*\EOT{I<\1084278\SOH\183116!c\\\n\1107501\183146\DC1,-xX\EMV?\t\168648\1054239\DC2\DEL1\SOHu\SOH\63459\53061\SO+h\ACK::\RS\21356_g,\SO*\v\DC4\1093710HFF\188918\1081075fF\ESC2\SOHT\DC1)\fc\35905l\1061547\f#~\STX]\1035086/Or)kY\1031423\SOHNCk\1067954\&5\1083470x=H\NUL\23760\1058646\1099097E/$\DELpbi\137522\FSKi\15676\1018134\t7\"OL\54208\7516\&5\43466\NUL(\1030852\166514\SOH\149343\994835\25513C==\GSTV3\DELl6\999006.Z)$\16723|\172732\1090303J;O\GSbw\vI\1101024I\SYN\DC2^\149630\STX3%i\EMW\138614\DC4\1113619tsL5\147087W\96700(_,\1091179*\1041287rckx\SOH\SIs\SOHJd\140574\SYNev.\DC4\DLE\99082.\1106785\996992\143448\US_\ETBf\STX\SO\DC3\1043748\&6O\DC1Q\SOH'\GS,|]W\SIa\62568\151062.\v\aH&-L\DC2+\147179\1095524\EOTm)\19925\181147\183368!\185223\142946m\DC4\DC3\1034282m\GS\185509>>\"NDw\1076877hY\1033831sFKz^ \1108187\&5Qec\NAK}|\1108194.Q\173114imb\1027220 p;\1089082\SYN\1065748kF\1102854r8o\DC1" + ) + (Just (CookieLabel {cookieLabelText = "r"})) + Nothing ) - (Just (CookieLabel {cookieLabelText = "r"})) - Nothing testObject_Login_user_2 :: Login testObject_Login_user_2 = SmsLogin - (Phone {fromPhone = "+956057641851"}) - (LoginCode {fromLoginCode = "\nG\1076650\&8\b"}) - (Just (CookieLabel {cookieLabelText = "G"})) + ( SmsLoginData + (Phone {fromPhone = "+956057641851"}) + (LoginCode {fromLoginCode = "\nG\1076650\&8\b"}) + (Just (CookieLabel {cookieLabelText = "G"})) + ) testObject_Login_user_3 :: Login testObject_Login_user_3 = PasswordLogin - (LoginByHandle (Handle {fromHandle = "c2wp.7s5."})) - ( PlainTextPassword - "&\RS\DC4\1104052Z\11418n\SO\158691\1010906/\127253'\1063038m\1010345\"\9772\138717\RS(&\996590\SOf1Wf'I\SI\100286\1047270\1033961\DC1Jq\1050673Y\\Bedu@\1014647c\1003986D\53211\1050614S\144414\ETX\ETXW>\1005358\DC4\rSO8FXy\166833a\EM\170017\SUBNF\158145L\RS$5\NULk\RSz*s\148780\157980\v\175417\"SY\DEL\STX\994691\1103514ub5q\ENQ\1014299\vN.\t\183536:l\1105396\RS\1027721\a\168001\SO\vt\1098704W\SYN\1042396\1109979\a'v\ETB\64211\NAK\59538\STX \NAK\STX\49684,\1111630x\1047668^\1067127\27366I;\NAKb\1092049o\162763_\190546MME\1022528\SI\1096252H;\SO\ETBs\SO\1065937{Knlrd;\35750\DC4\SI\1075008TO\1090529\999639U\48787\1099927t\1068680^y\17268u$\DC1Jp\1054308\164905\164446\STX\"\1095399*\SO\1004302\32166\990924X\1098844\ETXsK}\b\143918\NUL0\988724\&12\171116\tM052\189551\EOT0\RS\986138\1084688{ji\ESC\1020800\27259&t \SI\ESCy\aL\136111\131558\994027\r\1054821ga,\DC4do,tx[I&\DC4h\DLE\ETX\DLEBpm\1002292-\a]/ZI\1033117q]w3n\46911e\23692kYo5\1090844'K\1089820}v\146759;\1018792\\=\41264\&8g\DLEg*has\44159\1006118\DC3\USYg?I\19462\NAKaW2\150415m\t}h\155161RbU\STX\ETBlz2!\DC3JW5\ESC\1026156U\SOg,rpO\5857]0\ESC\479\1005443F\SI\1045994\RS\SO\11908rl\1104306~\ACK+Mn{5\993784a\EM2\v{jM\ETBT\1058105$\DC1\1099974\GSj_~Z\1007141P\SOH\EOTo@TJhk\EOT\ETBk:-\96583[p\DLE\DC1\RS'\r\STXQ,,\1016866?H\rh\30225\rj\147982\DC2\\(u\ESCu\154705\1002696o\DC4\988492\1103465\1052034\DC1q\GS-\b\40807\DC1qW>\fys\8130,'\159954<" + ( PasswordLoginData + (LoginByHandle (Handle {fromHandle = "c2wp.7s5."})) + ( PlainTextPassword + "&\RS\DC4\1104052Z\11418n\SO\158691\1010906/\127253'\1063038m\1010345\"\9772\138717\RS(&\996590\SOf1Wf'I\SI\100286\1047270\1033961\DC1Jq\1050673Y\\Bedu@\1014647c\1003986D\53211\1050614S\144414\ETX\ETXW>\1005358\DC4\rSO8FXy\166833a\EM\170017\SUBNF\158145L\RS$5\NULk\RSz*s\148780\157980\v\175417\"SY\DEL\STX\994691\1103514ub5q\ENQ\1014299\vN.\t\183536:l\1105396\RS\1027721\a\168001\SO\vt\1098704W\SYN\1042396\1109979\a'v\ETB\64211\NAK\59538\STX \NAK\STX\49684,\1111630x\1047668^\1067127\27366I;\NAKb\1092049o\162763_\190546MME\1022528\SI\1096252H;\SO\ETBs\SO\1065937{Knlrd;\35750\DC4\SI\1075008TO\1090529\999639U\48787\1099927t\1068680^y\17268u$\DC1Jp\1054308\164905\164446\STX\"\1095399*\SO\1004302\32166\990924X\1098844\ETXsK}\b\143918\NUL0\988724\&12\171116\tM052\189551\EOT0\RS\986138\1084688{ji\ESC\1020800\27259&t \SI\ESCy\aL\136111\131558\994027\r\1054821ga,\DC4do,tx[I&\DC4h\DLE\ETX\DLEBpm\1002292-\a]/ZI\1033117q]w3n\46911e\23692kYo5\1090844'K\1089820}v\146759;\1018792\\=\41264\&8g\DLEg*has\44159\1006118\DC3\USYg?I\19462\NAKaW2\150415m\t}h\155161RbU\STX\ETBlz2!\DC3JW5\ESC\1026156U\SOg,rpO\5857]0\ESC\479\1005443F\SI\1045994\RS\SO\11908rl\1104306~\ACK+Mn{5\993784a\EM2\v{jM\ETBT\1058105$\DC1\1099974\GSj_~Z\1007141P\SOH\EOTo@TJhk\EOT\ETBk:-\96583[p\DLE\DC1\RS'\r\STXQ,,\1016866?H\rh\30225\rj\147982\DC2\\(u\ESCu\154705\1002696o\DC4\988492\1103465\1052034\DC1q\GS-\b\40807\DC1qW>\fys\8130,'\159954<" + ) + (Just (CookieLabel {cookieLabelText = "\1082362\66362>XC"})) + (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) ) - (Just (CookieLabel {cookieLabelText = "\1082362\66362>XC"})) - (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) testObject_Login_user_4 :: Login testObject_Login_user_4 = SmsLogin - (Phone {fromPhone = "+04332691687649"}) - (LoginCode {fromLoginCode = "\94770m"}) - (Just (CookieLabel {cookieLabelText = ":"})) + ( SmsLoginData + (Phone {fromPhone = "+04332691687649"}) + (LoginCode {fromLoginCode = "\94770m"}) + (Just (CookieLabel {cookieLabelText = ":"})) + ) testObject_Login_user_5 :: Login testObject_Login_user_5 = PasswordLogin - ( LoginByHandle - ( Handle - { fromHandle = - "c372iaa_v5onjcck67rlzq4dn5_oxhtx7dpx7v82lp1rhx0e97i26--8r3c6k773bxtlzmkjc20-11_047ydua_o9_5u4sll_fl3ng_0sa." - } + ( PasswordLoginData + ( LoginByHandle + ( Handle + { fromHandle = + "c372iaa_v5onjcck67rlzq4dn5_oxhtx7dpx7v82lp1rhx0e97i26--8r3c6k773bxtlzmkjc20-11_047ydua_o9_5u4sll_fl3ng_0sa." + } + ) ) + ( PlainTextPassword + "\120347\184756DU\1035832hp\1006715t~\DC2\SOH\STX*\1053210y1\1078382H\173223{e\\S\SO?c_7\t\DC4X\135187\&6\172722E\100168j\SUB\t\SYN\1088511>HO]60\990035\ETX\"+w,t\1066040\ak(b%u\151197`>b\1028272e\ACKc\151393\1107996)\12375\&7\1082464`\186313yO+v%\1033664\rc<\65764\&2>8u\1094258\1080669\1113623\75033a\179193\NAK=\EOT\1077021\&8R&j\1042630\ESC\t4sj-\991835\40404n\136765\1064089N\GS\\\1026123\72288\&5\r\97004(P!\DEL\29235\26855\b\1067772Mr~\65123\EMjt>Z\GS~\140732A\1031358\SO\\>\DC16\">%\45860\1084751I@u5\187891\vrY\r;7\1071052#\1078407\1016286\CAN'\63315\1041397\EM_I_zY\987300\149441\EMd\1039844cd\DEL\1061999\136326Cp3\26325\GSXj\n\46305jy\44050\58825\t-\19065\43336d\1046547L\SUBYF\ACKPOL\54766\DC2\DC1\DC1\DC2*\rH\DLE(?\DC3F\25820\DLE\r]\1069451j\170177 @\ENQT\1100685s\FSF2\NAK]8\a\DC3!\NAKW\176469\1110834K\1025058\1112222_%\1001818\1113069'\1098149\70360(#\SOHky\t\ETB!\17570\NAK\DC4\ESC{\119317U2LS'" + ) + (Just (CookieLabel {cookieLabelText = "LGz%\119949j\f\RS/\SOH"})) + (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) ) - ( PlainTextPassword - "\120347\184756DU\1035832hp\1006715t~\DC2\SOH\STX*\1053210y1\1078382H\173223{e\\S\SO?c_7\t\DC4X\135187\&6\172722E\100168j\SUB\t\SYN\1088511>HO]60\990035\ETX\"+w,t\1066040\ak(b%u\151197`>b\1028272e\ACKc\151393\1107996)\12375\&7\1082464`\186313yO+v%\1033664\rc<\65764\&2>8u\1094258\1080669\1113623\75033a\179193\NAK=\EOT\1077021\&8R&j\1042630\ESC\t4sj-\991835\40404n\136765\1064089N\GS\\\1026123\72288\&5\r\97004(P!\DEL\29235\26855\b\1067772Mr~\65123\EMjt>Z\GS~\140732A\1031358\SO\\>\DC16\">%\45860\1084751I@u5\187891\vrY\r;7\1071052#\1078407\1016286\CAN'\63315\1041397\EM_I_zY\987300\149441\EMd\1039844cd\DEL\1061999\136326Cp3\26325\GSXj\n\46305jy\44050\58825\t-\19065\43336d\1046547L\SUBYF\ACKPOL\54766\DC2\DC1\DC1\DC2*\rH\DLE(?\DC3F\25820\DLE\r]\1069451j\170177 @\ENQT\1100685s\FSF2\NAK]8\a\DC3!\NAKW\176469\1110834K\1025058\1112222_%\1001818\1113069'\1098149\70360(#\SOHky\t\ETB!\17570\NAK\DC4\ESC{\119317U2LS'" - ) - (Just (CookieLabel {cookieLabelText = "LGz%\119949j\f\RS/\SOH"})) - (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) testObject_Login_user_6 :: Login testObject_Login_user_6 = PasswordLogin - (LoginByPhone (Phone {fromPhone = "+930266260693371"})) - ( PlainTextPassword - "K?)V\148106}_\185335\1060952\fJ3!\986581\1062221\51615\166583\1071064\a\1015675\SOH7\\#z9\133503\1081163\985690\1041362\EM\DC3\156174'\r)~Ke9+\175606\175778\994126M\1099049\"h\SOHTh\EOT`;\ACK\1093024\ENQ\1026474'e{\FSv\40757\US\143355*\16236\1076902\52767:E]:R\1093823K}l\1111648Y\51665\1049318S~\EOT#T\1029316\&1hIWn\v`\45455Kb~\ESC\DLEdT\FS\SI\1092141f\ETBY7\DEL\RS\131804\t\998971\13414\48242\GSG\DC3BH#\DEL\\RAd\166099g\1072356\1054332\SIk&\STXE\22217\FS\FS\FS$t\1001957:O\1098769q}_\1039296.\SOH\DC4\STX\157262c`L>\1050744l\1086722m'BtB5\1003280,t\"\1066340\&9(#\ENQ4\SIIy>\1031158\1100542\GSbf\"i\ETB\14367a\1086113C@\1078844\1092137\32415\NAK\999161\23344*N\SYN\ESC:iXibA\136851\169508q\1048663]:9r\63027\73801\NUL\1050763\USCN\US\147710\1048697\1016861eR\RSZbD5!8N\ESCV\7344\ACK\173064\SUBuz\1053950\188308~\ESC\SI%{3I/F\25232/DMS\US>o\187199\63000Z\1108766\GS[K\184801\94661\1088369\995346\ESCO-4\CAN\US\FSZp" + ( PasswordLoginData + (LoginByPhone (Phone {fromPhone = "+930266260693371"})) + ( PlainTextPassword + "K?)V\148106}_\185335\1060952\fJ3!\986581\1062221\51615\166583\1071064\a\1015675\SOH7\\#z9\133503\1081163\985690\1041362\EM\DC3\156174'\r)~Ke9+\175606\175778\994126M\1099049\"h\SOHTh\EOT`;\ACK\1093024\ENQ\1026474'e{\FSv\40757\US\143355*\16236\1076902\52767:E]:R\1093823K}l\1111648Y\51665\1049318S~\EOT#T\1029316\&1hIWn\v`\45455Kb~\ESC\DLEdT\FS\SI\1092141f\ETBY7\DEL\RS\131804\t\998971\13414\48242\GSG\DC3BH#\DEL\\RAd\166099g\1072356\1054332\SIk&\STXE\22217\FS\FS\FS$t\1001957:O\1098769q}_\1039296.\SOH\DC4\STX\157262c`L>\1050744l\1086722m'BtB5\1003280,t\"\1066340\&9(#\ENQ4\SIIy>\1031158\1100542\GSbf\"i\ETB\14367a\1086113C@\1078844\1092137\32415\NAK\999161\23344*N\SYN\ESC:iXibA\136851\169508q\1048663]:9r\63027\73801\NUL\1050763\USCN\US\147710\1048697\1016861eR\RSZbD5!8N\ESCV\7344\ACK\173064\SUBuz\1053950\188308~\ESC\SI%{3I/F\25232/DMS\US>o\187199\63000Z\1108766\GS[K\184801\94661\1088369\995346\ESCO-4\CAN\US\FSZp" + ) + (Just (CookieLabel {cookieLabelText = "\1014596'\998013KW\\\NUL\DC4"})) + (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) ) - (Just (CookieLabel {cookieLabelText = "\1014596'\998013KW\\\NUL\DC4"})) - (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) testObject_Login_user_7 :: Login testObject_Login_user_7 = PasswordLogin - (LoginByEmail (Email {emailLocal = "BG", emailDomain = "\12137c\v}\SIL$_"})) - ( PlainTextPassword - "&\991818\1023244\83352\STXJ<-~\STX>\v\74228\151871\&5QN\53968\166184ql\NAK\74290\&3}{\DC3\173242S\22739;\t7\183958_F~D*f\1049940)\1067330-9\20699\&7GK= %\RS@kOF#\179945\1094401\124994\&8_\42309\GSL\37698\ETX\1047946\&0Wl1A`LYz\USy\20728\SUBo\ESC[\DC4\bt\66640a\ETXs~\USF\175140G`$\vG\DC1\1044421\128611/\1014458C>\SI" + ( PasswordLoginData + (LoginByEmail (Email {emailLocal = "BG", emailDomain = "\12137c\v}\SIL$_"})) + ( PlainTextPassword + "&\991818\1023244\83352\STXJ<-~\STX>\v\74228\151871\&5QN\53968\166184ql\NAK\74290\&3}{\DC3\173242S\22739;\t7\183958_F~D*f\1049940)\1067330-9\20699\&7GK= %\RS@kOF#\179945\1094401\124994\&8_\42309\GSL\37698\ETX\1047946\&0Wl1A`LYz\USy\20728\SUBo\ESC[\DC4\bt\66640a\ETXs~\USF\175140G`$\vG\DC1\1044421\128611/\1014458C>\SI" + ) + (Just (CookieLabel {cookieLabelText = "\SO\NAKeC/"})) + (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) ) - (Just (CookieLabel {cookieLabelText = "\SO\NAKeC/"})) - (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) testObject_Login_user_8 :: Login testObject_Login_user_8 = PasswordLogin - (LoginByEmail (Email {emailLocal = "", emailDomain = "~^G\1075856\\"})) - ( PlainTextPassword - "z>\1088515\1024903/\137135\1092812\b%$\1037736\143620:}\t\CAN\1058585\1044157)\12957\1005180s\1006270\CAN}\40034\EM[\41342\vX#VG,df4\141493\&8m5\46365OTK\144460\37582\DEL\44719\9670Z\"ZS\ESCms|[Q%\1088673\ENQW\\\1000857C\185096+\1070458\4114\17825v\180321\41886){\1028513\DEL\143570f\187156}:X-\b2N\EM\USl\127906\49608Y\1071393\1012763r2.1\49912\EOT+\137561\DC3\145480]'\1028275s\997684\42805.}\185059o\992118X\132901\11013\r\SUBNq6\1019605'\fd\RS\14503\1097628,:%\t\151916\73955QD\1086880\ESC(q4KDQ2zcI\DLE>\EM5\993596\&1\fBkd\DC3\ACK:F:\EOT\100901\11650O N\FS,N\1054390\1000247[h\DEL9\5932:xZ=\f\1085312\DC3u\RS\fe#\SUB^$lkx\32804 \rr\SUBJ\1013606\1017057\FSR][_5\NAK\58351\11748\35779\&5\24821\1055669\996852\37445K!\1052768eRR%\32108+h~1\993198\35871lTzS$\DLE\1060275\"*\1086839pmRE\DC3(\US^\8047Jc\10129\1071815i\n+G$|\993993\156283g\FS\fgU3Y\119068\ACKf)\1093562\SYN\78340\1100638/\NULPi\43622{\1048095j\1083269\FS9\132797\1024684\32713w$\45599\126246)Si\167172\29311FX\1057490j{`\44452`\999383\159809\&4u%\1070378P*\1057403\25422\DELC\RSR\SYN-\51098\1011541g\68666:S>c\15266\132940\DLEY\1066831~a)YW_J\1063076P\a+ U\1084883j\EMk\SOH\1096984\DC1\18679e\172760\175328,\5135g@\DC2\GSHXl.\ETB\153793\&2\DC3mY\1054891\tv?L8L\1074044N\133565\nb1j\1044024\148213xfQ=\\\ENQe\995818\1023862U\DC2p{\SO\1099404jd^@U\994269tP.\DC2Y%R`a\r\160622\&7}HnUf\132856m^7:\NAK=\52348>l\95313hwp27\149950jE\fx=!.\DC3]Ar\tw\DC4&\SUBk\194572s\1042820\4498I\146071\61461\1060645dsY\DLE\181922dX.\146295i]\151113\1028288\rWS\USU\1098732\SUB\49884\1083906\DLE\STXN~-\SO6\190031\1110322\\O\185165Jc\1052359\1071278\NULHSo\DLE-W\DC36\170321I\1068712)\99800={\99796h\27961\61707M\1022570FwJQ\1111976ck\SUB\CAN|UV-\NAK\SOH|\DC4;\f\156907\145795\ENQS\NAK.B\"D\163007#o*\126577\32988m\RS\1049834B3Gg;\DC1\\\180659\1098926\ENQ B^\SI\152630$e\39220\170037>fMgC\187276,o\128488\\?\1033955~/s\SOH?MMc;D18Ne\EOT\CAN)*\STX\GS\16268\1088515\1024903/\137135\1092812\b%$\1037736\143620:}\t\CAN\1058585\1044157)\12957\1005180s\1006270\CAN}\40034\EM[\41342\vX#VG,df4\141493\&8m5\46365OTK\144460\37582\DEL\44719\9670Z\"ZS\ESCms|[Q%\1088673\ENQW\\\1000857C\185096+\1070458\4114\17825v\180321\41886){\1028513\DEL\143570f\187156}:X-\b2N\EM\USl\127906\49608Y\1071393\1012763r2.1\49912\EOT+\137561\DC3\145480]'\1028275s\997684\42805.}\185059o\992118X\132901\11013\r\SUBNq6\1019605'\fd\RS\14503\1097628,:%\t\151916\73955QD\1086880\ESC(q4KDQ2zcI\DLE>\EM5\993596\&1\fBkd\DC3\ACK:F:\EOT\100901\11650O N\FS,N\1054390\1000247[h\DEL9\5932:xZ=\f\1085312\DC3u\RS\fe#\SUB^$lkx\32804 \rr\SUBJ\1013606\1017057\FSR][_5\NAK\58351\11748\35779\&5\24821\1055669\996852\37445K!\1052768eRR%\32108+h~1\993198\35871lTzS$\DLE\1060275\"*\1086839pmRE\DC3(\US^\8047Jc\10129\1071815i\n+G$|\993993\156283g\FS\fgU3Y\119068\ACKf)\1093562\SYN\78340\1100638/\NULPi\43622{\1048095j\1083269\FS9\132797\1024684\32713w$\45599\126246)Si\167172\29311FX\1057490j{`\44452`\999383\159809\&4u%\1070378P*\1057403\25422\DELC\RSR\SYN-\51098\1011541g\68666:S>c\15266\132940\DLEY\1066831~a)YW_J\1063076P\a+ U\1084883j\EMk\SOH\1096984\DC1\18679e\172760\175328,\5135g@\DC2\GSHXl.\ETB\153793\&2\DC3mY\1054891\tv?L8L\1074044N\133565\nb1j\1044024\148213xfQ=\\\ENQe\995818\1023862U\DC2p{\SO\1099404jd^@U\994269tP.\DC2Y%R`a\r\160622\&7}HnUf\132856m^7:\NAK=\52348>l\95313hwp27\149950jE\fx=!.\DC3]Ar\tw\DC4&\SUBk\194572s\1042820\4498I\146071\61461\1060645dsY\DLE\181922dX.\146295i]\151113\1028288\rWS\USU\1098732\SUB\49884\1083906\DLE\STXN~-\SO6\190031\1110322\\O\185165Jc\1052359\1071278\NULHSo\DLE-W\DC36\170321I\1068712)\99800={\99796h\27961\61707M\1022570FwJQ\1111976ck\SUB\CAN|UV-\NAK\SOH|\DC4;\f\156907\145795\ENQS\NAK.B\"D\163007#o*\126577\32988m\RS\1049834B3Gg;\DC1\\\180659\1098926\ENQ B^\SI\152630$e\39220\170037>fMgC\187276,o\128488\\?\1033955~/s\SOH?MMc;D18Ne\EOT\CAN)*\STX\GS\162681/\t\NAK \1010386\1013311z\33488Bv\1109131(=<\SOq\1104556?L\6845\1066491\2972c\997644<&!\1103500\999823j~O3USw\DC2\ETX\a\ETB+\1024033Ny\31920(/Sco\STX{3\SIEh\SYN\1032591\1022672\27668-\FS.'\ENQX\98936\150419Ti3\1051250\"%\SYN\b\188444+\EOT\STX^\1108463)2bR\ACK\SIJB[\1045179&O9{w{aV\ENQgZ?3z\1065517\&8\4979\156950\990517`\1063252\"PE)uKq|w\SYN0\ESC. \ETX\73440sxW\160357\1001111m\ENQ7e)\77912\1008764:s\CANYj\9870\16356\ACK\USlTu\1110309I.\1087068O#kQ\RS!g\1062167\CANQ\US\172867\SYN\ACK|\"M\"P\US\ETX@ZPq\1016598gY\148621=\a\1057645l8\1041152\&3\995012\1022626CN<\147876gJ\1038434]\94932mX~\ACKw3\DLE\179764\&8\a6\EOT}\DLEi\DC3L5\1032336PY^|!Vz\ESC4\36208!iLa\12091\DC4\1059706\167964\GS:\1042431\149640h\\dLx\1087701\EM\194900\SUB\134635R%ps7\95168s\1074387fg\nIf\1067199\DC1l\SUB\1022871-n_\6065UY?4d]|c\\[T\ajS\18838\55046\37136aK\1025430\1112672\ETX\FSx+" + ( PasswordLoginData + (LoginByHandle (Handle {fromHandle = "6bolp"})) + ( PlainTextPassword + ">1/\t\NAK \1010386\1013311z\33488Bv\1109131(=<\SOq\1104556?L\6845\1066491\2972c\997644<&!\1103500\999823j~O3USw\DC2\ETX\a\ETB+\1024033Ny\31920(/Sco\STX{3\SIEh\SYN\1032591\1022672\27668-\FS.'\ENQX\98936\150419Ti3\1051250\"%\SYN\b\188444+\EOT\STX^\1108463)2bR\ACK\SIJB[\1045179&O9{w{aV\ENQgZ?3z\1065517\&8\4979\156950\990517`\1063252\"PE)uKq|w\SYN0\ESC. \ETX\73440sxW\160357\1001111m\ENQ7e)\77912\1008764:s\CANYj\9870\16356\ACK\USlTu\1110309I.\1087068O#kQ\RS!g\1062167\CANQ\US\172867\SYN\ACK|\"M\"P\US\ETX@ZPq\1016598gY\148621=\a\1057645l8\1041152\&3\995012\1022626CN<\147876gJ\1038434]\94932mX~\ACKw3\DLE\179764\&8\a6\EOT}\DLEi\DC3L5\1032336PY^|!Vz\ESC4\36208!iLa\12091\DC4\1059706\167964\GS:\1042431\149640h\\dLx\1087701\EM\194900\SUB\134635R%ps7\95168s\1074387fg\nIf\1067199\DC1l\SUB\1022871-n_\6065UY?4d]|c\\[T\ajS\18838\55046\37136aK\1025430\1112672\ETX\FSx+" + ) + (Just (CookieLabel {cookieLabelText = ""})) + (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) ) - (Just (CookieLabel {cookieLabelText = ""})) - (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) testObject_Login_user_10 :: Login testObject_Login_user_10 = SmsLogin - (Phone {fromPhone = "+4211134144507"}) - (LoginCode {fromLoginCode = "\13379\61834\135400!\ETBi\1050047"}) - (Just (CookieLabel {cookieLabelText = ""})) + ( SmsLoginData + (Phone {fromPhone = "+4211134144507"}) + (LoginCode {fromLoginCode = "\13379\61834\135400!\ETBi\1050047"}) + (Just (CookieLabel {cookieLabelText = ""})) + ) testObject_Login_user_11 :: Login testObject_Login_user_11 = - SmsLogin (Phone {fromPhone = "+338932197597737"}) (LoginCode {fromLoginCode = "\1069411+W\EM3"}) Nothing + SmsLogin (SmsLoginData (Phone {fromPhone = "+338932197597737"}) (LoginCode {fromLoginCode = "\1069411+W\EM3"}) Nothing) testObject_Login_user_12 :: Login testObject_Login_user_12 = PasswordLogin - (LoginByPhone (Phone {fromPhone = "+153353668"})) - ( PlainTextPassword - "n\1095465Q\169408\ESC\1003840&Q/\rd\43034\US\EOTw2C\ACK\1056364\178004\EOT\EOTv\1010012\bf,b\DEL\STX\1013552'\175696C]G\46305\1017071\190782\&4\NULY.\173618\SO3sI\194978F\1084606\&5\21073rG/:\"\1013990X\46943\&6\FS:\CAN\aeYwWT\1083802\136913Msbm\NAK@\984540\1013513\EOT^\FS\147032\NAK@\ENQ>\f\RSUc\EOTV9&c\3517\a\986228a'PPG\100445\179638>[\3453\&2\64964Xc\131306[0\1002646\b\99652B\DC1[\1029237\GS\19515\US\EMs-u\ETBs\1067133\1005008\161663n\1072320?\1045643ck\DC48XC\174289\RSI2\2862\STX\DLEM\ESC\n?<\\\DC3E\72219\GS\n$cyS\136198!,\v9\ETB/\DC1\62324?P\ETB\41758\DC2\999537~\1058761W-W4K8.\DC27\EML\1078049h\SI}t+H\SUB\ESCX\120523s\EOTt\177703taa\GS\f\152365(v\1024552M\ESCvg3P1\1032835\57603]g\3933\&4T\NAK$\38212);\\8\1109165\nK\NAK}D'^fJ'\143205e\174052\39597!\EM.\DC2{\\CEp\1045384\ETBk_\1083904\18397\164138\1063468]MG$\187650[E\1112126\b\1073487{b\50650\ESC^b@W\NAK$\FS<\1023895&\155992R\ACKJ\SI\1093108\1101041\41438n\1007134\&8]\148288\ENQ}|k\STX\CANQ\USI\a\CANDZ\1062877\NUL\50197rb\18947\&3G%\FS\162081\EOT\NAK4YB0-i\1018065IM\1073908[\1111554:Cr$\99636)L\136837W\40897.x;\41461\1030711\995525\USkb\CANY9)\SYN4\SI\1103461Av.\r\f\1061861\&9{\SO\ETBP\f\33538u\r-9cB4\1016091G\RS\22817\1014740r\128247HcsPm\59419s\120987!|J<\DLE8\FS[\NAKWYAK\75011^\987050c3\1042176\aC\ETX\ETB\1053739Y\DC4f\ACK\1060945!\1032209:RlQ!BX\f=\1070694f\151362\DEL\113727O\ETX\\\"\53275B<\RSLV4g%3\1098063\ACK`\NAK>\n\44626kp\986102\171479\DEL\60526H\20888lyJ\DC2)\1055149(\1027099A\FSh\EOTj\35251\DC4M\ESCP-q\bn\CAN\143310~\GS\EM\"o\21512%*e2\165597L\1023807sy\152913\&2m\GS\1049046{EG]\DC16B+{\983622IYa\1008153\&5,<\ESCX\f\SI\186613\153744E\134407\1011088L<\EMdUO\ETB\SUBZYm\ACK\1086320R\SUB\991954\DC3^\60967s\fu_g\EM?i~}\DELV2\148681R\FS\EOT3j\45841m\1542\1100884\n7S\SIT5j\170914\SI\1015133\141587h\182480Q\146618\59914\DEL\NAKZM\1110574\&02f\129340l!*\SOH\1027033\SOH\1070384\1094775\t\72805\ESCa:q UKEN\RS-\n\ETXH\22365a\1074707\b\37494\"\1035508\149695\1033139R4\ETX\DLE\FS\STX\1004750%\"@\1009369\&6=/x\NULP\EOT\174871/\190041\f\f\1005146?*\fIcKW\DELQ\"\1001726P*\1095849\&6=d\n\157680\RS\1087962\EOT\DC2I\47501U\b=Pc\DLE" + ( PasswordLoginData + (LoginByPhone (Phone {fromPhone = "+153353668"})) + ( PlainTextPassword + "n\1095465Q\169408\ESC\1003840&Q/\rd\43034\US\EOTw2C\ACK\1056364\178004\EOT\EOTv\1010012\bf,b\DEL\STX\1013552'\175696C]G\46305\1017071\190782\&4\NULY.\173618\SO3sI\194978F\1084606\&5\21073rG/:\"\1013990X\46943\&6\FS:\CAN\aeYwWT\1083802\136913Msbm\NAK@\984540\1013513\EOT^\FS\147032\NAK@\ENQ>\f\RSUc\EOTV9&c\3517\a\986228a'PPG\100445\179638>[\3453\&2\64964Xc\131306[0\1002646\b\99652B\DC1[\1029237\GS\19515\US\EMs-u\ETBs\1067133\1005008\161663n\1072320?\1045643ck\DC48XC\174289\RSI2\2862\STX\DLEM\ESC\n?<\\\DC3E\72219\GS\n$cyS\136198!,\v9\ETB/\DC1\62324?P\ETB\41758\DC2\999537~\1058761W-W4K8.\DC27\EML\1078049h\SI}t+H\SUB\ESCX\120523s\EOTt\177703taa\GS\f\152365(v\1024552M\ESCvg3P1\1032835\57603]g\3933\&4T\NAK$\38212);\\8\1109165\nK\NAK}D'^fJ'\143205e\174052\39597!\EM.\DC2{\\CEp\1045384\ETBk_\1083904\18397\164138\1063468]MG$\187650[E\1112126\b\1073487{b\50650\ESC^b@W\NAK$\FS<\1023895&\155992R\ACKJ\SI\1093108\1101041\41438n\1007134\&8]\148288\ENQ}|k\STX\CANQ\USI\a\CANDZ\1062877\NUL\50197rb\18947\&3G%\FS\162081\EOT\NAK4YB0-i\1018065IM\1073908[\1111554:Cr$\99636)L\136837W\40897.x;\41461\1030711\995525\USkb\CANY9)\SYN4\SI\1103461Av.\r\f\1061861\&9{\SO\ETBP\f\33538u\r-9cB4\1016091G\RS\22817\1014740r\128247HcsPm\59419s\120987!|J<\DLE8\FS[\NAKWYAK\75011^\987050c3\1042176\aC\ETX\ETB\1053739Y\DC4f\ACK\1060945!\1032209:RlQ!BX\f=\1070694f\151362\DEL\113727O\ETX\\\"\53275B<\RSLV4g%3\1098063\ACK`\NAK>\n\44626kp\986102\171479\DEL\60526H\20888lyJ\DC2)\1055149(\1027099A\FSh\EOTj\35251\DC4M\ESCP-q\bn\CAN\143310~\GS\EM\"o\21512%*e2\165597L\1023807sy\152913\&2m\GS\1049046{EG]\DC16B+{\983622IYa\1008153\&5,<\ESCX\f\SI\186613\153744E\134407\1011088L<\EMdUO\ETB\SUBZYm\ACK\1086320R\SUB\991954\DC3^\60967s\fu_g\EM?i~}\DELV2\148681R\FS\EOT3j\45841m\1542\1100884\n7S\SIT5j\170914\SI\1015133\141587h\182480Q\146618\59914\DEL\NAKZM\1110574\&02f\129340l!*\SOH\1027033\SOH\1070384\1094775\t\72805\ESCa:q UKEN\RS-\n\ETXH\22365a\1074707\b\37494\"\1035508\149695\1033139R4\ETX\DLE\FS\STX\1004750%\"@\1009369\&6=/x\NULP\EOT\174871/\190041\f\f\1005146?*\fIcKW\DELQ\"\1001726P*\1095849\&6=d\n\157680\RS\1087962\EOT\DC2I\47501U\b=Pc\DLE" + ) + (Just (CookieLabel {cookieLabelText = "\SI\128787-\125004:\136001\39864\ACK\SO"})) + (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) ) - (Just (CookieLabel {cookieLabelText = "\SI\128787-\125004:\136001\39864\ACK\SO"})) - (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) testObject_Login_user_13 :: Login testObject_Login_user_13 = - SmsLogin (Phone {fromPhone = "+626804710"}) (LoginCode {fromLoginCode = "&\1040514y"}) Nothing + SmsLogin (SmsLoginData (Phone {fromPhone = "+626804710"}) (LoginCode {fromLoginCode = "&\1040514y"}) Nothing) testObject_Login_user_14 :: Login testObject_Login_user_14 = SmsLogin - (Phone {fromPhone = "+5693913858477"}) - (LoginCode {fromLoginCode = ""}) - (Just (CookieLabel {cookieLabelText = "\95804\25610"})) + ( SmsLoginData + (Phone {fromPhone = "+5693913858477"}) + (LoginCode {fromLoginCode = ""}) + (Just (CookieLabel {cookieLabelText = "\95804\25610"})) + ) testObject_Login_user_15 :: Login testObject_Login_user_15 = SmsLogin - (Phone {fromPhone = "+56208262"}) - (LoginCode {fromLoginCode = ""}) - (Just (CookieLabel {cookieLabelText = "q\ETB(\1086676\187384>8\141442\n6"})) + ( SmsLoginData + (Phone {fromPhone = "+56208262"}) + (LoginCode {fromLoginCode = ""}) + (Just (CookieLabel {cookieLabelText = "q\ETB(\1086676\187384>8\141442\n6"})) + ) testObject_Login_user_16 :: Login testObject_Login_user_16 = SmsLogin - (Phone {fromPhone = "+588058222975"}) - (LoginCode {fromLoginCode = "_\1110666\1003968\1108501-_\ETB"}) - (Just (CookieLabel {cookieLabelText = "\SOL\1079080\1008939\1059848@\FS\DLE$"})) + ( SmsLoginData + (Phone {fromPhone = "+588058222975"}) + (LoginCode {fromLoginCode = "_\1110666\1003968\1108501-_\ETB"}) + (Just (CookieLabel {cookieLabelText = "\SOL\1079080\1008939\1059848@\FS\DLE$"})) + ) testObject_Login_user_17 :: Login testObject_Login_user_17 = SmsLogin - (Phone {fromPhone = "+3649176551364"}) - (LoginCode {fromLoginCode = "\ETB1\1002982n\DLEdV\1030538d\SOH"}) - (Just (CookieLabel {cookieLabelText = "\1112281{/p\100214"})) + ( SmsLoginData + (Phone {fromPhone = "+3649176551364"}) + (LoginCode {fromLoginCode = "\ETB1\1002982n\DLEdV\1030538d\SOH"}) + (Just (CookieLabel {cookieLabelText = "\1112281{/p\100214"})) + ) testObject_Login_user_18 :: Login testObject_Login_user_18 = SmsLogin - (Phone {fromPhone = "+478931600"}) - (LoginCode {fromLoginCode = ",\139681\13742,"}) - (Just (CookieLabel {cookieLabelText = "5"})) + ( SmsLoginData + (Phone {fromPhone = "+478931600"}) + (LoginCode {fromLoginCode = ",\139681\13742,"}) + (Just (CookieLabel {cookieLabelText = "5"})) + ) testObject_Login_user_19 :: Login testObject_Login_user_19 = SmsLogin - (Phone {fromPhone = "+92676996582869"}) - (LoginCode {fromLoginCode = "x\27255<"}) - (Just (CookieLabel {cookieLabelText = "w;U\ESCx:"})) + ( SmsLoginData + (Phone {fromPhone = "+92676996582869"}) + (LoginCode {fromLoginCode = "x\27255<"}) + (Just (CookieLabel {cookieLabelText = "w;U\ESCx:"})) + ) testObject_Login_user_20 :: Login testObject_Login_user_20 = PasswordLogin - (LoginByEmail (Email {emailLocal = "[%", emailDomain = ","})) - ( PlainTextPassword - "ryzP\DC39\11027-1A)\b,u\8457j~0\1090580\1033743\fI\170254er\DC4V|}'kzG%A;3H\amD\STXU1\NUL^\1043764\DLEO&5u\EOT\SUB\167046\&0A\996223X\DC2\FS7fEt\97366rPvytT\136915!\100713$Q|BI+EM5\NAK\t\DELRKrE\DLE\US\r?.\STX|@1v^\vycpu\n$\DC2\186675\131718-Q\151081\n\r\1033981\68381O\ENQ*\68660Z\USo\EOTn\188565%&\DC3Me*\STX;\DLE034\nv\NAK\140398(\1075494\990138n@\1108345|\48421d\n*\SI\NUL}\NAKA!\1045882\1036527Hx\ETB3\STX{#T|5|GC\1089070z.\USN\1080851\22324\vu\SYN~LP\147583CV\SO q\151952\DC2e8h\USg\1019358;\f\996107\1108688At\1022346)\USG\DC3\166541\39337|\1042043\SI\134073\EOTc~6\DLE:u\165393##^\nn{d\CAN\ng\16237\ESC\US\US~A8};T\RS\NAK)&\b\ACK\1106044\GS(\DC3u;\1094683;=e\1051162\"\40669vCt)o\987006m\43912\78088l1+\1036284[\STXFLx\1080932:\1031973\992752\&71/kE\93787p\DC4Ij\ETB\194985&\SUB^\FSl1\ACK\1019548\ETXW,+3\128058\95671\DLE7\59727\&7rG'\1078914JC9M\1053804\SYN\DC2\44350>~\1016308Y\1062059=i-\fS\172440\156520K2-@\ENQ\f\1108851_1D-&\128386lR\187248/\993988$:\31415:\52267Dg\1015243O\1010173\170117\SO\179807\&2z\NAKq\141547c\FSliJ{\1055925\1060070'BL\168670;\STX\1046844\18443B\NUL\7839b\1072569:w\1108016Ad\SUB6\NAKo\55279\nsPWM{\ETXfW\1018373JT\1021361$\989069\54608\190318\173259u4\1103286\t\34021\1039458\"\153264UM\1084148\1095406\34105\1105325\t\nIn'\1070532\21097\16091\EM\DC1<\v\bW\SI}\141807\b\1072339\1035283\GS`\1094467x\NUL\986937K\FSj\1079287\DC1\SI\168992d\991620k4\SUB\1009876\49943^\58464\1052547\1016875i2=$:[f\1064579\DC2n\NAKJ<=\2028\SI!z\1105364\SON\NAK\EM\180748V\1024876CQ_G\nY#ky\132779k\DC3\ENQ}OC\96566}~M\EMp\ETX\RSx\b\183962\1073008\b8/\DC4?\1081654B\1025870\EOT\SO\DELU\1020905\ESC=%\51062J\168855\ETB\992593\990312\985186\to\1101036X_@@\45111\43952$" + ( PasswordLoginData + (LoginByEmail (Email {emailLocal = "[%", emailDomain = ","})) + ( PlainTextPassword + "ryzP\DC39\11027-1A)\b,u\8457j~0\1090580\1033743\fI\170254er\DC4V|}'kzG%A;3H\amD\STXU1\NUL^\1043764\DLEO&5u\EOT\SUB\167046\&0A\996223X\DC2\FS7fEt\97366rPvytT\136915!\100713$Q|BI+EM5\NAK\t\DELRKrE\DLE\US\r?.\STX|@1v^\vycpu\n$\DC2\186675\131718-Q\151081\n\r\1033981\68381O\ENQ*\68660Z\USo\EOTn\188565%&\DC3Me*\STX;\DLE034\nv\NAK\140398(\1075494\990138n@\1108345|\48421d\n*\SI\NUL}\NAKA!\1045882\1036527Hx\ETB3\STX{#T|5|GC\1089070z.\USN\1080851\22324\vu\SYN~LP\147583CV\SO q\151952\DC2e8h\USg\1019358;\f\996107\1108688At\1022346)\USG\DC3\166541\39337|\1042043\SI\134073\EOTc~6\DLE:u\165393##^\nn{d\CAN\ng\16237\ESC\US\US~A8};T\RS\NAK)&\b\ACK\1106044\GS(\DC3u;\1094683;=e\1051162\"\40669vCt)o\987006m\43912\78088l1+\1036284[\STXFLx\1080932:\1031973\992752\&71/kE\93787p\DC4Ij\ETB\194985&\SUB^\FSl1\ACK\1019548\ETXW,+3\128058\95671\DLE7\59727\&7rG'\1078914JC9M\1053804\SYN\DC2\44350>~\1016308Y\1062059=i-\fS\172440\156520K2-@\ENQ\f\1108851_1D-&\128386lR\187248/\993988$:\31415:\52267Dg\1015243O\1010173\170117\SO\179807\&2z\NAKq\141547c\FSliJ{\1055925\1060070'BL\168670;\STX\1046844\18443B\NUL\7839b\1072569:w\1108016Ad\SUB6\NAKo\55279\nsPWM{\ETXfW\1018373JT\1021361$\989069\54608\190318\173259u4\1103286\t\34021\1039458\"\153264UM\1084148\1095406\34105\1105325\t\nIn'\1070532\21097\16091\EM\DC1<\v\bW\SI}\141807\b\1072339\1035283\GS`\1094467x\NUL\986937K\FSj\1079287\DC1\SI\168992d\991620k4\SUB\1009876\49943^\58464\1052547\1016875i2=$:[f\1064579\DC2n\NAKJ<=\2028\SI!z\1105364\SON\NAK\EM\180748V\1024876CQ_G\nY#ky\132779k\DC3\ENQ}OC\96566}~M\EMp\ETX\RSx\b\183962\1073008\b8/\DC4?\1081654B\1025870\EOT\SO\DELU\1020905\ESC=%\51062J\168855\ETB\992593\990312\985186\to\1101036X_@@\45111\43952$" + ) + (Just (CookieLabel {cookieLabelText = "\1055424\r9\998420`\NAKx"})) + (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) ) - (Just (CookieLabel {cookieLabelText = "\1055424\r9\998420`\NAKx"})) - (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "RcplMOQiGa-JY"))})) diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index 05d8e262c5..31e022d28a 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -21,460 +21,362 @@ module Brig.User.API.Auth ) where -import Brig.API.Error import Brig.API.Handler -import Brig.API.Types -import qualified Brig.API.User as User -import Brig.App -import Brig.Effects.BlacklistStore (BlacklistStore) -import Brig.Effects.GalleyProvider (GalleyProvider) -import Brig.Phone -import Brig.Types.Intra (ReAuthUser, reAuthCode, reAuthCodeAction, reAuthPassword) -import Brig.Types.User.Auth -import qualified Brig.User.Auth as Auth -import qualified Brig.User.Auth.Cookie as Auth -import qualified Brig.ZAuth as ZAuth -import Control.Error (catchE) -import Control.Monad.Except -import Control.Monad.Trans.Except (throwE) -import qualified Data.ByteString as BS -import Data.ByteString.Conversion -import Data.Id -import Data.List1 (List1) -import qualified Data.List1 as List1 -import Data.Predicate import qualified Data.Swagger.Build.Api as Doc -import qualified Data.ZAuth.Token as ZAuth import Imports -import Network.HTTP.Types.Status -import Network.Wai (Response) -import Network.Wai.Predicate -import qualified Network.Wai.Predicate as P -import qualified Network.Wai.Predicate.Request as R import Network.Wai.Routing -import Network.Wai.Utilities.Error ((!>>)) -import Network.Wai.Utilities.Request (JsonRequest, jsonRequest) -import Network.Wai.Utilities.Response (empty, json) -import qualified Network.Wai.Utilities.Response as WaiResp -import Network.Wai.Utilities.Swagger (document) -import qualified Network.Wai.Utilities.Swagger as Doc -import Polysemy (Member, Members) -import Wire.API.Error -import qualified Wire.API.Error.Brig as E -import qualified Wire.API.User as Public -import Wire.API.User.Auth as Public -import Wire.Swagger as Doc (pendingLoginError) routesPublic :: - Members - '[ BlacklistStore, - GalleyProvider - ] - r => Routes Doc.ApiBuilder (Handler r) () -routesPublic = do - -- Note: this endpoint should always remain available at its unversioned - -- path, since the login cookie hardcodes @/access@ as a path. - -- post "/access" (continue renewH) $ - -- accept "application" "json" - -- .&. tokenRequest - -- document "POST" "newAccessToken" $ do - -- Doc.summary "Obtain an access tokens for a cookie." - -- Doc.notes - -- "You can provide only a cookie or a cookie and token. \ - -- \Every other combination is invalid. \ - -- \Access tokens can be given as query parameter or authorisation \ - -- \header, with the latter being preferred." - -- Doc.returns (Doc.ref Public.modelAccessToken) - -- Doc.parameter Doc.Header "cookie" Doc.bytes' $ do - -- Doc.description "The 'zuid' cookie header" - -- Doc.optional - -- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do - -- Doc.description "The access-token as 'Authorization' header." - -- Doc.optional - -- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do - -- Doc.description "The access-token as query parameter." - -- Doc.optional - -- Doc.errorResponse (errorToWai @'E.BadCredentials) - - post "/login/send" (continue sendLoginCodeH) $ - jsonRequest @Public.SendLoginCode - document "POST" "sendLoginCode" $ do - Doc.summary "Send a login code to a verified phone number." - Doc.notes - "This operation generates and sends a login code via sms for phone login. \ - \A login code can be used only once and times out after \ - \10 minutes. Only one login code may be pending at a time.\ - \For 2nd factor authentication login with email and password, use the `/verification-code/send` endpoint." - Doc.body (Doc.ref Public.modelSendLoginCode) $ - Doc.description "JSON body" - Doc.returns (Doc.ref Public.modelLoginCodeResponse) - Doc.response 200 "Login code sent." Doc.end - Doc.errorResponse (errorToWai @'E.InvalidPhone) - Doc.errorResponse passwordExists - Doc.errorResponse' loginCodePending Doc.pendingLoginError - - -- This endpoint is used to test /i/metrics, when this is servantified, please - -- make sure some other wai-route endpoint is used to test that routes defined in - -- this function ('Brig.API.Public.sitemap') are recorded and reported correctly in /i/metrics. - -- see test/integration/API/Metrics.hs - post "/login" (continue loginH) $ - jsonRequest @Public.Login - .&. def False (query "persist") - .&. accept "application" "json" - document "POST" "login" $ do - Doc.summary "Authenticate a user to obtain a cookie and first access token." - Doc.notes "Logins are throttled at the server's discretion." - Doc.body (Doc.ref Public.modelLogin) $ - Doc.description - "The optional label can later be used to delete all \ - \cookies matching this label (cf. /cookies/remove)." - Doc.parameter Doc.Query "persist" (Doc.bool $ Doc.def False) $ do - Doc.description "Request a persistent cookie instead of a session cookie." - Doc.optional - Doc.errorResponse (errorToWai @'E.BadCredentials) - Doc.errorResponse accountSuspended - Doc.errorResponse accountPending - Doc.errorResponse loginCodeAuthenticationFailed - Doc.errorResponse loginCodeAuthenticationRequired - - post "/access/logout" (continue logoutH) $ - accept "application" "json" .&. tokenRequest - document "POST" "logout" $ do - Doc.summary "Log out in order to remove a cookie from the server." - Doc.notes - "Calling this endpoint will effectively revoke the given cookie \ - \and subsequent calls to /access with the same cookie will \ - \result in a 403." - Doc.parameter Doc.Header "cookie" Doc.bytes' $ - Doc.description "The 'zuid' cookie header" - Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do - Doc.description "The access-token as 'Authorization' header." - Doc.optional - Doc.parameter Doc.Query "access_token" Doc.bytes' $ do - Doc.description "The access-token as query parameter." - Doc.optional - Doc.errorResponse (errorToWai @'E.BadCredentials) - - put "/access/self/email" (continue changeSelfEmailH) $ - accept "application" "json" - .&. jsonRequest @Public.EmailUpdate - .&. tokenRequest - document "PUT" "changeEmail" $ do - Doc.summary "Change your email address" - Doc.parameter Doc.Header "cookie" Doc.bytes' $ - Doc.description "The 'zuid' cookie header" - Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do - Doc.description "The access-token as 'Authorization' header." - Doc.optional - Doc.parameter Doc.Query "access_token" Doc.bytes' $ do - Doc.description "The access-token as query parameter." - Doc.optional - Doc.body (Doc.ref Public.modelEmailUpdate) $ - Doc.description "JSON body" - Doc.response 202 "Update accepted and pending activation of the new email." Doc.end - Doc.response 204 "No update, current and new email address are the same." Doc.end - Doc.errorResponse (errorToWai @'E.InvalidEmail) - Doc.errorResponse (errorToWai @'E.UserKeyExists) - Doc.errorResponse blacklistedEmail - Doc.errorResponse (errorToWai @'E.BlacklistedPhone) - Doc.errorResponse missingAccessToken - Doc.errorResponse invalidAccessToken - Doc.errorResponse (errorToWai @'E.BadCredentials) - - get "/cookies" (continue listCookiesH) $ - header "Z-User" - .&. opt (query "labels") - .&. accept "application" "json" - document "GET" "getCookies" $ do - Doc.summary "Retrieve the list of cookies currently stored for the user." - Doc.returns (Doc.ref Public.modelCookieList) - Doc.parameter Doc.Query "labels" Doc.bytes' $ do - Doc.description "Filter by label (comma-separated list)" - Doc.optional - - post "/cookies/remove" (continue rmCookiesH) $ - header "Z-User" - .&. jsonRequest @Public.RemoveCookies - document "POST" "rmCookies" $ do - Doc.summary "Revoke stored cookies." - Doc.body (Doc.ref Public.modelRemoveCookies) Doc.end - Doc.errorResponse (errorToWai @'E.BadCredentials) - -routesInternal :: - Members '[GalleyProvider] r => - Routes a (Handler r) () -routesInternal = do - -- galley can query this endpoint at the right moment in the LegalHold flow - post "/i/legalhold-login" (continue legalHoldLoginH) $ - jsonRequest @LegalHoldLogin - .&. accept "application" "json" - - post "/i/sso-login" (continue ssoLoginH) $ - jsonRequest @SsoLogin - .&. def False (query "persist") - .&. accept "application" "json" - - get "/i/users/login-code" (continue getLoginCodeH) $ - accept "application" "json" - .&. param "phone" - - get "/i/users/:uid/reauthenticate" (continue reAuthUserH) $ - capture "uid" - .&. jsonRequest @ReAuthUser - --- Handlers - -sendLoginCodeH :: JsonRequest Public.SendLoginCode -> (Handler r) Response -sendLoginCodeH req = do - json <$> (sendLoginCode =<< parseJsonBody req) - -sendLoginCode :: Public.SendLoginCode -> (Handler r) Public.LoginCodeTimeout -sendLoginCode (Public.SendLoginCode phone call force) = do - checkWhitelist (Right phone) - c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError - pure $ Public.LoginCodeTimeout (pendingLoginTimeout c) - -getLoginCodeH :: JSON ::: Phone -> (Handler r) Response -getLoginCodeH (_ ::: phone) = json <$> getLoginCode phone - -getLoginCode :: Phone -> (Handler r) Public.PendingLoginCode -getLoginCode phone = do - code <- lift $ wrapClient $ Auth.lookupLoginCode phone - maybe (throwStd loginCodeNotFound) pure code - -reAuthUserH :: - Members '[GalleyProvider] r => - UserId ::: JsonRequest ReAuthUser -> - (Handler r) Response -reAuthUserH (uid ::: req) = do - reAuthUser uid =<< parseJsonBody req - pure empty - -reAuthUser :: - Members '[GalleyProvider] r => - UserId -> - ReAuthUser -> - (Handler r) () -reAuthUser uid body = do - wrapClientE (User.reauthenticate uid (reAuthPassword body)) !>> reauthError - case reAuthCodeAction body of - Just action -> - Auth.verifyCode (reAuthCode body) action uid - `catchE` \case - VerificationCodeRequired -> throwE $ reauthError ReAuthCodeVerificationRequired - VerificationCodeNoPendingCode -> throwE $ reauthError ReAuthCodeVerificationNoPendingCode - VerificationCodeNoEmail -> throwE $ reauthError ReAuthCodeVerificationNoEmail - Nothing -> pure () - -loginH :: - Members '[GalleyProvider] r => - JsonRequest Public.Login ::: Bool ::: JSON -> - (Handler r) Response -loginH (req ::: persist ::: _) = do - lift . tokenResponse =<< flip login persist =<< parseJsonBody req - -login :: - Members '[GalleyProvider] r => - Public.Login -> - Bool -> - (Handler r) (Auth.Access ZAuth.User) -login l persist = do - let typ = if persist then PersistentCookie else SessionCookie - Auth.login l typ !>> loginError - -ssoLoginH :: JsonRequest SsoLogin ::: Bool ::: JSON -> (Handler r) Response -ssoLoginH (req ::: persist ::: _) = do - lift . tokenResponse =<< flip ssoLogin persist =<< parseJsonBody req - -ssoLogin :: SsoLogin -> Bool -> (Handler r) (Auth.Access ZAuth.User) -ssoLogin l persist = do - let typ = if persist then PersistentCookie else SessionCookie - wrapHttpClientE (Auth.ssoLogin l typ) !>> loginError - -legalHoldLoginH :: - Members '[GalleyProvider] r => - JsonRequest LegalHoldLogin ::: JSON -> - (Handler r) Response -legalHoldLoginH (req ::: _) = do - lift . tokenResponse =<< legalHoldLogin =<< parseJsonBody req - -legalHoldLogin :: - Members '[GalleyProvider] r => - LegalHoldLogin -> - (Handler r) (Auth.Access ZAuth.LegalHoldUser) -legalHoldLogin l = do - let typ = PersistentCookie -- Session cookie isn't a supported use case here - Auth.legalHoldLogin l typ !>> legalHoldLoginError - -logoutH :: JSON ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> (Handler r) Response -logoutH (_ ::: ut ::: at) = empty <$ logout ut at - --- TODO: add legalhold test checking cookies are revoked (/access/logout is called) when legalhold device is deleted. -logout :: - Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) -> - Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> - (Handler r) () -logout Nothing Nothing = throwStd authMissingCookieAndToken -logout Nothing (Just _) = throwStd authMissingCookie -logout (Just _) Nothing = throwStd authMissingToken -logout (Just (Left _)) (Just (Right _)) = throwStd authTokenMismatch -logout (Just (Right _)) (Just (Left _)) = throwStd authTokenMismatch -logout (Just (Left ut)) (Just (Left at)) = wrapHttpClientE (Auth.logout ut at) !>> zauthError -logout (Just (Right ut)) (Just (Right at)) = wrapHttpClientE (Auth.logout ut at) !>> zauthError - -changeSelfEmailH :: - Member BlacklistStore r => - JSON - ::: JsonRequest Public.EmailUpdate - ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) - ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> - (Handler r) Response -changeSelfEmailH (_ ::: req ::: ckies ::: toks) = do - usr <- validateCredentials ckies toks - email <- Public.euEmail <$> parseJsonBody req - User.changeSelfEmail usr email User.ForbidSCIMUpdates >>= \case - ChangeEmailResponseIdempotent -> pure (WaiResp.setStatus status204 empty) - ChangeEmailResponseNeedsActivation -> pure (WaiResp.setStatus status202 empty) - where - validateCredentials = \case - Nothing -> - const $ throwStd authMissingCookie - Just (Right _legalholdUserTokens) -> - const $ throwStd authInvalidCookie - Just (Left userCookies) -> - \case - Nothing -> - throwStd missingAccessToken - Just (Right _legalholdAccessToken) -> - throwStd invalidAccessToken - Just (Left userTokens) -> - fst <$> wrapHttpClientE (Auth.validateTokens userCookies (Just userTokens)) !>> zauthError - -listCookiesH :: UserId ::: Maybe (List Public.CookieLabel) ::: JSON -> (Handler r) Response -listCookiesH (u ::: ll ::: _) = json <$> lift (listCookies u ll) - -listCookies :: UserId -> Maybe (List Public.CookieLabel) -> (AppT r) Public.CookieList -listCookies u ll = do - Public.CookieList <$> wrapClient (Auth.listCookies u (maybe [] fromList ll)) - -rmCookiesH :: UserId ::: JsonRequest Public.RemoveCookies -> (Handler r) Response -rmCookiesH (uid ::: req) = do - empty <$ (rmCookies uid =<< parseJsonBody req) - -rmCookies :: UserId -> Public.RemoveCookies -> (Handler r) () -rmCookies uid (Public.RemoveCookies pw lls ids) = - wrapClientE (Auth.revokeAccess uid pw ids lls) !>> authError - --- _renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response --- _renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at - --- | renew access for either: --- * a user with user token and optional access token, or --- * a legalhold user with legalhold user token and optional legalhold access token. --- --- Other combinations of provided inputs will cause an error to be raised. --- renew :: --- Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) -> --- Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> --- (Handler r) (Either (Auth.Access ZAuth.User) (Auth.Access ZAuth.LegalHoldUser)) --- renew = \case --- Nothing -> --- const $ throwStd authMissingCookie --- (Just (Left userTokens)) -> --- -- normal UserToken, so we want a normal AccessToken --- fmap Left . wrapHttpClientE . renewAccess userTokens <=< matchingOrNone leftToMaybe --- (Just (Right legalholdUserTokens)) -> --- -- LegalholdUserToken, so we want a LegalholdAccessToken --- fmap Right . wrapHttpClientE . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe --- where --- renewAccess uts mat = --- Auth.renewAccess uts mat !>> zauthError --- matchingOrNone :: (a -> Maybe b) -> Maybe a -> (Handler r) (Maybe b) --- matchingOrNone matching = traverse $ \accessToken -> --- case matching accessToken of --- Just m -> pure m --- Nothing -> throwStd authTokenMismatch - --- Utilities --- - --- | A predicate that captures user and access tokens for a request handler. -tokenRequest :: - forall r. - (R.HasCookies r, R.HasHeaders r, R.HasQuery r) => - Predicate - r - P.Error - ( Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) - ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) - ) -tokenRequest = opt (userToken ||| legalHoldUserToken) .&. opt (accessToken ||| legalHoldAccessToken) - where - userToken = cookieErr @ZAuth.User <$> cookies "zuid" - legalHoldUserToken = cookieErr @ZAuth.LegalHoldUser <$> cookies "zuid" - accessToken = parse @ZAuth.Access <$> (tokenHeader .|. tokenQuery) - legalHoldAccessToken = parse @ZAuth.LegalHoldAccess <$> (tokenHeader .|. tokenQuery) - - tokenHeader :: r -> Result P.Error ByteString - tokenHeader = bearer <$> header "authorization" - - tokenQuery :: r -> Result P.Error ByteString - tokenQuery = query "access_token" - - cookieErr :: Result P.Error (List1 (ZAuth.Token u)) -> Result P.Error (List1 (ZAuth.Token u)) - cookieErr x@Okay {} = x - cookieErr (Fail x) = Fail (setMessage "Invalid user token" (P.setStatus status403 x)) - - -- Extract the access token from the Authorization header. - bearer :: Result P.Error ByteString -> Result P.Error ByteString - bearer (Fail x) = Fail x - bearer (Okay _ b) = - let (prefix, suffix) = BS.splitAt 7 b - in if prefix == "Bearer " - then pure suffix - else - Fail - ( setReason - TypeError - (setMessage "Invalid authorization scheme" (err status403)) - ) - - -- Parse the access token - parse :: ZAuth.AccessTokenLike a => Result P.Error ByteString -> Result P.Error (ZAuth.Token a) - parse (Fail x) = Fail x - parse (Okay _ b) = case fromByteString b of - Nothing -> - Fail - ( setReason - TypeError - (setMessage "Invalid access token" (err status403)) - ) - Just t -> pure t - -tokenResponse :: ZAuth.UserTokenLike u => Auth.Access u -> (AppT r) Response -tokenResponse (Auth.Access t Nothing) = pure $ json t -tokenResponse (Auth.Access t (Just c)) = Auth.setResponseCookie c (json t) - --- | Internal utilities: These functions are nearly copies verbatim from the original --- project: https://gitlab.com/twittner/wai-predicates/-/blob/develop/src/Network/Wai/Predicate.hs#L106-112 --- I will still make an upstream PR but would not like to block this PR because of --- it. Main difference: the original stops after finding the first valid cookie which --- is a problem if clients send more than 1 cookie and one of them happens to be invalid --- We should also be dropping this in favor of servant which will make this redundant -cookies :: (R.HasCookies r, FromByteString a) => ByteString -> Predicate r P.Error (List1 a) -cookies k r = - case R.lookupCookie k r of - [] -> Fail . addLabel "cookie" $ notAvailable k - cc -> - case mapMaybe fromByteString cc of - [] -> Fail . addLabel "cookie" . typeError k $ "Failed to get zuid cookies" - (x : xs) -> pure $ List1.list1 x xs - -notAvailable :: ByteString -> P.Error -notAvailable k = e400 & setReason NotAvailable . setSource k -{-# INLINE notAvailable #-} - -typeError :: ByteString -> ByteString -> P.Error -typeError k m = e400 & setReason TypeError . setSource k . setMessage m -{-# INLINE typeError #-} +routesPublic = pure () + +routesInternal :: Routes a (Handler r) () +routesInternal = pure () + +-- Note: this endpoint should always remain available at its unversioned +-- path, since the login cookie hardcodes @/access@ as a path. +-- post "/access" (continue renewH) $ +-- accept "application" "json" +-- .&. tokenRequest +-- document "POST" "newAccessToken" $ do +-- Doc.summary "Obtain an access tokens for a cookie." +-- Doc.notes +-- "You can provide only a cookie or a cookie and token. \ +-- \Every other combination is invalid. \ +-- \Access tokens can be given as query parameter or authorisation \ +-- \header, with the latter being preferred." +-- Doc.returns (Doc.ref Public.modelAccessToken) +-- Doc.parameter Doc.Header "cookie" Doc.bytes' $ do +-- Doc.description "The 'zuid' cookie header" +-- Doc.optional +-- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do +-- Doc.description "The access-token as 'Authorization' header." +-- Doc.optional +-- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do +-- Doc.description "The access-token as query parameter." +-- Doc.optional +-- Doc.errorResponse (errorToWai @'E.BadCredentials) + +-- post "/login/send" (continue sendLoginCodeH) $ +-- jsonRequest @Public.SendLoginCode +-- document "POST" "sendLoginCode" $ do +-- Doc.summary "Send a login code to a verified phone number." +-- Doc.notes +-- "This operation generates and sends a login code via sms for phone login. \ +-- \A login code can be used only once and times out after \ +-- \10 minutes. Only one login code may be pending at a time.\ +-- \For 2nd factor authentication login with email and password, use the `/verification-code/send` endpoint." +-- Doc.body (Doc.ref Public.modelSendLoginCode) $ +-- Doc.description "JSON body" +-- Doc.returns (Doc.ref Public.modelLoginCodeResponse) +-- Doc.response 200 "Login code sent." Doc.end +-- Doc.errorResponse (errorToWai @'E.InvalidPhone) +-- Doc.errorResponse passwordExists +-- Doc.errorResponse' loginCodePending Doc.pendingLoginError + +-- -- This endpoint is used to test /i/metrics, when this is servantified, please +-- -- make sure some other wai-route endpoint is used to test that routes defined in +-- -- this function ('Brig.API.Public.sitemap') are recorded and reported correctly in /i/metrics. +-- -- see test/integration/API/Metrics.hs +-- post "/login" (continue loginH) $ +-- jsonRequest @Public.Login +-- .&. def False (query "persist") +-- .&. accept "application" "json" +-- document "POST" "login" $ do +-- Doc.summary "Authenticate a user to obtain a cookie and first access token." +-- Doc.notes "Logins are throttled at the server's discretion." +-- Doc.body (Doc.ref Public.modelLogin) $ +-- Doc.description +-- "The optional label can later be used to delete all \ +-- \cookies matching this label (cf. /cookies/remove)." +-- Doc.parameter Doc.Query "persist" (Doc.bool $ Doc.def False) $ do +-- Doc.description "Request a persistent cookie instead of a session cookie." +-- Doc.optional +-- Doc.errorResponse (errorToWai @'E.BadCredentials) +-- Doc.errorResponse accountSuspended +-- Doc.errorResponse accountPending +-- Doc.errorResponse loginCodeAuthenticationFailed +-- Doc.errorResponse loginCodeAuthenticationRequired + +-- post "/access/logout" (continue logoutH) $ +-- accept "application" "json" .&. tokenRequest +-- document "POST" "logout" $ do +-- Doc.summary "Log out in order to remove a cookie from the server." +-- Doc.notes +-- "Calling this endpoint will effectively revoke the given cookie \ +-- \and subsequent calls to /access with the same cookie will \ +-- \result in a 403." +-- Doc.parameter Doc.Header "cookie" Doc.bytes' $ +-- Doc.description "The 'zuid' cookie header" +-- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do +-- Doc.description "The access-token as 'Authorization' header." +-- Doc.optional +-- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do +-- Doc.description "The access-token as query parameter." +-- Doc.optional +-- Doc.errorResponse (errorToWai @'E.BadCredentials) + +-- put "/access/self/email" (continue changeSelfEmailH) $ +-- accept "application" "json" +-- .&. jsonRequest @Public.EmailUpdate +-- .&. tokenRequest +-- document "PUT" "changeEmail" $ do +-- Doc.summary "Change your email address" +-- Doc.parameter Doc.Header "cookie" Doc.bytes' $ +-- Doc.description "The 'zuid' cookie header" +-- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do +-- Doc.description "The access-token as 'Authorization' header." +-- Doc.optional +-- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do +-- Doc.description "The access-token as query parameter." +-- Doc.optional +-- Doc.body (Doc.ref Public.modelEmailUpdate) $ +-- Doc.description "JSON body" +-- Doc.response 202 "Update accepted and pending activation of the new email." Doc.end +-- Doc.response 204 "No update, current and new email address are the same." Doc.end +-- Doc.errorResponse (errorToWai @'E.InvalidEmail) +-- Doc.errorResponse (errorToWai @'E.UserKeyExists) +-- Doc.errorResponse blacklistedEmail +-- Doc.errorResponse (errorToWai @'E.BlacklistedPhone) +-- Doc.errorResponse missingAccessToken +-- Doc.errorResponse invalidAccessToken +-- Doc.errorResponse (errorToWai @'E.BadCredentials) + +-- get "/cookies" (continue listCookiesH) $ +-- header "Z-User" +-- .&. opt (query "labels") +-- .&. accept "application" "json" +-- document "GET" "getCookies" $ do +-- Doc.summary "Retrieve the list of cookies currently stored for the user." +-- Doc.returns (Doc.ref Public.modelCookieList) +-- Doc.parameter Doc.Query "labels" Doc.bytes' $ do +-- Doc.description "Filter by label (comma-separated list)" +-- Doc.optional + +-- post "/cookies/remove" (continue rmCookiesH) $ +-- header "Z-User" +-- .&. jsonRequest @Public.RemoveCookies +-- document "POST" "rmCookies" $ do +-- Doc.summary "Revoke stored cookies." +-- Doc.body (Doc.ref Public.modelRemoveCookies) Doc.end +-- Doc.errorResponse (errorToWai @'E.BadCredentials) + +-- do +-- -- galley can query this endpoint at the right moment in the LegalHold flow +-- post "/i/legalhold-login" (continue legalHoldLoginH) $ +-- jsonRequest @LegalHoldLogin +-- .&. accept "application" "json" + +-- post "/i/sso-login" (continue ssoLoginH) $ +-- jsonRequest @SsoLogin +-- .&. def False (query "persist") +-- .&. accept "application" "json" + +-- get "/i/users/login-code" (continue getLoginCodeH) $ +-- accept "application" "json" +-- .&. param "phone" + +-- get "/i/users/:uid/reauthenticate" (continue reAuthUserH) $ +-- capture "uid" +-- .&. jsonRequest @ReAuthUser + +---- Handlers + +--sendLoginCodeH :: JsonRequest Public.SendLoginCode -> (Handler r) Response +--sendLoginCodeH req = do +-- json <$> (sendLoginCode =<< parseJsonBody req) + +--sendLoginCode :: Public.SendLoginCode -> (Handler r) Public.LoginCodeTimeout +--sendLoginCode (Public.SendLoginCode phone call force) = do +-- checkWhitelist (Right phone) +-- c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError +-- pure $ Public.LoginCodeTimeout (pendingLoginTimeout c) + +--getLoginCodeH :: JSON ::: Phone -> (Handler r) Response +--getLoginCodeH (_ ::: phone) = json <$> getLoginCode phone + +--login :: Public.Login -> Bool -> (Handler r) (Auth.Access ZAuth.User) +--login l persist = do +-- let typ = if persist then PersistentCookie else SessionCookie +-- wrapHttpClientE (Auth.login l typ) !>> loginError + +--ssoLoginH :: JsonRequest SsoLogin ::: Bool ::: JSON -> (Handler r) Response +--ssoLoginH (req ::: persist ::: _) = do +-- lift . tokenResponse =<< flip ssoLogin persist =<< parseJsonBody req + +--legalHoldLogin :: LegalHoldLogin -> (Handler r) (Auth.Access ZAuth.LegalHoldUser) +--legalHoldLogin l = do +-- let typ = PersistentCookie -- Session cookie isn't a supported use case here +-- wrapHttpClientE (Auth.legalHoldLogin l typ) !>> legalHoldLoginError + +--logoutH :: JSON ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> (Handler r) Response +--logoutH (_ ::: ut ::: at) = empty <$ logout ut at + +---- TODO: add legalhold test checking cookies are revoked (/access/logout is called) when legalhold device is deleted. +--logout :: +-- Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) -> +-- Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> +-- (Handler r) () +--logout Nothing Nothing = throwStd authMissingCookieAndToken +--logout Nothing (Just _) = throwStd authMissingCookie +--logout (Just _) Nothing = throwStd authMissingToken +--logout (Just (Left _)) (Just (Right _)) = throwStd authTokenMismatch +--logout (Just (Right _)) (Just (Left _)) = throwStd authTokenMismatch +--logout (Just (Left ut)) (Just (Left at)) = wrapHttpClientE (Auth.logout ut at) !>> zauthError +--logout (Just (Right ut)) (Just (Right at)) = wrapHttpClientE (Auth.logout ut at) !>> zauthError + +--changeSelfEmailH :: +-- Member BlacklistStore r => +-- JSON +-- ::: JsonRequest Public.EmailUpdate +-- ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) +-- ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> +-- (Handler r) Response +--changeSelfEmailH (_ ::: req ::: ckies ::: toks) = do +-- usr <- validateCredentials ckies toks +-- email <- Public.euEmail <$> parseJsonBody req +-- User.changeSelfEmail usr email User.ForbidSCIMUpdates >>= \case +-- ChangeEmailResponseIdempotent -> pure (WaiResp.setStatus status204 empty) +-- ChangeEmailResponseNeedsActivation -> pure (WaiResp.setStatus status202 empty) +-- where +-- validateCredentials = \case +-- Nothing -> +-- const $ throwStd authMissingCookie +-- Just (Right _legalholdUserTokens) -> +-- const $ throwStd authInvalidCookie +-- Just (Left userCookies) -> +-- \case +-- Nothing -> +-- throwStd missingAccessToken +-- Just (Right _legalholdAccessToken) -> +-- throwStd invalidAccessToken +-- Just (Left userTokens) -> +-- fst <$> wrapHttpClientE (Auth.validateTokens userCookies (Just userTokens)) !>> zauthError + +--listCookiesH :: UserId ::: Maybe (List Public.CookieLabel) ::: JSON -> (Handler r) Response +--listCookiesH (u ::: ll ::: _) = json <$> lift (listCookies u ll) + +--listCookies :: UserId -> Maybe (List Public.CookieLabel) -> (AppT r) Public.CookieList +--listCookies u ll = do +-- Public.CookieList <$> wrapClient (Auth.listCookies u (maybe [] fromList ll)) + +--rmCookiesH :: UserId ::: JsonRequest Public.RemoveCookies -> (Handler r) Response +--rmCookiesH (uid ::: req) = do +-- empty <$ (rmCookies uid =<< parseJsonBody req) + +--rmCookies :: UserId -> Public.RemoveCookies -> (Handler r) () +--rmCookies uid (Public.RemoveCookies pw lls ids) = +-- wrapClientE (Auth.revokeAccess uid pw ids lls) !>> authError + +---- _renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response +---- _renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at + +---- | renew access for either: +---- * a user with user token and optional access token, or +---- * a legalhold user with legalhold user token and optional legalhold access token. +---- +---- Other combinations of provided inputs will cause an error to be raised. +---- renew :: +---- Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) -> +---- Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> +---- (Handler r) (Either (Auth.Access ZAuth.User) (Auth.Access ZAuth.LegalHoldUser)) +---- renew = \case +---- Nothing -> +---- const $ throwStd authMissingCookie +---- (Just (Left userTokens)) -> +---- -- normal UserToken, so we want a normal AccessToken +---- fmap Left . wrapHttpClientE . renewAccess userTokens <=< matchingOrNone leftToMaybe +---- (Just (Right legalholdUserTokens)) -> +---- -- LegalholdUserToken, so we want a LegalholdAccessToken +---- fmap Right . wrapHttpClientE . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe +---- where +---- renewAccess uts mat = +---- Auth.renewAccess uts mat !>> zauthError +---- matchingOrNone :: (a -> Maybe b) -> Maybe a -> (Handler r) (Maybe b) +---- matchingOrNone matching = traverse $ \accessToken -> +---- case matching accessToken of +---- Just m -> pure m +---- Nothing -> throwStd authTokenMismatch + +---- Utilities +---- + +---- | A predicate that captures user and access tokens for a request handler. +--tokenRequest :: +-- forall r. +-- (R.HasCookies r, R.HasHeaders r, R.HasQuery r) => +-- Predicate +-- r +-- P.Error +-- ( Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) +-- ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) +-- ) +--tokenRequest = opt (userToken ||| legalHoldUserToken) .&. opt (accessToken ||| legalHoldAccessToken) +-- where +-- userToken = cookieErr @ZAuth.User <$> cookies "zuid" +-- legalHoldUserToken = cookieErr @ZAuth.LegalHoldUser <$> cookies "zuid" +-- accessToken = parse @ZAuth.Access <$> (tokenHeader .|. tokenQuery) +-- legalHoldAccessToken = parse @ZAuth.LegalHoldAccess <$> (tokenHeader .|. tokenQuery) + +-- tokenHeader :: r -> Result P.Error ByteString +-- tokenHeader = bearer <$> header "authorization" + +-- tokenQuery :: r -> Result P.Error ByteString +-- tokenQuery = query "access_token" + +-- cookieErr :: Result P.Error (List1 (ZAuth.Token u)) -> Result P.Error (List1 (ZAuth.Token u)) +-- cookieErr x@Okay {} = x +-- cookieErr (Fail x) = Fail (setMessage "Invalid user token" (P.setStatus status403 x)) + +-- -- Extract the access token from the Authorization header. +-- bearer :: Result P.Error ByteString -> Result P.Error ByteString +-- bearer (Fail x) = Fail x +-- bearer (Okay _ b) = +-- let (prefix, suffix) = BS.splitAt 7 b +-- in if prefix == "Bearer " +-- then pure suffix +-- else +-- Fail +-- ( setReason +-- TypeError +-- (setMessage "Invalid authorization scheme" (err status403)) +-- ) + +-- -- Parse the access token +-- parse :: ZAuth.AccessTokenLike a => Result P.Error ByteString -> Result P.Error (ZAuth.Token a) +-- parse (Fail x) = Fail x +-- parse (Okay _ b) = case fromByteString b of +-- Nothing -> +-- Fail +-- ( setReason +-- TypeError +-- (setMessage "Invalid access token" (err status403)) +-- ) +-- Just t -> pure t + +--tokenResponse :: ZAuth.UserTokenLike u => Auth.Access u -> (AppT r) Response +--tokenResponse (Auth.Access t Nothing) = pure $ json t +--tokenResponse (Auth.Access t (Just c)) = Auth.setResponseCookie c (json t) + +---- | Internal utilities: These functions are nearly copies verbatim from the original +---- project: https://gitlab.com/twittner/wai-predicates/-/blob/develop/src/Network/Wai/Predicate.hs#L106-112 +---- I will still make an upstream PR but would not like to block this PR because of +---- it. Main difference: the original stops after finding the first valid cookie which +---- is a problem if clients send more than 1 cookie and one of them happens to be invalid +---- We should also be dropping this in favor of servant which will make this redundant +--cookies :: (R.HasCookies r, FromByteString a) => ByteString -> Predicate r P.Error (List1 a) +--cookies k r = +-- case R.lookupCookie k r of +-- [] -> Fail . addLabel "cookie" $ notAvailable k +-- cc -> +-- case mapMaybe fromByteString cc of +-- [] -> Fail . addLabel "cookie" . typeError k $ "Failed to get zuid cookies" +-- (x : xs) -> pure $ List1.list1 x xs + +--notAvailable :: ByteString -> P.Error +--notAvailable k = e400 & setReason NotAvailable . setSource k +--{-# INLINE notAvailable #-} + +--typeError :: ByteString -> ByteString -> P.Error +--typeError k m = e400 & setReason TypeError . setSource k . setMessage m +--{-# INLINE typeError #-} diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 95ce5c13eb..21bd03fb47 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -140,7 +140,7 @@ login :: Login -> CookieType -> ExceptT LoginError (AppT r) (Access ZAuth.User) -login (PasswordLogin li pw label code) typ = do +login (PasswordLogin (PasswordLoginData li pw label code)) typ = do uid <- wrapHttpClientE $ resolveLoginId li lift . Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.login") wrapHttpClientE $ checkRetryLimit uid @@ -161,7 +161,7 @@ login (PasswordLogin li pw label code) typ = do VerificationCodeNoPendingCode -> wrapHttpClientE $ loginFailedWith LoginCodeInvalid uid VerificationCodeRequired -> wrapHttpClientE $ loginFailedWith LoginCodeRequired uid VerificationCodeNoEmail -> wrapHttpClientE $ loginFailed uid -login (SmsLogin phone code label) typ = do +login (SmsLogin (SmsLoginData phone code label)) typ = do uid <- wrapHttpClientE $ resolveLoginId (LoginByPhone phone) lift . Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.login") wrapHttpClientE $ checkRetryLimit uid diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index ef786dbf38..9fbc2b7571 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -429,7 +429,8 @@ testCreateUserNoEmailNoPassword brig = do Just code <- do sendLoginCode brig p LoginCodeSMS False !!! const 200 === statusCode getPhoneLoginCode brig p - initiateEmailUpdateLogin brig e (SmsLogin p code Nothing) uid !!! (const 202 === statusCode) + initiateEmailUpdateLogin brig e (SmsLogin (SmsLoginData p code Nothing)) uid + !!! (const 202 === statusCode) -- The testCreateUserConflict test conforms to the following testing standards: -- @SF.Provisioning @TSFI.RESTfulAPI @S2 @@ -1089,7 +1090,10 @@ testPasswordChange brig = do put (brig . path "/self/password" . contentJson . zUser uid . body pwChange) !!! const 200 === statusCode -- login with new password - login brig (PasswordLogin (LoginByEmail email) newPass Nothing Nothing) PersistentCookie + login + brig + (PasswordLogin (PasswordLoginData (LoginByEmail email) newPass Nothing Nothing)) + PersistentCookie !!! const 200 === statusCode -- try to change the password to itself should fail put (brig . path "/self/password" . contentJson . zUser uid . body pwChange') diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index ad89e06d23..7c18a8cd1c 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -335,7 +335,7 @@ testPhoneLogin brig = do case code of Nothing -> liftIO $ assertFailure "missing login code" Just c -> - login brig (SmsLogin p c Nothing) PersistentCookie + login brig (SmsLogin (SmsLoginData p c Nothing)) PersistentCookie !!! const 200 === statusCode testHandleLogin :: Brig -> Http () @@ -345,7 +345,7 @@ testHandleLogin brig = do let update = RequestBodyLBS . encode $ HandleUpdate hdl put (brig . path "/self/handle" . contentJson . zUser usr . zConn "c" . Http.body update) !!! const 200 === statusCode - let l = PasswordLogin (LoginByHandle (Handle hdl)) defPassword Nothing Nothing + let l = PasswordLogin (PasswordLoginData (LoginByHandle (Handle hdl)) defPassword Nothing Nothing) login brig l PersistentCookie !!! const 200 === statusCode -- | Check that local part after @+@ is ignored by equality on email addresses if the domain is @@ -398,7 +398,13 @@ testLoginVerify6DigitEmailCodeSuccess brig galley db = do Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) key <- Code.mkKey (Code.ForEmail email) Just vcode <- Util.lookupCode db key Code.AccountLogin - checkLoginSucceeds $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) (Just $ Code.codeValue vcode) + checkLoginSucceeds $ + PasswordLogin $ + PasswordLoginData + (LoginByEmail email) + defPassword + (Just defCookieLabel) + (Just $ Code.codeValue vcode) testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: Brig -> Galley -> Opts.Opts -> DB.ClientState -> Http () testLoginVerify6DigitResendCodeSuccessAndRateLimiting brig galley _opts db = do @@ -426,8 +432,20 @@ testLoginVerify6DigitResendCodeSuccessAndRateLimiting brig galley _opts db = do void $ retryWhileN 10 ((==) 429 . statusCode) $ Util.generateVerificationCode' brig (Public.SendVerificationCode Public.Login email) mostRecentCode <- getCodeFromDb - checkLoginFails $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) (Just $ Code.codeValue fstCode) - checkLoginSucceeds $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) (Just $ Code.codeValue mostRecentCode) + checkLoginFails $ + PasswordLogin $ + PasswordLoginData + (LoginByEmail email) + defPassword + (Just defCookieLabel) + (Just $ Code.codeValue fstCode) + checkLoginSucceeds $ + PasswordLogin $ + PasswordLoginData + (LoginByEmail email) + defPassword + (Just defCookieLabel) + (Just $ Code.codeValue mostRecentCode) -- @SF.Channel @TSFI.RESTfulAPI @S2 -- @@ -445,7 +463,13 @@ testLoginVerify6DigitWrongCodeFails brig galley = do Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) let wrongCode = Code.Value $ unsafeRange (fromRight undefined (validate "123456")) - checkLoginFails $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) (Just wrongCode) + checkLoginFails $ + PasswordLogin $ + PasswordLoginData + (LoginByEmail email) + defPassword + (Just defCookieLabel) + (Just wrongCode) -- @END @@ -464,7 +488,13 @@ testLoginVerify6DigitMissingCodeFails brig galley = do Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - checkLoginFails $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) Nothing + checkLoginFails $ + PasswordLogin $ + PasswordLoginData + (LoginByEmail email) + defPassword + (Just defCookieLabel) + Nothing -- @END @@ -487,7 +517,13 @@ testLoginVerify6DigitExpiredCodeFails brig galley db = do Just vcode <- Util.lookupCode db key Code.AccountLogin -- wait > 5 sec for the code to expire (assumption: setVerificationTimeout in brig.integration.yaml is set to <= 5 sec) threadDelay $ (5 * 1000000) + 600000 - checkLoginFails $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) (Just $ Code.codeValue vcode) + checkLoginFails $ + PasswordLogin $ + PasswordLoginData + (LoginByEmail email) + defPassword + (Just defCookieLabel) + (Just $ Code.codeValue vcode) -- @END @@ -500,11 +536,19 @@ testLoginFailure brig = do Just email <- userEmail <$> randomUser brig -- login with wrong password let badpw = PlainTextPassword "wrongpassword" - login brig (PasswordLogin (LoginByEmail email) badpw Nothing Nothing) PersistentCookie + login + brig + (PasswordLogin (PasswordLoginData (LoginByEmail email) badpw Nothing Nothing)) + PersistentCookie !!! const 403 === statusCode -- login with wrong / non-existent email let badmail = Email "wrong" "wire.com" - login brig (PasswordLogin (LoginByEmail badmail) defPassword Nothing Nothing) PersistentCookie + login + brig + ( PasswordLogin + (PasswordLoginData (LoginByEmail badmail) defPassword Nothing Nothing) + ) + PersistentCookie !!! const 403 === statusCode -- @END diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 48ec40b666..9a96ec7d34 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -136,7 +136,9 @@ testAddGetClientVerificationCode db brig galley = do Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) k <- Code.mkKey (Code.ForEmail email) codeValue <- Code.codeValue <$$> lookupCode db k Code.AccountLogin - checkLoginSucceeds $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) codeValue + checkLoginSucceeds $ + PasswordLogin $ + PasswordLoginData (LoginByEmail email) defPassword (Just defCookieLabel) codeValue c <- addClient' codeValue getClient brig uid (clientId c) !!! do const 200 === statusCode @@ -197,7 +199,9 @@ testAddGetClientCodeExpired db brig galley = do Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) k <- Code.mkKey (Code.ForEmail email) codeValue <- Code.codeValue <$$> lookupCode db k Code.AccountLogin - checkLoginSucceeds $ PasswordLogin (LoginByEmail email) defPassword (Just defCookieLabel) codeValue + checkLoginSucceeds $ + PasswordLogin $ + PasswordLoginData (LoginByEmail email) defPassword (Just defCookieLabel) codeValue -- wait > 5 sec for the code to expire (assumption: setVerificationTimeout in brig.integration.yaml is set to <= 5 sec) threadDelay $ (5 * 1000000) + 600000 addClient' codeValue !!! do diff --git a/services/brig/test/integration/API/User/PasswordReset.hs b/services/brig/test/integration/API/User/PasswordReset.hs index 15362e4168..05554b4ac9 100644 --- a/services/brig/test/integration/API/User/PasswordReset.hs +++ b/services/brig/test/integration/API/User/PasswordReset.hs @@ -65,7 +65,10 @@ testPasswordReset brig cs = do -- try login login brig (defEmailLogin email) PersistentCookie !!! const 403 === statusCode - login brig (PasswordLogin (LoginByEmail email) newpw Nothing Nothing) PersistentCookie + login + brig + (PasswordLogin (PasswordLoginData (LoginByEmail email) newpw Nothing Nothing)) + PersistentCookie !!! const 200 === statusCode -- reset password again to the same new password, get 400 "must be different" do diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 22b93dcb20..6e42d8bc00 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -46,6 +46,7 @@ import Data.Qualified import Data.Range (unsafeRange) import qualified Data.Text.Ascii as Ascii import qualified Data.Vector as Vec +import qualified Data.ZAuth.Token as ZAuth import Federation.Util (withTempMockFederator) import Federator.MockServer (FederatedRequest (..)) import GHC.TypeLits (KnownSymbol) @@ -184,7 +185,7 @@ initiateEmailUpdateLogin brig email loginCreds uid = do pure (decodeCookie rsp, decodeToken rsp) initiateEmailUpdateCreds brig email (cky, tok) uid -initiateEmailUpdateCreds :: Brig -> Email -> (Bilge.Cookie, Brig.ZAuth.AccessToken) -> UserId -> (MonadIO m, MonadCatch m, MonadHttp m) => m ResponseLBS +initiateEmailUpdateCreds :: Brig -> Email -> (Bilge.Cookie, Brig.ZAuth.Token ZAuth.Access) -> UserId -> (MonadIO m, MonadCatch m, MonadHttp m) => m ResponseLBS initiateEmailUpdateCreds brig email (cky, tok) uid = do put $ unversioned diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index bcb0e9031a..5483c43738 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -71,6 +71,7 @@ import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.Encoding as T import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID +import qualified Data.ZAuth.Token as ZAuth import qualified Federator.MockServer as Mock import GHC.TypeLits import Galley.Types.Conversations.One2One (one2OneConvId) @@ -515,7 +516,7 @@ legalHoldLogin b l t = decodeCookie :: HasCallStack => Response a -> Bilge.Cookie decodeCookie = fromMaybe (error "missing zuid cookie") . getCookie "zuid" -decodeToken :: HasCallStack => Response (Maybe LByteString) -> ZAuth.AccessToken +decodeToken :: HasCallStack => Response (Maybe LByteString) -> ZAuth.Token ZAuth.Access decodeToken = decodeToken' decodeToken' :: (HasCallStack, ZAuth.AccessTokenLike a) => Response (Maybe LByteString) -> ZAuth.Token a @@ -905,7 +906,7 @@ defEmailLogin :: Email -> Login defEmailLogin e = emailLogin e defPassword (Just defCookieLabel) emailLogin :: Email -> PlainTextPassword -> Maybe CookieLabel -> Login -emailLogin e pw cl = PasswordLogin (LoginByEmail e) pw cl Nothing +emailLogin e pw cl = PasswordLogin (PasswordLoginData (LoginByEmail e) pw cl Nothing) somePrekeys :: [Prekey] somePrekeys = diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs index 0d31489f2c..b41ff0951a 100644 --- a/services/spar/test-integration/Util/Email.hs +++ b/services/spar/test-integration/Util/Email.hs @@ -56,7 +56,9 @@ changeEmailBrig brig usr newEmail = do changeEmailBrigCreds brig cky tok newEmail where emailLogin :: Email -> Misc.PlainTextPassword -> Maybe Auth.CookieLabel -> Auth.Login - emailLogin e pw cl = Auth.PasswordLogin (Auth.LoginByEmail e) pw cl Nothing + emailLogin e pw cl = + Auth.PasswordLogin $ + Auth.PasswordLoginData (Auth.LoginByEmail e) pw cl Nothing login :: Auth.Login -> Auth.CookieType -> (MonadIO m, MonadHttp m) => m ResponseLBS login l t = From 8543315a9a4b862a7a1363c162f683a09960b798 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 5 Oct 2022 16:59:21 +0200 Subject: [PATCH 08/43] WIP --- .../src/Wire/API/Routes/Public/Brig.hs | 18 ++++++++++---- libs/wire-api/src/Wire/API/User/Auth.hs | 24 +++++++++++++++++++ services/brig/src/Brig/User/Auth.hs | 5 ---- services/brig/src/Brig/ZAuth.hs | 1 + 4 files changed, 38 insertions(+), 10 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index b973f12631..ad17f06e9a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -62,6 +62,7 @@ import Wire.API.Routes.QualifiedCapture import Wire.API.Routes.Version import Wire.API.User hiding (NoIdentity) import Wire.API.User.Activation +import Wire.API.User.Auth import Wire.API.User.Client import Wire.API.User.Client.DPoPAccessToken import Wire.API.User.Client.Prekey @@ -1145,26 +1146,26 @@ type SearchAPI = type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) data SomeUserToken - = UserToken (ZAuth.Token ZAuth.User) + = PlainUserToken (ZAuth.Token ZAuth.User) | LHUserToken (ZAuth.Token ZAuth.LegalHoldUser) deriving (Show) instance FromHttpApiData SomeUserToken where parseHeader h = first T.pack $ - fmap UserToken (runParser parser h) + fmap PlainUserToken (runParser parser h) <|> fmap LHUserToken (runParser parser h) parseUrlPiece = parseHeader . T.encodeUtf8 data SomeAccessToken - = AccessToken (ZAuth.Token ZAuth.Access) + = PlainAccessToken (ZAuth.Token ZAuth.Access) | LHAccessToken (ZAuth.Token ZAuth.LegalHoldAccess) deriving (Show) instance FromHttpApiData SomeAccessToken where parseHeader h = first T.pack $ - fmap AccessToken (runParser parser h) + fmap PlainAccessToken (runParser parser h) <|> fmap LHAccessToken (runParser parser h) parseUrlPiece = parseHeader . T.encodeUtf8 @@ -1180,7 +1181,14 @@ type AuthAPI = \ header, with the latter being preferred." :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken - :> MultiVerb1 'POST '[JSON] (Respond 201 "TODO" Text) + :> MultiVerb1 + 'POST + '[JSON] + ( WithHeaders + '[Header "Set-Cookie" SomeCookie] + SomeAccess + (Respond 201 "TODO" AccessToken) + ) ) type BrigAPI = diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index af16c70f1f..a2b5539a57 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -36,6 +36,7 @@ module Wire.API.User.Auth CookieId (..), CookieType (..), Cookie (..), + SomeCookie (..), CookieLabel (..), RemoveCookies (..), @@ -43,6 +44,9 @@ module Wire.API.User.Auth AccessToken (..), bearerToken, TokenType (..), + + -- * Access + SomeAccess (..), ) where @@ -64,6 +68,7 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy.Encoding as LT import Data.Time.Clock (UTCTime) import Data.Tuple.Extra +import qualified Data.ZAuth.Token as ZAuth import Imports import Wire.API.User.Identity (Email, Phone) import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) @@ -239,6 +244,13 @@ deriving via Schema (Cookie ()) instance ToJSON (Cookie ()) deriving via Schema (Cookie ()) instance S.ToSchema (Cookie ()) +data SomeCookie + = PlainCookie (Cookie (ZAuth.Token ZAuth.User)) + | LHCookie (Cookie (ZAuth.Token ZAuth.LegalHoldUser)) + +instance S.ToParamSchema SomeCookie where + toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString + -- | A device-specific identifying label for one or more cookies. -- Cookies can be listed and deleted based on their labels. newtype CookieLabel = CookieLabel @@ -434,3 +446,15 @@ data TokenType = Bearer instance ToSchema TokenType where schema = enum @Text "TokenType" $ element "Bearer" Bearer + +-------------------------------------------------------------------------------- +-- Access + +data Access u = Access + { accessToken :: !AccessToken, + accessCookie :: !(Maybe (Cookie (ZAuth.Token u))) + } + +data SomeAccess + = PlainAccess (Access ZAuth.User) + | LHAccess (Access ZAuth.LegalHoldUser) diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 21bd03fb47..fb5e79c1e8 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -82,11 +82,6 @@ import qualified Wire.API.Team.Feature as Public import Wire.API.User import Wire.API.User.Auth -data Access u = Access - { accessToken :: !AccessToken, - accessCookie :: !(Maybe (Cookie (ZAuth.Token u))) - } - sendLoginCode :: ( MonadClient m, MonadReader Env m, diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index 167f386eb1..8bad3ae0f7 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -247,6 +247,7 @@ instance AccessTokenLike LegalHoldAccess where class (FromByteString (Token u), ToByteString u) => UserTokenLike u where userTokenOf :: Token u -> UserId + mkSomeAccess :: Token u -> Maybe (Cookie (Token u)) -> SomeAccess mkUserToken :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m (Token u) userTokenRand :: Token u -> Word32 newUserToken :: MonadZAuth m => UserId -> m (Token u) From b19d2ee0650553cc1699e9cebaa4d48e9e55d8c2 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 5 Oct 2022 17:19:52 +0200 Subject: [PATCH 09/43] Add Access(..) --- libs/wire-api/src/Wire/API/User/Auth.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index a2b5539a57..f7b48691bf 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -46,6 +46,7 @@ module Wire.API.User.Auth TokenType (..), -- * Access + Access (..), SomeAccess (..), ) where From ae434e01b0d077b77825ac65e85fa241f52af1f7 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 5 Oct 2022 17:37:54 +0200 Subject: [PATCH 10/43] Add mkSomeAccess and mkSomeCookie & adapt --- services/brig/src/Brig/API/Auth.hs | 16 +++++++--------- services/brig/src/Brig/ZAuth.hs | 11 ++++++++++- 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 51be93827a..fd3927d226 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -20,8 +20,8 @@ module Brig.API.Auth where import Brig.API.Error (authTokenMismatch, internalServerError, throwStd, zauthError) import Brig.API.Handler import Brig.App (wrapHttpClientE) -import Brig.User.Auth (Access) import qualified Brig.User.Auth as Auth +import Brig.ZAuth (UserTokenLike (mkSomeAccess)) import qualified Brig.ZAuth as ZAuth import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE @@ -31,15 +31,13 @@ import Imports import Network.Wai.Utilities ((!>>)) import Wire.API.Routes.Public.Brig (SomeUserToken) import Wire.API.Routes.Public.Brig hiding (SomeUserToken) +import Wire.API.User.Auth (SomeAccess) -access :: forall r. NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r Text +access :: forall r. NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess access ut mat = do partitionTokens ut mat >>= either (uncurry renew) (uncurry renew) where - renew t mt = mkResponse <$> wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError - -mkResponse :: Access u -> Text -mkResponse _ = error "TODO" + renew t mt = mkSomeAccess <$> wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError partitionTokens :: NonEmpty SomeUserToken -> @@ -54,11 +52,11 @@ partitionTokens tokens mat = case (partitionEithers (map toEither (NE.toList tokens)), mat) of -- only PlainUserToken ((at : ats, []), Nothing) -> pure (Left (at :| ats, Nothing)) - ((at : ats, []), Just (AccessToken a)) -> pure (Left (at :| ats, Just a)) + ((at : ats, []), Just (PlainAccessToken a)) -> pure (Left (at :| ats, Just a)) ((_t : _ts, []), Just (LHAccessToken _)) -> throwStd authTokenMismatch -- only LHUserToken tokens (([], lt : lts), Nothing) -> pure (Right (lt :| lts, Nothing)) - (([], _t : _ts), Just (AccessToken _)) -> throwStd authTokenMismatch + (([], _t : _ts), Just (PlainAccessToken _)) -> throwStd authTokenMismatch (([], lt : lts), Just (LHAccessToken l)) -> pure (Right (lt :| lts, Just l)) -- impossible (([], []), _) -> throwStd internalServerError @@ -66,5 +64,5 @@ partitionTokens tokens mat = ((_ats, _lts), _) -> throwStd authTokenMismatch where toEither :: SomeUserToken -> Either (ZAuth.Token ZAuth.User) (ZAuth.Token ZAuth.LegalHoldUser) - toEither (UserToken ut) = Left ut + toEither (PlainUserToken ut) = Left ut toEither (LHUserToken lt) = Right lt diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index 8bad3ae0f7..ce9bab4716 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -69,6 +69,8 @@ module Brig.ZAuth -- * Token Inspection accessTokenOf, userTokenOf, + mkSomeAccess, + mkSomeCookie, legalHoldAccessTokenOf, legalHoldUserTokenOf, userTokenRand, @@ -101,6 +103,8 @@ import qualified Data.ZAuth.Validation as ZV import Imports import OpenSSL.Random import Sodium.Crypto.Sign +import Wire.API.User.Auth (Cookie, SomeAccess, SomeCookie) +import qualified Wire.API.User.Auth as Auth newtype ZAuth a = ZAuth {unZAuth :: ReaderT Env IO a} deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env) @@ -247,7 +251,8 @@ instance AccessTokenLike LegalHoldAccess where class (FromByteString (Token u), ToByteString u) => UserTokenLike u where userTokenOf :: Token u -> UserId - mkSomeAccess :: Token u -> Maybe (Cookie (Token u)) -> SomeAccess + mkSomeAccess :: Auth.Access u -> SomeAccess + mkSomeCookie :: Cookie (Token u) -> SomeCookie mkUserToken :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m (Token u) userTokenRand :: Token u -> Word32 newUserToken :: MonadZAuth m => UserId -> m (Token u) @@ -258,6 +263,8 @@ class (FromByteString (Token u), ToByteString u) => UserTokenLike u where instance UserTokenLike User where mkUserToken = mkUserToken' userTokenOf = userTokenOf' + mkSomeAccess = Auth.PlainAccess + mkSomeCookie = Auth.PlainCookie userTokenRand = userTokenRand' newUserToken = newUserToken' newSessionToken uid = newSessionToken' uid @@ -267,6 +274,8 @@ instance UserTokenLike User where instance UserTokenLike LegalHoldUser where mkUserToken = mkLegalHoldUserToken userTokenOf = legalHoldUserTokenOf + mkSomeAccess = Auth.LHAccess + mkSomeCookie = Auth.LHCookie userTokenRand = legalHoldUserTokenRand newUserToken = newLegalHoldUserToken newSessionToken _ = throwM ZV.Unsupported From 35065c29cb4039560b758fd68d41bbc1d176d837 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 6 Oct 2022 10:20:03 +0200 Subject: [PATCH 11/43] Optional response headers in MultiVerb --- .../wire-api/src/Wire/API/Routes/MultiVerb.hs | 25 +++++++++++++++---- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs index 4893b29ab3..dc254eae11 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs @@ -312,6 +312,9 @@ instance AsHeaders '[h] a (a, h) where data DescHeader (name :: Symbol) (desc :: Symbol) (a :: *) +-- | A wrapper to turn a response header into an optional one. +data OptHeader h + class ServantHeaders hs xs | hs -> xs where constructHeaders :: NP I xs -> [HTTP.Header] extractHeaders :: Seq HTTP.Header -> Maybe (NP I xs) @@ -337,8 +340,8 @@ instance ServantHeaders (h ': hs) (x ': xs) where constructHeaders (I x :* xs) = - (headerName @name, toHeader x) : - constructHeaders @hs xs + constructHeader @h x + <> constructHeaders @hs xs -- FUTUREWORK: should we concatenate all the matching headers instead of just -- taking the first one? @@ -351,11 +354,23 @@ instance xs <- extractHeaders @hs hs1 pure (I x :* xs) -class ServantHeader h (name :: Symbol) x | h -> name x +class ServantHeader h (name :: Symbol) x | h -> name x where + constructHeader :: x -> [HTTP.Header] + +instance + (KnownSymbol name, ToHttpApiData x) => + ServantHeader (Header' mods name x) name x + where + constructHeader x = [(headerName @name, toHeader x)] -instance ServantHeader (Header' mods name x) name x +instance + (KnownSymbol name, ToHttpApiData x) => + ServantHeader (DescHeader name desc x) name x + where + constructHeader x = [(headerName @name, toHeader x)] -instance ServantHeader (DescHeader name desc x) name x +instance ServantHeader h name x => ServantHeader (OptHeader h) name (Maybe x) where + constructHeader = foldMap (constructHeader @h) instance (KnownSymbol name, KnownSymbol desc, S.ToParamSchema a) => From 39548c155eb80ebec3d4d9d41d0869ac92f75925 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 6 Oct 2022 12:04:09 +0200 Subject: [PATCH 12/43] Replace SomeCookie with UserTokenCookie --- .../wire-api/src/Wire/API/Routes/MultiVerb.hs | 4 + .../src/Wire/API/Routes/Public/Brig.hs | 30 +------ libs/wire-api/src/Wire/API/User/Auth.hs | 85 +++++++++++++++---- services/brig/src/Brig/API/Auth.hs | 4 +- services/brig/src/Brig/User/Auth.hs | 2 +- services/brig/src/Brig/ZAuth.hs | 23 +++-- 6 files changed, 92 insertions(+), 56 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs index dc254eae11..20d7505f8f 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs @@ -28,6 +28,7 @@ module Wire.API.Routes.MultiVerb RespondStreaming, WithHeaders, DescHeader, + OptHeader, AsHeaders (..), AsUnion (..), eitherToUnion, @@ -382,6 +383,9 @@ instance desc = Text.pack (symbolVal (Proxy @desc)) sch = S.toParamSchema (Proxy @a) +instance ToResponseHeader h => ToResponseHeader (OptHeader h) where + toResponseHeader _ = toResponseHeader (Proxy @h) + type instance ResponseType (WithHeaders hs a r) = a instance diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index ad17f06e9a..ef182baef6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -20,7 +20,6 @@ module Wire.API.Routes.Public.Brig where import qualified Data.Aeson as A (FromJSON, ToJSON, Value) -import Data.Bifunctor import Data.ByteString.Conversion import Data.Code (Timeout) import Data.CommaSeparatedList (CommaSeparatedList) @@ -35,9 +34,6 @@ import Data.SOP import Data.Schema as Schema import Data.Swagger hiding (Contact, Header, Schema, ToSchema) import qualified Data.Swagger as S -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.ZAuth.Token as ZAuth import qualified Generics.SOP as GSOP import Imports hiding (head) import Network.Wai.Utilities @@ -1145,30 +1141,6 @@ type SearchAPI = type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) -data SomeUserToken - = PlainUserToken (ZAuth.Token ZAuth.User) - | LHUserToken (ZAuth.Token ZAuth.LegalHoldUser) - deriving (Show) - -instance FromHttpApiData SomeUserToken where - parseHeader h = - first T.pack $ - fmap PlainUserToken (runParser parser h) - <|> fmap LHUserToken (runParser parser h) - parseUrlPiece = parseHeader . T.encodeUtf8 - -data SomeAccessToken - = PlainAccessToken (ZAuth.Token ZAuth.Access) - | LHAccessToken (ZAuth.Token ZAuth.LegalHoldAccess) - deriving (Show) - -instance FromHttpApiData SomeAccessToken where - parseHeader h = - first T.pack $ - fmap PlainAccessToken (runParser parser h) - <|> fmap LHAccessToken (runParser parser h) - parseUrlPiece = parseHeader . T.encodeUtf8 - type AuthAPI = Named "access" @@ -1185,7 +1157,7 @@ type AuthAPI = 'POST '[JSON] ( WithHeaders - '[Header "Set-Cookie" SomeCookie] + '[OptHeader (Header "Set-Cookie" UserTokenCookie)] SomeAccess (Respond 201 "TODO" AccessToken) ) diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index f7b48691bf..64fd1b79a4 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -36,7 +36,6 @@ module Wire.API.User.Auth CookieId (..), CookieType (..), Cookie (..), - SomeCookie (..), CookieLabel (..), RemoveCookies (..), @@ -44,10 +43,14 @@ module Wire.API.User.Auth AccessToken (..), bearerToken, TokenType (..), + SomeUserToken (..), + SomeAccessToken (..), + UserTokenCookie (..), -- * Access - Access (..), - SomeAccess (..), + AccessWithCookie (..), + Access, + SomeAccess, ) where @@ -56,6 +59,7 @@ import Control.Lens ((?~)) import Control.Lens.TH import Data.Aeson (FromJSON, ToJSON) import qualified Data.Aeson.Types as A +import Data.Bifunctor import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LBS import Data.Code as Code @@ -63,14 +67,18 @@ import Data.Handle (Handle) import Data.Id (UserId) import Data.Json.Util import Data.Misc (PlainTextPassword (..)) +import Data.SOP import Data.Schema import qualified Data.Swagger as S +import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy.Encoding as LT import Data.Time.Clock (UTCTime) -import Data.Tuple.Extra +import Data.Tuple.Extra hiding (first) import qualified Data.ZAuth.Token as ZAuth import Imports +import Web.HttpApiData +import Wire.API.Routes.MultiVerb import Wire.API.User.Identity (Email, Phone) import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) @@ -245,13 +253,6 @@ deriving via Schema (Cookie ()) instance ToJSON (Cookie ()) deriving via Schema (Cookie ()) instance S.ToSchema (Cookie ()) -data SomeCookie - = PlainCookie (Cookie (ZAuth.Token ZAuth.User)) - | LHCookie (Cookie (ZAuth.Token ZAuth.LegalHoldUser)) - -instance S.ToParamSchema SomeCookie where - toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString - -- | A device-specific identifying label for one or more cookies. -- Cookies can be listed and deleted based on their labels. newtype CookieLabel = CookieLabel @@ -451,11 +452,63 @@ instance ToSchema TokenType where -------------------------------------------------------------------------------- -- Access -data Access u = Access +-- summary of types involved: +-- +-- user tokens SomeUserToken = Token User + Token LHUser +-- access tokens SomeAccessToken = Token Access + Token LHAccess + +-- session: Cookie (Token u) (used in DB) + +-- cookie: UserTokenCookie + +data AccessWithCookie c = Access { accessToken :: !AccessToken, - accessCookie :: !(Maybe (Cookie (ZAuth.Token u))) + accessCookie :: !(Maybe c) } + deriving (Functor) -data SomeAccess - = PlainAccess (Access ZAuth.User) - | LHAccess (Access ZAuth.LegalHoldUser) +type Access u = AccessWithCookie (Cookie (ZAuth.Token u)) + +type SomeAccess = AccessWithCookie UserTokenCookie + +instance AsHeaders '[Maybe UserTokenCookie] AccessToken SomeAccess where + toHeaders (Access at c) = (I c :* Nil, at) + fromHeaders (I c :* Nil, at) = Access at c + +-------------------------------------------------------------------------------- +-- Token sum types + +data SomeUserToken + = PlainUserToken (ZAuth.Token ZAuth.User) + | LHUserToken (ZAuth.Token ZAuth.LegalHoldUser) + deriving (Show) + +instance FromHttpApiData SomeUserToken where + parseHeader h = + first T.pack $ + fmap PlainUserToken (runParser parser h) + <|> fmap LHUserToken (runParser parser h) + parseUrlPiece = parseHeader . T.encodeUtf8 + +data SomeAccessToken + = PlainAccessToken (ZAuth.Token ZAuth.Access) + | LHAccessToken (ZAuth.Token ZAuth.LegalHoldAccess) + deriving (Show) + +instance FromHttpApiData SomeAccessToken where + parseHeader h = + first T.pack $ + fmap PlainAccessToken (runParser parser h) + <|> fmap LHAccessToken (runParser parser h) + parseUrlPiece = parseHeader . T.encodeUtf8 + +-- | Data that is returned to the client in the form of a cookie containing a +-- user token. +data UserTokenCookie = UserTokenCookie + { utcType :: CookieType, + utcExpires :: UTCTime, + utcToken :: SomeUserToken + } + +instance S.ToParamSchema UserTokenCookie where + toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index fd3927d226..1144842371 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -29,9 +29,7 @@ import Data.List1 (List1 (..)) import qualified Data.ZAuth.Token as ZAuth import Imports import Network.Wai.Utilities ((!>>)) -import Wire.API.Routes.Public.Brig (SomeUserToken) -import Wire.API.Routes.Public.Brig hiding (SomeUserToken) -import Wire.API.User.Auth (SomeAccess) +import Wire.API.User.Auth access :: forall r. NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess access ut mat = do diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index fb5e79c1e8..f67317b047 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -17,7 +17,7 @@ -- | High-level user authentication and access control. module Brig.User.Auth - ( Access (..), + ( Access, sendLoginCode, login, logout, diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index ce9bab4716..c275c106a6 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -70,7 +70,7 @@ module Brig.ZAuth accessTokenOf, userTokenOf, mkSomeAccess, - mkSomeCookie, + mkUserTokenCookie, legalHoldAccessTokenOf, legalHoldUserTokenOf, userTokenRand, @@ -103,7 +103,7 @@ import qualified Data.ZAuth.Validation as ZV import Imports import OpenSSL.Random import Sodium.Crypto.Sign -import Wire.API.User.Auth (Cookie, SomeAccess, SomeCookie) +import Wire.API.User.Auth (Cookie, SomeAccess) import qualified Wire.API.User.Auth as Auth newtype ZAuth a = ZAuth {unZAuth :: ReaderT Env IO a} @@ -252,7 +252,8 @@ instance AccessTokenLike LegalHoldAccess where class (FromByteString (Token u), ToByteString u) => UserTokenLike u where userTokenOf :: Token u -> UserId mkSomeAccess :: Auth.Access u -> SomeAccess - mkSomeCookie :: Cookie (Token u) -> SomeCookie + mkSomeAccess = fmap mkUserTokenCookie + mkUserTokenCookie :: Cookie (Token u) -> Auth.UserTokenCookie mkUserToken :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m (Token u) userTokenRand :: Token u -> Word32 newUserToken :: MonadZAuth m => UserId -> m (Token u) @@ -263,8 +264,12 @@ class (FromByteString (Token u), ToByteString u) => UserTokenLike u where instance UserTokenLike User where mkUserToken = mkUserToken' userTokenOf = userTokenOf' - mkSomeAccess = Auth.PlainAccess - mkSomeCookie = Auth.PlainCookie + mkUserTokenCookie c = + Auth.UserTokenCookie + { Auth.utcType = Auth.cookieType c, + Auth.utcExpires = Auth.cookieExpires c, + Auth.utcToken = Auth.PlainUserToken (Auth.cookieValue c) + } userTokenRand = userTokenRand' newUserToken = newUserToken' newSessionToken uid = newSessionToken' uid @@ -274,8 +279,12 @@ instance UserTokenLike User where instance UserTokenLike LegalHoldUser where mkUserToken = mkLegalHoldUserToken userTokenOf = legalHoldUserTokenOf - mkSomeAccess = Auth.LHAccess - mkSomeCookie = Auth.LHCookie + mkUserTokenCookie c = + Auth.UserTokenCookie + { Auth.utcType = Auth.cookieType c, + Auth.utcExpires = Auth.cookieExpires c, + Auth.utcToken = Auth.LHUserToken (Auth.cookieValue c) + } userTokenRand = legalHoldUserTokenRand newUserToken = newLegalHoldUserToken newSessionToken _ = throwM ZV.Unsupported From b0d10a68dbb8e6db92435396192391fecb5b3ad9 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 6 Oct 2022 13:27:08 +0200 Subject: [PATCH 13/43] Finish servantification of access endpoint --- libs/wire-api/src/Wire/API/User/Auth.hs | 52 +++++++++++++++++++++++-- services/brig/src/Brig/API/Auth.hs | 26 +++++++++++-- services/brig/src/Brig/ZAuth.hs | 22 ++--------- 3 files changed, 74 insertions(+), 26 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index 64fd1b79a4..70d3fb7259 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -60,6 +60,7 @@ import Control.Lens.TH import Data.Aeson (FromJSON, ToJSON) import qualified Data.Aeson.Types as A import Data.Bifunctor +import Data.ByteString.Builder import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LBS import Data.Code as Code @@ -77,6 +78,7 @@ import Data.Time.Clock (UTCTime) import Data.Tuple.Extra hiding (first) import qualified Data.ZAuth.Token as ZAuth import Imports +import Web.Cookie import Web.HttpApiData import Wire.API.Routes.MultiVerb import Wire.API.User.Identity (Email, Phone) @@ -465,7 +467,7 @@ data AccessWithCookie c = Access { accessToken :: !AccessToken, accessCookie :: !(Maybe c) } - deriving (Functor) + deriving (Functor, Foldable, Traversable) type Access u = AccessWithCookie (Cookie (ZAuth.Token u)) @@ -490,6 +492,15 @@ instance FromHttpApiData SomeUserToken where <|> fmap LHUserToken (runParser parser h) parseUrlPiece = parseHeader . T.encodeUtf8 +instance FromByteString SomeUserToken where + parser = + PlainUserToken <$> parser + <|> LHUserToken <$> parser + +instance ToByteString SomeUserToken where + builder (PlainUserToken t) = builder t + builder (LHUserToken t) = builder t + data SomeAccessToken = PlainAccessToken (ZAuth.Token ZAuth.Access) | LHAccessToken (ZAuth.Token ZAuth.LegalHoldAccess) @@ -505,10 +516,43 @@ instance FromHttpApiData SomeAccessToken where -- | Data that is returned to the client in the form of a cookie containing a -- user token. data UserTokenCookie = UserTokenCookie - { utcType :: CookieType, - utcExpires :: UTCTime, - utcToken :: SomeUserToken + { utcExpires :: Maybe UTCTime, + utcToken :: SomeUserToken, + utcSecure :: Bool } +utcFromSetCookie :: SetCookie -> Either Text UserTokenCookie +utcFromSetCookie c = do + v <- first T.pack $ runParser parser (setCookieValue c) + pure + UserTokenCookie + { utcToken = v, + utcExpires = setCookieExpires c, + utcSecure = setCookieSecure c + } + +utcToSetCookie :: UserTokenCookie -> SetCookie +utcToSetCookie c = + def + { setCookieName = "zuid", + setCookieValue = toByteString' (utcToken c), + setCookiePath = Just "/access", + setCookieExpires = utcExpires c, + setCookieSecure = utcSecure c, + setCookieHttpOnly = True + } + instance S.ToParamSchema UserTokenCookie where toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString + +instance FromHttpApiData UserTokenCookie where + parseHeader = utcFromSetCookie . parseSetCookie + parseUrlPiece = parseHeader . T.encodeUtf8 + +instance ToHttpApiData UserTokenCookie where + toHeader = + LBS.toStrict + . toLazyByteString + . renderSetCookie + . utcToSetCookie + toUrlPiece = T.decodeUtf8 . toHeader diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 1144842371..77c5032043 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -19,10 +19,11 @@ module Brig.API.Auth where import Brig.API.Error (authTokenMismatch, internalServerError, throwStd, zauthError) import Brig.API.Handler -import Brig.App (wrapHttpClientE) +import Brig.App +import Brig.Options import qualified Brig.User.Auth as Auth -import Brig.ZAuth (UserTokenLike (mkSomeAccess)) -import qualified Brig.ZAuth as ZAuth +import Brig.ZAuth hiding (Env, settings) +import Control.Lens (view) import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE import Data.List1 (List1 (..)) @@ -35,7 +36,24 @@ access :: forall r. NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r access ut mat = do partitionTokens ut mat >>= either (uncurry renew) (uncurry renew) where - renew t mt = mkSomeAccess <$> wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError + renew t mt = + traverse mkUserTokenCookie + =<< wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError + +mkUserTokenCookie :: + (MonadReader Env m, UserTokenLike u) => + Cookie (Token u) -> + m UserTokenCookie +mkUserTokenCookie c = do + s <- view settings + pure + UserTokenCookie + { utcExpires = + guard (cookieType c == PersistentCookie) + $> cookieExpires c, + utcToken = mkSomeToken (cookieValue c), + utcSecure = not (setCookieInsecure s) + } partitionTokens :: NonEmpty SomeUserToken -> diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index c275c106a6..1a7c2d9403 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -50,6 +50,7 @@ module Brig.ZAuth -- * Token Creation Token, mkUserToken, + mkSomeToken, newUserToken, newSessionToken, newAccessToken, @@ -69,8 +70,6 @@ module Brig.ZAuth -- * Token Inspection accessTokenOf, userTokenOf, - mkSomeAccess, - mkUserTokenCookie, legalHoldAccessTokenOf, legalHoldUserTokenOf, userTokenRand, @@ -103,7 +102,6 @@ import qualified Data.ZAuth.Validation as ZV import Imports import OpenSSL.Random import Sodium.Crypto.Sign -import Wire.API.User.Auth (Cookie, SomeAccess) import qualified Wire.API.User.Auth as Auth newtype ZAuth a = ZAuth {unZAuth :: ReaderT Env IO a} @@ -251,9 +249,7 @@ instance AccessTokenLike LegalHoldAccess where class (FromByteString (Token u), ToByteString u) => UserTokenLike u where userTokenOf :: Token u -> UserId - mkSomeAccess :: Auth.Access u -> SomeAccess - mkSomeAccess = fmap mkUserTokenCookie - mkUserTokenCookie :: Cookie (Token u) -> Auth.UserTokenCookie + mkSomeToken :: Token u -> Auth.SomeUserToken mkUserToken :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m (Token u) userTokenRand :: Token u -> Word32 newUserToken :: MonadZAuth m => UserId -> m (Token u) @@ -264,12 +260,7 @@ class (FromByteString (Token u), ToByteString u) => UserTokenLike u where instance UserTokenLike User where mkUserToken = mkUserToken' userTokenOf = userTokenOf' - mkUserTokenCookie c = - Auth.UserTokenCookie - { Auth.utcType = Auth.cookieType c, - Auth.utcExpires = Auth.cookieExpires c, - Auth.utcToken = Auth.PlainUserToken (Auth.cookieValue c) - } + mkSomeToken = Auth.PlainUserToken userTokenRand = userTokenRand' newUserToken = newUserToken' newSessionToken uid = newSessionToken' uid @@ -279,12 +270,7 @@ instance UserTokenLike User where instance UserTokenLike LegalHoldUser where mkUserToken = mkLegalHoldUserToken userTokenOf = legalHoldUserTokenOf - mkUserTokenCookie c = - Auth.UserTokenCookie - { Auth.utcType = Auth.cookieType c, - Auth.utcExpires = Auth.cookieExpires c, - Auth.utcToken = Auth.LHUserToken (Auth.cookieValue c) - } + mkSomeToken = Auth.LHUserToken userTokenRand = legalHoldUserTokenRand newUserToken = newLegalHoldUserToken newSessionToken _ = throwM ZV.Unsupported From 2a28f5cb6192f6ce3eb2366ec9d225759440c487 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 6 Oct 2022 15:47:09 +0200 Subject: [PATCH 14/43] Servantify send-login-code --- .../src/Wire/API/Routes/Public/Brig.hs | 16 + services/brig/src/Brig/API/Auth.hs | 13 +- services/brig/src/Brig/API/Public.hs | 1 + services/brig/src/Brig/User/API/Auth.hs | 348 ------------------ 4 files changed, 28 insertions(+), 350 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index ef182baef6..fdba5b53e8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1162,6 +1162,22 @@ type AuthAPI = (Respond 201 "TODO" AccessToken) ) ) + :<|> Named + "send-login-code" + ( "login" :> "send" + :> Summary "Send a login code to a verified phone number" + :> Description + "This operation generates and sends a login code via sms for phone login.\ + \ A login code can be used only once and times out after\ + \ 10 minutes. Only one login code may be pending at a time.\ + \ For 2nd factor authentication login with email and password, use the\ + \ `/verification-code/send` endpoint." + :> ReqBody '[JSON] SendLoginCode + :> MultiVerb1 + 'POST + '[JSON] + (Respond 201 "TODO" LoginCodeTimeout) + ) type BrigAPI = UserAPI diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 77c5032043..5658f715a8 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -17,7 +17,7 @@ module Brig.API.Auth where -import Brig.API.Error (authTokenMismatch, internalServerError, throwStd, zauthError) +import Brig.API.Error import Brig.API.Handler import Brig.App import Brig.Options @@ -32,7 +32,7 @@ import Imports import Network.Wai.Utilities ((!>>)) import Wire.API.User.Auth -access :: forall r. NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess +access :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess access ut mat = do partitionTokens ut mat >>= either (uncurry renew) (uncurry renew) where @@ -40,6 +40,15 @@ access ut mat = do traverse mkUserTokenCookie =<< wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError +sendLoginCode :: SendLoginCode -> Handler r LoginCodeTimeout +sendLoginCode (SendLoginCode phone call force) = do + checkWhitelist (Right phone) + c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError + pure $ LoginCodeTimeout (pendingLoginTimeout c) + +-------------------------------------------------------------------------------- +-- Utils + mkUserTokenCookie :: (MonadReader Env m, UserTokenLike u) => Cookie (Token u) -> diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 396186eb69..fbcbe8ad14 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -289,6 +289,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey authAPI :: ServerT AuthAPI (Handler r) authAPI = Named @"access" access + :<|> Named @"send-login-code" sendLoginCode -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index 31e022d28a..d8672e269d 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -32,351 +32,3 @@ routesPublic = pure () routesInternal :: Routes a (Handler r) () routesInternal = pure () - --- Note: this endpoint should always remain available at its unversioned --- path, since the login cookie hardcodes @/access@ as a path. --- post "/access" (continue renewH) $ --- accept "application" "json" --- .&. tokenRequest --- document "POST" "newAccessToken" $ do --- Doc.summary "Obtain an access tokens for a cookie." --- Doc.notes --- "You can provide only a cookie or a cookie and token. \ --- \Every other combination is invalid. \ --- \Access tokens can be given as query parameter or authorisation \ --- \header, with the latter being preferred." --- Doc.returns (Doc.ref Public.modelAccessToken) --- Doc.parameter Doc.Header "cookie" Doc.bytes' $ do --- Doc.description "The 'zuid' cookie header" --- Doc.optional --- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do --- Doc.description "The access-token as 'Authorization' header." --- Doc.optional --- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do --- Doc.description "The access-token as query parameter." --- Doc.optional --- Doc.errorResponse (errorToWai @'E.BadCredentials) - --- post "/login/send" (continue sendLoginCodeH) $ --- jsonRequest @Public.SendLoginCode --- document "POST" "sendLoginCode" $ do --- Doc.summary "Send a login code to a verified phone number." --- Doc.notes --- "This operation generates and sends a login code via sms for phone login. \ --- \A login code can be used only once and times out after \ --- \10 minutes. Only one login code may be pending at a time.\ --- \For 2nd factor authentication login with email and password, use the `/verification-code/send` endpoint." --- Doc.body (Doc.ref Public.modelSendLoginCode) $ --- Doc.description "JSON body" --- Doc.returns (Doc.ref Public.modelLoginCodeResponse) --- Doc.response 200 "Login code sent." Doc.end --- Doc.errorResponse (errorToWai @'E.InvalidPhone) --- Doc.errorResponse passwordExists --- Doc.errorResponse' loginCodePending Doc.pendingLoginError - --- -- This endpoint is used to test /i/metrics, when this is servantified, please --- -- make sure some other wai-route endpoint is used to test that routes defined in --- -- this function ('Brig.API.Public.sitemap') are recorded and reported correctly in /i/metrics. --- -- see test/integration/API/Metrics.hs --- post "/login" (continue loginH) $ --- jsonRequest @Public.Login --- .&. def False (query "persist") --- .&. accept "application" "json" --- document "POST" "login" $ do --- Doc.summary "Authenticate a user to obtain a cookie and first access token." --- Doc.notes "Logins are throttled at the server's discretion." --- Doc.body (Doc.ref Public.modelLogin) $ --- Doc.description --- "The optional label can later be used to delete all \ --- \cookies matching this label (cf. /cookies/remove)." --- Doc.parameter Doc.Query "persist" (Doc.bool $ Doc.def False) $ do --- Doc.description "Request a persistent cookie instead of a session cookie." --- Doc.optional --- Doc.errorResponse (errorToWai @'E.BadCredentials) --- Doc.errorResponse accountSuspended --- Doc.errorResponse accountPending --- Doc.errorResponse loginCodeAuthenticationFailed --- Doc.errorResponse loginCodeAuthenticationRequired - --- post "/access/logout" (continue logoutH) $ --- accept "application" "json" .&. tokenRequest --- document "POST" "logout" $ do --- Doc.summary "Log out in order to remove a cookie from the server." --- Doc.notes --- "Calling this endpoint will effectively revoke the given cookie \ --- \and subsequent calls to /access with the same cookie will \ --- \result in a 403." --- Doc.parameter Doc.Header "cookie" Doc.bytes' $ --- Doc.description "The 'zuid' cookie header" --- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do --- Doc.description "The access-token as 'Authorization' header." --- Doc.optional --- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do --- Doc.description "The access-token as query parameter." --- Doc.optional --- Doc.errorResponse (errorToWai @'E.BadCredentials) - --- put "/access/self/email" (continue changeSelfEmailH) $ --- accept "application" "json" --- .&. jsonRequest @Public.EmailUpdate --- .&. tokenRequest --- document "PUT" "changeEmail" $ do --- Doc.summary "Change your email address" --- Doc.parameter Doc.Header "cookie" Doc.bytes' $ --- Doc.description "The 'zuid' cookie header" --- Doc.parameter Doc.Header "Authorization" Doc.bytes' $ do --- Doc.description "The access-token as 'Authorization' header." --- Doc.optional --- Doc.parameter Doc.Query "access_token" Doc.bytes' $ do --- Doc.description "The access-token as query parameter." --- Doc.optional --- Doc.body (Doc.ref Public.modelEmailUpdate) $ --- Doc.description "JSON body" --- Doc.response 202 "Update accepted and pending activation of the new email." Doc.end --- Doc.response 204 "No update, current and new email address are the same." Doc.end --- Doc.errorResponse (errorToWai @'E.InvalidEmail) --- Doc.errorResponse (errorToWai @'E.UserKeyExists) --- Doc.errorResponse blacklistedEmail --- Doc.errorResponse (errorToWai @'E.BlacklistedPhone) --- Doc.errorResponse missingAccessToken --- Doc.errorResponse invalidAccessToken --- Doc.errorResponse (errorToWai @'E.BadCredentials) - --- get "/cookies" (continue listCookiesH) $ --- header "Z-User" --- .&. opt (query "labels") --- .&. accept "application" "json" --- document "GET" "getCookies" $ do --- Doc.summary "Retrieve the list of cookies currently stored for the user." --- Doc.returns (Doc.ref Public.modelCookieList) --- Doc.parameter Doc.Query "labels" Doc.bytes' $ do --- Doc.description "Filter by label (comma-separated list)" --- Doc.optional - --- post "/cookies/remove" (continue rmCookiesH) $ --- header "Z-User" --- .&. jsonRequest @Public.RemoveCookies --- document "POST" "rmCookies" $ do --- Doc.summary "Revoke stored cookies." --- Doc.body (Doc.ref Public.modelRemoveCookies) Doc.end --- Doc.errorResponse (errorToWai @'E.BadCredentials) - --- do --- -- galley can query this endpoint at the right moment in the LegalHold flow --- post "/i/legalhold-login" (continue legalHoldLoginH) $ --- jsonRequest @LegalHoldLogin --- .&. accept "application" "json" - --- post "/i/sso-login" (continue ssoLoginH) $ --- jsonRequest @SsoLogin --- .&. def False (query "persist") --- .&. accept "application" "json" - --- get "/i/users/login-code" (continue getLoginCodeH) $ --- accept "application" "json" --- .&. param "phone" - --- get "/i/users/:uid/reauthenticate" (continue reAuthUserH) $ --- capture "uid" --- .&. jsonRequest @ReAuthUser - ----- Handlers - ---sendLoginCodeH :: JsonRequest Public.SendLoginCode -> (Handler r) Response ---sendLoginCodeH req = do --- json <$> (sendLoginCode =<< parseJsonBody req) - ---sendLoginCode :: Public.SendLoginCode -> (Handler r) Public.LoginCodeTimeout ---sendLoginCode (Public.SendLoginCode phone call force) = do --- checkWhitelist (Right phone) --- c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError --- pure $ Public.LoginCodeTimeout (pendingLoginTimeout c) - ---getLoginCodeH :: JSON ::: Phone -> (Handler r) Response ---getLoginCodeH (_ ::: phone) = json <$> getLoginCode phone - ---login :: Public.Login -> Bool -> (Handler r) (Auth.Access ZAuth.User) ---login l persist = do --- let typ = if persist then PersistentCookie else SessionCookie --- wrapHttpClientE (Auth.login l typ) !>> loginError - ---ssoLoginH :: JsonRequest SsoLogin ::: Bool ::: JSON -> (Handler r) Response ---ssoLoginH (req ::: persist ::: _) = do --- lift . tokenResponse =<< flip ssoLogin persist =<< parseJsonBody req - ---legalHoldLogin :: LegalHoldLogin -> (Handler r) (Auth.Access ZAuth.LegalHoldUser) ---legalHoldLogin l = do --- let typ = PersistentCookie -- Session cookie isn't a supported use case here --- wrapHttpClientE (Auth.legalHoldLogin l typ) !>> legalHoldLoginError - ---logoutH :: JSON ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> (Handler r) Response ---logoutH (_ ::: ut ::: at) = empty <$ logout ut at - ----- TODO: add legalhold test checking cookies are revoked (/access/logout is called) when legalhold device is deleted. ---logout :: --- Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) -> --- Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> --- (Handler r) () ---logout Nothing Nothing = throwStd authMissingCookieAndToken ---logout Nothing (Just _) = throwStd authMissingCookie ---logout (Just _) Nothing = throwStd authMissingToken ---logout (Just (Left _)) (Just (Right _)) = throwStd authTokenMismatch ---logout (Just (Right _)) (Just (Left _)) = throwStd authTokenMismatch ---logout (Just (Left ut)) (Just (Left at)) = wrapHttpClientE (Auth.logout ut at) !>> zauthError ---logout (Just (Right ut)) (Just (Right at)) = wrapHttpClientE (Auth.logout ut at) !>> zauthError - ---changeSelfEmailH :: --- Member BlacklistStore r => --- JSON --- ::: JsonRequest Public.EmailUpdate --- ::: Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) --- ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) -> --- (Handler r) Response ---changeSelfEmailH (_ ::: req ::: ckies ::: toks) = do --- usr <- validateCredentials ckies toks --- email <- Public.euEmail <$> parseJsonBody req --- User.changeSelfEmail usr email User.ForbidSCIMUpdates >>= \case --- ChangeEmailResponseIdempotent -> pure (WaiResp.setStatus status204 empty) --- ChangeEmailResponseNeedsActivation -> pure (WaiResp.setStatus status202 empty) --- where --- validateCredentials = \case --- Nothing -> --- const $ throwStd authMissingCookie --- Just (Right _legalholdUserTokens) -> --- const $ throwStd authInvalidCookie --- Just (Left userCookies) -> --- \case --- Nothing -> --- throwStd missingAccessToken --- Just (Right _legalholdAccessToken) -> --- throwStd invalidAccessToken --- Just (Left userTokens) -> --- fst <$> wrapHttpClientE (Auth.validateTokens userCookies (Just userTokens)) !>> zauthError - ---listCookiesH :: UserId ::: Maybe (List Public.CookieLabel) ::: JSON -> (Handler r) Response ---listCookiesH (u ::: ll ::: _) = json <$> lift (listCookies u ll) - ---listCookies :: UserId -> Maybe (List Public.CookieLabel) -> (AppT r) Public.CookieList ---listCookies u ll = do --- Public.CookieList <$> wrapClient (Auth.listCookies u (maybe [] fromList ll)) - ---rmCookiesH :: UserId ::: JsonRequest Public.RemoveCookies -> (Handler r) Response ---rmCookiesH (uid ::: req) = do --- empty <$ (rmCookies uid =<< parseJsonBody req) - ---rmCookies :: UserId -> Public.RemoveCookies -> (Handler r) () ---rmCookies uid (Public.RemoveCookies pw lls ids) = --- wrapClientE (Auth.revokeAccess uid pw ids lls) !>> authError - ----- _renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> (Handler r) Response ----- _renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at - ----- | renew access for either: ----- * a user with user token and optional access token, or ----- * a legalhold user with legalhold user token and optional legalhold access token. ----- ----- Other combinations of provided inputs will cause an error to be raised. ----- renew :: ----- Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) -> ----- Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> ----- (Handler r) (Either (Auth.Access ZAuth.User) (Auth.Access ZAuth.LegalHoldUser)) ----- renew = \case ----- Nothing -> ----- const $ throwStd authMissingCookie ----- (Just (Left userTokens)) -> ----- -- normal UserToken, so we want a normal AccessToken ----- fmap Left . wrapHttpClientE . renewAccess userTokens <=< matchingOrNone leftToMaybe ----- (Just (Right legalholdUserTokens)) -> ----- -- LegalholdUserToken, so we want a LegalholdAccessToken ----- fmap Right . wrapHttpClientE . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe ----- where ----- renewAccess uts mat = ----- Auth.renewAccess uts mat !>> zauthError ----- matchingOrNone :: (a -> Maybe b) -> Maybe a -> (Handler r) (Maybe b) ----- matchingOrNone matching = traverse $ \accessToken -> ----- case matching accessToken of ----- Just m -> pure m ----- Nothing -> throwStd authTokenMismatch - ----- Utilities ----- - ----- | A predicate that captures user and access tokens for a request handler. ---tokenRequest :: --- forall r. --- (R.HasCookies r, R.HasHeaders r, R.HasQuery r) => --- Predicate --- r --- P.Error --- ( Maybe (Either (List1 (ZAuth.Token ZAuth.User)) (List1 (ZAuth.Token ZAuth.LegalHoldUser))) --- ::: Maybe (Either (ZAuth.Token ZAuth.Access) (ZAuth.Token ZAuth.LegalHoldAccess)) --- ) ---tokenRequest = opt (userToken ||| legalHoldUserToken) .&. opt (accessToken ||| legalHoldAccessToken) --- where --- userToken = cookieErr @ZAuth.User <$> cookies "zuid" --- legalHoldUserToken = cookieErr @ZAuth.LegalHoldUser <$> cookies "zuid" --- accessToken = parse @ZAuth.Access <$> (tokenHeader .|. tokenQuery) --- legalHoldAccessToken = parse @ZAuth.LegalHoldAccess <$> (tokenHeader .|. tokenQuery) - --- tokenHeader :: r -> Result P.Error ByteString --- tokenHeader = bearer <$> header "authorization" - --- tokenQuery :: r -> Result P.Error ByteString --- tokenQuery = query "access_token" - --- cookieErr :: Result P.Error (List1 (ZAuth.Token u)) -> Result P.Error (List1 (ZAuth.Token u)) --- cookieErr x@Okay {} = x --- cookieErr (Fail x) = Fail (setMessage "Invalid user token" (P.setStatus status403 x)) - --- -- Extract the access token from the Authorization header. --- bearer :: Result P.Error ByteString -> Result P.Error ByteString --- bearer (Fail x) = Fail x --- bearer (Okay _ b) = --- let (prefix, suffix) = BS.splitAt 7 b --- in if prefix == "Bearer " --- then pure suffix --- else --- Fail --- ( setReason --- TypeError --- (setMessage "Invalid authorization scheme" (err status403)) --- ) - --- -- Parse the access token --- parse :: ZAuth.AccessTokenLike a => Result P.Error ByteString -> Result P.Error (ZAuth.Token a) --- parse (Fail x) = Fail x --- parse (Okay _ b) = case fromByteString b of --- Nothing -> --- Fail --- ( setReason --- TypeError --- (setMessage "Invalid access token" (err status403)) --- ) --- Just t -> pure t - ---tokenResponse :: ZAuth.UserTokenLike u => Auth.Access u -> (AppT r) Response ---tokenResponse (Auth.Access t Nothing) = pure $ json t ---tokenResponse (Auth.Access t (Just c)) = Auth.setResponseCookie c (json t) - ----- | Internal utilities: These functions are nearly copies verbatim from the original ----- project: https://gitlab.com/twittner/wai-predicates/-/blob/develop/src/Network/Wai/Predicate.hs#L106-112 ----- I will still make an upstream PR but would not like to block this PR because of ----- it. Main difference: the original stops after finding the first valid cookie which ----- is a problem if clients send more than 1 cookie and one of them happens to be invalid ----- We should also be dropping this in favor of servant which will make this redundant ---cookies :: (R.HasCookies r, FromByteString a) => ByteString -> Predicate r P.Error (List1 a) ---cookies k r = --- case R.lookupCookie k r of --- [] -> Fail . addLabel "cookie" $ notAvailable k --- cc -> --- case mapMaybe fromByteString cc of --- [] -> Fail . addLabel "cookie" . typeError k $ "Failed to get zuid cookies" --- (x : xs) -> pure $ List1.list1 x xs - ---notAvailable :: ByteString -> P.Error ---notAvailable k = e400 & setReason NotAvailable . setSource k ---{-# INLINE notAvailable #-} - ---typeError :: ByteString -> ByteString -> P.Error ---typeError k m = e400 & setReason TypeError . setSource k . setMessage m ---{-# INLINE typeError #-} From eb004a886829386e8dcb0b9ff83537535d6bd9ca Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 6 Oct 2022 15:58:43 +0200 Subject: [PATCH 15/43] Servantify login endpoint --- .../src/Wire/API/Routes/Public/Brig.hs | 30 ++++++++++++++----- services/brig/src/Brig/API/Auth.hs | 6 ++++ services/brig/src/Brig/API/Public.hs | 1 + 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index fdba5b53e8..6e6b5d730d 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1141,6 +1141,12 @@ type SearchAPI = type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) +type TokenResponse = + WithHeaders + '[OptHeader (Header "Set-Cookie" UserTokenCookie)] + SomeAccess + (Respond 201 "TODO" AccessToken) + type AuthAPI = Named "access" @@ -1153,14 +1159,7 @@ type AuthAPI = \ header, with the latter being preferred." :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken - :> MultiVerb1 - 'POST - '[JSON] - ( WithHeaders - '[OptHeader (Header "Set-Cookie" UserTokenCookie)] - SomeAccess - (Respond 201 "TODO" AccessToken) - ) + :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named "send-login-code" @@ -1178,6 +1177,21 @@ type AuthAPI = '[JSON] (Respond 201 "TODO" LoginCodeTimeout) ) + :<|> Named + "login" + ( "login" + :> Summary "Authenticate a user to obtain a cookie and first access token" + :> Description "Logins are throttled at the server's discretion" + :> ReqBody '[JSON] Login + :> QueryParam' + [ Optional, + Strict, + Description "Request a persistent cookie instead of a session cookie" + ] + "persist" + Bool + :> MultiVerb1 'POST '[JSON] TokenResponse + ) type BrigAPI = UserAPI diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 5658f715a8..fecff00cb8 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -46,6 +46,12 @@ sendLoginCode (SendLoginCode phone call force) = do c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError pure $ LoginCodeTimeout (pendingLoginTimeout c) +login :: Login -> Maybe Bool -> Handler r SomeAccess +login l (fromMaybe False -> persist) = do + let typ = if persist then PersistentCookie else SessionCookie + c <- wrapHttpClientE (Auth.login l typ) !>> loginError + traverse mkUserTokenCookie c + -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index fbcbe8ad14..24ee7209c7 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -290,6 +290,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey authAPI = Named @"access" access :<|> Named @"send-login-code" sendLoginCode + :<|> Named @"login" login -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling From 8ae927bed65d0d2dbae87b06e31fe4ddabebf0d8 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 7 Oct 2022 14:11:21 +0200 Subject: [PATCH 16/43] Servantify logout endpoint --- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 39 +++++++++++++++++-- .../src/Wire/API/Routes/Public/Brig.hs | 14 +++++++ libs/wire-api/src/Wire/API/User/Auth.hs | 9 ++++- services/brig/src/Brig/API/Auth.hs | 33 ++++++++++------ services/brig/src/Brig/API/Public.hs | 3 +- 5 files changed, 81 insertions(+), 17 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index 2762383158..18495393d8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -32,18 +32,32 @@ import Web.Cookie (parseCookies) data (:::) a b +data (::?) a b + +-- | A combinator to extract cookies from an HTTP request. The recommended way +-- to use this combinator is to specify it exactly once in the description of +-- an endpoint, passing a list of pairs of cookie name and type, separated by +-- either '(:::)' or '(::?)'. The former makes the corresponding cookie +-- mandatory, while the latter makes it optional, and returns a 'Maybe' result. +-- +-- For example: +-- @@ +-- Cookies '["foo" ::: Int64, "bar" ::? Text] +-- @@ +-- results in a mandatory cookie with name "foo" containing a 64-bit integer, +-- and an optional cookie with name "bar" containing an arbitrary text value. data Cookies (cs :: [*]) type CookieHeader cs = Header' '[Required] "Cookie" (CookieTuple cs) -type CookieType = NonEmpty - -- CookieTypes = map snd type family CookieTypes (cs :: [*]) :: [*] type instance CookieTypes '[] = '[] -type instance CookieTypes ((lbl ::: x) ': cs) = (CookieType x ': CookieTypes cs) +type instance CookieTypes ((lbl ::: x) ': cs) = (NonEmpty x ': CookieTypes cs) + +type instance CookieTypes ((lbl ::? x) ': cs) = ([x] ': CookieTypes cs) newtype CookieTuple cs = CookieTuple {unCookieTuple :: NP I (CookieTypes cs)} @@ -74,7 +88,7 @@ instance ) => CookieArgs ((lbl ::: (x :: *)) ': cs) where - type AddArgs ((lbl ::: x) ': cs) a = CookieType x -> AddArgs cs a + type AddArgs ((lbl ::: x) ': cs) a = NonEmpty x -> AddArgs cs a uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) mapArgs h f = mapArgs @cs h . f mkTuple m = do @@ -84,6 +98,23 @@ instance CookieTuple t <- mkTuple @cs m pure (CookieTuple (I vs :* t)) +instance + ( CookieArgs cs, + KnownSymbol lbl, + FromHttpApiData x + ) => + CookieArgs ((lbl ::? (x :: *)) ': cs) + where + type AddArgs ((lbl ::? x) ': cs) a = [x] -> AddArgs cs a + uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) + mapArgs h f = mapArgs @cs h . f + mkTuple m = do + let k = T.pack (symbolVal (Proxy @lbl)) + bs <- pure . maybe [] toList $ M.lookup (T.encodeUtf8 k) m + vs <- traverse parseHeader bs + CookieTuple t <- mkTuple @cs m + pure (CookieTuple (I vs :* t)) + mkCookieMap :: [(ByteString, ByteString)] -> CookieMap mkCookieMap = foldr (\(k, v) -> M.insertWith (<>) k (pure v)) mempty diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 6e6b5d730d..40ce7efd43 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1159,6 +1159,7 @@ type AuthAPI = \ header, with the latter being preferred." :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken + -- TODO: access_token query parameter :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named @@ -1192,6 +1193,19 @@ type AuthAPI = Bool :> MultiVerb1 'POST '[JSON] TokenResponse ) + :<|> Named + "logout" + ( "access" :> "logout" + :> Summary "Log out in order to remove a cookie from the server" + :> Description + "Calling this endpoint will effectively revoke the given cookie\ + \ and subsequent calls to /access with the same cookie will\ + \ result in a 403." + :> Cookies '["zuid" ::? SomeUserToken] + :> Bearer SomeAccessToken + -- TODO: access_token query parameter + :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Logout") + ) type BrigAPI = UserAPI diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index 70d3fb7259..3bbafc8199 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -337,7 +337,14 @@ smsLoginSchema = SmsLoginData <$> slPhone .= field "phone" schema <*> slCode .= field "code" schema - <*> slLabel .= optField "label" (maybeWithDefault A.Null schema) + <*> slLabel + .= optFieldWithDocModifier + "label" + ( description + ?~ "This label can be used to delete all cookies matching it\ + \ (cf. /cookies/remove)" + ) + (maybeWithDefault A.Null schema) $(makePrisms ''Login) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index fecff00cb8..c58cbcca58 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -25,20 +25,19 @@ import qualified Brig.User.Auth as Auth import Brig.ZAuth hiding (Env, settings) import Control.Lens (view) import Data.List.NonEmpty (NonEmpty ((:|))) -import qualified Data.List.NonEmpty as NE import Data.List1 (List1 (..)) import qualified Data.ZAuth.Token as ZAuth import Imports import Network.Wai.Utilities ((!>>)) -import Wire.API.User.Auth +import Wire.API.User.Auth hiding (access) -access :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess -access ut mat = do - partitionTokens ut mat >>= either (uncurry renew) (uncurry renew) - where - renew t mt = - traverse mkUserTokenCookie - =<< wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError +accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess +accessH ut mat = partitionTokens ut mat >>= either (uncurry access) (uncurry access) + +access :: TokenPair u a => NonEmpty (Token u) -> Maybe (Token a) -> Handler r SomeAccess +access t mt = + traverse mkUserTokenCookie + =<< wrapHttpClientE (Auth.renewAccess (List1 t) mt) !>> zauthError sendLoginCode :: SendLoginCode -> Handler r LoginCodeTimeout sendLoginCode (SendLoginCode phone call force) = do @@ -52,6 +51,17 @@ login l (fromMaybe False -> persist) = do c <- wrapHttpClientE (Auth.login l typ) !>> loginError traverse mkUserTokenCookie c +logoutH :: [SomeUserToken] -> Maybe SomeAccessToken -> Handler r () +logoutH [] Nothing = throwStd authMissingCookieAndToken +logoutH [] (Just _) = throwStd authMissingCookie +logoutH uts mat = + partitionTokens uts mat + >>= either (uncurry logout) (uncurry logout) + +logout :: TokenPair u a => NonEmpty (Token u) -> Maybe (Token a) -> Handler r () +logout _ Nothing = throwStd authMissingToken +logout uts (Just at) = wrapHttpClientE $ Auth.logout (List1 uts) at !>> zauthError + -------------------------------------------------------------------------------- -- Utils @@ -71,7 +81,8 @@ mkUserTokenCookie c = do } partitionTokens :: - NonEmpty SomeUserToken -> + Foldable f => + f SomeUserToken -> Maybe SomeAccessToken -> Handler r @@ -80,7 +91,7 @@ partitionTokens :: (NonEmpty (ZAuth.Token ZAuth.LegalHoldUser), Maybe (ZAuth.Token ZAuth.LegalHoldAccess)) ) partitionTokens tokens mat = - case (partitionEithers (map toEither (NE.toList tokens)), mat) of + case (partitionEithers (map toEither (toList tokens)), mat) of -- only PlainUserToken ((at : ats, []), Nothing) -> pure (Left (at :| ats, Nothing)) ((at : ats, []), Just (PlainAccessToken a)) -> pure (Left (at :| ats, Just a)) diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 24ee7209c7..d60f87a55e 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -288,9 +288,10 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey authAPI :: ServerT AuthAPI (Handler r) authAPI = - Named @"access" access + Named @"access" accessH :<|> Named @"send-login-code" sendLoginCode :<|> Named @"login" login + :<|> Named @"logout" logoutH -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling From eca8df34e49c702b8ebf72edc284d512a8b7060f Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 7 Oct 2022 15:30:24 +0200 Subject: [PATCH 17/43] Servantify change-self-email endpoint --- .../src/Wire/API/Routes/Public/Brig.hs | 21 ++++++++++++++ libs/wire-api/src/Wire/API/User.hs | 16 +++++++++++ services/brig/src/Brig/API/Auth.hs | 28 ++++++++++++++++++- services/brig/src/Brig/API/Public.hs | 1 + services/brig/src/Brig/API/Types.hs | 6 ---- 5 files changed, 65 insertions(+), 7 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 40ce7efd43..5b46e3e7f0 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1160,6 +1160,7 @@ type AuthAPI = :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken -- TODO: access_token query parameter + -- TODO: CanThrow :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named @@ -1173,6 +1174,7 @@ type AuthAPI = \ For 2nd factor authentication login with email and password, use the\ \ `/verification-code/send` endpoint." :> ReqBody '[JSON] SendLoginCode + -- TODO: CanThrow :> MultiVerb1 'POST '[JSON] @@ -1191,6 +1193,7 @@ type AuthAPI = ] "persist" Bool + -- TODO: CanThrow :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named @@ -1204,8 +1207,26 @@ type AuthAPI = :> Cookies '["zuid" ::? SomeUserToken] :> Bearer SomeAccessToken -- TODO: access_token query parameter + -- TODO: CanThrow :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Logout") ) + :<|> Named + "change-self-email" + ( "access" :> "self" :> "email" + :> Summary "Change your email address" + :> Cookies '["zuid" ::: SomeUserToken] + -- TODO: access_token query parameter + :> Bearer SomeAccessToken + :> ReqBody '[JSON] EmailUpdate + -- TODO: CanThrow + :> MultiVerb + 'PUT + '[JSON] + '[ Respond 202 "Update accepted and pending activation of the new email" (), + Respond 204 "No update, current and new email address are the same" () + ] + ChangeEmailResponse + ) type BrigAPI = UserAPI diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 53e44cac01..ac94b01341 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -89,6 +89,7 @@ module Wire.API.User ChangeHandleError (..), ChangeHandleResponses, NameUpdate (..), + ChangeEmailResponse (..), -- * Account Deletion DeleteUser (..), @@ -1270,6 +1271,21 @@ instance FromJSON NameUpdate where parseJSON = A.withObject "name-update" $ \o -> NameUpdate <$> o A..: "name" +data ChangeEmailResponse + = ChangeEmailResponseIdempotent + | ChangeEmailResponseNeedsActivation + +instance + AsUnion + '[Respond 202 desc1 (), Respond 204 desc2 ()] + ChangeEmailResponse + where + toUnion ChangeEmailResponseIdempotent = S (Z (I ())) + toUnion ChangeEmailResponseNeedsActivation = Z (I ()) + fromUnion (Z (I ())) = ChangeEmailResponseNeedsActivation + fromUnion (S (Z (I ()))) = ChangeEmailResponseIdempotent + fromUnion (S (S x)) = case x of {} + ----------------------------------------------------------------------------- -- Account Deletion diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index c58cbcca58..065276e9de 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -19,16 +19,21 @@ module Brig.API.Auth where import Brig.API.Error import Brig.API.Handler +import Brig.API.User import Brig.App +import Brig.Effects.BlacklistStore import Brig.Options import qualified Brig.User.Auth as Auth import Brig.ZAuth hiding (Env, settings) import Control.Lens (view) +import Data.Id import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List1 (List1 (..)) import qualified Data.ZAuth.Token as ZAuth import Imports import Network.Wai.Utilities ((!>>)) +import Polysemy +import Wire.API.User import Wire.API.User.Auth hiding (access) accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess @@ -48,7 +53,7 @@ sendLoginCode (SendLoginCode phone call force) = do login :: Login -> Maybe Bool -> Handler r SomeAccess login l (fromMaybe False -> persist) = do let typ = if persist then PersistentCookie else SessionCookie - c <- wrapHttpClientE (Auth.login l typ) !>> loginError + c <- Auth.login l typ !>> loginError traverse mkUserTokenCookie c logoutH :: [SomeUserToken] -> Maybe SomeAccessToken -> Handler r () @@ -62,6 +67,27 @@ logout :: TokenPair u a => NonEmpty (Token u) -> Maybe (Token a) -> Handler r () logout _ Nothing = throwStd authMissingToken logout uts (Just at) = wrapHttpClientE $ Auth.logout (List1 uts) at !>> zauthError +changeSelfEmailH :: + Member BlacklistStore r => + NonEmpty SomeUserToken -> + Maybe SomeAccessToken -> + EmailUpdate -> + Handler r ChangeEmailResponse +changeSelfEmailH uts mat up = do + toks <- partitionTokens uts mat + usr <- either (uncurry validateCredentials) (uncurry validateCredentials) toks + let email = euEmail up + changeSelfEmail usr email ForbidSCIMUpdates + +validateCredentials :: + TokenPair u a => + NonEmpty (Token u) -> + Maybe (Token a) -> + Handler r UserId +validateCredentials _ Nothing = throwStd missingAccessToken +validateCredentials uts mat = + fst <$> wrapHttpClientE (Auth.validateTokens (List1 uts) mat) !>> zauthError + -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index d60f87a55e..e104664fb0 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -292,6 +292,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"send-login-code" sendLoginCode :<|> Named @"login" login :<|> Named @"logout" logoutH + :<|> Named @"change-self-email" changeSelfEmailH -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 57acbd8697..8a7814718b 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -81,12 +81,6 @@ data ChangeEmailResult | -- | The user asked to change the email address to the one already owned ChangeEmailIdempotent --- | Typed response of the @put /self/email@ end-point (returned in --- 'Brig.API.User.changeSelfEmail'. -data ChangeEmailResponse - = ChangeEmailResponseIdempotent - | ChangeEmailResponseNeedsActivation - ------------------------------------------------------------------------------- -- Failures From e35c4863c7d32da62210274556b89e45697e548d Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 10:46:44 +0200 Subject: [PATCH 18/43] Servantify list-cookies endpoint --- libs/types-common/src/Data/CommaSeparatedList.hs | 3 ++- libs/wire-api/src/Wire/API/Routes/Public/Brig.hs | 11 +++++++++++ services/brig/src/Brig/API/Auth.hs | 7 +++++++ services/brig/src/Brig/API/Public.hs | 3 ++- 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/libs/types-common/src/Data/CommaSeparatedList.hs b/libs/types-common/src/Data/CommaSeparatedList.hs index 4225dcedf0..ba4bcabc8a 100644 --- a/libs/types-common/src/Data/CommaSeparatedList.hs +++ b/libs/types-common/src/Data/CommaSeparatedList.hs @@ -32,7 +32,8 @@ import Servant (FromHttpApiData (..)) newtype CommaSeparatedList a = CommaSeparatedList {fromCommaSeparatedList :: [a]} deriving stock (Show, Eq) - deriving newtype (Bounds) + deriving (Functor, Foldable, Traversable) + deriving newtype (Bounds, Semigroup, Monoid) instance FromByteString (List a) => FromHttpApiData (CommaSeparatedList a) where parseUrlPiece t = diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 5b46e3e7f0..d40c849e7e 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1227,6 +1227,17 @@ type AuthAPI = ] ChangeEmailResponse ) + :<|> Named + "list-cookies" + ( "cookies" + :> Summary "Retrieve the list of cookies currently stored for the user" + :> ZLocalUser + :> QueryParam' + [Optional, Strict, Description "Filter by label (comma-separated list)"] + "labels" + (CommaSeparatedList CookieLabel) + :> MultiVerb1 'GET '[JSON] (Respond 200 "List of cookies" CookieList) + ) type BrigAPI = UserAPI diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 065276e9de..8cc041355d 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -26,9 +26,11 @@ import Brig.Options import qualified Brig.User.Auth as Auth import Brig.ZAuth hiding (Env, settings) import Control.Lens (view) +import Data.CommaSeparatedList import Data.Id import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List1 (List1 (..)) +import Data.Qualified import qualified Data.ZAuth.Token as ZAuth import Imports import Network.Wai.Utilities ((!>>)) @@ -88,6 +90,11 @@ validateCredentials _ Nothing = throwStd missingAccessToken validateCredentials uts mat = fst <$> wrapHttpClientE (Auth.validateTokens (List1 uts) mat) !>> zauthError +listCookies :: Local UserId -> Maybe (CommaSeparatedList CookieLabel) -> Handler r CookieList +listCookies lusr (fold -> labels) = + CookieList + <$> wrapClientE (Auth.listCookies (tUnqualified lusr) (toList labels)) + -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e104664fb0..446e141665 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -78,7 +78,7 @@ import Data.Aeson hiding (json) import Data.Bifunctor import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList)) +import Data.CommaSeparatedList import Data.Domain import Data.FileEmbed import Data.Handle (Handle, parseHandle) @@ -293,6 +293,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"login" login :<|> Named @"logout" logoutH :<|> Named @"change-self-email" changeSelfEmailH + :<|> Named @"list-cookies" listCookies -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling From caeab9528a773a897b4bf02f991f289c42b7f6f4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 11:29:24 +0200 Subject: [PATCH 19/43] Servantify remove-cookies endpoint --- libs/wire-api/src/Wire/API/Routes/Public/Brig.hs | 9 +++++++++ services/brig/src/Brig/API/Auth.hs | 7 ++++++- services/brig/src/Brig/API/Public.hs | 1 + 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index d40c849e7e..f5643f0163 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1238,6 +1238,15 @@ type AuthAPI = (CommaSeparatedList CookieLabel) :> MultiVerb1 'GET '[JSON] (Respond 200 "List of cookies" CookieList) ) + :<|> Named + "remove-cookies" + ( "cookies" :> "remove" + :> Summary "Revoke stored cookies" + :> ZLocalUser + :> CanThrow 'BadCredentials + :> ReqBody '[JSON] RemoveCookies + :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Cookies revoked") + ) type BrigAPI = UserAPI diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 8cc041355d..811205c303 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -22,6 +22,7 @@ import Brig.API.Handler import Brig.API.User import Brig.App import Brig.Effects.BlacklistStore +import Brig.Effects.GalleyProvider import Brig.Options import qualified Brig.User.Auth as Auth import Brig.ZAuth hiding (Env, settings) @@ -52,7 +53,7 @@ sendLoginCode (SendLoginCode phone call force) = do c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError pure $ LoginCodeTimeout (pendingLoginTimeout c) -login :: Login -> Maybe Bool -> Handler r SomeAccess +login :: Member GalleyProvider r => Login -> Maybe Bool -> Handler r SomeAccess login l (fromMaybe False -> persist) = do let typ = if persist then PersistentCookie else SessionCookie c <- Auth.login l typ !>> loginError @@ -95,6 +96,10 @@ listCookies lusr (fold -> labels) = CookieList <$> wrapClientE (Auth.listCookies (tUnqualified lusr) (toList labels)) +removeCookies :: Local UserId -> RemoveCookies -> Handler r () +removeCookies lusr (RemoveCookies pw lls ids) = + wrapClientE (Auth.revokeAccess (tUnqualified lusr) pw ids lls) !>> authError + -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 446e141665..cf98846eaf 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -294,6 +294,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"logout" logoutH :<|> Named @"change-self-email" changeSelfEmailH :<|> Named @"list-cookies" listCookies + :<|> Named @"remove-cookies" removeCookies -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling From f47f2e7f77880ac19bb4ef5eadad2dacefeecbc6 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 11:53:33 +0200 Subject: [PATCH 20/43] Change status code to 200 --- libs/wire-api/src/Wire/API/Routes/Public/Brig.hs | 4 ++-- services/galley/test/integration/API/Util.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index f5643f0163..8c4e02ecf5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1145,7 +1145,7 @@ type TokenResponse = WithHeaders '[OptHeader (Header "Set-Cookie" UserTokenCookie)] SomeAccess - (Respond 201 "TODO" AccessToken) + (Respond 200 "OK" AccessToken) type AuthAPI = Named @@ -1178,7 +1178,7 @@ type AuthAPI = :> MultiVerb1 'POST '[JSON] - (Respond 201 "TODO" LoginCodeTimeout) + (Respond 200 "OK" LoginCodeTimeout) ) :<|> Named "login" diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 5664206d25..ae8e4484ca 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -131,7 +131,7 @@ import qualified Wire.API.Team.Member as Team import Wire.API.Team.Permission hiding (self) import Wire.API.Team.Role import Wire.API.User -import Wire.API.User.Auth +import Wire.API.User.Auth hiding (Access) import Wire.API.User.Client import qualified Wire.API.User.Client as Client import Wire.API.User.Client.Prekey From d4311d685e8386f5856b1f654dba3e09de2bbdca Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 15:23:31 +0200 Subject: [PATCH 21/43] Servantify legalhold-login endpoint --- libs/brig-types/brig-types.cabal | 1 - .../src/Wire/API/Routes/Internal/Brig.hs | 23 ++++++++-- .../src/Wire/API/Routes/Public/Brig.hs | 6 --- libs/wire-api/src/Wire/API/User/Auth.hs | 14 +++++- .../src/Wire/API/User/Auth/LegalHold.hs | 45 +++++++++++++++++++ .../src/Wire/API/User/Auth/Sso.hs} | 31 +------------ libs/wire-api/wire-api.cabal | 2 + services/brig/src/Brig/API/Auth.hs | 12 +++++ services/brig/src/Brig/API/Internal.hs | 13 +++++- services/brig/src/Brig/User/Auth.hs | 3 +- services/spar/src/Spar/Intra/Brig.hs | 2 +- 11 files changed, 109 insertions(+), 43 deletions(-) create mode 100644 libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs rename libs/{brig-types/src/Brig/Types/User/Auth.hs => wire-api/src/Wire/API/User/Auth/Sso.hs} (60%) diff --git a/libs/brig-types/brig-types.cabal b/libs/brig-types/brig-types.cabal index 3220d58a2d..357a127075 100644 --- a/libs/brig-types/brig-types.cabal +++ b/libs/brig-types/brig-types.cabal @@ -23,7 +23,6 @@ library Brig.Types.Team.LegalHold Brig.Types.Test.Arbitrary Brig.Types.User - Brig.Types.User.Auth Brig.Types.User.Event other-modules: Paths_brig_types diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 1c03b4f6e9..6d4960d4e6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -22,6 +22,7 @@ module Wire.API.Routes.Internal.Brig MLSAPI, TeamsAPI, UserAPI, + AuthAPI, EJPDRequest, GetAccountConferenceCallingConfig, PutAccountConferenceCallingConfig, @@ -44,8 +45,7 @@ import Data.Schema hiding (swaggerDoc) import Data.Swagger (HasInfo (info), HasTitle (title), Swagger) import qualified Data.Swagger as S import Imports hiding (head) -import Servant hiding (Handler, JSON, WithStatus, addHeader, respond) -import qualified Servant +import Servant hiding (Handler, WithStatus, addHeader, respond) import Servant.Swagger (HasSwagger (toSwagger)) import Servant.Swagger.Internal.Orphans () import Servant.Swagger.UI @@ -61,6 +61,8 @@ import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named import Wire.API.Team.Feature import Wire.API.User +import Wire.API.User.Auth +import Wire.API.User.Auth.LegalHold import Wire.API.User.Client type EJPDRequest = @@ -311,7 +313,14 @@ type GetVerificationCode = type API = "i" - :> (EJPD_API :<|> AccountAPI :<|> MLSAPI :<|> GetVerificationCode :<|> TeamsAPI :<|> UserAPI) + :> ( EJPD_API + :<|> AccountAPI + :<|> MLSAPI + :<|> GetVerificationCode + :<|> TeamsAPI + :<|> UserAPI + :<|> AuthAPI + ) type TeamsAPI = Named @@ -349,6 +358,14 @@ type GetDefaultLocale = :> "locale" :> Get '[Servant.JSON] LocaleUpdate +type AuthAPI = + Named + "legalhold-login" + ( "legalhold-login" + :> ReqBody '[JSON] LegalHoldLogin + :> MultiVerb1 'POST '[JSON] TokenResponse + ) + type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" swaggerDoc :: Swagger diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 8c4e02ecf5..8711a445e0 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1141,12 +1141,6 @@ type SearchAPI = type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) -type TokenResponse = - WithHeaders - '[OptHeader (Header "Set-Cookie" UserTokenCookie)] - SomeAccess - (Respond 200 "OK" AccessToken) - type AuthAPI = Named "access" diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index 3bbafc8199..3d3d2f50c7 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -51,6 +51,9 @@ module Wire.API.User.Auth AccessWithCookie (..), Access, SomeAccess, + + -- * Servant + TokenResponse, ) where @@ -78,8 +81,8 @@ import Data.Time.Clock (UTCTime) import Data.Tuple.Extra hiding (first) import qualified Data.ZAuth.Token as ZAuth import Imports +import Servant import Web.Cookie -import Web.HttpApiData import Wire.API.Routes.MultiVerb import Wire.API.User.Identity (Email, Phone) import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) @@ -563,3 +566,12 @@ instance ToHttpApiData UserTokenCookie where . renderSetCookie . utcToSetCookie toUrlPiece = T.decodeUtf8 . toHeader + +-------------------------------------------------------------------------------- +-- Servant + +type TokenResponse = + WithHeaders + '[OptHeader (Header "Set-Cookie" UserTokenCookie)] + SomeAccess + (Respond 200 "OK" AccessToken) diff --git a/libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs b/libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs new file mode 100644 index 0000000000..473c0c9d0e --- /dev/null +++ b/libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs @@ -0,0 +1,45 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.User.Auth.LegalHold where + +import Data.Aeson (FromJSON (..), ToJSON (..)) +import qualified Data.Aeson as A +import Data.Id +import Data.Misc +import Data.Schema +import qualified Data.Swagger as S +import Imports +import Wire.API.User.Auth + +-- | A special kind of login that is only used for an internal endpoint. +-- This kind of login returns restricted 'LegalHoldUserToken's instead of regular +-- tokens. +data LegalHoldLogin = LegalHoldLogin + { lhlUserId :: !UserId, + lhlPassword :: !(Maybe PlainTextPassword), + lhlLabel :: !(Maybe CookieLabel) + } + deriving (FromJSON, ToJSON, S.ToSchema) via Schema LegalHoldLogin + +instance ToSchema LegalHoldLogin where + schema = + object "LegalHoldLogin" $ + LegalHoldLogin + <$> lhlUserId .= field "user" schema + <*> lhlPassword .= optField "password" (maybeWithDefault A.Null schema) + <*> lhlLabel .= optField "label" (maybeWithDefault A.Null schema) diff --git a/libs/brig-types/src/Brig/Types/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth/Sso.hs similarity index 60% rename from libs/brig-types/src/Brig/Types/User/Auth.hs rename to libs/wire-api/src/Wire/API/User/Auth/Sso.hs index 0bb1553b7a..f5d0e62857 100644 --- a/libs/brig-types/src/Brig/Types/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth/Sso.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -17,15 +15,10 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.Types.User.Auth - ( SsoLogin (..), - LegalHoldLogin (..), - ) -where +module Wire.API.User.Auth.Sso where import Data.Aeson -import Data.Id (UserId) -import Data.Misc (PlainTextPassword (..)) +import Data.Id import Imports import Wire.API.User.Auth @@ -33,12 +26,6 @@ import Wire.API.User.Auth data SsoLogin = SsoLogin !UserId !(Maybe CookieLabel) --- | A special kind of login that is only used for an internal endpoint. --- This kind of login returns restricted 'LegalHoldUserToken's instead of regular --- tokens. -data LegalHoldLogin - = LegalHoldLogin !UserId !(Maybe PlainTextPassword) !(Maybe CookieLabel) - instance FromJSON SsoLogin where parseJSON = withObject "SsoLogin" $ \o -> SsoLogin <$> o .: "user" <*> o .:? "label" @@ -46,17 +33,3 @@ instance FromJSON SsoLogin where instance ToJSON SsoLogin where toJSON (SsoLogin uid label) = object ["user" .= uid, "label" .= label] - -instance FromJSON LegalHoldLogin where - parseJSON = withObject "LegalHoldLogin" $ \o -> - LegalHoldLogin <$> o .: "user" - <*> o .:? "password" - <*> o .:? "label" - -instance ToJSON LegalHoldLogin where - toJSON (LegalHoldLogin uid password label) = - object - [ "user" .= uid, - "password" .= password, - "label" .= label - ] diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index e581cf6e6d..0df4235fd7 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -113,6 +113,8 @@ library Wire.API.User Wire.API.User.Activation Wire.API.User.Auth + Wire.API.User.Auth.LegalHold + Wire.API.User.Auth.Sso Wire.API.User.Client Wire.API.User.Client.DPoPAccessToken Wire.API.User.Client.Prekey diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 811205c303..0296d15a53 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -38,6 +38,7 @@ import Network.Wai.Utilities ((!>>)) import Polysemy import Wire.API.User import Wire.API.User.Auth hiding (access) +import Wire.API.User.Auth.LegalHold accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess accessH ut mat = partitionTokens ut mat >>= either (uncurry access) (uncurry access) @@ -100,6 +101,17 @@ removeCookies :: Local UserId -> RemoveCookies -> Handler r () removeCookies lusr (RemoveCookies pw lls ids) = wrapClientE (Auth.revokeAccess (tUnqualified lusr) pw ids lls) !>> authError +legalHoldLogin :: LegalHoldLogin -> Handler r SomeAccess +legalHoldLogin lhl = do + let typ = PersistentCookie -- Session cookie isn't a supported use case here + c <- wrapHttpClientE (Auth.legalHoldLogin lhl typ) !>> legalHoldLoginError + traverse mkUserTokenCookie c + +--legalHoldLogin :: LegalHoldLogin -> Handler r (Auth.Access ZAuth.LegalHoldUser) +--legalHoldLogin l = do +-- let typ = PersistentCookie -- Session cookie isn't a supported use case here +-- wrapHttpClientE (Auth.legalHoldLogin l typ) !>> legalHoldLoginError + -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 7fe68751cd..d8c42403d5 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -24,6 +24,7 @@ module Brig.API.Internal ) where +import Brig.API.Auth import qualified Brig.API.Client as API import qualified Brig.API.Connection as API import Brig.API.Error @@ -112,7 +113,14 @@ servantSitemap :: ] r => ServerT BrigIRoutes.API (Handler r) -servantSitemap = ejpdAPI :<|> accountAPI :<|> mlsAPI :<|> getVerificationCode :<|> teamsAPI :<|> userAPI +servantSitemap = + ejpdAPI + :<|> accountAPI + :<|> mlsAPI + :<|> getVerificationCode + :<|> teamsAPI + :<|> userAPI + :<|> authAPI ejpdAPI :: Members @@ -163,6 +171,9 @@ userAPI = :<|> deleteLocale :<|> getDefaultUserLocale +authAPI :: ServerT BrigIRoutes.AuthAPI (Handler r) +authAPI = Named @"legalhold-login" legalHoldLogin + -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) getAccountConferenceCallingConfig uid = diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index f67317b047..f4f546d181 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -54,7 +54,6 @@ import Brig.Email import qualified Brig.Options as Opt import Brig.Phone import Brig.Types.Intra -import Brig.Types.User.Auth import Brig.User.Auth.Cookie import Brig.User.Handle import Brig.User.Phone @@ -81,6 +80,8 @@ import Wire.API.Team.Feature import qualified Wire.API.Team.Feature as Public import Wire.API.User import Wire.API.User.Auth +import Wire.API.User.Auth.LegalHold +import Wire.API.User.Auth.Sso sendLoginCode :: ( MonadClient m, diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 2a2f088ef7..da87163073 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -45,7 +45,6 @@ where import Bilge import Brig.Types.Intra import Brig.Types.User -import Brig.Types.User.Auth (SsoLogin (..)) import Control.Monad.Except import Data.ByteString.Conversion import Data.Code as Code @@ -61,6 +60,7 @@ import Spar.Error import qualified System.Logger.Class as Log import Web.Cookie import Wire.API.User +import Wire.API.User.Auth.Sso import Wire.API.User.RichInfo as RichInfo import Wire.API.User.Scim (ValidExternalId (..), runValidExternalIdEither) From dd57173a6a62a37e7300d7d2d0a3ff0f44fbc722 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 15:31:47 +0200 Subject: [PATCH 22/43] Servantify sso-login endpoint --- .../src/Wire/API/Routes/Internal/Brig.hs | 8 ++++++ libs/wire-api/src/Wire/API/User/Auth/Sso.hs | 25 +++++++++++-------- services/brig/src/Brig/API/Auth.hs | 10 +++++--- services/brig/src/Brig/API/Internal.hs | 4 ++- 4 files changed, 32 insertions(+), 15 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 6d4960d4e6..849ccb1ebd 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -63,6 +63,7 @@ import Wire.API.Team.Feature import Wire.API.User import Wire.API.User.Auth import Wire.API.User.Auth.LegalHold +import Wire.API.User.Auth.Sso import Wire.API.User.Client type EJPDRequest = @@ -365,6 +366,13 @@ type AuthAPI = :> ReqBody '[JSON] LegalHoldLogin :> MultiVerb1 'POST '[JSON] TokenResponse ) + :<|> Named + "sso-login" + ( "sso-login" + :> ReqBody '[JSON] SsoLogin + :> QueryParam' [Optional, Strict] "persist" Bool + :> MultiVerb1 'POST '[JSON] TokenResponse + ) type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" diff --git a/libs/wire-api/src/Wire/API/User/Auth/Sso.hs b/libs/wire-api/src/Wire/API/User/Auth/Sso.hs index f5d0e62857..725d41ba67 100644 --- a/libs/wire-api/src/Wire/API/User/Auth/Sso.hs +++ b/libs/wire-api/src/Wire/API/User/Auth/Sso.hs @@ -17,19 +17,24 @@ module Wire.API.User.Auth.Sso where -import Data.Aeson +import Data.Aeson (FromJSON (..), ToJSON (..)) +import qualified Data.Aeson as A import Data.Id +import Data.Schema +import qualified Data.Swagger as S import Imports import Wire.API.User.Auth -- | A special kind of login that is only used for an internal endpoint. -data SsoLogin - = SsoLogin !UserId !(Maybe CookieLabel) +data SsoLogin = SsoLogin + { ssoUserId :: !UserId, + ssoLabel :: !(Maybe CookieLabel) + } + deriving (FromJSON, ToJSON, S.ToSchema) via Schema SsoLogin -instance FromJSON SsoLogin where - parseJSON = withObject "SsoLogin" $ \o -> - SsoLogin <$> o .: "user" <*> o .:? "label" - -instance ToJSON SsoLogin where - toJSON (SsoLogin uid label) = - object ["user" .= uid, "label" .= label] +instance ToSchema SsoLogin where + schema = + object "SsoLogin" $ + SsoLogin + <$> ssoUserId .= field "user" schema + <*> ssoLabel .= optField "label" (maybeWithDefault A.Null schema) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 0296d15a53..3f44af5c92 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -39,6 +39,7 @@ import Polysemy import Wire.API.User import Wire.API.User.Auth hiding (access) import Wire.API.User.Auth.LegalHold +import Wire.API.User.Auth.Sso accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess accessH ut mat = partitionTokens ut mat >>= either (uncurry access) (uncurry access) @@ -107,10 +108,11 @@ legalHoldLogin lhl = do c <- wrapHttpClientE (Auth.legalHoldLogin lhl typ) !>> legalHoldLoginError traverse mkUserTokenCookie c ---legalHoldLogin :: LegalHoldLogin -> Handler r (Auth.Access ZAuth.LegalHoldUser) ---legalHoldLogin l = do --- let typ = PersistentCookie -- Session cookie isn't a supported use case here --- wrapHttpClientE (Auth.legalHoldLogin l typ) !>> legalHoldLoginError +ssoLogin :: SsoLogin -> Maybe Bool -> Handler r SomeAccess +ssoLogin l (fromMaybe False -> persist) = do + let typ = if persist then PersistentCookie else SessionCookie + c <- wrapHttpClientE (Auth.ssoLogin l typ) !>> loginError + traverse mkUserTokenCookie c -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index d8c42403d5..fcd2a32c2a 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -172,7 +172,9 @@ userAPI = :<|> getDefaultUserLocale authAPI :: ServerT BrigIRoutes.AuthAPI (Handler r) -authAPI = Named @"legalhold-login" legalHoldLogin +authAPI = + Named @"legalhold-login" legalHoldLogin + :<|> Named @"sso-login" ssoLogin -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) From e50af5d21fdfddc6cb6aad7158f6eb0fe1f0980a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 15:42:06 +0200 Subject: [PATCH 23/43] Servantify login-code endpoint --- libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs | 6 ++++++ libs/wire-api/src/Wire/API/User/Identity.hs | 2 +- services/brig/src/Brig/API/Auth.hs | 9 +++++++-- services/brig/src/Brig/API/Internal.hs | 3 ++- services/galley/src/Galley/Intra/Client.hs | 2 +- 5 files changed, 17 insertions(+), 5 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 849ccb1ebd..2532fb2169 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -373,6 +373,12 @@ type AuthAPI = :> QueryParam' [Optional, Strict] "persist" Bool :> MultiVerb1 'POST '[JSON] TokenResponse ) + :<|> Named + "login-code" + ( "users" :> "login-code" + :> QueryParam' [Required, Strict] "phone" Phone + :> MultiVerb1 'GET '[JSON] (Respond 200 "Login code" PendingLoginCode) + ) type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs index 7a3bcecf32..db31aacbbe 100644 --- a/libs/wire-api/src/Wire/API/User/Identity.hs +++ b/libs/wire-api/src/Wire/API/User/Identity.hs @@ -61,7 +61,6 @@ import Data.Attoparsec.Text import Data.Bifunctor (first) import Data.ByteString.Conversion import qualified Data.CaseInsensitive as CI -import Data.Proxy (Proxy (..)) import Data.Schema import Data.String.Conversions (cs) import Data.Swagger (ToParamSchema (..)) @@ -75,6 +74,7 @@ import SAML2.WebSSO.Test.Arbitrary () import qualified SAML2.WebSSO.Types as SAML import qualified SAML2.WebSSO.Types.Email as SAMLEmail import qualified SAML2.WebSSO.XML as SAML +import Servant import qualified Servant.API as S import System.FilePath (()) import qualified Test.QuickCheck as QC diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 3f44af5c92..2881289b2c 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -102,10 +102,10 @@ removeCookies :: Local UserId -> RemoveCookies -> Handler r () removeCookies lusr (RemoveCookies pw lls ids) = wrapClientE (Auth.revokeAccess (tUnqualified lusr) pw ids lls) !>> authError -legalHoldLogin :: LegalHoldLogin -> Handler r SomeAccess +legalHoldLogin :: Member GalleyProvider r => LegalHoldLogin -> Handler r SomeAccess legalHoldLogin lhl = do let typ = PersistentCookie -- Session cookie isn't a supported use case here - c <- wrapHttpClientE (Auth.legalHoldLogin lhl typ) !>> legalHoldLoginError + c <- Auth.legalHoldLogin lhl typ !>> legalHoldLoginError traverse mkUserTokenCookie c ssoLogin :: SsoLogin -> Maybe Bool -> Handler r SomeAccess @@ -114,6 +114,11 @@ ssoLogin l (fromMaybe False -> persist) = do c <- wrapHttpClientE (Auth.ssoLogin l typ) !>> loginError traverse mkUserTokenCookie c +getLoginCode :: Phone -> Handler r PendingLoginCode +getLoginCode phone = do + code <- lift $ wrapClient $ Auth.lookupLoginCode phone + maybe (throwStd loginCodeNotFound) pure code + -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index fcd2a32c2a..3769d6b2dc 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -171,10 +171,11 @@ userAPI = :<|> deleteLocale :<|> getDefaultUserLocale -authAPI :: ServerT BrigIRoutes.AuthAPI (Handler r) +authAPI :: Member GalleyProvider r => ServerT BrigIRoutes.AuthAPI (Handler r) authAPI = Named @"legalhold-login" legalHoldLogin :<|> Named @"sso-login" ssoLogin + :<|> Named @"login-code" getLoginCode -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) diff --git a/services/galley/src/Galley/Intra/Client.hs b/services/galley/src/Galley/Intra/Client.hs index fdd4514de9..d21233576b 100644 --- a/services/galley/src/Galley/Intra/Client.hs +++ b/services/galley/src/Galley/Intra/Client.hs @@ -34,7 +34,6 @@ import Bilge hiding (getHeader, options, statusCode) import Bilge.RPC import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) -import Brig.Types.User.Auth (LegalHoldLogin (..)) import Control.Monad.Catch import Data.ByteString.Conversion (toByteString') import Data.Id @@ -64,6 +63,7 @@ import Wire.API.Error.Galley import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage import Wire.API.Routes.Internal.Brig +import Wire.API.User.Auth.LegalHold import Wire.API.User.Client import Wire.API.User.Client.Prekey From 08f5a16c6dea893555e108f2a10945067d6f8112 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 15:57:49 +0200 Subject: [PATCH 24/43] Servantify reauthenticate endpoint --- libs/brig-types/src/Brig/Types/Intra.hs | 27 ---------- .../src/Wire/API/Routes/Internal/Brig.hs | 9 ++++ .../wire-api/src/Wire/API/User/Auth/ReAuth.hs | 49 +++++++++++++++++++ libs/wire-api/wire-api.cabal | 1 + services/brig/src/Brig/API/Auth.hs | 16 ++++++ services/brig/src/Brig/API/Internal.hs | 1 + services/spar/src/Spar/Intra/Brig.hs | 1 + 7 files changed, 77 insertions(+), 27 deletions(-) create mode 100644 libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs index 0fafba46c2..88bc7fda2e 100644 --- a/libs/brig-types/src/Brig/Types/Intra.hs +++ b/libs/brig-types/src/Brig/Types/Intra.hs @@ -24,14 +24,11 @@ module Brig.Types.Intra UserAccount (..), NewUserScimInvitation (..), UserSet (..), - ReAuthUser (..), ) where import Data.Aeson as A -import Data.Code as Code import Data.Id (TeamId) -import Data.Misc (PlainTextPassword (..)) import qualified Data.Schema as Schema import qualified Data.Swagger as S import Imports @@ -134,27 +131,3 @@ instance ToJSON NewUserScimInvitation where "name" .= name, "email" .= email ] - -------------------------------------------------------------------------------- --- ReAuthUser - --- | Certain operations might require reauth of the user. These are available --- only for users that have already set a password. -data ReAuthUser = ReAuthUser - { reAuthPassword :: Maybe PlainTextPassword, - reAuthCode :: Maybe Code.Value, - reAuthCodeAction :: Maybe VerificationAction - } - deriving (Eq, Show, Generic) - -instance FromJSON ReAuthUser where - parseJSON = withObject "reauth-user" $ \o -> - ReAuthUser <$> o .:? "password" <*> o .:? "verification_code" <*> o .:? "action" - -instance ToJSON ReAuthUser where - toJSON ru = - object - [ "password" .= reAuthPassword ru, - "verification_code" .= reAuthCode ru, - "action" .= reAuthCodeAction ru - ] diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 2532fb2169..5f0c5fe255 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -63,6 +63,7 @@ import Wire.API.Team.Feature import Wire.API.User import Wire.API.User.Auth import Wire.API.User.Auth.LegalHold +import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso import Wire.API.User.Client @@ -379,6 +380,14 @@ type AuthAPI = :> QueryParam' [Required, Strict] "phone" Phone :> MultiVerb1 'GET '[JSON] (Respond 200 "Login code" PendingLoginCode) ) + :<|> Named + "reauthenticate" + ( "users" + :> Capture "uid" UserId + :> "reauthenticate" + :> ReqBody '[JSON] ReAuthUser + :> MultiVerb1 'GET '[JSON] (RespondEmpty 200 "OK") + ) type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" diff --git a/libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs b/libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs new file mode 100644 index 0000000000..b6c7e02e8c --- /dev/null +++ b/libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs @@ -0,0 +1,49 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.User.Auth.ReAuth + ( -- * ReAuth + ReAuthUser (..), + ) +where + +import Data.Aeson (FromJSON (..), ToJSON (..)) +import qualified Data.Aeson as A +import Data.Code +import Data.Misc +import Data.Schema +import qualified Data.Swagger as S +import Imports +import Wire.API.User + +-- | Certain operations might require reauth of the user. These are available +-- only for users that have already set a password. +data ReAuthUser = ReAuthUser + { reAuthPassword :: Maybe PlainTextPassword, + reAuthCode :: Maybe Value, + reAuthCodeAction :: Maybe VerificationAction + } + deriving (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema ReAuthUser + +instance ToSchema ReAuthUser where + schema = + object "ReAuthUser" $ + ReAuthUser + <$> reAuthPassword .= optField "password" (maybeWithDefault A.Null schema) + <*> reAuthCode .= optField "verification_code" (maybeWithDefault A.Null schema) + <*> reAuthCodeAction .= optField "action" (maybeWithDefault A.Null schema) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 0df4235fd7..0cf0a0d3f8 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -114,6 +114,7 @@ library Wire.API.User.Activation Wire.API.User.Auth Wire.API.User.Auth.LegalHold + Wire.API.User.Auth.ReAuth Wire.API.User.Auth.Sso Wire.API.User.Client Wire.API.User.Client.DPoPAccessToken diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 2881289b2c..180bd9490f 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -19,14 +19,17 @@ module Brig.API.Auth where import Brig.API.Error import Brig.API.Handler +import Brig.API.Types import Brig.API.User import Brig.App +import qualified Brig.Data.User as User import Brig.Effects.BlacklistStore import Brig.Effects.GalleyProvider import Brig.Options import qualified Brig.User.Auth as Auth import Brig.ZAuth hiding (Env, settings) import Control.Lens (view) +import Control.Monad.Trans.Except import Data.CommaSeparatedList import Data.Id import Data.List.NonEmpty (NonEmpty ((:|))) @@ -39,6 +42,7 @@ import Polysemy import Wire.API.User import Wire.API.User.Auth hiding (access) import Wire.API.User.Auth.LegalHold +import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess @@ -119,6 +123,18 @@ getLoginCode phone = do code <- lift $ wrapClient $ Auth.lookupLoginCode phone maybe (throwStd loginCodeNotFound) pure code +reauthenticate :: Member GalleyProvider r => UserId -> ReAuthUser -> Handler r () +reauthenticate uid body = do + wrapClientE (User.reauthenticate uid (reAuthPassword body)) !>> reauthError + case reAuthCodeAction body of + Just action -> + Auth.verifyCode (reAuthCode body) action uid + `catchE` \case + VerificationCodeRequired -> throwE $ reauthError ReAuthCodeVerificationRequired + VerificationCodeNoPendingCode -> throwE $ reauthError ReAuthCodeVerificationNoPendingCode + VerificationCodeNoEmail -> throwE $ reauthError ReAuthCodeVerificationNoEmail + Nothing -> pure () + -------------------------------------------------------------------------------- -- Utils diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 3769d6b2dc..3bfcb6ecbb 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -176,6 +176,7 @@ authAPI = Named @"legalhold-login" legalHoldLogin :<|> Named @"sso-login" ssoLogin :<|> Named @"login-code" getLoginCode + :<|> Named @"reauthenticate" reauthenticate -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index da87163073..58dc6bd8e7 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -60,6 +60,7 @@ import Spar.Error import qualified System.Logger.Class as Log import Web.Cookie import Wire.API.User +import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso import Wire.API.User.RichInfo as RichInfo import Wire.API.User.Scim (ValidExternalId (..), runValidExternalIdEither) From 5b228f9c1419ded16fd9f9d98c93bb7db8a5e2c8 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 10 Oct 2022 16:02:24 +0200 Subject: [PATCH 25/43] Fix build --- libs/brig-types/test/unit/Test/Brig/Types/User.hs | 3 ++- services/brig/test/integration/API/User/Auth.hs | 4 +++- services/brig/test/integration/Util.hs | 3 ++- services/galley/src/Galley/API/Util.hs | 2 +- services/galley/src/Galley/Effects/BrigAccess.hs | 1 + services/galley/src/Galley/Intra/User.hs | 3 ++- 6 files changed, 11 insertions(+), 5 deletions(-) diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index e54ed41c01..2b2cb07eca 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -26,7 +26,7 @@ module Test.Brig.Types.User where import Brig.Types.Connection (UpdateConnectionsInternal (..)) -import Brig.Types.Intra (NewUserScimInvitation (..), ReAuthUser (..), UserAccount (..)) +import Brig.Types.Intra (NewUserScimInvitation (..), UserAccount (..)) import Brig.Types.Search (SearchVisibilityInbound (..)) import Brig.Types.User (ManagedByUpdate (..), RichInfoUpdate (..)) import Data.Aeson @@ -36,6 +36,7 @@ import Test.QuickCheck (Arbitrary (arbitrary)) import Test.Tasty import Test.Tasty.HUnit import Wire.API.Routes.Internal.Brig.EJPD (EJPDRequestBody (..), EJPDResponseBody (..)) +import Wire.API.User.Auth.ReAuth tests :: TestTree tests = testGroup "User (types vs. aeson)" $ roundtripTests diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 7c18a8cd1c..6631784187 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -32,7 +32,6 @@ import Bilge.Assert hiding (assert) import qualified Brig.Code as Code import qualified Brig.Options as Opts import Brig.Types.Intra -import Brig.Types.User.Auth import Brig.ZAuth (ZAuth, runZAuth) import qualified Brig.ZAuth as ZAuth import qualified Cassandra as DB @@ -69,6 +68,9 @@ import Wire.API.User import qualified Wire.API.User as Public import Wire.API.User.Auth import qualified Wire.API.User.Auth as Auth +import Wire.API.User.Auth.LegalHold +import Wire.API.User.Auth.ReAuth +import Wire.API.User.Auth.Sso -- | FUTUREWORK: Implement this function. This wrapper should make sure that -- wrapped tests run only when the feature flag 'legalhold' is set to diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 5483c43738..08547f89e6 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -33,7 +33,6 @@ import qualified Brig.Options as Opts import qualified Brig.Run as Run import Brig.Types.Activation import Brig.Types.Intra -import Brig.Types.User.Auth import qualified Brig.ZAuth as ZAuth import Control.Concurrent.Async import Control.Exception (throw) @@ -117,6 +116,8 @@ import Wire.API.Team.Member hiding (userId) import Wire.API.User import Wire.API.User.Activation import Wire.API.User.Auth +import Wire.API.User.Auth.LegalHold +import Wire.API.User.Auth.Sso import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.VersionInfo diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 34d890bb55..189966f3b5 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -19,7 +19,6 @@ module Galley.API.Util where -import Brig.Types.Intra (ReAuthUser (..)) import Control.Lens (set, view, (.~), (^.)) import Control.Monad.Extra (allM, anyM) import Data.Bifunctor @@ -79,6 +78,7 @@ import Wire.API.Team.Member import Wire.API.Team.Role import Wire.API.User (VerificationAction) import qualified Wire.API.User as User +import Wire.API.User.Auth.ReAuth type JSON = Media "application" "json" diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index eb0c3e754d..5257a591f7 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -80,6 +80,7 @@ import qualified Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Mul import Wire.API.Team.Feature import Wire.API.Team.Size import Wire.API.User +import Wire.API.User.Auth.ReAuth import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.RichInfo diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 90b24af2e5..b04ca2a62b 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -67,6 +67,7 @@ import qualified Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Mul import Wire.API.Routes.Named import Wire.API.Team.Feature import Wire.API.User +import Wire.API.User.Auth.ReAuth import Wire.API.User.RichInfo (RichInfo) -- | Get statuses of all connections between two groups of users (the usual @@ -141,7 +142,7 @@ deleteBot cid bot = do -- | Calls 'Brig.User.API.Auth.reAuthUserH'. reAuthUser :: UserId -> - Brig.ReAuthUser -> + ReAuthUser -> App (Either AuthenticationError ()) reAuthUser uid auth = do let req = From e8482ba176c3ec39c7ae402bd652a17ff27b83d0 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 11 Oct 2022 09:57:09 +0200 Subject: [PATCH 26/43] Add access_token query parameter --- libs/wire-api/src/Wire/API/Routes/Bearer.hs | 10 +++++++++- libs/wire-api/src/Wire/API/Routes/Public/Brig.hs | 3 --- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Bearer.hs b/libs/wire-api/src/Wire/API/Routes/Bearer.hs index 0d643495c9..1b4a910590 100644 --- a/libs/wire-api/src/Wire/API/Routes/Bearer.hs +++ b/libs/wire-api/src/Wire/API/Routes/Bearer.hs @@ -34,6 +34,11 @@ instance FromHttpApiData a => FromHttpApiData (Bearer a) where type BearerHeader a = Header "Authorization" (Bearer a) +type BearerQueryParam = + QueryParam' + [Optional, Strict, Description "Access token"] + "access_token" + instance HasSwagger api => HasSwagger (Bearer a :> api) where -- TODO toSwagger _ = toSwagger (Proxy @api) @@ -51,5 +56,8 @@ instance type ServerT (Bearer a :> api) m = Maybe a -> ServerT api m route _ ctx action = - route (Proxy @(BearerHeader a :> api)) ctx (fmap (. (fmap unBearer)) action) + route + (Proxy @(BearerHeader a :> BearerQueryParam a :> api)) + ctx + (fmap (\f u v -> f (fmap unBearer u <|> v)) action) hoistServerWithContext _ ctx f h = hoistServerWithContext (Proxy @api) ctx f . h diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 8711a445e0..f7042d0f67 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1153,7 +1153,6 @@ type AuthAPI = \ header, with the latter being preferred." :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken - -- TODO: access_token query parameter -- TODO: CanThrow :> MultiVerb1 'POST '[JSON] TokenResponse ) @@ -1200,7 +1199,6 @@ type AuthAPI = \ result in a 403." :> Cookies '["zuid" ::? SomeUserToken] :> Bearer SomeAccessToken - -- TODO: access_token query parameter -- TODO: CanThrow :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Logout") ) @@ -1209,7 +1207,6 @@ type AuthAPI = ( "access" :> "self" :> "email" :> Summary "Change your email address" :> Cookies '["zuid" ::: SomeUserToken] - -- TODO: access_token query parameter :> Bearer SomeAccessToken :> ReqBody '[JSON] EmailUpdate -- TODO: CanThrow From 4f628423d54c8e1dbcbf338009ed94501f3ec9c0 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 11 Oct 2022 10:18:33 +0200 Subject: [PATCH 27/43] Parse cookies leniently --- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index 18495393d8..e28fd4f88c 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -18,7 +18,7 @@ module Wire.API.Routes.Cookies where import Control.Error.Util -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import qualified Data.Map as M import Data.Metrics.Servant import Data.SOP @@ -94,7 +94,8 @@ instance mkTuple m = do let k = T.pack (symbolVal (Proxy @lbl)) bs <- note ("Missing cookie: " <> k) $ M.lookup (T.encodeUtf8 k) m - vs <- traverse parseHeader bs + let (es, mvs) = nonEmpty <$> partitionEithers (map parseHeader (toList bs)) + vs <- note (head es) mvs CookieTuple t <- mkTuple @cs m pure (CookieTuple (I vs :* t)) @@ -111,7 +112,7 @@ instance mkTuple m = do let k = T.pack (symbolVal (Proxy @lbl)) bs <- pure . maybe [] toList $ M.lookup (T.encodeUtf8 k) m - vs <- traverse parseHeader bs + let vs = mapMaybe (hush . parseHeader) bs CookieTuple t <- mkTuple @cs m pure (CookieTuple (I vs :* t)) From b4523094c5dcb37065a5016316545c29f82f5f9c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 11 Oct 2022 11:40:45 +0200 Subject: [PATCH 28/43] Adapt integration test to new error codes --- .../src/Wire/API/Routes/Public/Brig.hs | 4 +- services/brig/src/Brig/API/Auth.hs | 8 ++-- .../brig/test/integration/API/User/Auth.hs | 41 ++++++++++--------- 3 files changed, 28 insertions(+), 25 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index f7042d0f67..a7275e1bc8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1151,8 +1151,8 @@ type AuthAPI = \ Every other combination is invalid.\ \ Access tokens can be given as query parameter or authorisation\ \ header, with the latter being preferred." - :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken + :> Cookies '["zuid" ::: SomeUserToken] -- TODO: CanThrow :> MultiVerb1 'POST '[JSON] TokenResponse ) @@ -1206,8 +1206,8 @@ type AuthAPI = "change-self-email" ( "access" :> "self" :> "email" :> Summary "Change your email address" - :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken + :> Cookies '["zuid" ::: SomeUserToken] :> ReqBody '[JSON] EmailUpdate -- TODO: CanThrow :> MultiVerb diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 180bd9490f..db966eec4a 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -45,8 +45,8 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso -accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess -accessH ut mat = partitionTokens ut mat >>= either (uncurry access) (uncurry access) +accessH :: Maybe SomeAccessToken -> NonEmpty SomeUserToken -> Handler r SomeAccess +accessH mat ut = partitionTokens ut mat >>= either (uncurry access) (uncurry access) access :: TokenPair u a => NonEmpty (Token u) -> Maybe (Token a) -> Handler r SomeAccess access t mt = @@ -78,11 +78,11 @@ logout uts (Just at) = wrapHttpClientE $ Auth.logout (List1 uts) at !>> zauthErr changeSelfEmailH :: Member BlacklistStore r => - NonEmpty SomeUserToken -> Maybe SomeAccessToken -> + NonEmpty SomeUserToken -> EmailUpdate -> Handler r ChangeEmailResponse -changeSelfEmailH uts mat up = do +changeSelfEmailH mat uts up = do toks <- partitionTokens uts mat usr <- either (uncurry validateCredentials) (uncurry validateCredentials) toks let email = euEmail up diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 6631784187..1ac3a2a9a1 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -768,7 +768,7 @@ testInvalidCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Htt testInvalidCookie z b = do -- Syntactically invalid post (unversioned . b . path "/access" . cookieRaw "zuid" "xxx") !!! do - const 403 === statusCode + const 400 === statusCode const (Just "Invalid user token") =~= responseBody -- Expired user <- userId <$> randomUser b @@ -790,7 +790,7 @@ testInvalidToken b = do !!! errResponse where errResponse = do - const 403 === statusCode + const 400 === statusCode const (Just "Invalid access token") =~= responseBody testMissingCookie :: forall u a. ZAuth.TokenPair u a => ZAuth.Env -> Brig -> Http () @@ -805,9 +805,8 @@ testMissingCookie z b = do !!! errResponse where errResponse = do - const 403 === statusCode - const (Just "Missing cookie") =~= responseBody - const (Just "invalid-credentials") =~= responseBody + const 400 === statusCode + const (Just "Header Cookie is required") =~= responseBody testUnknownCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Http () testUnknownCookie z b = do @@ -862,19 +861,19 @@ testAccessSelfEmailAllowed nginz brig withCookie = do . header "Authorization" ("Bearer " <> toByteString' tok) put (req . Bilge.json ()) - !!! const (if withCookie then 400 else 403) === statusCode + !!! const 400 === statusCode put (req . Bilge.json (EmailUpdate email)) - !!! const (if withCookie then 204 else 403) === statusCode + !!! const (if withCookie then 204 else 400) === statusCode -- this test duplicates some of 'initiateEmailUpdateLogin' intentionally. testAccessSelfEmailDenied :: ZAuth.Env -> Nginz -> Brig -> Bool -> Http () testAccessSelfEmailDenied zenv nginz brig withCookie = do + usr <- randomUser brig + let Just email = userEmail usr mbCky <- if withCookie then do - usr <- randomUser brig - let Just email = userEmail usr rsp <- login nginz (emailLogin email defPassword (Just "nexus1")) PersistentCookie toByteString' tok)) - !!! errResponse "invalid-credentials" "Invalid token" - where - errResponse label msg = do - const 403 === statusCode + !!! do + const (if withCookie then 403 else 400) === statusCode when withCookie $ do - const (Just label) =~= responseBody - const (Just msg) =~= responseBody + const (Just "Invalid token") =~= responseBody + const (Just "invalid-credentials") =~= responseBody -- | We are a little bit nasty on this test. For most cases, one can use brig and nginz interchangeably. -- In this case, the issue relates to the usage of `getAndTestDBSupersededCookieAndItsValidSuccessor`. From 719763e06b92a4079250057a444253dc969eca34 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 11 Oct 2022 12:18:48 +0200 Subject: [PATCH 29/43] Add CanThrow annotations --- libs/wire-api/src/Wire/API/Error/Brig.hs | 27 +++++++++++++++ .../src/Wire/API/Routes/Public/Brig.hs | 19 ++++++++--- services/brig/src/Brig/API/Error.hs | 33 +++++-------------- 3 files changed, 50 insertions(+), 29 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 2ce133f35f..03c1508da8 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -55,6 +55,12 @@ data BrigError | MLSProtocolError | MLSDuplicatePublicKey | InvalidPhone + | PasswordExists + | AccountSuspended + | AccountEphemeral + | AccountPending + | LoginCodeAuthenticationFailed + | LoginCodeAuthenticationRequired | UserKeyExists | NameManagedByScim | HandleManagedByScim @@ -162,6 +168,27 @@ type instance MapError 'MLSProtocolError = 'StaticError 400 "mls-protocol-error" type instance MapError 'InvalidPhone = 'StaticError 400 "invalid-phone" "Invalid mobile phone number" +type instance + MapError 'PasswordExists = + 'StaticError + 403 + "password-exists" + "The operation is not permitted because the user has a password set" + +type instance MapError 'AccountSuspended = 'StaticError 403 "suspended" "Account suspended" + +type instance MapError 'AccountEphemeral = 'StaticError 403 "ephemeral" "Account ephemeral" + +type instance MapError 'AccountPending = 'StaticError 403 "pending-activation" "Account pending activation" + +type instance + MapError 'LoginCodeAuthenticationFailed = + 'StaticError 403 "code-authentication-failed" "The login code is not valid" + +type instance + MapError 'LoginCodeAuthenticationRequired = + 'StaticError 403 "code-authentication-required" "A login verification code is required." + type instance MapError 'UserKeyExists = 'StaticError 409 "key-exists" "The given e-mail address or phone number is in use." type instance MapError 'NameManagedByScim = 'StaticError 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index a7275e1bc8..b0d7fc24d1 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1153,7 +1153,7 @@ type AuthAPI = \ header, with the latter being preferred." :> Bearer SomeAccessToken :> Cookies '["zuid" ::: SomeUserToken] - -- TODO: CanThrow + :> CanThrow 'BadCredentials :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named @@ -1167,7 +1167,8 @@ type AuthAPI = \ For 2nd factor authentication login with email and password, use the\ \ `/verification-code/send` endpoint." :> ReqBody '[JSON] SendLoginCode - -- TODO: CanThrow + :> CanThrow 'InvalidPhone + :> CanThrow 'PasswordExists :> MultiVerb1 'POST '[JSON] @@ -1186,7 +1187,11 @@ type AuthAPI = ] "persist" Bool - -- TODO: CanThrow + :> CanThrow 'BadCredentials + :> CanThrow 'AccountSuspended + :> CanThrow 'AccountPending + :> CanThrow 'LoginCodeAuthenticationFailed + :> CanThrow 'LoginCodeAuthenticationRequired :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named @@ -1199,7 +1204,7 @@ type AuthAPI = \ result in a 403." :> Cookies '["zuid" ::? SomeUserToken] :> Bearer SomeAccessToken - -- TODO: CanThrow + :> CanThrow 'BadCredentials :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Logout") ) :<|> Named @@ -1209,7 +1214,11 @@ type AuthAPI = :> Bearer SomeAccessToken :> Cookies '["zuid" ::: SomeUserToken] :> ReqBody '[JSON] EmailUpdate - -- TODO: CanThrow + :> CanThrow 'InvalidEmail + :> CanThrow 'UserKeyExists + :> CanThrow 'BlacklistedEmail + :> CanThrow 'BlacklistedPhone + :> CanThrow 'BadCredentials :> MultiVerb 'PUT '[JSON] diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 9eafa8463d..e703bea98e 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -96,7 +96,7 @@ pwResetError ResetPasswordMustDiffer = StdError (errorToWai @'E.ResetPasswordMus sendLoginCodeError :: SendLoginCodeError -> Error sendLoginCodeError (SendLoginInvalidPhone _) = StdError (errorToWai @'E.InvalidPhone) -sendLoginCodeError SendLoginPasswordExists = StdError passwordExists +sendLoginCodeError SendLoginPasswordExists = StdError (errorToWai @'E.PasswordExists) sendActCodeError :: SendActivationCodeError -> Error sendActCodeError (InvalidRecipient k) = StdError $ foldKey (const (errorToWai @'E.InvalidEmail)) (const (errorToWai @'E.InvalidPhone)) k @@ -123,9 +123,9 @@ legalHoldLoginError (LegalHoldReAuthError e) = reauthError e loginError :: LoginError -> Error loginError LoginFailed = StdError (errorToWai @'E.BadCredentials) -loginError LoginSuspended = StdError accountSuspended -loginError LoginEphemeral = StdError accountEphemeral -loginError LoginPendingActivation = StdError accountPending +loginError LoginSuspended = StdError (errorToWai @'E.AccountSuspended) +loginError LoginEphemeral = StdError (errorToWai @'E.AccountEphemeral) +loginError LoginPendingActivation = StdError (errorToWai @'E.AccountPending) loginError (LoginThrottled wait) = RichError loginsTooFrequent @@ -136,15 +136,15 @@ loginError (LoginBlocked wait) = tooManyFailedLogins () [("Retry-After", toByteString' (retryAfterSeconds wait))] -loginError LoginCodeRequired = StdError loginCodeAuthenticationRequired -loginError LoginCodeInvalid = StdError loginCodeAuthenticationFailed +loginError LoginCodeRequired = StdError (errorToWai @'E.LoginCodeAuthenticationRequired) +loginError LoginCodeInvalid = StdError (errorToWai @'E.LoginCodeAuthenticationFailed) authError :: AuthError -> Error authError AuthInvalidUser = StdError (errorToWai @'E.BadCredentials) authError AuthInvalidCredentials = StdError (errorToWai @'E.BadCredentials) -authError AuthSuspended = StdError accountSuspended -authError AuthEphemeral = StdError accountEphemeral -authError AuthPendingInvitation = StdError accountPending +authError AuthSuspended = StdError (errorToWai @'E.AccountSuspended) +authError AuthEphemeral = StdError (errorToWai @'E.AccountEphemeral) +authError AuthPendingInvitation = StdError (errorToWai @'E.AccountPending) reauthError :: ReAuthError -> Error reauthError ReAuthMissingPassword = StdError (errorToWai @'E.MissingAuth) @@ -276,21 +276,6 @@ loginCodePending = Wai.mkError status403 "pending-login" "A login code is still loginCodeNotFound :: Wai.Error loginCodeNotFound = Wai.mkError status404 "no-pending-login" "No login code was found." -loginCodeAuthenticationFailed :: Wai.Error -loginCodeAuthenticationFailed = Wai.mkError status403 "code-authentication-failed" "The login code is not valid." - -loginCodeAuthenticationRequired :: Wai.Error -loginCodeAuthenticationRequired = Wai.mkError status403 "code-authentication-required" "A login verification code is required." - -accountPending :: Wai.Error -accountPending = Wai.mkError status403 "pending-activation" "Account pending activation." - -accountSuspended :: Wai.Error -accountSuspended = Wai.mkError status403 "suspended" "Account suspended." - -accountEphemeral :: Wai.Error -accountEphemeral = Wai.mkError status403 "ephemeral" "Account is ephemeral." - newPasswordMustDiffer :: Wai.Error newPasswordMustDiffer = Wai.mkError status409 "password-must-differ" "For provider password change or reset, new and old password must be different." From c3c14241e6dfef7a7783bdb6fea09635f2aebd58 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 11 Oct 2022 15:38:00 +0200 Subject: [PATCH 30/43] Document Bearer token in Swagger --- libs/wire-api/src/Wire/API/Routes/Bearer.hs | 8 ++++++-- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 1 - 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Bearer.hs b/libs/wire-api/src/Wire/API/Routes/Bearer.hs index 1b4a910590..91337ce102 100644 --- a/libs/wire-api/src/Wire/API/Routes/Bearer.hs +++ b/libs/wire-api/src/Wire/API/Routes/Bearer.hs @@ -17,8 +17,11 @@ module Wire.API.Routes.Bearer where +import Control.Lens ((<>~)) import qualified Data.ByteString as BS +import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Metrics.Servant +import Data.Swagger hiding (Header) import qualified Data.Text.Encoding as T import Imports import Servant @@ -40,8 +43,9 @@ type BearerQueryParam = "access_token" instance HasSwagger api => HasSwagger (Bearer a :> api) where - -- TODO - toSwagger _ = toSwagger (Proxy @api) + toSwagger _ = + toSwagger (Proxy @api) + & security <>~ [SecurityRequirement $ InsOrdHashMap.singleton "ZAuth" []] instance RoutesToPaths api => RoutesToPaths (Bearer a :> api) where getRoutes = getRoutes @api diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index e28fd4f88c..6cf7807dcc 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -64,7 +64,6 @@ newtype CookieTuple cs = CookieTuple {unCookieTuple :: NP I (CookieTypes cs)} type CookieMap = Map ByteString (NonEmpty ByteString) instance HasSwagger api => HasSwagger (Cookies cs :> api) where - -- TODO toSwagger _ = toSwagger (Proxy @api) class CookieArgs (cs :: [*]) where From 16b4253337081edf25d737512c787138a07d05c6 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 11 Oct 2022 16:12:24 +0200 Subject: [PATCH 31/43] Add CHANGELOG entry --- changelog.d/5-internal/auth-servant | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/auth-servant diff --git a/changelog.d/5-internal/auth-servant b/changelog.d/5-internal/auth-servant new file mode 100644 index 0000000000..a77ad3a581 --- /dev/null +++ b/changelog.d/5-internal/auth-servant @@ -0,0 +1 @@ +Convert brig's auth endpoints to servant From 67c6c234b6409bcd593b1d7824e72e765159329d Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 17 Oct 2022 15:46:33 +0200 Subject: [PATCH 32/43] Revert "Adapt integration test to new error codes" This reverts commit 165340ab3072d21fc72cf097c00aabd857c5f584. --- .../src/Wire/API/Routes/Public/Brig.hs | 4 +- services/brig/src/Brig/API/Auth.hs | 8 ++-- .../brig/test/integration/API/User/Auth.hs | 41 +++++++++---------- 3 files changed, 25 insertions(+), 28 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index b0d7fc24d1..46415f2b66 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1151,9 +1151,9 @@ type AuthAPI = \ Every other combination is invalid.\ \ Access tokens can be given as query parameter or authorisation\ \ header, with the latter being preferred." - :> Bearer SomeAccessToken :> Cookies '["zuid" ::: SomeUserToken] :> CanThrow 'BadCredentials + :> Bearer SomeAccessToken :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named @@ -1211,8 +1211,8 @@ type AuthAPI = "change-self-email" ( "access" :> "self" :> "email" :> Summary "Change your email address" - :> Bearer SomeAccessToken :> Cookies '["zuid" ::: SomeUserToken] + :> Bearer SomeAccessToken :> ReqBody '[JSON] EmailUpdate :> CanThrow 'InvalidEmail :> CanThrow 'UserKeyExists diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index db966eec4a..180bd9490f 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -45,8 +45,8 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso -accessH :: Maybe SomeAccessToken -> NonEmpty SomeUserToken -> Handler r SomeAccess -accessH mat ut = partitionTokens ut mat >>= either (uncurry access) (uncurry access) +accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess +accessH ut mat = partitionTokens ut mat >>= either (uncurry access) (uncurry access) access :: TokenPair u a => NonEmpty (Token u) -> Maybe (Token a) -> Handler r SomeAccess access t mt = @@ -78,11 +78,11 @@ logout uts (Just at) = wrapHttpClientE $ Auth.logout (List1 uts) at !>> zauthErr changeSelfEmailH :: Member BlacklistStore r => - Maybe SomeAccessToken -> NonEmpty SomeUserToken -> + Maybe SomeAccessToken -> EmailUpdate -> Handler r ChangeEmailResponse -changeSelfEmailH mat uts up = do +changeSelfEmailH uts mat up = do toks <- partitionTokens uts mat usr <- either (uncurry validateCredentials) (uncurry validateCredentials) toks let email = euEmail up diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 1ac3a2a9a1..6631784187 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -768,7 +768,7 @@ testInvalidCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Htt testInvalidCookie z b = do -- Syntactically invalid post (unversioned . b . path "/access" . cookieRaw "zuid" "xxx") !!! do - const 400 === statusCode + const 403 === statusCode const (Just "Invalid user token") =~= responseBody -- Expired user <- userId <$> randomUser b @@ -790,7 +790,7 @@ testInvalidToken b = do !!! errResponse where errResponse = do - const 400 === statusCode + const 403 === statusCode const (Just "Invalid access token") =~= responseBody testMissingCookie :: forall u a. ZAuth.TokenPair u a => ZAuth.Env -> Brig -> Http () @@ -805,8 +805,9 @@ testMissingCookie z b = do !!! errResponse where errResponse = do - const 400 === statusCode - const (Just "Header Cookie is required") =~= responseBody + const 403 === statusCode + const (Just "Missing cookie") =~= responseBody + const (Just "invalid-credentials") =~= responseBody testUnknownCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Http () testUnknownCookie z b = do @@ -861,19 +862,19 @@ testAccessSelfEmailAllowed nginz brig withCookie = do . header "Authorization" ("Bearer " <> toByteString' tok) put (req . Bilge.json ()) - !!! const 400 === statusCode + !!! const (if withCookie then 400 else 403) === statusCode put (req . Bilge.json (EmailUpdate email)) - !!! const (if withCookie then 204 else 400) === statusCode + !!! const (if withCookie then 204 else 403) === statusCode -- this test duplicates some of 'initiateEmailUpdateLogin' intentionally. testAccessSelfEmailDenied :: ZAuth.Env -> Nginz -> Brig -> Bool -> Http () testAccessSelfEmailDenied zenv nginz brig withCookie = do - usr <- randomUser brig - let Just email = userEmail usr mbCky <- if withCookie then do + usr <- randomUser brig + let Just email = userEmail usr rsp <- login nginz (emailLogin email defPassword (Just "nexus1")) PersistentCookie toByteString' tok)) - !!! do - const (if withCookie then 403 else 400) === statusCode + !!! errResponse "invalid-credentials" "Invalid token" + where + errResponse label msg = do + const 403 === statusCode when withCookie $ do - const (Just "Invalid token") =~= responseBody - const (Just "invalid-credentials") =~= responseBody + const (Just label) =~= responseBody + const (Just msg) =~= responseBody -- | We are a little bit nasty on this test. For most cases, one can use brig and nginz interchangeably. -- In this case, the issue relates to the usage of `getAndTestDBSupersededCookieAndItsValidSuccessor`. From 30ce1f15851d18b5120c4baba8ddbe2574faeef5 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 17 Oct 2022 15:46:37 +0200 Subject: [PATCH 33/43] Make servant cookie parser lenient --- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 15 +++++----- services/brig/src/Brig/API/Auth.hs | 29 ++++++++++++++++---- 2 files changed, 30 insertions(+), 14 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index 6cf7807dcc..189fcbb308 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -18,7 +18,7 @@ module Wire.API.Routes.Cookies where import Control.Error.Util -import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map as M import Data.Metrics.Servant import Data.SOP @@ -55,9 +55,9 @@ type family CookieTypes (cs :: [*]) :: [*] type instance CookieTypes '[] = '[] -type instance CookieTypes ((lbl ::: x) ': cs) = (NonEmpty x ': CookieTypes cs) +type instance CookieTypes ((lbl ::: x) ': cs) = (NonEmpty (Either Text x) ': CookieTypes cs) -type instance CookieTypes ((lbl ::? x) ': cs) = ([x] ': CookieTypes cs) +type instance CookieTypes ((lbl ::? x) ': cs) = ([Either Text x] ': CookieTypes cs) newtype CookieTuple cs = CookieTuple {unCookieTuple :: NP I (CookieTypes cs)} @@ -87,14 +87,13 @@ instance ) => CookieArgs ((lbl ::: (x :: *)) ': cs) where - type AddArgs ((lbl ::: x) ': cs) a = NonEmpty x -> AddArgs cs a + type AddArgs ((lbl ::: x) ': cs) a = NonEmpty (Either Text x) -> AddArgs cs a uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) mapArgs h f = mapArgs @cs h . f mkTuple m = do let k = T.pack (symbolVal (Proxy @lbl)) bs <- note ("Missing cookie: " <> k) $ M.lookup (T.encodeUtf8 k) m - let (es, mvs) = nonEmpty <$> partitionEithers (map parseHeader (toList bs)) - vs <- note (head es) mvs + let vs = fmap parseHeader bs CookieTuple t <- mkTuple @cs m pure (CookieTuple (I vs :* t)) @@ -105,13 +104,13 @@ instance ) => CookieArgs ((lbl ::? (x :: *)) ': cs) where - type AddArgs ((lbl ::? x) ': cs) a = [x] -> AddArgs cs a + type AddArgs ((lbl ::? x) ': cs) a = [Either Text x] -> AddArgs cs a uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) mapArgs h f = mapArgs @cs h . f mkTuple m = do let k = T.pack (symbolVal (Proxy @lbl)) bs <- pure . maybe [] toList $ M.lookup (T.encodeUtf8 k) m - let vs = mapMaybe (hush . parseHeader) bs + let vs = map parseHeader bs CookieTuple t <- mkTuple @cs m pure (CookieTuple (I vs :* t)) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 180bd9490f..1ae21ce5a5 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -35,9 +35,12 @@ import Data.Id import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List1 (List1 (..)) import Data.Qualified +import qualified Data.Text.Lazy as LT import qualified Data.ZAuth.Token as ZAuth import Imports +import Network.HTTP.Types import Network.Wai.Utilities ((!>>)) +import qualified Network.Wai.Utilities.Error as Wai import Polysemy import Wire.API.User import Wire.API.User.Auth hiding (access) @@ -45,8 +48,11 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso -accessH :: NonEmpty SomeUserToken -> Maybe SomeAccessToken -> Handler r SomeAccess -accessH ut mat = partitionTokens ut mat >>= either (uncurry access) (uncurry access) +accessH :: NonEmpty (Either Text SomeUserToken) -> Maybe SomeAccessToken -> Handler r SomeAccess +accessH eut mat = do + ut <- traverse handleTokenErrors eut + partitionTokens ut mat + >>= either (uncurry access) (uncurry access) access :: TokenPair u a => NonEmpty (Token u) -> Maybe (Token a) -> Handler r SomeAccess access t mt = @@ -65,10 +71,11 @@ login l (fromMaybe False -> persist) = do c <- Auth.login l typ !>> loginError traverse mkUserTokenCookie c -logoutH :: [SomeUserToken] -> Maybe SomeAccessToken -> Handler r () +logoutH :: [Either Text SomeUserToken] -> Maybe SomeAccessToken -> Handler r () logoutH [] Nothing = throwStd authMissingCookieAndToken logoutH [] (Just _) = throwStd authMissingCookie -logoutH uts mat = +logoutH euts mat = do + uts <- traverse handleTokenErrors euts partitionTokens uts mat >>= either (uncurry logout) (uncurry logout) @@ -78,11 +85,12 @@ logout uts (Just at) = wrapHttpClientE $ Auth.logout (List1 uts) at !>> zauthErr changeSelfEmailH :: Member BlacklistStore r => - NonEmpty SomeUserToken -> + NonEmpty (Either Text SomeUserToken) -> Maybe SomeAccessToken -> EmailUpdate -> Handler r ChangeEmailResponse -changeSelfEmailH uts mat up = do +changeSelfEmailH euts mat up = do + uts <- traverse handleTokenErrors euts toks <- partitionTokens uts mat usr <- either (uncurry validateCredentials) (uncurry validateCredentials) toks let email = euEmail up @@ -181,3 +189,12 @@ partitionTokens tokens mat = toEither :: SomeUserToken -> Either (ZAuth.Token ZAuth.User) (ZAuth.Token ZAuth.LegalHoldUser) toEither (PlainUserToken ut) = Left ut toEither (LHUserToken lt) = Right lt + +handleTokenErrors :: Either Text a -> Handler r a +handleTokenErrors = + either + ( throwStd + . Wai.mkError status403 "client-error" + . LT.fromStrict + ) + pure From 9060721c6d1c73fab22ce74e85b6cd3c009c5a46 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 19 Oct 2022 11:55:29 +0200 Subject: [PATCH 34/43] More leniency in Servant parsers --- libs/wire-api/src/Wire/API/Routes/Bearer.hs | 8 +-- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 50 +++++++---------- .../src/Wire/API/Routes/Public/Brig.hs | 2 +- services/brig/src/Brig/API/Auth.hs | 53 ++++++++++++------- .../brig/test/integration/API/User/Auth.hs | 13 +++-- 5 files changed, 66 insertions(+), 60 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Bearer.hs b/libs/wire-api/src/Wire/API/Routes/Bearer.hs index 91337ce102..ca88c1c5e4 100644 --- a/libs/wire-api/src/Wire/API/Routes/Bearer.hs +++ b/libs/wire-api/src/Wire/API/Routes/Bearer.hs @@ -35,11 +35,11 @@ instance FromHttpApiData a => FromHttpApiData (Bearer a) where _ -> Left "Invalid authorization scheme" parseUrlPiece = parseHeader . T.encodeUtf8 -type BearerHeader a = Header "Authorization" (Bearer a) +type BearerHeader a = Header' '[Lenient] "Authorization" (Bearer a) type BearerQueryParam = QueryParam' - [Optional, Strict, Description "Access token"] + [Lenient, Description "Access token"] "access_token" instance HasSwagger api => HasSwagger (Bearer a :> api) where @@ -57,11 +57,11 @@ instance ) => HasServer (Bearer a :> api) ctx where - type ServerT (Bearer a :> api) m = Maybe a -> ServerT api m + type ServerT (Bearer a :> api) m = Maybe (Either Text a) -> ServerT api m route _ ctx action = route (Proxy @(BearerHeader a :> BearerQueryParam a :> api)) ctx - (fmap (\f u v -> f (fmap unBearer u <|> v)) action) + (fmap (\f u v -> f (fmap (fmap unBearer) u <|> v)) action) hoistServerWithContext _ ctx f h = hoistServerWithContext (Proxy @api) ctx f . h diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index 189fcbb308..3936e02e6b 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -17,7 +17,6 @@ module Wire.API.Routes.Cookies where -import Control.Error.Util import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map as M import Data.Metrics.Servant @@ -32,32 +31,27 @@ import Web.Cookie (parseCookies) data (:::) a b -data (::?) a b - -- | A combinator to extract cookies from an HTTP request. The recommended way -- to use this combinator is to specify it exactly once in the description of -- an endpoint, passing a list of pairs of cookie name and type, separated by --- either '(:::)' or '(::?)'. The former makes the corresponding cookie --- mandatory, while the latter makes it optional, and returns a 'Maybe' result. +-- '(:::)'. Cookies are always optional. -- -- For example: -- @@ --- Cookies '["foo" ::: Int64, "bar" ::? Text] +-- Cookies '["foo" ::: Int64, "bar" ::: Text] -- @@ --- results in a mandatory cookie with name "foo" containing a 64-bit integer, --- and an optional cookie with name "bar" containing an arbitrary text value. +-- results in a cookie with name "foo" containing a 64-bit integer, and a +-- cookie with name "bar" containing an arbitrary text value. data Cookies (cs :: [*]) -type CookieHeader cs = Header' '[Required] "Cookie" (CookieTuple cs) +type CookieHeader cs = Header "Cookie" (CookieTuple cs) -- CookieTypes = map snd type family CookieTypes (cs :: [*]) :: [*] type instance CookieTypes '[] = '[] -type instance CookieTypes ((lbl ::: x) ': cs) = (NonEmpty (Either Text x) ': CookieTypes cs) - -type instance CookieTypes ((lbl ::? x) ': cs) = ([Either Text x] ': CookieTypes cs) +type instance CookieTypes ((lbl ::: x) ': cs) = ([Either Text x] ': CookieTypes cs) newtype CookieTuple cs = CookieTuple {unCookieTuple :: NP I (CookieTypes cs)} @@ -73,12 +67,14 @@ class CookieArgs (cs :: [*]) where uncurryArgs :: AddArgs cs a -> CookieTuple cs -> a mapArgs :: (a -> b) -> AddArgs cs a -> AddArgs cs b mkTuple :: CookieMap -> Either Text (CookieTuple cs) + emptyTuple :: CookieTuple cs instance CookieArgs '[] where type AddArgs '[] a = a uncurryArgs a _ = a mapArgs h = h - mkTuple _ = pure (CookieTuple Nil) + mkTuple _ = pure emptyTuple + emptyTuple = CookieTuple Nil instance ( CookieArgs cs, @@ -87,24 +83,7 @@ instance ) => CookieArgs ((lbl ::: (x :: *)) ': cs) where - type AddArgs ((lbl ::: x) ': cs) a = NonEmpty (Either Text x) -> AddArgs cs a - uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) - mapArgs h f = mapArgs @cs h . f - mkTuple m = do - let k = T.pack (symbolVal (Proxy @lbl)) - bs <- note ("Missing cookie: " <> k) $ M.lookup (T.encodeUtf8 k) m - let vs = fmap parseHeader bs - CookieTuple t <- mkTuple @cs m - pure (CookieTuple (I vs :* t)) - -instance - ( CookieArgs cs, - KnownSymbol lbl, - FromHttpApiData x - ) => - CookieArgs ((lbl ::? (x :: *)) ': cs) - where - type AddArgs ((lbl ::? x) ': cs) a = [Either Text x] -> AddArgs cs a + type AddArgs ((lbl ::: x) ': cs) a = [Either Text x] -> AddArgs cs a uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) mapArgs h f = mapArgs @cs h . f mkTuple m = do @@ -113,6 +92,7 @@ instance let vs = map parseHeader bs CookieTuple t <- mkTuple @cs m pure (CookieTuple (I vs :* t)) + emptyTuple = CookieTuple (I [] :* unCookieTuple (emptyTuple @cs)) mkCookieMap :: [(ByteString, ByteString)] -> CookieMap mkCookieMap = foldr (\(k, v) -> M.insertWith (<>) k (pure v)) mempty @@ -131,7 +111,13 @@ instance type ServerT (Cookies cs :> api) m = AddArgs cs (ServerT api m) route _ ctx action = - route (Proxy @(CookieHeader cs :> api)) ctx (fmap uncurryArgs action) + route + (Proxy @(CookieHeader cs :> api)) + ctx + ( fmap + (\f -> uncurryArgs f . fromMaybe emptyTuple) + action + ) hoistServerWithContext _ ctx f = mapArgs @cs (hoistServerWithContext (Proxy @api) ctx f) instance RoutesToPaths api => RoutesToPaths (Cookies cs :> api) where diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 46415f2b66..6dd6e9dfa8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1202,7 +1202,7 @@ type AuthAPI = "Calling this endpoint will effectively revoke the given cookie\ \ and subsequent calls to /access with the same cookie will\ \ result in a 403." - :> Cookies '["zuid" ::? SomeUserToken] + :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken :> CanThrow 'BadCredentials :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Logout") diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 1ae21ce5a5..d0a608bab8 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -48,9 +48,13 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso -accessH :: NonEmpty (Either Text SomeUserToken) -> Maybe SomeAccessToken -> Handler r SomeAccess -accessH eut mat = do - ut <- traverse handleTokenErrors eut +accessH :: + [Either Text SomeUserToken] -> + Maybe (Either Text SomeAccessToken) -> + Handler r SomeAccess +accessH ut' mat' = do + ut <- handleTokenErrors ut' + mat <- traverse handleTokenError mat' partitionTokens ut mat >>= either (uncurry access) (uncurry access) @@ -71,11 +75,13 @@ login l (fromMaybe False -> persist) = do c <- Auth.login l typ !>> loginError traverse mkUserTokenCookie c -logoutH :: [Either Text SomeUserToken] -> Maybe SomeAccessToken -> Handler r () -logoutH [] Nothing = throwStd authMissingCookieAndToken -logoutH [] (Just _) = throwStd authMissingCookie -logoutH euts mat = do - uts <- traverse handleTokenErrors euts +logoutH :: + [Either Text SomeUserToken] -> + Maybe (Either Text SomeAccessToken) -> + Handler r () +logoutH uts' mat' = do + uts <- handleTokenErrors uts' + mat <- traverse handleTokenError mat' partitionTokens uts mat >>= either (uncurry logout) (uncurry logout) @@ -85,12 +91,13 @@ logout uts (Just at) = wrapHttpClientE $ Auth.logout (List1 uts) at !>> zauthErr changeSelfEmailH :: Member BlacklistStore r => - NonEmpty (Either Text SomeUserToken) -> - Maybe SomeAccessToken -> + [Either Text SomeUserToken] -> + Maybe (Either Text SomeAccessToken) -> EmailUpdate -> Handler r ChangeEmailResponse -changeSelfEmailH euts mat up = do - uts <- traverse handleTokenErrors euts +changeSelfEmailH uts' mat' up = do + uts <- handleTokenErrors uts' + mat <- traverse handleTokenError mat' toks <- partitionTokens uts mat usr <- either (uncurry validateCredentials) (uncurry validateCredentials) toks let email = euEmail up @@ -162,8 +169,7 @@ mkUserTokenCookie c = do } partitionTokens :: - Foldable f => - f SomeUserToken -> + [SomeUserToken] -> Maybe SomeAccessToken -> Handler r @@ -181,8 +187,9 @@ partitionTokens tokens mat = (([], lt : lts), Nothing) -> pure (Right (lt :| lts, Nothing)) (([], _t : _ts), Just (PlainAccessToken _)) -> throwStd authTokenMismatch (([], lt : lts), Just (LHAccessToken l)) -> pure (Right (lt :| lts, Just l)) - -- impossible - (([], []), _) -> throwStd internalServerError + -- no cookie + (([], []), Nothing) -> throwStd authMissingCookieAndToken + (([], []), _) -> throwStd authMissingCookie -- mixed PlainUserToken and LHUserToken ((_ats, _lts), _) -> throwStd authTokenMismatch where @@ -190,11 +197,21 @@ partitionTokens tokens mat = toEither (PlainUserToken ut) = Left ut toEither (LHUserToken lt) = Right lt -handleTokenErrors :: Either Text a -> Handler r a -handleTokenErrors = +handleTokenError :: Either Text a -> Handler r a +handleTokenError = either ( throwStd . Wai.mkError status403 "client-error" . LT.fromStrict ) pure + +handleTokenErrors :: [Either Text a] -> Handler r [a] +handleTokenErrors ts = case partitionEithers ts of + ((e : _), []) -> + ( throwStd + . Wai.mkError status403 "client-error" + . LT.fromStrict + $ e + ) + (_, vs) -> pure vs diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 6631784187..2ff132e975 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -140,7 +140,7 @@ tests conf m z db b g n = "refresh /access" [ test m "invalid-cookie" (testInvalidCookie @ZAuth.User z b), test m "invalid-cookie legalhold" (testInvalidCookie @ZAuth.LegalHoldUser z b), - test m "invalid-token" (testInvalidToken b), + test m "invalid-token" (testInvalidToken z b), test m "missing-cookie" (testMissingCookie @ZAuth.User @ZAuth.Access z b), test m "missing-cookie legalhold" (testMissingCookie @ZAuth.LegalHoldUser @ZAuth.LegalHoldAccess z b), test m "unknown-cookie" (testUnknownCookie @ZAuth.User z b), @@ -781,12 +781,15 @@ testInvalidCookie z b = do -- @END -testInvalidToken :: Brig -> Http () -testInvalidToken b = do +testInvalidToken :: ZAuth.Env -> Brig -> Http () +testInvalidToken z b = do + user <- userId <$> randomUser b + t <- toByteString' <$> runZAuth z (ZAuth.newUserToken @ZAuth.User user) + -- Syntactically invalid - post (unversioned . b . path "/access" . queryItem "access_token" "xxx") + post (unversioned . b . path "/access" . queryItem "access_token" "xxx" . cookieRaw "zuid" t) !!! errResponse - post (unversioned . b . path "/access" . header "Authorization" "Bearer xxx") + post (unversioned . b . path "/access" . header "Authorization" "Bearer xxx" . cookieRaw "zuid" t) !!! errResponse where errResponse = do From 4a446ac7a27b16b21e3696d1d5c94c3489149f95 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 10:52:31 +0200 Subject: [PATCH 35/43] Adapt some tests --- services/brig/src/Brig/API/Auth.hs | 14 +++++++++++--- services/brig/test/integration/API/User/Auth.hs | 12 ++++++------ 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index d0a608bab8..4447949e55 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -35,6 +35,7 @@ import Data.Id import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List1 (List1 (..)) import Data.Qualified +import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.ZAuth.Token as ZAuth import Imports @@ -200,11 +201,18 @@ partitionTokens tokens mat = handleTokenError :: Either Text a -> Handler r a handleTokenError = either - ( throwStd - . Wai.mkError status403 "client-error" - . LT.fromStrict + ( \e -> + throwStd + . Wai.mkError status403 (label e) + . LT.fromStrict + $ e ) pure + where + -- for backwards compatibility + label e + | T.isPrefixOf "Failed reading" e = "client-error" + | otherwise = "invalid-credentials" handleTokenErrors :: [Either Text a] -> Handler r [a] handleTokenErrors ts = case partitionEithers ts of diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 2ff132e975..7d815ccf91 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -865,7 +865,7 @@ testAccessSelfEmailAllowed nginz brig withCookie = do . header "Authorization" ("Bearer " <> toByteString' tok) put (req . Bilge.json ()) - !!! const (if withCookie then 400 else 403) === statusCode + !!! const 400 === statusCode put (req . Bilge.json (EmailUpdate email)) !!! const (if withCookie then 204 else 403) === statusCode @@ -873,11 +873,11 @@ testAccessSelfEmailAllowed nginz brig withCookie = do -- this test duplicates some of 'initiateEmailUpdateLogin' intentionally. testAccessSelfEmailDenied :: ZAuth.Env -> Nginz -> Brig -> Bool -> Http () testAccessSelfEmailDenied zenv nginz brig withCookie = do + usr <- randomUser brig + let Just email = userEmail usr mbCky <- if withCookie then do - usr <- randomUser brig - let Just email = userEmail usr rsp <- login nginz (emailLogin email defPassword (Just "nexus1")) PersistentCookie toByteString' tok)) !!! errResponse "invalid-credentials" "Invalid token" where From 3810abcf9117df2fe06a4e3764f0767046cb0c4c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 11:28:31 +0200 Subject: [PATCH 36/43] Remove redundant Brig error --- libs/wire-api/src/Wire/API/Error/Brig.hs | 10 ---------- libs/wire-api/src/Wire/API/Routes/Public/Brig.hs | 4 ++-- services/brig/src/Brig/API/Error.hs | 4 ++-- 3 files changed, 4 insertions(+), 14 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 03c1508da8..0903494e5e 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -59,8 +59,6 @@ data BrigError | AccountSuspended | AccountEphemeral | AccountPending - | LoginCodeAuthenticationFailed - | LoginCodeAuthenticationRequired | UserKeyExists | NameManagedByScim | HandleManagedByScim @@ -181,14 +179,6 @@ type instance MapError 'AccountEphemeral = 'StaticError 403 "ephemeral" "Account type instance MapError 'AccountPending = 'StaticError 403 "pending-activation" "Account pending activation" -type instance - MapError 'LoginCodeAuthenticationFailed = - 'StaticError 403 "code-authentication-failed" "The login code is not valid" - -type instance - MapError 'LoginCodeAuthenticationRequired = - 'StaticError 403 "code-authentication-required" "A login verification code is required." - type instance MapError 'UserKeyExists = 'StaticError 409 "key-exists" "The given e-mail address or phone number is in use." type instance MapError 'NameManagedByScim = 'StaticError 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 6dd6e9dfa8..6c429a7382 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1190,8 +1190,8 @@ type AuthAPI = :> CanThrow 'BadCredentials :> CanThrow 'AccountSuspended :> CanThrow 'AccountPending - :> CanThrow 'LoginCodeAuthenticationFailed - :> CanThrow 'LoginCodeAuthenticationRequired + :> CanThrow 'CodeAuthenticationFailed + :> CanThrow 'CodeAuthenticationRequired :> MultiVerb1 'POST '[JSON] TokenResponse ) :<|> Named diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index e703bea98e..faed54da93 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -136,8 +136,8 @@ loginError (LoginBlocked wait) = tooManyFailedLogins () [("Retry-After", toByteString' (retryAfterSeconds wait))] -loginError LoginCodeRequired = StdError (errorToWai @'E.LoginCodeAuthenticationRequired) -loginError LoginCodeInvalid = StdError (errorToWai @'E.LoginCodeAuthenticationFailed) +loginError LoginCodeRequired = StdError (errorToWai @'E.CodeAuthenticationRequired) +loginError LoginCodeInvalid = StdError (errorToWai @'E.CodeAuthenticationFailed) authError :: AuthError -> Error authError AuthInvalidUser = StdError (errorToWai @'E.BadCredentials) From 89812314edbfd4740c8de36ee4c7508f947b0eb2 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 11:29:06 +0200 Subject: [PATCH 37/43] Redundant brackets --- libs/wire-api/src/Wire/API/User/Auth.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index 3d3d2f50c7..99f339d2e2 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -432,7 +432,7 @@ instance ToSchema AccessToken where .= fieldWithDocModifier "access_token" (description ?~ "The opaque access token string") - ( (LBS.fromStrict . T.encodeUtf8) <$> (T.decodeUtf8 . LBS.toStrict) + ( LBS.fromStrict . T.encodeUtf8 <$> (T.decodeUtf8 . LBS.toStrict) .= schema ) <*> tokenType .= field "token_type" schema From 5531174e3a207921154f028b8b2a196aa1879ff9 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 11:32:27 +0200 Subject: [PATCH 38/43] =?UTF-8?q?lbl=20=E2=86=92=20label?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index 3936e02e6b..af51f950b6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -51,7 +51,7 @@ type family CookieTypes (cs :: [*]) :: [*] type instance CookieTypes '[] = '[] -type instance CookieTypes ((lbl ::: x) ': cs) = ([Either Text x] ': CookieTypes cs) +type instance CookieTypes ((label ::: x) ': cs) = ([Either Text x] ': CookieTypes cs) newtype CookieTuple cs = CookieTuple {unCookieTuple :: NP I (CookieTypes cs)} @@ -78,16 +78,16 @@ instance CookieArgs '[] where instance ( CookieArgs cs, - KnownSymbol lbl, + KnownSymbol label, FromHttpApiData x ) => - CookieArgs ((lbl ::: (x :: *)) ': cs) + CookieArgs ((label ::: (x :: *)) ': cs) where - type AddArgs ((lbl ::: x) ': cs) a = [Either Text x] -> AddArgs cs a + type AddArgs ((label ::: x) ': cs) a = [Either Text x] -> AddArgs cs a uncurryArgs f (CookieTuple (I x :* xs)) = uncurryArgs @cs (f x) (CookieTuple xs) mapArgs h f = mapArgs @cs h . f mkTuple m = do - let k = T.pack (symbolVal (Proxy @lbl)) + let k = T.pack (symbolVal (Proxy @label)) bs <- pure . maybe [] toList $ M.lookup (T.encodeUtf8 k) m let vs = map parseHeader bs CookieTuple t <- mkTuple @cs m From 2cc2396b2179c7337dbe8e289bd7efdbc4d4b82b Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 11:41:41 +0200 Subject: [PATCH 39/43] Reformat long line --- services/brig/src/Brig/API/Public.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index cf98846eaf..a4fb57973a 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -178,7 +178,19 @@ servantSitemap :: ] r => ServerT BrigAPI (Handler r) -servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekeyAPI :<|> userClientAPI :<|> connectionAPI :<|> propertiesAPI :<|> mlsAPI :<|> userHandleAPI :<|> searchAPI :<|> authAPI +servantSitemap = + userAPI + :<|> selfAPI + :<|> accountAPI + :<|> clientAPI + :<|> prekeyAPI + :<|> userClientAPI + :<|> connectionAPI + :<|> propertiesAPI + :<|> mlsAPI + :<|> userHandleAPI + :<|> searchAPI + :<|> authAPI where userAPI :: ServerT UserAPI (Handler r) userAPI = From 9be5fe0785d00548cceb74efc13ddc2a0fcd2a4c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 11:45:35 +0200 Subject: [PATCH 40/43] Remove empty routes --- services/brig/brig.cabal | 1 - services/brig/src/Brig/API/Internal.hs | 2 -- services/brig/src/Brig/API/Public.hs | 2 -- services/brig/src/Brig/User/API/Auth.hs | 34 ------------------------- 4 files changed, 39 deletions(-) delete mode 100644 services/brig/src/Brig/User/API/Auth.hs diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 0655272c90..df94145ca1 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -110,7 +110,6 @@ library Brig.Team.Util Brig.Template Brig.Unique - Brig.User.API.Auth Brig.User.API.Handle Brig.User.API.Search Brig.User.Auth diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 3bfcb6ecbb..bb0c7f75bc 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -58,7 +58,6 @@ import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.Types.User import Brig.Types.User.Event (UserEvent (UserUpdated), UserUpdatedData (eupSSOId, eupSSOIdRemoved), emptyUserUpdatedData) -import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Search as Search import qualified Brig.User.EJPD import qualified Brig.User.Search.Index as Index @@ -449,7 +448,6 @@ sitemap = do .&. accept "application" "json" Provider.routesInternal - Auth.routesInternal Search.routesInternal Team.routesInternal diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index a4fb57973a..d105bc2b65 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -62,7 +62,6 @@ import qualified Brig.Team.Email as Team import Brig.Types.Activation (ActivationPair) import Brig.Types.Intra (AccountStatus (Ephemeral), UserAccount (UserAccount, accountUser)) import Brig.Types.User (HavePendingInvitations (..)) -import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Handle as Handle import Brig.User.API.Search (teamUserSearch) import qualified Brig.User.API.Search as Search @@ -328,7 +327,6 @@ sitemap :: Routes Doc.ApiBuilder (Handler r) () sitemap = do Provider.routesPublic - Auth.routesPublic Team.routesPublic Calling.routesPublic diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs deleted file mode 100644 index d8672e269d..0000000000 --- a/services/brig/src/Brig/User/API/Auth.hs +++ /dev/null @@ -1,34 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.User.API.Auth - ( routesPublic, - routesInternal, - ) -where - -import Brig.API.Handler -import qualified Data.Swagger.Build.Api as Doc -import Imports -import Network.Wai.Routing - -routesPublic :: - Routes Doc.ApiBuilder (Handler r) () -routesPublic = pure () - -routesInternal :: Routes a (Handler r) () -routesInternal = pure () From d218c4346b5e86398e69737af4060d950716dcab Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 14:12:50 +0200 Subject: [PATCH 41/43] Apply hlint suggestions --- services/brig/src/Brig/API/Auth.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 4447949e55..87c3e166d8 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -216,10 +216,9 @@ handleTokenError = handleTokenErrors :: [Either Text a] -> Handler r [a] handleTokenErrors ts = case partitionEithers ts of - ((e : _), []) -> - ( throwStd - . Wai.mkError status403 "client-error" - . LT.fromStrict - $ e - ) + (e : _, []) -> + throwStd + . Wai.mkError status403 "client-error" + . LT.fromStrict + $ e (_, vs) -> pure vs From 0c700db2ae314d40b5bc5e586197022a1d431197 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 20 Oct 2022 14:37:22 +0200 Subject: [PATCH 42/43] Regenerate nix derivations --- libs/wire-api/default.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 6c5633ef60..0569448d06 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -22,7 +22,7 @@ , tasty-hunit, tasty-quickcheck, text, time, types-common, unliftio , unordered-containers, uri-bytestring, utf8-string, uuid, vector , wai, wai-extra, wai-utilities, wai-websockets, websockets -, wire-message-proto-lens, x509 +, wire-message-proto-lens, x509, zauth }: mkDerivation { pname = "wire-api"; @@ -45,7 +45,7 @@ mkDerivation { sop-core string-conversions swagger swagger2 tagged text time types-common unordered-containers uri-bytestring utf8-string uuid vector wai wai-extra wai-utilities wai-websockets websockets - wire-message-proto-lens x509 + wire-message-proto-lens x509 zauth ]; testHaskellDepends = [ aeson aeson-pretty aeson-qq async base binary bytestring From 4a3f8ffd8db1626d197a40783053dc14782c6628 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 21 Oct 2022 09:53:41 +0200 Subject: [PATCH 43/43] fixup! Regenerate nix derivations