[chore] Move Cql instances to avoid orphans

libs/brig-types/src/Brig/Types/Search.hs

@@ -26,6 +26,7 @@ module Brig.Types.Search
   )
 where
 
+import Cassandra qualified as C
 import Data.Aeson
 import Data.Attoparsec.ByteString
 import Data.ByteString.Builder
@@ -77,6 +78,16 @@ instance FromByteString SearchVisibilityInbound where
     SearchableByOwnTeam <$ string "searchable-by-own-team"
       <|> SearchableByAllTeams <$ string "searchable-by-all-teams"
 
+instance C.Cql SearchVisibilityInbound where
+  ctype = C.Tagged C.IntColumn
+
+  toCql SearchableByOwnTeam = C.CqlInt 0
+  toCql SearchableByAllTeams = C.CqlInt 1
+
+  fromCql (C.CqlInt 0) = pure SearchableByOwnTeam
+  fromCql (C.CqlInt 1) = pure SearchableByAllTeams
+  fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n
+
 defaultSearchVisibilityInbound :: SearchVisibilityInbound
 defaultSearchVisibilityInbound = SearchableByOwnTeam
 

libs/types-common/src/Data/Domain.hs

@@ -19,6 +19,7 @@
 
 module Data.Domain where
 
+import Cassandra
 import Control.Lens ((?~))
 import Data.Aeson (FromJSON, FromJSONKey, FromJSONKeyFunction (FromJSONKeyTextParser), ToJSON, ToJSONKey (toJSONKey))
 import Data.Aeson qualified as Aeson
@@ -177,3 +178,9 @@ instance Arbitrary DomainText where
           [ (1, pure ""),
             (5, x) -- to get longer labels
           ]
+
+instance Cql Domain where
+  ctype = Tagged TextColumn
+  toCql = CqlText . domainText
+  fromCql (CqlText txt) = mkDomain txt
+  fromCql _ = Left "Domain: Text expected"

libs/types-common/src/Data/Handle.hs

@@ -25,6 +25,7 @@ module Data.Handle
   )
 where
 
+import Cassandra qualified as C
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Attoparsec.ByteString.Char8 qualified as Atto
 import Data.Bifunctor (Bifunctor (first))
@@ -50,6 +51,8 @@ newtype Handle = Handle
   deriving newtype (ToByteString, Hashable, S.ToParamSchema)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema Handle
 
+deriving instance C.Cql Handle
+
 instance ToSchema Handle where
   schema = fromHandle .= parsedText "Handle" p
     where

libs/wire-api/src/Wire/API/Asset.hs

@@ -31,7 +31,6 @@ module Wire.API.Asset
     -- * AssetKey
     AssetKey (..),
     assetKeyToText,
-    nilAssetKey,
 
     -- * AssetToken
     AssetToken (..),
@@ -63,6 +62,7 @@ module Wire.API.Asset
   )
 where
 
+import Cassandra qualified as C
 import Codec.MIME.Type qualified as MIME
 import Control.Lens (makeLenses, (?~))
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -186,8 +186,11 @@ instance S.ToParamSchema AssetKey where
 instance FromHttpApiData AssetKey where
   parseUrlPiece = first T.pack . runParser parser . T.encodeUtf8
 
-nilAssetKey :: AssetKey
-nilAssetKey = AssetKeyV3 (Id UUID.nil) AssetVolatile
+instance C.Cql AssetKey where
+  ctype = C.Tagged C.TextColumn
+  toCql = C.CqlText . assetKeyToText
+  fromCql (C.CqlText txt) = runParser parser . T.encodeUtf8 $ txt
+  fromCql _ = Left "AssetKey: Text expected"
 
 --------------------------------------------------------------------------------
 -- AssetToken

libs/wire-api/src/Wire/API/Connection.hs

@@ -40,6 +40,7 @@ module Wire.API.Connection
   )
 where
 
+import Cassandra qualified as C
 import Control.Applicative (optional)
 import Control.Lens ((?~))
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -224,6 +225,38 @@ instance ToHttpApiData Relation where
     Cancelled -> "cancelled"
     MissingLegalholdConsent -> "missing-legalhold-consent"
 
+instance C.Cql RelationWithHistory where
+  ctype = C.Tagged C.IntColumn
+
+  fromCql (C.CqlInt i) = case i of
+    0 -> pure AcceptedWithHistory
+    1 -> pure BlockedWithHistory
+    2 -> pure PendingWithHistory
+    3 -> pure IgnoredWithHistory
+    4 -> pure SentWithHistory
+    5 -> pure CancelledWithHistory
+    6 -> pure MissingLegalholdConsentFromAccepted
+    7 -> pure MissingLegalholdConsentFromBlocked
+    8 -> pure MissingLegalholdConsentFromPending
+    9 -> pure MissingLegalholdConsentFromIgnored
+    10 -> pure MissingLegalholdConsentFromSent
+    11 -> pure MissingLegalholdConsentFromCancelled
+    n -> Left $ "unexpected RelationWithHistory: " ++ show n
+  fromCql _ = Left "RelationWithHistory: int expected"
+
+  toCql AcceptedWithHistory = C.CqlInt 0
+  toCql BlockedWithHistory = C.CqlInt 1
+  toCql PendingWithHistory = C.CqlInt 2
+  toCql IgnoredWithHistory = C.CqlInt 3
+  toCql SentWithHistory = C.CqlInt 4
+  toCql CancelledWithHistory = C.CqlInt 5
+  toCql MissingLegalholdConsentFromAccepted = C.CqlInt 6
+  toCql MissingLegalholdConsentFromBlocked = C.CqlInt 7
+  toCql MissingLegalholdConsentFromPending = C.CqlInt 8
+  toCql MissingLegalholdConsentFromIgnored = C.CqlInt 9
+  toCql MissingLegalholdConsentFromSent = C.CqlInt 10
+  toCql MissingLegalholdConsentFromCancelled = C.CqlInt 11
+
 ----------------
 -- Requests
 

libs/wire-api/src/Wire/API/MLS/CipherSuite.hs

@@ -41,6 +41,7 @@ module Wire.API.MLS.CipherSuite
   )
 where
 
+import Cassandra qualified as C
 import Cassandra.CQL
 import Control.Applicative
 import Control.Error (note)
@@ -134,6 +135,16 @@ instance ToSchema CipherSuiteTag where
           pure
           (cipherSuiteTag (CipherSuite index))
 
+instance C.Cql CipherSuiteTag where
+  ctype = Tagged IntColumn
+  toCql = CqlInt . fromIntegral . cipherSuiteNumber . tagCipherSuite
+
+  fromCql (CqlInt index) =
+    case cipherSuiteTag (CipherSuite (fromIntegral index)) of
+      Just t -> Right t
+      Nothing -> Left "CipherSuiteTag: unexpected index"
+  fromCql _ = Left "CipherSuiteTag: int expected"
+
 -- | See https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol.html#table-5.
 cipherSuiteTag :: CipherSuite -> Maybe CipherSuiteTag
 cipherSuiteTag cs = listToMaybe $ do

libs/wire-api/src/Wire/API/Properties.hs

@@ -25,6 +25,7 @@ module Wire.API.Properties
   )
 where
 
+import Cassandra qualified as C
 import Control.Lens ((?~))
 import Data.Aeson (FromJSON (..), ToJSON (..), Value)
 import Data.Aeson qualified as A
@@ -67,9 +68,17 @@ instance S.ToParamSchema PropertyKey where
       & S.type_ ?~ S.OpenApiString
       & S.format ?~ "printable"
 
+deriving instance C.Cql PropertyKey
+
 -- | A raw, unparsed property value.
 newtype RawPropertyValue = RawPropertyValue {rawPropertyBytes :: LByteString}
 
+instance C.Cql RawPropertyValue where
+  ctype = C.Tagged C.BlobColumn
+  toCql = C.toCql . C.Blob . rawPropertyBytes
+  fromCql (C.CqlBlob v) = pure (RawPropertyValue v)
+  fromCql _ = Left "PropertyValue: Blob expected"
+
 instance {-# OVERLAPPING #-} MimeUnrender JSON RawPropertyValue where
   mimeUnrender _ = pure . RawPropertyValue
 

libs/wire-api/src/Wire/API/User.hs

@@ -159,6 +159,7 @@ module Wire.API.User
   )
 where
 
+import Cassandra qualified as C
 import Control.Applicative
 import Control.Arrow ((&&&))
 import Control.Error.Safe (rightMay)
@@ -345,6 +346,8 @@ instance ToByteString PhonePrefix where
 instance FromHttpApiData PhonePrefix where
   parseUrlPiece = Bifunctor.first cs . phonePrefixParser
 
+deriving instance C.Cql PhonePrefix
+
 phonePrefixParser :: Text -> Either String PhonePrefix
 phonePrefixParser p = maybe err pure (parsePhonePrefix p)
   where
@@ -1362,6 +1365,8 @@ instance FromHttpApiData InvitationCode where
 instance ToHttpApiData InvitationCode where
   toQueryParam = cs . toByteString . fromInvitationCode
 
+deriving instance C.Cql InvitationCode
+
 --------------------------------------------------------------------------------
 -- NewTeamUser
 
@@ -1862,6 +1867,24 @@ instance Schema.ToSchema AccountStatus where
           Schema.element "pending-invitation" PendingInvitation
         ]
 
+instance C.Cql AccountStatus where
+  ctype = C.Tagged C.IntColumn
+
+  toCql Active = C.CqlInt 0
+  toCql Suspended = C.CqlInt 1
+  toCql Deleted = C.CqlInt 2
+  toCql Ephemeral = C.CqlInt 3
+  toCql PendingInvitation = C.CqlInt 4
+
+  fromCql (C.CqlInt i) = case i of
+    0 -> pure Active
+    1 -> pure Suspended
+    2 -> pure Deleted
+    3 -> pure Ephemeral
+    4 -> pure PendingInvitation
+    n -> Left $ "unexpected account status: " ++ show n
+  fromCql _ = Left "account status: int expected"
+
 data AccountStatusResp = AccountStatusResp {fromAccountStatusResp :: AccountStatus}
   deriving (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform AccountStatusResp)
@@ -2007,6 +2030,13 @@ data BaseProtocolTag = BaseProtocolProteusTag | BaseProtocolMLSTag
   deriving (Arbitrary) via (GenericUniform BaseProtocolTag)
   deriving (FromJSON, ToJSON, S.ToSchema) via (Schema BaseProtocolTag)
 
+instance C.Cql (Imports.Set BaseProtocolTag) where
+  ctype = C.Tagged C.IntColumn
+
+  toCql = C.CqlInt . fromIntegral . protocolSetBits
+  fromCql (C.CqlInt bits) = pure $ protocolSetFromBits (fromIntegral bits)
+  fromCql _ = Left "Protocol set: Int expected"
+
 baseProtocolMask :: BaseProtocolTag -> Word32
 baseProtocolMask BaseProtocolProteusTag = 1
 baseProtocolMask BaseProtocolMLSTag = 2

libs/wire-api/src/Wire/API/User/Activation.hs

@@ -35,6 +35,7 @@ module Wire.API.User.Activation
   )
 where
 
+import Cassandra qualified as C
 import Control.Lens ((?~))
 import Data.Aeson qualified as A
 import Data.Aeson.Types (Parser)
@@ -82,6 +83,8 @@ instance ToParamSchema ActivationKey where
 instance FromHttpApiData ActivationKey where
   parseUrlPiece = fmap ActivationKey . parseUrlPiece
 
+deriving instance C.Cql ActivationKey
+
 --------------------------------------------------------------------------------
 -- ActivationCode
 
@@ -100,6 +103,8 @@ instance ToParamSchema ActivationCode where
 instance FromHttpApiData ActivationCode where
   parseQueryParam = fmap ActivationCode . parseUrlPiece
 
+deriving instance C.Cql ActivationCode
+
 --------------------------------------------------------------------------------
 -- Activate
 

libs/wire-api/src/Wire/API/User/Client.hs

@@ -68,7 +68,7 @@ module Wire.API.User.Client
   )
 where
 
-import Cassandra qualified as Cql
+import Cassandra qualified as C
 import Control.Applicative
 import Control.Lens hiding (element, enum, set, (#), (.=))
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -157,12 +157,12 @@ instance ToSchema ClientCapability where
     enum @Text "ClientCapability" $
       element "legalhold-implicit-consent" ClientSupportsLegalholdImplicitConsent
 
-instance Cql.Cql ClientCapability where
-  ctype = Cql.Tagged Cql.IntColumn
+instance C.Cql ClientCapability where
+  ctype = C.Tagged C.IntColumn
 
-  toCql ClientSupportsLegalholdImplicitConsent = Cql.CqlInt 1
+  toCql ClientSupportsLegalholdImplicitConsent = C.CqlInt 1
 
-  fromCql (Cql.CqlInt i) = case i of
+  fromCql (C.CqlInt i) = case i of
     1 -> pure ClientSupportsLegalholdImplicitConsent
     n -> Left $ "Unexpected ClientCapability value: " ++ show n
   fromCql _ = Left "ClientCapability value: int expected"
@@ -614,6 +614,17 @@ instance ToSchema ClientType where
         <> element "permanent" PermanentClientType
         <> element "legalhold" LegalHoldClientType
 
+instance C.Cql ClientType where
+  ctype = C.Tagged C.IntColumn
+  toCql TemporaryClientType = C.CqlInt 0
+  toCql PermanentClientType = C.CqlInt 1
+  toCql LegalHoldClientType = C.CqlInt 2
+
+  fromCql (C.CqlInt 0) = pure TemporaryClientType
+  fromCql (C.CqlInt 1) = pure PermanentClientType
+  fromCql (C.CqlInt 2) = pure LegalHoldClientType
+  fromCql _ = Left "ClientType: Int [0, 2] expected"
+
 data ClientClass
   = PhoneClient
   | TabletClient
@@ -631,6 +642,19 @@ instance ToSchema ClientClass where
         <> element "desktop" DesktopClient
         <> element "legalhold" LegalHoldClient
 
+instance C.Cql ClientClass where
+  ctype = C.Tagged C.IntColumn
+  toCql PhoneClient = C.CqlInt 0
+  toCql TabletClient = C.CqlInt 1
+  toCql DesktopClient = C.CqlInt 2
+  toCql LegalHoldClient = C.CqlInt 3
+
+  fromCql (C.CqlInt 0) = pure PhoneClient
+  fromCql (C.CqlInt 1) = pure TabletClient
+  fromCql (C.CqlInt 2) = pure DesktopClient
+  fromCql (C.CqlInt 3) = pure LegalHoldClient
+  fromCql _ = Left "ClientClass: Int [0, 3] expected"
+
 --------------------------------------------------------------------------------
 -- NewClient
 

libs/wire-api/src/Wire/API/User/Identity.hs

@@ -52,6 +52,7 @@ module Wire.API.User.Identity
   )
 where
 
+import Cassandra qualified as C
 import Control.Applicative (optional)
 import Control.Lens (dimap, over, (.~), (?~), (^.))
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -199,6 +200,16 @@ instance Arbitrary Email where
     domain <- Text.filter (/= '@') <$> arbitrary
     pure $ Email localPart domain
 
+instance C.Cql Email where
+  ctype = C.Tagged C.TextColumn
+
+  fromCql (C.CqlText t) = case parseEmail t of
+    Just e -> pure e
+    Nothing -> Left "fromCql: Invalid email"
+  fromCql _ = Left "fromCql: email: CqlText expected"
+
+  toCql = C.toCql . fromEmail
+
 fromEmail :: Email -> Text
 fromEmail (Email loc dom) = loc <> "@" <> dom
 
@@ -283,6 +294,8 @@ instance Arbitrary Phone where
       maxi <- mkdigits =<< QC.chooseInt (0, 7)
       pure $ '+' : mini <> maxi
 
+deriving instance C.Cql Phone
+
 -- | Parses a phone number in E.164 format with a mandatory leading '+'.
 parsePhone :: Text -> Maybe Phone
 parsePhone p
@@ -315,6 +328,16 @@ data UserSSOId
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserSSOId)
 
+instance C.Cql UserSSOId where
+  ctype = C.Tagged C.TextColumn
+
+  fromCql (C.CqlText t) = case A.eitherDecode $ cs t of
+    Right i -> pure i
+    Left msg -> Left $ "fromCql: Invalid UserSSOId: " ++ msg
+  fromCql _ = Left "fromCql: UserSSOId: CqlText expected"
+
+  toCql = C.toCql . cs @LByteString @Text . A.encode
+
 -- | FUTUREWORK: This schema should ideally be a choice of either tenant+subject, or scim_external_id
 -- but this is currently not possible to derive in swagger2
 -- Maybe this becomes possible with swagger 3?