typeclassify more functions

services/brig/src/Brig/API.hs

@@ -58,6 +58,7 @@ import qualified Brig.Team.API                 as Team
 import qualified Brig.Team.Email               as Team
 import qualified Brig.TURN.API                 as TURN
 import qualified System.Logger.Class           as Log
+import qualified Data.ZAuth.Token              as ZAuth
 
 ---------------------------------------------------------------------------
 -- Sitemap
@@ -1081,8 +1082,8 @@ createUser (_ ::: req) = do
         for_ (liftM3 (,,) (userEmail usr) (createdUserTeam result) (newUserTeam new)) $ \(e, ct, ut) ->
             sendWelcomeEmail e ct ut (Just lang)
     cok <- case acc of
-        UserAccount _ Ephemeral -> lift $ Auth.newCookie (userId usr) SessionCookie (newUserLabel new)
-        UserAccount _ _         -> lift $ Auth.newCookie (userId usr) PersistentCookie (newUserLabel new)
+        UserAccount _ Ephemeral -> lift $ Auth.newCookie @ZAuth.User (userId usr) SessionCookie (newUserLabel new)
+        UserAccount _ _         -> lift $ Auth.newCookie @ZAuth.User (userId usr) PersistentCookie (newUserLabel new)
     lift $ Auth.setResponseCookie cok
         $ setStatus status201
         . addHeader "Location" (toByteString' (userId usr))

services/brig/src/Brig/User/API/Auth.hs

@@ -27,7 +27,6 @@ import qualified Brig.Types.Swagger            as Doc
 import qualified Data.Swagger.Build.Api        as Doc
 import qualified Network.Wai.Utilities.Swagger as Doc
 import qualified Brig.ZAuth                    as ZAuth
-import qualified Data.ZAuth.Token              as ZAuth
 import qualified Network.Wai.Predicate         as P
 
 routes :: Routes Doc.ApiBuilder Handler ()
@@ -217,8 +216,7 @@ legalHoldLogin :: JsonRequest LegalHoldLogin ::: JSON -> Handler Response
 legalHoldLogin (req ::: _) = do
     l <- parseJsonBody req
     let typ = PersistentCookie -- Session cookie isn't a supported use case here
-    a <- undefined -- TODO create and return a LegalHoldUserToken as cookie and a LegalHoldAccessToken as (brig's) AccessToken
-    --a <- Auth.ssoLogin l typ !>> loginError
+    a <- Auth.legalHoldLogin l typ !>> loginError
     tokenResponse a
 
 logout :: JSON ::: Maybe ZAuth.UserToken ::: Maybe ZAuth.AccessToken -> Handler Response
@@ -249,9 +247,8 @@ renew (_ ::: Just ut ::: at) = do
 renewLegalHold :: JSON ::: Maybe ZAuth.LegalHoldUserToken ::: Maybe ZAuth.LegalHoldAccessToken -> Handler Response
 renewLegalHold (_ ::: Nothing :::  _) = throwStd authMissingCookie
 renewLegalHold (_ ::: Just ut ::: at) = do
-    undefined
-    -- a <- Auth.renewAccess ut at !>> zauthError
-    -- tokenResponse a
+    a <- Auth.renewAccess ut at !>> zauthError
+    tokenResponse a
 
 -- Utilities
 
@@ -292,6 +289,6 @@ tokenRequest = opt userToken .&. opt accessToken
                         (setMessage "Invalid access token" (err status403)))
         Just  t -> return t
 
-tokenResponse :: (Auth.Access ZAuth.User) -> Handler Response
+tokenResponse :: ZAuth.UserTokenLike u => Auth.Access u -> Handler Response
 tokenResponse (Auth.Access t  Nothing) = return (json t)
 tokenResponse (Auth.Access t (Just c)) = lift $ Auth.setResponseCookie c (json t)

services/brig/src/Brig/User/Auth.hs

@@ -10,6 +10,7 @@ module Brig.User.Auth
       -- * Internal
     , lookupLoginCode
     , ssoLogin
+    , legalHoldLogin
 
       -- * Re-exports
     , listCookies
@@ -90,17 +91,6 @@ logout ut at = do
     (u, ck) <- validateTokens ut (Just at)
     lift $ revokeCookies u [cookieId ck] []
 
--- renewAccess
---     :: ZAuth.UserToken
---     -> Maybe ZAuth.AccessToken
---     -> ExceptT ZAuth.Failure AppIO (Access ZAuth.User)
--- renewAccess ut at = do
---     (_, ck) <- validateTokens ut at
---     ck' <- lift $ nextCookie ck
---     at' <- lift $ newAccessToken (fromMaybe ck ck') at
---     return $ Access at' ck'
-
--- FUTUREWORK: less code duplication?
 renewAccess
     :: ZAuth.TokenPair u a
     => ZAuth.Token u

services/brig/src/Brig/User/Auth/Cookie.hs

@@ -154,10 +154,11 @@ revokeCookies u ids labels = do
 -- Limited Cookies
 
 newCookieLimited
-    :: UserId
+    :: ZAuth.UserTokenLike t
+    => UserId
     -> CookieType
     -> Maybe CookieLabel
-    -> AppIO (Either RetryAfter (Cookie ZAuth.UserToken))
+    -> AppIO (Either RetryAfter (Cookie (ZAuth.Token t)))
 newCookieLimited u typ label = do
     cs  <- filter ((typ ==) . cookieType) <$> DB.listCookies u
     now <- liftIO =<< view currentTime
@@ -176,8 +177,8 @@ newCookieLimited u typ label = do
 -- HTTP
 
 setResponseCookie
-    :: Monad m
-    => Cookie ZAuth.UserToken
+    :: (Monad m, ZAuth.UserTokenLike u)
+    => Cookie (ZAuth.Token u)
     -> Response
     -> AppT m Response
 setResponseCookie c r = do

services/brig/src/Brig/ZAuth.hs

@@ -188,7 +188,7 @@ mkEnv sk pk sets = do
     let zv = ZV.mkEnv (NonEmpty.head pk) (NonEmpty.tail pk)
     return $! Env zc zv sets
 
-class (UserTokenLike u, AccessTokenLike a, ToByteString u, ToByteString a) => TokenPair u a where
+class (UserTokenLike u, AccessTokenLike a) => TokenPair u a where
     newAccessToken :: MonadZAuth m => Token u -> m (Token a)
 
 instance TokenPair User Access where
@@ -197,7 +197,7 @@ instance TokenPair User Access where
 instance TokenPair LegalHoldUser LegalHoldAccess where
     newAccessToken = newLegalHoldAccessToken
 
-class AccessTokenLike a where
+class ToByteString a => AccessTokenLike a where
     accessTokenOf :: Token a -> UserId
     renewAccessToken :: MonadZAuth m => Token a -> m (Token a)
     settingsTTL :: Maybe (Token a) -> Settings -> Integer -- The token is not used, the compiler just needs a nudge. TODO: Other way to do that?
@@ -212,16 +212,13 @@ instance AccessTokenLike LegalHoldAccess where
     renewAccessToken = renewLegalHoldAccessToken
     settingsTTL _ = legalHoldAccessTokenTimeoutSeconds . (^.legalHoldAccessTokenTimeout)
 
-class UserTokenLike u where
+class ToByteString u => UserTokenLike u where
     userTokenOf :: Token u -> UserId
     mkUserToken :: MonadZAuth m => UserId -> Word32 -> UTCTime -> m (Token u)
     userTokenRand :: Token u -> Word32
     newUserToken :: MonadZAuth m => UserId -> m (Token u)
     newSessionToken :: MonadZAuth m => UserId -> m (Token u)
 
-    -- TODO add these?
-    -- mkToken :: Integer -> UUID -> Word32 -> Create (Token t)
-
 instance UserTokenLike User where
     mkUserToken = mkUserToken'
     userTokenOf = userTokenOf'