Hash SCIM tokens

services/spar/package.yaml

@@ -20,6 +20,7 @@ dependencies:
   - aeson
   - aeson-pretty
   - aeson-qq
+  - attoparsec
   - base
   - base64-bytestring
   - bilge
@@ -51,6 +52,7 @@ dependencies:
   - insert-ordered-containers
   - interpolate
   - lens
+  - memory
   - metrics-core
   - metrics-wai
   - mtl

services/spar/spar.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 54710b4d4da7f1d6f621e0c28ded0702090f208db2f230715c129480502db771
+-- hash: 7a433aaa30026803e763166dffe8888607987a8374c359e18186353fbf7136b6
 
 name:           spar
 version:        0.1
@@ -50,6 +50,7 @@ library
     , aeson
     , aeson-pretty
     , aeson-qq
+    , attoparsec
     , base
     , base64-bytestring
     , bilge
@@ -80,6 +81,7 @@ library
     , insert-ordered-containers
     , interpolate
     , lens
+    , memory
     , metrics-core
     , metrics-wai
     , mtl
@@ -128,6 +130,7 @@ executable spar
     , aeson
     , aeson-pretty
     , aeson-qq
+    , attoparsec
     , base
     , base64-bytestring
     , bilge
@@ -158,6 +161,7 @@ executable spar
     , insert-ordered-containers
     , interpolate
     , lens
+    , memory
     , metrics-core
     , metrics-wai
     , mtl
@@ -224,6 +228,7 @@ executable spar-integration
     , aeson-pretty
     , aeson-qq
     , async
+    , attoparsec
     , base
     , base64-bytestring
     , bilge
@@ -258,6 +263,7 @@ executable spar-integration
     , interpolate
     , lens
     , lens-aeson
+    , memory
     , metrics-core
     , metrics-wai
     , mtl
@@ -329,6 +335,7 @@ executable spar-schema
     , aeson
     , aeson-pretty
     , aeson-qq
+    , attoparsec
     , base
     , base64-bytestring
     , bilge
@@ -359,6 +366,7 @@ executable spar-schema
     , insert-ordered-containers
     , interpolate
     , lens
+    , memory
     , metrics-core
     , metrics-wai
     , mtl
@@ -403,6 +411,7 @@ test-suite spec
       Test.Spar.APISpec
       Test.Spar.DataSpec
       Test.Spar.Intra.BrigSpec
+      Test.Spar.Roundtrip.ByteString
       Test.Spar.ScimSpec
       Test.Spar.TypesSpec
       Paths_spar
@@ -416,6 +425,7 @@ test-suite spec
     , aeson
     , aeson-pretty
     , aeson-qq
+    , attoparsec
     , base
     , base64-bytestring
     , bilge
@@ -449,6 +459,7 @@ test-suite spec
     , interpolate
     , lens
     , lens-aeson
+    , memory
     , metrics-core
     , metrics-wai
     , mtl

services/spar/src/Spar/Data.hs

@@ -87,6 +87,7 @@ where
 
 import Brig.Types.Common (Email, fromEmail)
 import Cassandra as Cas
+import Control.Arrow (Arrow ((&&&)))
 import Control.Lens
 import Control.Monad.Except
 import Data.Id
@@ -105,6 +106,7 @@ import URI.ByteString
 import qualified Web.Cookie as Cky
 import Web.Scim.Schema.Common (WithId (..))
 import Web.Scim.Schema.Meta (Meta (..), WithMeta (..))
+import qualified Prelude
 
 -- | A lower bound: @schemaVersion <= whatWeFoundOnCassandra@, not @==@.
 schemaVersion :: Int32
@@ -579,12 +581,15 @@ deleteDefaultSsoCode = retry x5 . write del $ params Quorum ()
 --
 -- docs/developer/scim/storage.md {#DevScimStorageTokens}
 
-type ScimTokenRow = (ScimToken, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text)
+type ScimTokenRow = (ScimTokenLookupKey, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text)
 
 fromScimTokenRow :: ScimTokenRow -> ScimTokenInfo
 fromScimTokenRow (_, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) =
   ScimTokenInfo {..}
 
+scimTokenLookupKey :: ScimTokenRow -> ScimTokenLookupKey
+scimTokenLookupKey (key, _, _, _, _, _) = key
+
 -- | Add a new SCIM provisioning token. The token should be random and
 -- generated by the backend, not by the user.
 insertScimToken ::
@@ -595,22 +600,23 @@ insertScimToken ::
 insertScimToken token ScimTokenInfo {..} = retry x5 . batch $ do
   setType BatchLogged
   setConsistency Quorum
-  addPrepQuery insByToken (token, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr)
-  addPrepQuery insByTeam (token, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr)
-  where
-    insByToken, insByTeam :: PrepQuery W ScimTokenRow ()
-    insByToken =
-      [r|
-      INSERT INTO team_provisioning_by_token
-        (token_, team, id, created_at, idp, descr)
-        VALUES (?, ?, ?, ?, ?, ?)
-    |]
-    insByTeam =
-      [r|
-      INSERT INTO team_provisioning_by_team
-        (token_, team, id, created_at, idp, descr)
-        VALUES (?, ?, ?, ?, ?, ?)
-    |]
+  let tokenHash = hashScimToken token
+  addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr)
+  addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr)
+
+insByToken, insByTeam :: PrepQuery W ScimTokenRow ()
+insByToken =
+  [r|
+  INSERT INTO team_provisioning_by_token
+    (token_, team, id, created_at, idp, descr)
+    VALUES (?, ?, ?, ?, ?, ?)
+  |]
+insByTeam =
+  [r|
+  INSERT INTO team_provisioning_by_team
+    (token_, team, id, created_at, idp, descr)
+    VALUES (?, ?, ?, ?, ?, ?)
+  |]
 
 -- | Check whether a token exists and if yes, what team and IdP are
 -- associated with it.
@@ -619,15 +625,48 @@ lookupScimToken ::
   ScimToken ->
   m (Maybe ScimTokenInfo)
 lookupScimToken token = do
-  mbRow <- retry x1 . query1 sel $ params Quorum (Identity token)
-  pure $ fmap fromScimTokenRow mbRow
-  where
-    sel :: PrepQuery R (Identity ScimToken) ScimTokenRow
+  let tokenHash = hashScimToken token
+  rows <- retry x1 . query sel $ params Quorum (tokenHash, token)
+  case fmap (scimTokenLookupKey &&& Prelude.id) rows of
+    [(ScimTokenLookupKeyHashed _, row)] ->
+      pure (Just (fromScimTokenRow row))
+    [(ScimTokenLookupKeyPlaintext plain, row)] ->
+      convert plain row
+    [(ScimTokenLookupKeyHashed _, _), (ScimTokenLookupKeyPlaintext plain, row)] ->
+      convert plain row
+    [(ScimTokenLookupKeyPlaintext plain, row), (ScimTokenLookupKeyHashed _', _)] ->
+      convert plain row
+    _ -> pure Nothing
+  where
+    sel :: PrepQuery R (ScimTokenHash, ScimToken) ScimTokenRow
     sel =
       [r|
       SELECT token_, team, id, created_at, idp, descr
-        FROM team_provisioning_by_token WHERE token_ = ?
-    |]
+        FROM team_provisioning_by_token WHERE token_ in (?, ?)
+      |]
+
+    convert :: MonadClient m => ScimToken -> ScimTokenRow -> m (Maybe ScimTokenInfo)
+    convert plain row = do
+      let tokenInfo = fromScimTokenRow row
+      connvertPlaintextToken plain tokenInfo
+      pure (Just tokenInfo)
+
+connvertPlaintextToken ::
+  (HasCallStack, MonadClient m) =>
+  ScimToken ->
+  ScimTokenInfo ->
+  m ()
+connvertPlaintextToken token ScimTokenInfo {..} = retry x5 . batch $ do
+  setType BatchLogged
+  setConsistency Quorum
+  addPrepQuery delByTokenLookup (Identity (ScimTokenLookupKeyPlaintext token))
+  let tokenHash = hashScimToken token
+  -- enter by new lookup key
+  addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr)
+  -- update info table
+  addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr)
+  -- remove old lookup key
+  addPrepQuery delByTokenLookup (Identity (ScimTokenLookupKeyPlaintext token))
 
 -- | List all tokens associated with a team, in the order of their creation.
 getScimTokens ::
@@ -645,7 +684,7 @@ getScimTokens team = do
       [r|
       SELECT token_, team, id, created_at, idp, descr
         FROM team_provisioning_by_team WHERE team = ?
-    |]
+      |]
 
 -- | Delete a token.
 deleteScimToken ::
@@ -659,27 +698,29 @@ deleteScimToken team tokenid = do
     setType BatchLogged
     setConsistency Quorum
     addPrepQuery delById (team, tokenid)
-    for_ mbToken $ \(Identity token) ->
-      addPrepQuery delByToken (Identity token)
+    for_ mbToken $ \(Identity key) ->
+      addPrepQuery delByTokenLookup (Identity key)
   where
-    selById :: PrepQuery R (TeamId, ScimTokenId) (Identity ScimToken)
+    selById :: PrepQuery R (TeamId, ScimTokenId) (Identity ScimTokenLookupKey)
     selById =
       [r|
       SELECT token_ FROM team_provisioning_by_team
         WHERE team = ? AND id = ?
     |]
-    delById :: PrepQuery W (TeamId, ScimTokenId) ()
-    delById =
-      [r|
-      DELETE FROM team_provisioning_by_team
-        WHERE team = ? AND id = ?
-    |]
-    delByToken :: PrepQuery W (Identity ScimToken) ()
-    delByToken =
-      [r|
-      DELETE FROM team_provisioning_by_token
-        WHERE token_ = ?
-    |]
+
+delById :: PrepQuery W (TeamId, ScimTokenId) ()
+delById =
+  [r|
+  DELETE FROM team_provisioning_by_team
+    WHERE team = ? AND id = ?
+  |]
+
+delByTokenLookup :: PrepQuery W (Identity ScimTokenLookupKey) ()
+delByTokenLookup =
+  [r|
+  DELETE FROM team_provisioning_by_token
+    WHERE token_ = ?
+|]
 
 -- | Delete all tokens belonging to a team.
 deleteTeamScimTokens ::
@@ -692,14 +733,12 @@ deleteTeamScimTokens team = do
     setType BatchLogged
     setConsistency Quorum
     addPrepQuery delByTeam (Identity team)
-    mapM_ (addPrepQuery delByToken) tokens
+    mapM_ (addPrepQuery delByTokenLookup) tokens
   where
-    sel :: PrepQuery R (Identity TeamId) (Identity ScimToken)
+    sel :: PrepQuery R (Identity TeamId) (Identity ScimTokenLookupKey)
     sel = "SELECT token_ FROM team_provisioning_by_team WHERE team = ?"
     delByTeam :: PrepQuery W (Identity TeamId) ()
     delByTeam = "DELETE FROM team_provisioning_by_team WHERE team = ?"
-    delByToken :: PrepQuery W (Identity ScimToken) ()
-    delByToken = "DELETE FROM team_provisioning_by_token WHERE token_ = ?"
 
 ----------------------------------------------------------------------
 -- SCIM user records

services/spar/src/Spar/Data/Instances.hs

@@ -32,6 +32,7 @@ module Spar.Data.Instances
 where
 
 import Cassandra as Cas
+import Data.ByteString.Conversion (fromByteString, toByteString)
 import Data.String.Conversions
 import Data.X509 (SignedCertificate)
 import Imports
@@ -101,3 +102,18 @@ toVerdictFormat (VerdictFormatConMobile, Just succredir, Just errredir) = Just $
 toVerdictFormat _ = Nothing
 
 deriving instance Cql ScimToken
+
+instance Cql ScimTokenHash where
+  ctype = Tagged TextColumn
+  toCql = CqlText . cs . toByteString
+  fromCql (CqlText t) = maybe (Left "ScimTokenHash: parse error") Right (fromByteString . cs $ t)
+  fromCql _ = Left "ScimTokenHash: expected CqlText"
+
+instance Cql ScimTokenLookupKey where
+  ctype = Tagged TextColumn
+  toCql = \case
+    ScimTokenLookupKeyHashed h -> toCql h
+    ScimTokenLookupKeyPlaintext t -> toCql t
+  fromCql s@(CqlText _) =
+    ScimTokenLookupKeyHashed <$> fromCql s <|> ScimTokenLookupKeyPlaintext <$> fromCql s
+  fromCql _ = Left "ScimTokenLookupKey: expected CqlText"

services/spar/src/Spar/Types.hs

@@ -24,8 +24,12 @@ module Spar.Types where
 
 import Control.Lens (makeLenses)
 import Control.Monad.Except
+import Crypto.Hash (SHA512 (..), hash)
 import Data.Aeson
 import Data.Aeson.TH
+import Data.Attoparsec.ByteString (string)
+import qualified Data.Binary.Builder as BB (fromByteString)
+import Data.ByteArray.Encoding (Base (..), convertToBase)
 import qualified Data.ByteString.Builder as Builder
 import Data.ByteString.Conversion
 import Data.Id (ScimTokenId, TeamId, UserId)
@@ -143,6 +147,25 @@ instance ToJSON IdPMetadataInfo where
 newtype ScimToken = ScimToken {fromScimToken :: Text}
   deriving (Eq, Show, FromJSON, ToJSON, FromByteString, ToByteString)
 
+newtype ScimTokenHash = ScimTokenHash {fromScimTokenHash :: Text}
+  deriving (Eq, Show)
+
+instance FromByteString ScimTokenHash where
+  parser = string "sha512:" *> (ScimTokenHash <$> parser)
+
+instance ToByteString ScimTokenHash where
+  builder (ScimTokenHash t) = BB.fromByteString "sha512:" <> builder t
+
+data ScimTokenLookupKey
+  = ScimTokenLookupKeyHashed ScimTokenHash
+  | ScimTokenLookupKeyPlaintext ScimToken
+  deriving (Eq, Show)
+
+hashScimToken :: ScimToken -> ScimTokenHash
+hashScimToken token =
+  let digest = hash @ByteString @SHA512 (encodeUtf8 (fromScimToken token))
+   in ScimTokenHash (cs @ByteString @Text (convertToBase Base64 digest))
+
 -- | Metadata that we store about each token.
 data ScimTokenInfo = ScimTokenInfo
   { -- | Which team can be managed with the token