From 5eb93c2dd91bda5086c563bc02f44222645a13e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 15 Apr 2024 14:20:46 +0200 Subject: [PATCH 01/28] Drop 'cs' from types-common --- libs/imports/default.nix | 2 -- libs/imports/imports.cabal | 1 - libs/imports/src/Imports.hs | 2 -- libs/types-common/default.nix | 4 ++++ libs/types-common/src/Data/Code.hs | 7 ++++--- libs/types-common/src/Data/Domain.hs | 2 +- libs/types-common/src/Data/Json/Util.hs | 3 ++- libs/types-common/src/Data/Misc.hs | 10 +++++++--- libs/types-common/src/Data/Nonce.hs | 21 ++++++++++++++++----- libs/types-common/src/Util/Logging.hs | 6 +++--- libs/types-common/test/Test/Data/PEMKeys.hs | 1 + libs/types-common/test/Test/Properties.hs | 1 + libs/types-common/types-common.cabal | 2 ++ 13 files changed, 41 insertions(+), 21 deletions(-) diff --git a/libs/imports/default.nix b/libs/imports/default.nix index b1b77f2c86e..728fca8f3b5 100644 --- a/libs/imports/default.nix +++ b/libs/imports/default.nix @@ -11,7 +11,6 @@ , gitignoreSource , lib , mtl -, string-conversions , text , transformers , unliftio @@ -29,7 +28,6 @@ mkDerivation { deepseq extra mtl - string-conversions text transformers unliftio diff --git a/libs/imports/imports.cabal b/libs/imports/imports.cabal index 845228c8f10..a1ddc13d9bb 100644 --- a/libs/imports/imports.cabal +++ b/libs/imports/imports.cabal @@ -75,7 +75,6 @@ library , deepseq , extra , mtl - , string-conversions , text , transformers , unliftio diff --git a/libs/imports/src/Imports.hs b/libs/imports/src/Imports.hs index d44ab47c404..91841bbdd8c 100644 --- a/libs/imports/src/Imports.hs +++ b/libs/imports/src/Imports.hs @@ -114,7 +114,6 @@ module Imports -- * Extra Helpers whenM, unlessM, - cs, -- * Functor (<$$>), @@ -165,7 +164,6 @@ import Data.Ord import Data.Semigroup hiding (diff) import Data.Set (Set) import Data.String -import Data.String.Conversions (cs) import Data.Text (Text) import Data.Text.Lazy qualified import Data.Traversable diff --git a/libs/types-common/default.nix b/libs/types-common/default.nix index abf2ee2f27d..7421aae499c 100644 --- a/libs/types-common/default.nix +++ b/libs/types-common/default.nix @@ -41,6 +41,7 @@ , random , schema-profunctor , servant-server +, string-conversions , tagged , tasty , tasty-hunit @@ -52,6 +53,7 @@ , unix , unordered-containers , uri-bytestring +, utf8-string , uuid , yaml }: @@ -105,6 +107,7 @@ mkDerivation { unix unordered-containers uri-bytestring + utf8-string uuid yaml ]; @@ -116,6 +119,7 @@ mkDerivation { cereal imports protobuf + string-conversions tasty tasty-hunit tasty-quickcheck diff --git a/libs/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index c745b752caa..ef70a0aeb52 100644 --- a/libs/types-common/src/Data/Code.hs +++ b/libs/types-common/src/Data/Code.hs @@ -35,7 +35,8 @@ import Data.Range import Data.Schema import Data.Text (pack) import Data.Text.Ascii -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Time.Clock import Imports import Servant (FromHttpApiData (..), ToHttpApiData (..)) @@ -62,7 +63,7 @@ instance FromHttpApiData Key where first pack $ runParser parser (encodeUtf8 s) instance ToHttpApiData Key where - toQueryParam key = cs (toByteString' key) + toQueryParam key = decodeUtf8With lenientDecode (toByteString' key) -- | A secret value bound to a 'Key' and a 'Timeout'. newtype Value = Value {asciiValue :: Range 6 20 AsciiBase64Url} @@ -85,7 +86,7 @@ instance FromHttpApiData Value where first pack $ runParser parser (encodeUtf8 s) instance ToHttpApiData Value where - toQueryParam key = cs (toByteString' key) + toQueryParam key = decodeUtf8With lenientDecode (toByteString' key) -- | A 'Timeout' is rendered in/parsed from JSON as an integer representing the -- number of seconds remaining. diff --git a/libs/types-common/src/Data/Domain.hs b/libs/types-common/src/Data/Domain.hs index e45d966c85b..ed74cd230a3 100644 --- a/libs/types-common/src/Data/Domain.hs +++ b/libs/types-common/src/Data/Domain.hs @@ -82,7 +82,7 @@ instance FromByteString Domain where parser = domainParser instance ToByteString Domain where - builder = Builder.lazyByteString . cs @Text @LByteString . _domainText + builder = Builder.lazyByteString . BS.Char8.fromStrict . Text.E.encodeUtf8 . _domainText instance FromHttpApiData Domain where parseUrlPiece = first Text.pack . mkDomain diff --git a/libs/types-common/src/Data/Json/Util.hs b/libs/types-common/src/Data/Json/Util.hs index f6c990081ec..91f0e420fe6 100644 --- a/libs/types-common/src/Data/Json/Util.hs +++ b/libs/types-common/src/Data/Json/Util.hs @@ -61,6 +61,7 @@ import Data.ByteString.Base64.URL qualified as B64U import Data.ByteString.Builder qualified as BB import Data.ByteString.Conversion qualified as BS import Data.ByteString.Lazy qualified as L +import Data.ByteString.UTF8 qualified as UTF8 import Data.Fixed import Data.OpenApi qualified as S import Data.Schema @@ -141,7 +142,7 @@ instance Show UTCTimeMillis where showsPrec d = showParen (d > 10) . showString . Text.unpack . showUTCTimeMillis instance BS.ToByteString UTCTimeMillis where - builder = BB.byteString . cs . show + builder = BB.byteString . UTF8.fromString . show instance BS.FromByteString UTCTimeMillis where parser = maybe (fail "UTCTimeMillis") pure . readUTCTimeMillis =<< BS.parser diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index 23a404e2c02..837c24d18c2 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -79,7 +79,8 @@ import Data.OpenApi qualified as S import Data.Range import Data.Schema import Data.Text qualified as Text -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error import GHC.TypeLits (Nat) import GHC.TypeNats (KnownNat) import Imports @@ -139,10 +140,13 @@ instance ToSchema IpAddr where schema = toText .= parsedText "IpAddr" fromText where toText :: IpAddr -> Text - toText = cs . toByteString + toText = decodeUtf8With lenientDecode . toStrict . toByteString fromText :: Text -> Either String IpAddr - fromText = maybe (Left "Failed parsing IP address.") Right . fromByteString . cs + fromText = + maybe (Left "Failed parsing IP address.") Right + . fromByteString + . encodeUtf8 instance ToSchema Port where schema = Port <$> portNumber .= schema diff --git a/libs/types-common/src/Data/Nonce.hs b/libs/types-common/src/Data/Nonce.hs index 1f094bab764..50d84f7c655 100644 --- a/libs/types-common/src/Data/Nonce.hs +++ b/libs/types-common/src/Data/Nonce.hs @@ -35,6 +35,8 @@ import Data.OpenApi qualified as S import Data.OpenApi.ParamSchema import Data.Proxy (Proxy (Proxy)) import Data.Schema +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.UUID as UUID (UUID, fromByteString, toByteString) import Data.UUID.V4 (nextRandom) import Imports @@ -48,10 +50,15 @@ newtype Nonce = Nonce {unNonce :: UUID} deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema Nonce) instance ToSchema Nonce where - schema = (cs . toByteString') .= parsedText "Nonce" p + schema = + (decodeUtf8With lenientDecode . toByteString') .= parsedText "Nonce" p where p :: Text -> Either String Nonce - p = maybe (Left "Invalid Nonce") Right . fromByteString' . cs + p = + maybe (Left "Invalid Nonce") Right + . fromByteString' + . fromStrict + . encodeUtf8 instance ToByteString Nonce where builder = builder . Base64.encodeUnpadded . toStrict . UUID.toByteString . unNonce @@ -68,16 +75,20 @@ instance ToParamSchema Nonce where toParamSchema _ = toParamSchema (Proxy @Text) instance ToHttpApiData Nonce where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData Nonce where - parseQueryParam = maybe (Left "Invalid Nonce") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid Nonce") Right + . fromByteString' + . fromStrict + . encodeUtf8 randomNonce :: MonadIO m => m Nonce randomNonce = Nonce <$> liftIO nextRandom isValidBase64UrlEncodedUUID :: ByteString -> Bool -isValidBase64UrlEncodedUUID = isJust . fromByteString' @Nonce . cs +isValidBase64UrlEncodedUUID = isJust . fromByteString' @Nonce . fromStrict instance Cql Nonce where ctype = Tagged UuidColumn diff --git a/libs/types-common/src/Util/Logging.hs b/libs/types-common/src/Util/Logging.hs index 0b4a3e7c5a2..318785c7578 100644 --- a/libs/types-common/src/Util/Logging.hs +++ b/libs/types-common/src/Util/Logging.hs @@ -29,7 +29,7 @@ import System.Logger.Message (Msg) sha256String :: Text -> Text sha256String t = let digest = hash @ByteString @SHA256 (encodeUtf8 t) - in cs . show $ digest + in T.pack . show $ digest logHandle :: Handle -> (Msg -> Msg) logHandle handl = @@ -44,7 +44,7 @@ logFunction fn = Log.field "fn" fn . Log.field "module" (getModule fn) x -> T.intercalate "." (init x) logUser :: UserId -> (Msg -> Msg) -logUser uid = Log.field "user" (cs @_ @Text . show $ uid) +logUser uid = Log.field "user" (T.pack . show $ uid) logTeam :: TeamId -> (Msg -> Msg) -logTeam tid = Log.field "team" (cs @_ @Text . show $ tid) +logTeam tid = Log.field "team" (T.pack . show $ tid) diff --git a/libs/types-common/test/Test/Data/PEMKeys.hs b/libs/types-common/test/Test/Data/PEMKeys.hs index 013688d7d70..c7a727f23d1 100644 --- a/libs/types-common/test/Test/Data/PEMKeys.hs +++ b/libs/types-common/test/Test/Data/PEMKeys.hs @@ -22,6 +22,7 @@ where import Data.ByteString.Conversion import Data.PEMKeys +import Data.String.Conversions import Imports import Test.Tasty import Test.Tasty.HUnit diff --git a/libs/types-common/test/Test/Properties.hs b/libs/types-common/test/Test/Properties.hs index 8e0556df41d..fbd1de60122 100644 --- a/libs/types-common/test/Test/Properties.hs +++ b/libs/types-common/test/Test/Properties.hs @@ -39,6 +39,7 @@ import Data.Json.Util qualified as Util import Data.Nonce (Nonce) import Data.ProtocolBuffers.Internal import Data.Serialize +import Data.String.Conversions import Data.Text.Ascii import Data.Text.Ascii qualified as Ascii import Data.Time diff --git a/libs/types-common/types-common.cabal b/libs/types-common/types-common.cabal index 14cb8cb6a6a..5fb1c0ca72c 100644 --- a/libs/types-common/types-common.cabal +++ b/libs/types-common/types-common.cabal @@ -136,6 +136,7 @@ library , unix , unordered-containers >=0.2 , uri-bytestring >=0.2 + , utf8-string , uuid >=1.3.11 , yaml >=0.8.22 @@ -209,6 +210,7 @@ test-suite tests , cereal , imports , protobuf + , string-conversions , tasty , tasty-hunit , tasty-quickcheck From 9f413fc32a7827f9d04e5cfe51f5fb58af824fee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 15 Apr 2024 14:49:30 +0200 Subject: [PATCH 02/28] Drop 'cs' from metrics-wai --- libs/metrics-wai/default.nix | 2 ++ libs/metrics-wai/metrics-wai.cabal | 1 + libs/metrics-wai/src/Data/Metrics/Servant.hs | 11 +++++++---- libs/metrics-wai/src/Data/Metrics/Test.hs | 9 +++++++-- 4 files changed, 17 insertions(+), 6 deletions(-) diff --git a/libs/metrics-wai/default.nix b/libs/metrics-wai/default.nix index 616c581b7fd..eb65cf447ae 100644 --- a/libs/metrics-wai/default.nix +++ b/libs/metrics-wai/default.nix @@ -16,6 +16,7 @@ , servant , servant-multipart , text +, utf8-string , wai , wai-middleware-prometheus , wai-route @@ -35,6 +36,7 @@ mkDerivation { servant servant-multipart text + utf8-string wai wai-middleware-prometheus wai-route diff --git a/libs/metrics-wai/metrics-wai.cabal b/libs/metrics-wai/metrics-wai.cabal index 5ea237e1964..3d9725348fe 100644 --- a/libs/metrics-wai/metrics-wai.cabal +++ b/libs/metrics-wai/metrics-wai.cabal @@ -79,6 +79,7 @@ library , servant , servant-multipart , text >=0.11 + , utf8-string , wai >=3 , wai-middleware-prometheus , wai-route >=0.3 diff --git a/libs/metrics-wai/src/Data/Metrics/Servant.hs b/libs/metrics-wai/src/Data/Metrics/Servant.hs index 372cdc95055..b8ec0984997 100644 --- a/libs/metrics-wai/src/Data/Metrics/Servant.hs +++ b/libs/metrics-wai/src/Data/Metrics/Servant.hs @@ -26,11 +26,14 @@ -- | Given a servant API type, this module gives you a 'Paths' for 'withPathTemplate'. module Data.Metrics.Servant where +import Data.ByteString.UTF8 qualified as UTF8 import Data.Metrics.Middleware.Prometheus (normalizeWaiRequestRoute) import Data.Metrics.Types import Data.Metrics.Types qualified as Metrics import Data.Metrics.WaiRoute (treeToPaths) import Data.Proxy +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Tree import GHC.TypeLits import Imports @@ -48,8 +51,8 @@ servantPrometheusMiddleware _ = Promth.prometheus conf . instrument promthNormal promthNormalize :: Wai.Request -> Text promthNormalize req = pathInfo where - mPathInfo = Metrics.treeLookup (routesToPaths @api) $ cs <$> Wai.pathInfo req - pathInfo = cs $ fromMaybe "N/A" mPathInfo + mPathInfo = Metrics.treeLookup (routesToPaths @api) $ encodeUtf8 <$> Wai.pathInfo req + pathInfo = decodeUtf8With lenientDecode $ fromMaybe "N/A" mPathInfo -- See Note [Raw Response] instrument = Promth.instrumentHandlerValueWithFilter Promth.ignoreRawResponses @@ -85,14 +88,14 @@ instance (KnownSymbol seg, RoutesToPaths segs) => RoutesToPaths (seg :> segs) where - getRoutes = [Node (Right . cs $ symbolVal (Proxy @seg)) (getRoutes @segs)] + getRoutes = [Node (Right . UTF8.fromString $ symbolVal (Proxy @seg)) (getRoutes @segs)] -- :> routes instance (KnownSymbol capture, RoutesToPaths segs) => RoutesToPaths (Capture' mods capture a :> segs) where - getRoutes = [Node (Left (cs (":" <> symbolVal (Proxy @capture)))) (getRoutes @segs)] + getRoutes = [Node (Left (UTF8.fromString (":" <> symbolVal (Proxy @capture)))) (getRoutes @segs)] instance (RoutesToPaths rest) => diff --git a/libs/metrics-wai/src/Data/Metrics/Test.hs b/libs/metrics-wai/src/Data/Metrics/Test.hs index 308dc18193f..95016f23a5f 100644 --- a/libs/metrics-wai/src/Data/Metrics/Test.hs +++ b/libs/metrics-wai/src/Data/Metrics/Test.hs @@ -19,6 +19,8 @@ module Data.Metrics.Test where import Data.Metrics.Types import Data.Text qualified as Text +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Tree qualified as Tree import Imports @@ -50,9 +52,12 @@ pathsConsistencyCheck (Paths forest) = mconcat $ go [] <$> forest findSiteConsistencyError prefix subtrees = case mapMaybe captureVars subtrees of [] -> Nothing [_] -> Nothing - bad@(_ : _ : _) -> Just $ SiteConsistencyError (either cs cs <$> prefix) bad + bad@(_ : _ : _) -> + Just $ + SiteConsistencyError (either decode decode <$> prefix) bad captureVars :: Tree.Tree (Either ByteString any) -> Maybe (Text, Int) - captureVars (Tree.Node (Left root) trees) = Just (cs root, weight trees) + captureVars (Tree.Node (Left root) trees) = Just (decode root, weight trees) captureVars (Tree.Node (Right _) _) = Nothing weight :: Tree.Forest a -> Int weight = sum . fmap (length . Tree.flatten) + decode = decodeUtf8With lenientDecode From 427d5d614deff64a28c21359cc55920a65153a0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 15 Apr 2024 15:22:45 +0200 Subject: [PATCH 03/28] Drop 'cs' from extended --- libs/extended/default.nix | 10 +++++++- libs/extended/extended.cabal | 1 + libs/extended/src/Servant/API/Extended.hs | 3 ++- libs/extended/src/System/Logger/Extended.hs | 23 ++++++++++++++++--- .../test/Test/System/Logger/ExtendedSpec.hs | 1 + 5 files changed, 33 insertions(+), 5 deletions(-) diff --git a/libs/extended/default.nix b/libs/extended/default.nix index ad03254ed71..66687c40075 100644 --- a/libs/extended/default.nix +++ b/libs/extended/default.nix @@ -29,6 +29,7 @@ , servant-client-core , servant-openapi3 , servant-server +, string-conversions , temporary , text , time @@ -69,7 +70,14 @@ mkDerivation { unliftio wai ]; - testHaskellDepends = [ aeson base hspec imports temporary ]; + testHaskellDepends = [ + aeson + base + hspec + imports + string-conversions + temporary + ]; testToolDepends = [ hspec-discover ]; description = "Extended versions of common modules"; license = lib.licenses.agpl3Only; diff --git a/libs/extended/extended.cabal b/libs/extended/extended.cabal index 2bfb4d92022..087fb75843a 100644 --- a/libs/extended/extended.cabal +++ b/libs/extended/extended.cabal @@ -172,6 +172,7 @@ test-suite extended-tests , extended , hspec , imports + , string-conversions , temporary default-language: GHC2021 diff --git a/libs/extended/src/Servant/API/Extended.hs b/libs/extended/src/Servant/API/Extended.hs index c1e87f38beb..a531f141bd7 100644 --- a/libs/extended/src/Servant/API/Extended.hs +++ b/libs/extended/src/Servant/API/Extended.hs @@ -19,6 +19,7 @@ -- errors instead of plaintext. module Servant.API.Extended where +import Data.ByteString import Data.ByteString.Lazy qualified as BL import Data.EitherR (fmapL) import Data.Kind @@ -92,7 +93,7 @@ instance fromMaybe "application/octet-stream" $ lookup hContentType $ requestHeaders request - case canHandleCTypeH (Proxy :: Proxy list) (cs contentTypeH) :: Maybe (BL.ByteString -> Either String a) of + case canHandleCTypeH (Proxy :: Proxy list) (fromStrict contentTypeH) :: Maybe (BL.ByteString -> Either String a) of Nothing -> delayedFail err415 Just f -> pure f -- Body check, we get a body parsing functions as the first argument. diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index e360da4e852..2b45c3f746c 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -37,9 +37,12 @@ import Control.Monad.Catch import Data.Aeson as Aeson import Data.Aeson.Encoding (list, pair, text) import Data.Aeson.Key qualified as Key +import Data.ByteString (toStrict) import Data.ByteString.Builder qualified as B import Data.ByteString.Lazy.Char8 qualified as L import Data.Map.Lazy qualified as Map +import Data.Text.Encoding +import Data.Text.Encoding.Error import GHC.Generics import Imports import System.Logger as Log @@ -65,7 +68,14 @@ elementToEncoding :: Element' -> Encoding elementToEncoding (Element' fields msgs) = pairs $ fields <> msgsToSeries msgs where msgsToSeries :: [Builder] -> Series - msgsToSeries = pair "msgs" . list (text . cs . eval) + msgsToSeries = + pair "msgs" + . list + ( text + . decodeUtf8With lenientDecode + . toStrict + . eval + ) collect :: [Element] -> Element' collect = foldr go (Element' mempty []) @@ -74,7 +84,14 @@ collect = foldr go (Element' mempty []) go (Bytes b) (Element' f m) = Element' f (b : m) go (Field k v) (Element' f m) = - Element' (f <> pair (Key.fromText . cs . eval $ k) (text . cs . eval $ v)) m + Element' + ( f + <> pair + (Key.fromText . dec . toStrict . eval $ k) + (text . dec . toStrict . eval $ v) + ) + m + dec = decodeUtf8With lenientDecode jsonRenderer :: Renderer jsonRenderer _sep _dateFormat _logLevel = fromEncoding . elementToEncoding . collect @@ -105,7 +122,7 @@ structuredJSONRenderer _sep _dateFmt _lvlThreshold logElems = renderTextList xs = toJSON xs builderToText :: Builder -> Text - builderToText = cs . eval + builderToText = decodeUtf8With lenientDecode . toStrict . eval -- We need to do this to work around https://gitlab.com/twittner/tinylog/-/issues/5 parseLevel :: Text -> Maybe Level diff --git a/libs/extended/test/Test/System/Logger/ExtendedSpec.hs b/libs/extended/test/Test/System/Logger/ExtendedSpec.hs index 7516a6f7014..753ba59ada7 100644 --- a/libs/extended/test/Test/System/Logger/ExtendedSpec.hs +++ b/libs/extended/test/Test/System/Logger/ExtendedSpec.hs @@ -19,6 +19,7 @@ module Test.System.Logger.ExtendedSpec where import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson +import Data.String.Conversions import Imports import System.IO.Temp import System.Logger.Extended hiding ((.=)) From c766c9a21db9896959348b591db22158e0a86fa4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 15 Apr 2024 15:44:10 +0200 Subject: [PATCH 04/28] Drop 'cs' from wai-utilities --- .../src/Network/Wai/Utilities/Headers.hs | 11 +++++++++-- .../wai-utilities/src/Network/Wai/Utilities/Server.hs | 8 +++++--- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs index f1673e7de13..56049d0ecdf 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs @@ -17,9 +17,12 @@ module Network.Wai.Utilities.Headers where +import Data.ByteString import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString', toByteString') import Data.OpenApi.ParamSchema (ToParamSchema (..)) import Data.Text as T +import Data.Text.Encoding +import Data.Text.Encoding.Error import Imports import Servant (FromHttpApiData (..), Proxy (Proxy), ToHttpApiData (..)) @@ -37,10 +40,14 @@ instance FromByteString CacheControl where _ -> fail $ "Invalid CacheControl type: " ++ show t instance ToHttpApiData CacheControl where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData CacheControl where - parseQueryParam = maybe (Left "Invalid CacheControl") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid CacheControl") Right + . fromByteString' + . fromStrict + . encodeUtf8 instance ToParamSchema CacheControl where toParamSchema _ = toParamSchema (Proxy @Text) diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index e611a3e34fd..80ee4329c13 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -52,6 +52,7 @@ import Control.Error.Util ((?:)) import Control.Exception (throw) import Control.Monad.Catch hiding (onError, onException) import Data.Aeson (decode, encode) +import Data.ByteString (toStrict) import Data.ByteString qualified as BS import Data.ByteString.Builder import Data.ByteString.Char8 qualified as C @@ -61,6 +62,7 @@ import Data.Metrics.GC (spawnGCMetricsCollector) import Data.Metrics.Middleware import Data.Streaming.Zlib (ZlibException (..)) import Data.Text.Encoding.Error (lenientDecode) +import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Encoding qualified as LT import Imports import Network.HTTP.Types.Status @@ -222,7 +224,7 @@ errorHandlers = Wai.mkError status500 "server-error" "Server Error", Handler $ \(e :: SomeException) -> pure . Left $ - Wai.mkError status500 "server-error" ("Server Error. " <> cs (displayException e)) + Wai.mkError status500 "server-error" ("Server Error. " <> LT.pack (displayException e)) ] {-# INLINE errorHandlers #-} @@ -290,7 +292,7 @@ heavyDebugLogging sanitizeReq lvl lgr app = \req cont -> do -- >>> pure $ fromMaybe "" nextChunk emitLByteString :: LByteString -> IO (IO ByteString) emitLByteString lbs = do - tvar <- newTVarIO (cs lbs) + tvar <- newTVarIO (toStrict lbs) -- Emit the bytestring on the first read, then always return "" on subsequent reads pure . atomically $ swapTVar tvar mempty @@ -323,7 +325,7 @@ rethrow5xx logger app req k = app req k' wrapError :: Status -> LByteString -> Wai.Error wrapError st body = decode body ?: - Wai.mkError st "server-error" (cs body) + Wai.mkError st "server-error" (LT.decodeUtf8With lenientDecode body) -- | This flushes the response! If you want to keep using the response, you need to construct -- a new one with a fresh body stream. From 2caf6308804a7943a20eac64308d9a029a8b3c6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:04:20 +0200 Subject: [PATCH 05/28] Drop 'cs' from wire-api --- libs/wire-api/default.nix | 2 + libs/wire-api/src/Wire/API/Call/Config.hs | 10 ++-- libs/wire-api/src/Wire/API/Conversation.hs | 3 +- .../src/Wire/API/Internal/Notification.hs | 2 +- .../src/Wire/API/MLS/AuthenticatedContent.hs | 2 +- libs/wire-api/src/Wire/API/MLS/CipherSuite.hs | 2 +- .../src/Wire/API/MLS/Group/Serialisation.hs | 2 +- libs/wire-api/src/Wire/API/MLS/KeyPackage.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Message.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Proposal.hs | 2 +- .../src/Wire/API/MLS/SubConversation.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Validation.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Welcome.hs | 2 +- libs/wire-api/src/Wire/API/Notification.hs | 3 +- libs/wire-api/src/Wire/API/OAuth.hs | 52 ++++++++++++------- .../Wire/API/Routes/MultiTablePaging/State.hs | 4 +- .../wire-api/src/Wire/API/Routes/MultiVerb.hs | 2 +- libs/wire-api/src/Wire/API/Routes/Named.hs | 5 +- libs/wire-api/src/Wire/API/Routes/Public.hs | 16 +++++- .../src/Wire/API/Routes/Version/Wai.hs | 3 +- libs/wire-api/src/Wire/API/Team/Export.hs | 12 +++-- libs/wire-api/src/Wire/API/Team/Feature.hs | 14 +++-- libs/wire-api/src/Wire/API/User.hs | 27 +++++++--- .../Wire/API/User/Client/DPoPAccessToken.hs | 20 +++++-- libs/wire-api/src/Wire/API/User/Identity.hs | 26 ++++++---- .../src/Wire/API/User/IdentityProvider.hs | 19 +++++-- libs/wire-api/src/Wire/API/User/RichInfo.hs | 6 +-- libs/wire-api/src/Wire/API/User/Saml.hs | 14 ++++- libs/wire-api/src/Wire/API/User/Scim.hs | 7 +-- libs/wire-api/src/Wire/API/User/Search.hs | 2 +- .../golden/Test/Wire/API/Golden/Runner.hs | 1 + .../test/unit/Test/Wire/API/Routes/Version.hs | 1 + .../unit/Test/Wire/API/Routes/Version/Wai.hs | 1 + .../test/unit/Test/Wire/API/User/Search.hs | 1 + libs/wire-api/wire-api.cabal | 2 + 35 files changed, 192 insertions(+), 81 deletions(-) diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 581ac8b9612..b3c02ca5099 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -86,6 +86,7 @@ , singletons-base , singletons-th , sop-core +, string-conversions , tagged , tasty , tasty-hspec @@ -244,6 +245,7 @@ mkDerivation { schema-profunctor servant servant-server + string-conversions tasty tasty-hspec tasty-hunit diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index 442f81fd4af..a4eb530ae5c 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -93,6 +93,7 @@ import Data.Aeson qualified as A hiding (()) import Data.Aeson.Types qualified as A import Data.Attoparsec.Text hiding (Parser, parse) import Data.Attoparsec.Text qualified as Text +import Data.ByteString (toStrict) import Data.ByteString.Builder import Data.ByteString.Conversion (toByteString) import Data.ByteString.Conversion qualified as BC @@ -104,6 +105,7 @@ import Data.Schema import Data.Text qualified as Text import Data.Text.Ascii import Data.Text.Encoding qualified as TE +import Data.Text.Encoding.Error import Data.Text.Strict.Lens (utf8) import Data.Time.Clock.POSIX import Imports @@ -264,7 +266,9 @@ data TurnURI = TurnURI deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TurnURI) instance ToSchema TurnURI where - schema = (cs . toByteString) .= parsedText "TurnURI" parseTurnURI + schema = + (TE.decodeUtf8With lenientDecode . toStrict . toByteString) + .= parsedText "TurnURI" parseTurnURI turnURI :: Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI turnURI = TurnURI @@ -478,7 +482,7 @@ instance ToSchema SFTUsername where fromText = parseOnly (parseSFTUsername <* endOfInput) toText :: SFTUsername -> Text - toText = cs . toByteString + toText = TE.decodeUtf8With lenientDecode . toStrict . toByteString instance BC.ToByteString SFTUsername where builder su = @@ -555,7 +559,7 @@ instance ToSchema TurnUsername where fromText = parseOnly (parseTurnUsername <* endOfInput) toText :: TurnUsername -> Text - toText = cs . toByteString + toText = TE.decodeUtf8With lenientDecode . toStrict . toByteString instance BC.ToByteString TurnUsername where builder tu = diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 84cd7d2390b..120ffe6a921 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -104,6 +104,7 @@ import Data.Range (Range, fromRange, rangedSchema) import Data.SOP import Data.Schema import Data.Set qualified as Set +import Data.Text qualified as Text import Data.UUID qualified as UUID import Data.UUID.V5 qualified as UUIDV5 import Imports @@ -724,7 +725,7 @@ newConvSchema sch = \to be part of this conversation" usersRoleDesc :: Text usersRoleDesc = - cs $ + Text.pack $ "The conversation permissions the users \ \added in this request should have. \ \Optional, defaults to '" diff --git a/libs/wire-api/src/Wire/API/Internal/Notification.hs b/libs/wire-api/src/Wire/API/Internal/Notification.hs index 849c8125460..7d43ef30962 100644 --- a/libs/wire-api/src/Wire/API/Internal/Notification.hs +++ b/libs/wire-api/src/Wire/API/Internal/Notification.hs @@ -47,7 +47,7 @@ import Data.Id import Data.List1 import Data.OpenApi qualified as Swagger import Data.Schema qualified as S -import Imports hiding (cs) +import Imports import Wire.API.Notification ------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs b/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs index 521217f7c53..394a18ede1a 100644 --- a/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs +++ b/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs @@ -25,7 +25,7 @@ module Wire.API.MLS.AuthenticatedContent where import Crypto.PubKey.Ed25519 -import Imports hiding (cs) +import Imports import Wire.API.MLS.CipherSuite import Wire.API.MLS.Context import Wire.API.MLS.Epoch diff --git a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs index f4e24df2989..32073718892 100644 --- a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs +++ b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs @@ -68,7 +68,7 @@ import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Builder qualified as LT import Data.Text.Lazy.Builder.Int qualified as LT import Data.Word -import Imports hiding (cs) +import Imports import Web.HttpApiData import Wire.API.MLS.Serialisation import Wire.Arbitrary diff --git a/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs b/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs index 9a52f1a0879..3250af2f81a 100644 --- a/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs @@ -35,7 +35,7 @@ import Data.Qualified import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.UUID qualified as UUID -import Imports hiding (cs) +import Imports import Web.HttpApiData (FromHttpApiData (parseHeader)) import Wire.API.Conversation import Wire.API.MLS.Group diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index 906ec74fc58..eb736de6ea5 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs @@ -49,7 +49,7 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.X509 qualified as X509 import GHC.Records -import Imports hiding (cs) +import Imports import Test.QuickCheck import Web.HttpApiData import Wire.API.MLS.CipherSuite diff --git a/libs/wire-api/src/Wire/API/MLS/Message.hs b/libs/wire-api/src/Wire/API/MLS/Message.hs index c13dcc0d96f..342bb739e23 100644 --- a/libs/wire-api/src/Wire/API/MLS/Message.hs +++ b/libs/wire-api/src/Wire/API/MLS/Message.hs @@ -45,7 +45,7 @@ import Data.Json.Util import Data.OpenApi qualified as S import Data.Schema hiding (HasField) import GHC.Records -import Imports hiding (cs) +import Imports import Test.QuickCheck hiding (label) import Wire.API.Event.Conversation import Wire.API.MLS.CipherSuite diff --git a/libs/wire-api/src/Wire/API/MLS/Proposal.hs b/libs/wire-api/src/Wire/API/MLS/Proposal.hs index 125364b8362..1ae2ef989ac 100644 --- a/libs/wire-api/src/Wire/API/MLS/Proposal.hs +++ b/libs/wire-api/src/Wire/API/MLS/Proposal.hs @@ -25,7 +25,7 @@ import Control.Lens (makePrisms) import Data.Binary import Data.ByteString as B import GHC.Records -import Imports hiding (cs) +import Imports import Test.QuickCheck import Wire.API.MLS.CipherSuite import Wire.API.MLS.Extension diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs index c01aa3e2366..043984800ac 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -35,7 +35,7 @@ import Data.Schema hiding (HasField) import Data.Text qualified as T import Data.Time.Clock import GHC.Records -import Imports hiding (cs) +import Imports import Servant (FromHttpApiData (..), ToHttpApiData (toQueryParam)) import Test.QuickCheck import Wire.API.MLS.CipherSuite diff --git a/libs/wire-api/src/Wire/API/MLS/Validation.hs b/libs/wire-api/src/Wire/API/MLS/Validation.hs index 2f98d969426..b256f846632 100644 --- a/libs/wire-api/src/Wire/API/MLS/Validation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Validation.hs @@ -29,7 +29,7 @@ import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Builder qualified as LT import Data.Text.Lazy.Builder.Int qualified as LT import Data.X509 qualified as X509 -import Imports hiding (cs) +import Imports import Wire.API.MLS.Capabilities import Wire.API.MLS.CipherSuite import Wire.API.MLS.Credential diff --git a/libs/wire-api/src/Wire/API/MLS/Welcome.hs b/libs/wire-api/src/Wire/API/MLS/Welcome.hs index 08028e31219..8cf1839e9d5 100644 --- a/libs/wire-api/src/Wire/API/MLS/Welcome.hs +++ b/libs/wire-api/src/Wire/API/MLS/Welcome.hs @@ -18,7 +18,7 @@ module Wire.API.MLS.Welcome where import Data.OpenApi qualified as S -import Imports hiding (cs) +import Imports import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.KeyPackage diff --git a/libs/wire-api/src/Wire/API/Notification.hs b/libs/wire-api/src/Wire/API/Notification.hs index 1b7601bce10..83317eb5259 100644 --- a/libs/wire-api/src/Wire/API/Notification.hs +++ b/libs/wire-api/src/Wire/API/Notification.hs @@ -51,6 +51,7 @@ import Data.OpenApi (ToParamSchema (..)) import Data.OpenApi qualified as S import Data.SOP import Data.Schema +import Data.Text.Encoding import Data.Time.Clock (UTCTime) import Data.UUID qualified as UUID import Imports @@ -150,7 +151,7 @@ newtype RawNotificationId = RawNotificationId {unRawNotificationId :: ByteString deriving stock (Eq, Show, Generic) instance FromHttpApiData RawNotificationId where - parseUrlPiece = pure . RawNotificationId . cs + parseUrlPiece = pure . RawNotificationId . encodeUtf8 instance ToParamSchema RawNotificationId where toParamSchema _ = toParamSchema (Proxy @Text) diff --git a/libs/wire-api/src/Wire/API/OAuth.hs b/libs/wire-api/src/Wire/API/OAuth.hs index 8b0a8617ad3..dfbd5987201 100644 --- a/libs/wire-api/src/Wire/API/OAuth.hs +++ b/libs/wire-api/src/Wire/API/OAuth.hs @@ -26,7 +26,7 @@ import Data.Aeson.KeyMap qualified as M import Data.Aeson.Types qualified as A import Data.ByteArray (convert) import Data.ByteString.Conversion -import Data.ByteString.Lazy (toStrict) +import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Either.Combinators (mapLeft) import Data.HashMap.Strict qualified as HM import Data.Id as Id @@ -115,8 +115,8 @@ instance ToSchema OAuthClientConfig where where applicationNameDescription = description ?~ "The name of the application. This will be shown to the user when they are asked to authorize the application. The name must be between " <> minL <> " and " <> maxL <> " characters long." redirectUrlDescription = description ?~ "The URL to redirect to after the user has authorized the application." - minL = cs @String @Text $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMinLength) - maxL = cs @String @Text $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMaxLength) + minL = T.pack $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMinLength) + maxL = T.pack $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMaxLength) newtype OAuthClientPlainTextSecret = OAuthClientPlainTextSecret {unOAuthClientPlainTextSecret :: AsciiBase16} deriving (Eq, Generic, Arbitrary) @@ -130,7 +130,7 @@ instance ToSchema OAuthClientPlainTextSecret where schema = (toText . unOAuthClientPlainTextSecret) .= parsedText "OAuthClientPlainTextSecret" (fmap OAuthClientPlainTextSecret . validateBase16) instance FromHttpApiData OAuthClientPlainTextSecret where - parseQueryParam = bimap cs OAuthClientPlainTextSecret . validateBase16 . cs + parseQueryParam = bimap T.pack OAuthClientPlainTextSecret . validateBase16 instance ToHttpApiData OAuthClientPlainTextSecret where toQueryParam = toText . unOAuthClientPlainTextSecret @@ -236,11 +236,17 @@ instance ToSchema OAuthScopes where schema = OAuthScopes <$> (oauthScopesToText . unOAuthScopes) .= withParser schema oauthScopeParser where oauthScopesToText :: Set OAuthScope -> Text - oauthScopesToText = T.intercalate " " . fmap (cs . toByteString') . Set.toList + oauthScopesToText = + T.intercalate " " + . fmap (TE.decodeUtf8With lenientDecode . toByteString') + . Set.toList oauthScopeParser :: Text -> A.Parser (Set OAuthScope) oauthScopeParser scope = - pure $ (not . T.null) `filter` T.splitOn " " scope & maybe Set.empty Set.fromList . mapM (fromByteString' . cs) + pure $ + (not . T.null) `filter` T.splitOn " " scope + & maybe Set.empty Set.fromList + . mapM (fromByteString' . fromStrict . TE.encodeUtf8) data CodeChallengeMethod = S256 deriving (Eq, Show, Generic) @@ -265,7 +271,7 @@ instance ToSchema OAuthCodeVerifier where schema = OAuthCodeVerifier <$> unOAuthCodeVerifier .= schema instance FromHttpApiData OAuthCodeVerifier where - parseQueryParam = fmap OAuthCodeVerifier . mapLeft cs . checkedEither + parseQueryParam = fmap OAuthCodeVerifier . mapLeft T.pack . checkedEither instance ToHttpApiData OAuthCodeVerifier where toQueryParam = fromRange . unOAuthCodeVerifier @@ -294,7 +300,7 @@ mkChallenge = . encodeBase64UrlUnpadded . convert . Crypto.hash @ByteString @Crypto.SHA256 - . cs + . TE.encodeUtf8 . fromRange . unOAuthCodeVerifier @@ -347,7 +353,7 @@ instance FromByteString OAuthAuthorizationCode where parser = OAuthAuthorizationCode <$> parser instance FromHttpApiData OAuthAuthorizationCode where - parseQueryParam = bimap cs OAuthAuthorizationCode . validateBase16 . cs + parseQueryParam = bimap T.pack OAuthAuthorizationCode . validateBase16 instance ToHttpApiData OAuthAuthorizationCode where toQueryParam = toText . unOAuthAuthorizationCode @@ -379,10 +385,10 @@ instance ToByteString OAuthGrantType where OAuthGrantTypeRefreshToken -> "refresh_token" instance FromHttpApiData OAuthGrantType where - parseQueryParam = maybe (Left "invalid OAuthGrantType") pure . fromByteString . cs + parseQueryParam = maybe (Left "invalid OAuthGrantType") pure . fromByteString . TE.encodeUtf8 instance ToHttpApiData OAuthGrantType where - toQueryParam = cs . toByteString + toQueryParam = TE.decodeUtf8With lenientDecode . toStrict . toByteString data OAuthAccessTokenRequest = OAuthAccessTokenRequest { grantType :: OAuthGrantType, @@ -454,20 +460,27 @@ instance ToByteString (OAuthToken a) where instance FromByteString (OAuthToken a) where parser = do t <- parser @Text - case decodeCompact (cs (TE.encodeUtf8 t)) of + case decodeCompact (fromStrict (TE.encodeUtf8 t)) of Left (err :: JWTError) -> fail $ show err Right jwt -> pure $ OAuthToken jwt instance ToHttpApiData (OAuthToken a) where toHeader = toByteString' - toUrlPiece = cs . toHeader + toUrlPiece = TE.decodeUtf8With lenientDecode . toHeader instance FromHttpApiData (OAuthToken a) where - parseHeader = either (Left . cs) pure . runParser parser . cs - parseUrlPiece = parseHeader . cs + parseHeader = either (Left . T.pack) pure . runParser parser + parseUrlPiece = parseHeader . TE.encodeUtf8 instance ToSchema (OAuthToken a) where - schema = (TE.decodeUtf8 . toByteString') .= withParser schema (either fail pure . runParser parser . cs) + schema = + (TE.decodeUtf8 . toByteString') + .= withParser + schema + ( either fail pure + . runParser parser + . TE.encodeUtf8 + ) type OAuthAccessToken = OAuthToken 'Access @@ -686,8 +699,11 @@ instance Cql OAuthAuthorizationCode where instance Cql OAuthScope where ctype = Tagged TextColumn - toCql = CqlText . cs . toByteString' - fromCql (CqlText t) = maybe (Left "invalid oauth scope") Right $ fromByteString' (cs t) + toCql = CqlText . TE.decodeUtf8With lenientDecode . toByteString' + fromCql (CqlText t) = + maybe (Left "invalid oauth scope") Right $ + fromByteString' . fromStrict . TE.encodeUtf8 $ + t fromCql _ = Left "OAuthScope: Text expected" instance Cql OAuthCodeChallenge where diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs index 7d43b3009be..1fae94b78b4 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs @@ -64,7 +64,9 @@ instance PagingTable tables => ToHttpApiData (MultiTablePagingState name tables) toQueryParam = (Text.decodeUtf8 . Base64Url.encode) . encodePagingState instance PagingTable tables => FromHttpApiData (MultiTablePagingState name tables) where - parseQueryParam = mapLeft cs . (parsePagingState <=< (Base64Url.decode . Text.encodeUtf8)) + parseQueryParam = + mapLeft Text.pack + . (parsePagingState <=< (Base64Url.decode . Text.encodeUtf8)) -- | A class for values that can be encoded with a single byte. Used to add a -- byte of extra information to the paging state in order to recover the table diff --git a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs index ed24bbfdbe5..7c4e6dcd5ab 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs @@ -72,7 +72,7 @@ import Data.Text.Encoding qualified as Text import Data.Typeable import GHC.TypeLits import Generics.SOP as GSOP -import Imports hiding (cs) +import Imports import Network.HTTP.Media qualified as M import Network.HTTP.Types (hContentType) import Network.HTTP.Types qualified as HTTP diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index f76ada19664..5e8220818b5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Named.hs +++ b/libs/wire-api/src/Wire/API/Routes/Named.hs @@ -25,6 +25,7 @@ import Data.Metrics.Servant import Data.OpenApi.Lens hiding (HasServer) import Data.OpenApi.Operation import Data.Proxy +import Data.Text qualified as T import GHC.TypeLits import Imports import Servant @@ -42,7 +43,7 @@ class RenderableSymbol a where renderSymbol :: Text instance {-# OVERLAPPABLE #-} KnownSymbol a => RenderableSymbol a where - renderSymbol = cs . show $ symbolVal (Proxy @a) + renderSymbol = T.pack . show $ symbolVal (Proxy @a) instance {-# OVERLAPPING #-} (RenderableSymbol a, RenderableSymbol b) => RenderableSymbol '(a, b) where renderSymbol = "(" <> (renderSymbol @a) <> ", " <> (renderSymbol @b) <> ")" @@ -55,7 +56,7 @@ instance (HasOpenApi api, RenderableSymbol name) => HasOpenApi (Named name api) dscr :: Text dscr = " [internal route ID: " - <> cs (renderSymbol @name) + <> renderSymbol @name <> "]" instance HasServer api ctx => HasServer (Named name api) ctx where diff --git a/libs/wire-api/src/Wire/API/Routes/Public.hs b/libs/wire-api/src/Wire/API/Routes/Public.hs index f5dd0fd40fa..73b6de1b3f6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public.hs @@ -39,6 +39,7 @@ module Wire.API.Routes.Public where import Control.Lens ((%~), (<>~)) +import Data.ByteString (toStrict) import Data.ByteString.Conversion (toByteString) import Data.Domain import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap @@ -48,6 +49,8 @@ import Data.Metrics.Servant import Data.OpenApi hiding (HasServer, Header, Server) import Data.OpenApi qualified as S import Data.Qualified +import Data.Text.Encoding +import Data.Text.Encoding.Error import GHC.Base (Symbol) import GHC.TypeLits (KnownSymbol) import Imports hiding (All, head) @@ -339,7 +342,18 @@ instance toOpenApi _ = addScopeDescription @scope (toOpenApi (Proxy @api)) addScopeDescription :: forall scope. OAuth.IsOAuthScope scope => OpenApi -> OpenApi -addScopeDescription = allOperations . description %~ Just . (<> "\nOAuth scope: `" <> cs (toByteString (OAuth.toOAuthScope @scope)) <> "`") . fold +addScopeDescription = + allOperations + . description + %~ Just + . ( <> + "\nOAuth scope: `" + <> ( decodeUtf8With lenientDecode . toStrict . toByteString $ + OAuth.toOAuthScope @scope + ) + <> "`" + ) + . fold instance (HasServer api ctx) => HasServer (DescriptionOAuthScope scope :> api) ctx where type ServerT (DescriptionOAuthScope scope :> api) m = ServerT api m diff --git a/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs b/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs index 939b91c5b75..cd797101f11 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs @@ -21,6 +21,7 @@ import Control.Monad.Except (throwError) import Data.ByteString.Conversion import Data.EitherR (fmapL) import Data.Text qualified as T +import Data.Text.Lazy (fromStrict) import Imports import Network.HTTP.Types qualified as HTTP import Network.Wai @@ -44,7 +45,7 @@ versionMiddleware disabledAPIVersions app req k = case parseVersion (removeVersi err :: Text -> IO ResponseReceived err v = k . errorRs' . mkError HTTP.status404 "unsupported-version" $ - "Version " <> cs v <> " is not supported" + "Version " <> fromStrict v <> " is not supported" errint :: IO ResponseReceived errint = diff --git a/libs/wire-api/src/Wire/API/Team/Export.hs b/libs/wire-api/src/Wire/API/Team/Export.hs index f5bfbbe08bb..1f1d4b1462a 100644 --- a/libs/wire-api/src/Wire/API/Team/Export.hs +++ b/libs/wire-api/src/Wire/API/Team/Export.hs @@ -67,7 +67,7 @@ instance ToNamedRecord TeamExportUser where ("managed_by", secureCsvFieldToByteString (tExportManagedBy row)), ("saml_name_id", secureCsvFieldToByteString (tExportSAMLNamedId row)), ("scim_external_id", secureCsvFieldToByteString (tExportSCIMExternalId row)), - ("scim_rich_info", maybe "" (cs . Aeson.encode) (tExportSCIMRichInfo row)), + ("scim_rich_info", maybe "" (C.toStrict . Aeson.encode) (tExportSCIMRichInfo row)), ("user_id", secureCsvFieldToByteString (tExportUserId row)), ("num_devices", secureCsvFieldToByteString (tExportNumDevices row)) ] @@ -100,7 +100,7 @@ allowEmpty p str = Just <$> p str parseByteString :: forall a. FromByteString a => ByteString -> Parser a parseByteString bstr = - case parseOnly (parser @a) (cs (unquoted bstr)) of + case parseOnly (parser @a) (C.fromStrict (unquoted bstr)) of Left err -> fail err Right thing -> pure thing @@ -117,7 +117,13 @@ instance FromNamedRecord TeamExportUser where <*> (nrec .: "managed_by" >>= parseByteString) <*> (nrec .: "saml_name_id" >>= parseByteString) <*> (nrec .: "scim_external_id" >>= parseByteString) - <*> (nrec .: "scim_rich_info" >>= allowEmpty (maybe (fail "failed to decode RichInfo") pure . Aeson.decode . cs)) + <*> ( nrec .: "scim_rich_info" + >>= allowEmpty + ( maybe (fail "failed to decode RichInfo") pure + . Aeson.decode + . C.fromStrict + ) + ) <*> (nrec .: "user_id" >>= parseByteString) <*> (nrec .: "num_devices" >>= parseByteString) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 8dd48682f7a..55319e388d4 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -94,6 +94,7 @@ import Control.Lens (makeLenses, (?~)) import Data.Aeson qualified as A import Data.Aeson.Types qualified as A import Data.Attoparsec.ByteString qualified as Parser +import Data.ByteString (fromStrict) import Data.ByteString.Conversion import Data.ByteString.UTF8 qualified as UTF8 import Data.Domain (Domain) @@ -108,6 +109,7 @@ import Data.Schema import Data.Scientific (toBoundedInteger) import Data.Text qualified as T import Data.Text.Encoding qualified as T +import Data.Text.Encoding.Error import Data.Text.Lazy qualified as TL import Data.Time import Deriving.Aeson @@ -509,7 +511,7 @@ data LockStatus = LockStatusLocked | LockStatusUnlocked deriving (ToJSON, FromJSON, S.ToSchema) via (Schema LockStatus) instance FromHttpApiData LockStatus where - parseUrlPiece = maybeToEither "Invalid lock status" . fromByteString . cs + parseUrlPiece = maybeToEither "Invalid lock status" . fromByteString . T.encodeUtf8 instance ToSchema LockStatus where schema = @@ -1106,7 +1108,7 @@ instance RenderableSymbol EnforceFileDownloadLocationConfig where renderSymbol = "EnforceFileDownloadLocationConfig" instance Arbitrary EnforceFileDownloadLocationConfig where - arbitrary = EnforceFileDownloadLocationConfig . fmap (cs . getPrintableString) <$> arbitrary + arbitrary = EnforceFileDownloadLocationConfig . fmap (T.pack . getPrintableString) <$> arbitrary instance ToSchema EnforceFileDownloadLocationConfig where schema = @@ -1164,10 +1166,14 @@ instance S.ToParamSchema FeatureStatus where } instance FromHttpApiData FeatureStatus where - parseUrlPiece = maybe (Left "must be 'enabled' or 'disabled'") Right . fromByteString' . cs + parseUrlPiece = + maybe (Left "must be 'enabled' or 'disabled'") Right + . fromByteString' + . fromStrict + . T.encodeUtf8 instance ToHttpApiData FeatureStatus where - toUrlPiece = cs . toByteString' + toUrlPiece = T.decodeUtf8With lenientDecode . toByteString' instance ToSchema FeatureStatus where schema = diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 39e01c892ce..e51b6949746 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -170,6 +170,7 @@ import Data.Attoparsec.ByteString qualified as Parser import Data.Attoparsec.Text qualified as TParser import Data.Bifunctor qualified as Bifunctor import Data.Bits +import Data.ByteString (toStrict) import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Conversion import Data.CaseInsensitive qualified as CI @@ -194,6 +195,7 @@ import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Ascii import Data.Text.Encoding qualified as T +import Data.Text.Encoding.Error import Data.Time.Clock (NominalDiffTime) import Data.UUID (UUID, nil) import Data.UUID qualified as UUID @@ -329,7 +331,7 @@ newtype PhonePrefix = PhonePrefix {fromPhonePrefix :: Text} instance Arbitrary PhonePrefix where arbitrary = do digits <- take 8 <$> QC.listOf1 (QC.elements ['0' .. '9']) - pure . PhonePrefix . cs $ "+" <> digits + pure . PhonePrefix . T.pack $ "+" <> digits instance ToSchema PhonePrefix where schema = fromPhonePrefix .= parsedText "PhonePrefix" phonePrefixParser @@ -344,7 +346,7 @@ instance ToByteString PhonePrefix where builder = builder . fromPhonePrefix instance FromHttpApiData PhonePrefix where - parseUrlPiece = Bifunctor.first cs . phonePrefixParser + parseUrlPiece = Bifunctor.first T.pack . phonePrefixParser deriving instance C.Cql PhonePrefix @@ -766,7 +768,11 @@ scimExternalId ManagedByWire (UserSSOId _) = Nothing ssoIssuerAndNameId :: UserSSOId -> Maybe (Text, Text) ssoIssuerAndNameId (UserSSOId (SAML.UserRef (SAML.Issuer uri) nameIdXML)) = Just (fromUri uri, fromNameId nameIdXML) where - fromUri = cs . toLazyByteString . serializeURIRef + fromUri = + T.decodeUtf8With lenientDecode + . toStrict + . toLazyByteString + . serializeURIRef fromNameId = CI.original . SAML.unsafeShowNameID ssoIssuerAndNameId (UserScimExternalId _) = Nothing @@ -1360,10 +1366,14 @@ instance S.ToParamSchema InvitationCode where toParamSchema _ = S.toParamSchema (Proxy @Text) instance FromHttpApiData InvitationCode where - parseQueryParam = bimap cs InvitationCode . validateBase64Url + parseQueryParam = bimap T.pack InvitationCode . validateBase64Url instance ToHttpApiData InvitationCode where - toQueryParam = cs . toByteString . fromInvitationCode + toQueryParam = + T.decodeUtf8With lenientDecode + . toStrict + . toByteString + . fromInvitationCode deriving instance C.Cql InvitationCode @@ -1996,10 +2006,13 @@ instance S.ToParamSchema VerificationAction where } instance FromHttpApiData VerificationAction where - parseUrlPiece = maybeToEither "Invalid verification action" . fromByteString . cs + parseUrlPiece = + maybeToEither "Invalid verification action" + . fromByteString + . T.encodeUtf8 instance ToHttpApiData VerificationAction where - toQueryParam a = cs (toByteString' a) + toQueryParam a = T.decodeUtf8With lenientDecode (toByteString' a) data SendVerificationCode = SendVerificationCode { svcAction :: VerificationAction, diff --git a/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs b/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs index 99ed6e13d92..980e376e7fd 100644 --- a/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs +++ b/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs @@ -21,13 +21,15 @@ module Wire.API.User.Client.DPoPAccessToken where import Data.Aeson (FromJSON, ToJSON) +import Data.ByteString (fromStrict) import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString', toByteString') import Data.OpenApi qualified as S import Data.OpenApi.ParamSchema (ToParamSchema (..)) import Data.SOP import Data.Schema import Data.Text as T -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error import Imports import Servant (FromHttpApiData (..), ToHttpApiData (..)) @@ -36,10 +38,14 @@ newtype Proof = Proof {unProof :: ByteString} deriving newtype (FromByteString, ToByteString) instance ToHttpApiData Proof where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData Proof where - parseQueryParam = maybe (Left "Invalid Proof") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid Proof") Right + . fromByteString' + . fromStrict + . encodeUtf8 instance ToParamSchema Proof where toParamSchema _ = toParamSchema (Proxy @Text) @@ -56,10 +62,14 @@ instance ToParamSchema DPoPAccessToken where toParamSchema _ = toParamSchema (Proxy @Text) instance ToHttpApiData DPoPAccessToken where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData DPoPAccessToken where - parseQueryParam = maybe (Left "Invalid DPoPAccessToken") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid DPoPAccessToken") Right + . fromByteString' + . fromStrict + . encodeUtf8 data AccessTokenType = DPoP deriving (Eq, Show, Generic) diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs index 0475554bfeb..1bca729ebe8 100644 --- a/libs/wire-api/src/Wire/API/User/Identity.hs +++ b/libs/wire-api/src/Wire/API/User/Identity.hs @@ -61,12 +61,15 @@ import Data.Aeson.Types qualified as A import Data.Attoparsec.Text import Data.Bifunctor (first) import Data.ByteString.Conversion +import Data.ByteString.UTF8 qualified as UTF8 import Data.CaseInsensitive qualified as CI import Data.OpenApi (ToParamSchema (..)) import Data.OpenApi qualified as S import Data.Schema import Data.Text qualified as Text -import Data.Text.Encoding (decodeUtf8', encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error +import Data.Text.Lazy qualified as LT import Data.Time.Clock import Data.Tuple.Extra (fst3, snd3, thd3) import Imports @@ -189,10 +192,10 @@ instance FromByteString Email where parser = parser >>= maybe (fail "Invalid email") pure . parseEmail instance S.FromHttpApiData Email where - parseUrlPiece = maybe (Left "Invalid email") Right . fromByteString . cs + parseUrlPiece = maybe (Left "Invalid email") Right . fromByteString . encodeUtf8 instance S.ToHttpApiData Email where - toUrlPiece = cs . toByteString' + toUrlPiece = decodeUtf8With lenientDecode . toByteString' instance Arbitrary Email where arbitrary = do @@ -281,10 +284,10 @@ instance FromByteString Phone where parser = parser >>= maybe (fail "Invalid phone") pure . parsePhone instance S.FromHttpApiData Phone where - parseUrlPiece = maybe (Left "Invalid phone") Right . fromByteString . cs + parseUrlPiece = maybe (Left "Invalid phone") Right . fromByteString . encodeUtf8 instance S.ToHttpApiData Phone where - toUrlPiece = cs . toByteString' + toUrlPiece = decodeUtf8With lenientDecode . toByteString' instance Arbitrary Phone where arbitrary = @@ -394,7 +397,7 @@ lenientlyParseSAMLIssuer mbtxt = forM mbtxt $ \txt -> do asurl :: Either String SAML.Issuer asurl = bimap show SAML.Issuer $ - URI.parseURI URI.laxURIParserOptions (cs txt) + URI.parseURI URI.laxURIParserOptions (encodeUtf8 . LT.toStrict $ txt) err :: String err = "lenientlyParseSAMLIssuer: " <> show (asxml, asurl, mbtxt) @@ -412,11 +415,11 @@ lenientlyParseSAMLNameID (Just txt) = do maybe (Left "not an email") (fmap emailToSAMLNameID . validateEmail) - (parseEmail (cs txt)) + (parseEmail . LT.toStrict $ txt) astxt :: Either String SAML.NameID astxt = do - nm <- mkName (cs txt) + nm <- mkName . LT.toStrict $ txt SAML.mkNameID (SAML.mkUNameIDUnspecified (fromName nm)) Nothing Nothing Nothing err :: String @@ -449,7 +452,12 @@ mkSampleUref :: Text -> Text -> SAML.UserRef mkSampleUref iseed nseed = SAML.UserRef issuer nameid where issuer :: SAML.Issuer - issuer = SAML.Issuer ([uri|http://example.com/|] & URI.pathL .~ cs ("/" cs iseed)) + issuer = + SAML.Issuer + ( [uri|http://example.com/|] + & URI.pathL + .~ UTF8.fromString ("/" Text.unpack iseed) + ) nameid :: SAML.NameID nameid = fromRight (error "impossible") $ do diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index e954f15c2e6..544e8718685 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -28,11 +28,15 @@ import Data.Aeson.Types (parseMaybe) import Data.Attoparsec.ByteString qualified as AP import Data.Binary.Builder qualified as BSB import Data.ByteString.Conversion qualified as BSC +import Data.ByteString.Lazy (fromStrict, toStrict) import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap import Data.Id (TeamId) import Data.OpenApi import Data.Proxy (Proxy (Proxy)) +import Data.Text.Encoding +import Data.Text.Encoding.Error +import Data.Text.Lazy qualified as LT import Imports import Network.HTTP.Media ((//)) import SAML2.WebSSO (IdPConfig) @@ -98,12 +102,14 @@ instance BSC.FromByteString WireIdPAPIVersion where <|> (AP.string "v2" >> pure WireIdPAPIV2) instance FromHttpApiData WireIdPAPIVersion where - parseQueryParam txt = maybe err Right $ BSC.fromByteString' (cs txt) + parseQueryParam txt = + maybe err Right $ + (BSC.fromByteString' . fromStrict . encodeUtf8) txt where err = Left $ "FromHttpApiData WireIdPAPIVersion: " <> txt instance ToHttpApiData WireIdPAPIVersion where - toQueryParam = cs . BSC.toByteString' + toQueryParam = decodeUtf8With lenientDecode . BSC.toByteString' instance ToParamSchema WireIdPAPIVersion where toParamSchema Proxy = @@ -153,10 +159,13 @@ instance Accept RawXML where contentType Proxy = "application" // "xml" instance MimeUnrender RawXML IdPMetadataInfo where - mimeUnrender Proxy raw = IdPMetadataValue (cs raw) <$> mimeUnrender (Proxy @SAML.XML) raw + mimeUnrender Proxy raw = + IdPMetadataValue + (decodeUtf8With lenientDecode . toStrict $ raw) + <$> mimeUnrender (Proxy @SAML.XML) raw instance MimeRender RawXML RawIdPMetadata where - mimeRender Proxy (RawIdPMetadata raw) = cs raw + mimeRender Proxy (RawIdPMetadata raw) = fromStrict . encodeUtf8 $ raw newtype RawIdPMetadata = RawIdPMetadata Text deriving (Eq, Show, Generic) @@ -164,7 +173,7 @@ newtype RawIdPMetadata = RawIdPMetadata Text instance FromJSON IdPMetadataInfo where parseJSON = withObject "IdPMetadataInfo" $ \obj -> do raw <- obj .: "value" - either fail (pure . IdPMetadataValue raw) (SAML.decode (cs raw)) + either fail (pure . IdPMetadataValue raw) (SAML.decode (LT.fromStrict raw)) instance ToJSON IdPMetadataInfo where toJSON (IdPMetadataValue _ x) = diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index e6723b9d651..d84ba4f3c2f 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -133,7 +133,7 @@ ciObject name sch = mkSchema s r w desc = S.description ?~ ("json object with case-insensitive fields." :: Text) r :: A.Value -> A.Parser b - r = A.withObject (cs name) f + r = A.withObject (Text.unpack name) f where f :: A.Object -> A.Parser b f = schemaIn sch . g @@ -350,8 +350,8 @@ instance ToSchema RichField where instance Arbitrary RichField where arbitrary = RichField - <$> (CI.mk . cs . QC.getPrintableString <$> arbitrary) - <*> (cs . QC.getPrintableString <$> arbitrary) + <$> (CI.mk . Text.pack . QC.getPrintableString <$> arbitrary) + <*> (Text.pack . QC.getPrintableString <$> arbitrary) shrink (RichField k v) = RichField <$> QC.shrink k <*> QC.shrink v -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/User/Saml.hs b/libs/wire-api/src/Wire/API/User/Saml.hs index 09ad0d24367..f165a17f76c 100644 --- a/libs/wire-api/src/Wire/API/User/Saml.hs +++ b/libs/wire-api/src/Wire/API/User/Saml.hs @@ -28,11 +28,14 @@ import Control.Lens (makeLenses) import Control.Monad.Except import Data.Aeson hiding (fieldLabelModifier) import Data.Aeson.TH hiding (fieldLabelModifier) +import Data.ByteString (toStrict) import Data.ByteString.Builder qualified as Builder import Data.Id (UserId) import Data.OpenApi import Data.Proxy (Proxy (Proxy)) import Data.Text qualified as T +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Time import GHC.TypeLits (KnownSymbol, symbolVal) import GHC.Types (Symbol) @@ -66,8 +69,15 @@ deriveJSON deriveJSONOptions ''VerdictFormat mkVerdictGrantedFormatMobile :: MonadError String m => URI -> SetCookie -> UserId -> m URI mkVerdictGrantedFormatMobile before cky uid = parseURI' - . substituteVar "cookie" (cs . Builder.toLazyByteString . renderSetCookie $ cky) - . substituteVar "userid" (cs . show $ uid) + . substituteVar + "cookie" + ( decodeUtf8With lenientDecode + . toStrict + . Builder.toLazyByteString + . renderSetCookie + $ cky + ) + . substituteVar "userid" (T.pack . show $ uid) $ renderURI before mkVerdictDeniedFormatMobile :: MonadError String m => URI -> Text -> m URI diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index 1b3e4e50b5e..d8482447523 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -61,6 +61,7 @@ import Data.Map qualified as Map import Data.Misc (PlainTextPassword6) import Data.OpenApi hiding (Operation) import Data.Proxy +import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Time.Clock (UTCTime) import Imports @@ -252,8 +253,8 @@ instance QC.Arbitrary (Scim.User SparTag) where where addFields :: Scim.User.User tag -> QC.Gen (Scim.User.User tag) addFields usr = do - gexternalId <- cs . QC.getPrintableString <$$> QC.arbitrary - gdisplayName <- cs . QC.getPrintableString <$$> QC.arbitrary + gexternalId <- T.pack . QC.getPrintableString <$$> QC.arbitrary + gdisplayName <- T.pack . QC.getPrintableString <$$> QC.arbitrary gactive <- Just . Scim.ScimBool <$> QC.arbitrary -- (`Nothing` maps on `Just True` and was in the way of a unit test.) gemails <- catMaybes <$> (A.decode <$$> QC.listOf (QC.elements ["a@b.c", "x@y,z", "roland@st.uv"])) pure @@ -268,7 +269,7 @@ instance QC.Arbitrary (Scim.User SparTag) where genSchemas = QC.listOf1 $ QC.elements Scim.fakeEnumSchema genUserName :: QC.Gen Text - genUserName = cs . QC.getPrintableString <$> QC.arbitrary + genUserName = T.pack . QC.getPrintableString <$> QC.arbitrary genExtra :: QC.Gen ScimUserExtra genExtra = QC.arbitrary diff --git a/libs/wire-api/src/Wire/API/User/Search.hs b/libs/wire-api/src/Wire/API/User/Search.hs index 8b2fa6fb710..435c7cf3998 100644 --- a/libs/wire-api/src/Wire/API/User/Search.hs +++ b/libs/wire-api/src/Wire/API/User/Search.hs @@ -73,7 +73,7 @@ instance ToParamSchema PagingState where toParamSchema _ = toParamSchema (Proxy @Text) instance FromHttpApiData PagingState where - parseQueryParam s = mapLeft cs $ PagingState <$> validateBase64Url s + parseQueryParam s = mapLeft T.pack $ PagingState <$> validateBase64Url s instance ToHttpApiData PagingState where toQueryParam = toText . unPagingState diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs index f4c9a736005..6a458413d84 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs @@ -33,6 +33,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.ProtoLens.Encoding (decodeMessage, encodeMessage) import Data.ProtoLens.Message (Message) import Data.ProtoLens.TextFormat (readMessage, showMessage) +import Data.String.Conversions import Data.Text.Lazy.IO qualified as LText import Imports import Test.Tasty (TestTree) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs index 603e14776af..b6224933398 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs @@ -4,6 +4,7 @@ import Data.Aeson as Aeson import Data.Binary.Builder import Data.ByteString.Conversion import Data.Set as Set +import Data.String.Conversions import Imports import Servant.API import Test.Tasty diff --git a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs index 573904b8600..2e87537f60b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs @@ -2,6 +2,7 @@ module Test.Wire.API.Routes.Version.Wai where import Data.Proxy import Data.Set qualified as Set +import Data.String.Conversions import Data.Text as T import Imports import Network.HTTP.Types.Status (status200, status400) diff --git a/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs b/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs index ad437d6d06f..a1fd13f4252 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs @@ -20,6 +20,7 @@ module Test.Wire.API.User.Search where import Data.Aeson (encode, toJSON) import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap +import Data.String.Conversions import Imports import Test.Tasty qualified as T import Test.Tasty.QuickCheck (counterexample, testProperty) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index a5ad166cf26..e17d212cde5 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -614,6 +614,7 @@ test-suite wire-api-golden-tests , lens , pem , proto-lens + , string-conversions , tasty , tasty-hunit , text @@ -689,6 +690,7 @@ test-suite wire-api-tests , schema-profunctor , servant , servant-server + , string-conversions , tasty , tasty-hspec , tasty-hunit From c0c1f53b64b61ba61a6e552548d6e72162c16dca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:08:31 +0200 Subject: [PATCH 06/28] Drop 'cs' from polysemy-wire-zoo --- libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs index c0edb3d94c4..913e5cbf7b7 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs @@ -5,6 +5,7 @@ module Wire.Sem.Jwk where import Control.Exception import Crypto.JOSE.JWK import Data.Aeson +import Data.ByteString (fromStrict) import qualified Data.ByteString as BS import Imports import Polysemy @@ -18,4 +19,8 @@ interpretJwk :: Members '[Embed IO] r => Sem (Jwk ': r) a -> Sem r a interpretJwk = interpret $ \(Get fp) -> liftIO $ readJwk fp readJwk :: FilePath -> IO (Maybe JWK) -readJwk fp = try @IOException (BS.readFile fp) <&> either (const Nothing) (decode . cs) +readJwk fp = + try @IOException (BS.readFile fp) + <&> either + (const Nothing) + (decode . fromStrict) From 9514c8e7bb00d263bcb4aa962cc62b5fb02ba1ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:10:12 +0200 Subject: [PATCH 07/28] Drop 'cs' from gundeck-types --- libs/gundeck-types/src/Gundeck/Types/Push/V2.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs index aedfc7f0164..c087d911135 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs @@ -83,7 +83,7 @@ import Data.List1 qualified as List1 import Data.Range import Data.Range qualified as Range import Data.Set qualified as Set -import Imports hiding (cs) +import Imports import Wire.API.Message (Priority (..)) import Wire.API.Push.V2.Token import Wire.Arbitrary From f398e060734a8b2f99c41fc86a6b66a02f43c6f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:15:52 +0200 Subject: [PATCH 08/28] Drop 'cs' from wire-api-federation --- libs/wire-api-federation/src/Wire/API/Federation/Error.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Error.hs b/libs/wire-api-federation/src/Wire/API/Federation/Error.hs index 2303d744abb..830a9f062fc 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Error.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Error.hs @@ -245,7 +245,9 @@ federationRemoteHTTP2Error target path = \case addErrData err = err { Wai.errorData = - ((mkDomain . cs . srvTargetDomain $ target) :: Either String Domain) + ( (mkDomain . T.decodeUtf8With T.lenientDecode . srvTargetDomain $ target) :: + Either String Domain + ) & either (const Nothing) (\dom -> Just (Wai.FederationErrorData dom path)) } @@ -271,7 +273,9 @@ federationRemoteResponseError target path status body = ) ) { Wai.errorData = - ((mkDomain . cs . srvTargetDomain $ target) :: Either String Domain) + ( (mkDomain . T.decodeUtf8With T.lenientDecode . srvTargetDomain $ target) :: + Either String Domain + ) & either (const Nothing) (\dom -> Just (Wai.FederationErrorData dom path)), Wai.innerError = Just $ From c9656d6e90d5dd63f3b6fc1c51847afd211bc6e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:23:47 +0200 Subject: [PATCH 09/28] Drop 'cs' from galley-types --- libs/galley-types/default.nix | 2 ++ libs/galley-types/galley-types.cabal | 1 + libs/galley-types/src/Galley/Types.hs | 2 +- libs/galley-types/src/Galley/Types/Teams.hs | 8 +++++--- 4 files changed, 9 insertions(+), 4 deletions(-) diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index 2cbe283392e..5a6070c01a4 100644 --- a/libs/galley-types/default.nix +++ b/libs/galley-types/default.nix @@ -21,6 +21,7 @@ , tasty-quickcheck , text , types-common +, utf8-string , uuid , wire-api }: @@ -43,6 +44,7 @@ mkDerivation { schema-profunctor text types-common + utf8-string uuid wire-api ]; diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 947ca36cd70..4953776a8ae 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -85,6 +85,7 @@ library , schema-profunctor , text >=0.11 , types-common >=0.16 + , utf8-string , uuid , wire-api diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 8e035a40e02..b08103a22cd 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -26,7 +26,7 @@ where import Data.Aeson import Data.Id (ClientId, UserId) import Data.Map.Strict qualified as Map -import Imports hiding (cs) +import Imports import Wire.API.Message -------------------------------------------------------------------------------- diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 07a2d755b4c..715377e42bb 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -62,6 +62,8 @@ where import Control.Lens (makeLenses, view) import Data.Aeson import Data.Aeson.Types qualified as A +import Data.ByteString (toStrict) +import Data.ByteString.UTF8 qualified as UTF8 import Data.Id (UserId) import Data.Schema qualified as Schema import Data.Set qualified as Set @@ -199,7 +201,7 @@ instance ToJSON FeatureFlags where instance FromJSON FeatureSSO where parseJSON (String "enabled-by-default") = pure FeatureSSOEnabledByDefault parseJSON (String "disabled-by-default") = pure FeatureSSODisabledByDefault - parseJSON bad = fail $ "FeatureSSO: " <> cs (encode bad) + parseJSON bad = fail $ "FeatureSSO: " <> (UTF8.toString . toStrict . encode $ bad) instance ToJSON FeatureSSO where toJSON FeatureSSOEnabledByDefault = String "enabled-by-default" @@ -209,7 +211,7 @@ instance FromJSON FeatureLegalHold where parseJSON (String "disabled-permanently") = pure $ FeatureLegalHoldDisabledPermanently parseJSON (String "disabled-by-default") = pure $ FeatureLegalHoldDisabledByDefault parseJSON (String "whitelist-teams-and-implicit-consent") = pure FeatureLegalHoldWhitelistTeamsAndImplicitConsent - parseJSON bad = fail $ "FeatureLegalHold: " <> cs (encode bad) + parseJSON bad = fail $ "FeatureLegalHold: " <> (UTF8.toString . toStrict . encode $ bad) instance ToJSON FeatureLegalHold where toJSON FeatureLegalHoldDisabledPermanently = String "disabled-permanently" @@ -219,7 +221,7 @@ instance ToJSON FeatureLegalHold where instance FromJSON FeatureTeamSearchVisibilityAvailability where parseJSON (String "enabled-by-default") = pure FeatureTeamSearchVisibilityAvailableByDefault parseJSON (String "disabled-by-default") = pure FeatureTeamSearchVisibilityUnavailableByDefault - parseJSON bad = fail $ "FeatureSearchVisibility: " <> cs (encode bad) + parseJSON bad = fail $ "FeatureSearchVisibility: " <> (UTF8.toString . toStrict . encode $ bad) instance ToJSON FeatureTeamSearchVisibilityAvailability where toJSON FeatureTeamSearchVisibilityAvailableByDefault = String "enabled-by-default" From d50693cfbcd99600bc3519e0cb26b4012b0d9c7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:28:04 +0200 Subject: [PATCH 10/28] Drop 'cs' from bilge --- libs/bilge/src/Bilge/Request.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/bilge/src/Bilge/Request.hs b/libs/bilge/src/Bilge/Request.hs index 30c15eee8e0..1acd96aa03e 100644 --- a/libs/bilge/src/Bilge/Request.hs +++ b/libs/bilge/src/Bilge/Request.hs @@ -82,7 +82,7 @@ import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy.Char8 qualified as LC import Data.CaseInsensitive (original) import Data.Id (RequestId (..)) -import Imports hiding (cs, intercalate) +import Imports hiding (intercalate) import Network.HTTP.Client (Cookie, GivesPopper, Request, RequestBody (..)) import Network.HTTP.Client qualified as Rq import Network.HTTP.Client.Internal (CookieJar (..), brReadSome, throwHttp) From d681ba07476caa8b4459f45303160da95b4fae45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:33:48 +0200 Subject: [PATCH 11/28] Drop 'cs' from jwt-tools --- libs/jwt-tools/default.nix | 11 ++++++++++- libs/jwt-tools/jwt-tools.cabal | 2 ++ libs/jwt-tools/src/Data/Jwt/Tools.hs | 9 +++++---- libs/jwt-tools/test/Spec.hs | 1 + 4 files changed, 18 insertions(+), 5 deletions(-) diff --git a/libs/jwt-tools/default.nix b/libs/jwt-tools/default.nix index a6cdf09b241..1314bde5186 100644 --- a/libs/jwt-tools/default.nix +++ b/libs/jwt-tools/default.nix @@ -12,7 +12,9 @@ , imports , lib , rusty_jwt_tools_ffi +, string-conversions , transformers +, utf8-string }: mkDerivation { pname = "jwt-tools"; @@ -24,9 +26,16 @@ mkDerivation { http-types imports transformers + utf8-string ]; librarySystemDepends = [ rusty_jwt_tools_ffi ]; - testHaskellDepends = [ bytestring hspec imports transformers ]; + testHaskellDepends = [ + bytestring + hspec + imports + string-conversions + transformers + ]; description = "FFI to rusty-jwt-tools"; license = lib.licenses.agpl3Only; } diff --git a/libs/jwt-tools/jwt-tools.cabal b/libs/jwt-tools/jwt-tools.cabal index 57f815466ab..e2f12a9b352 100644 --- a/libs/jwt-tools/jwt-tools.cabal +++ b/libs/jwt-tools/jwt-tools.cabal @@ -68,6 +68,7 @@ library , http-types , imports , transformers + , utf8-string default-language: GHC2021 other-extensions: ForeignFunctionInterface @@ -83,6 +84,7 @@ test-suite jwt-tools-tests , hspec , imports , jwt-tools + , string-conversions , transformers hs-source-dirs: test diff --git a/libs/jwt-tools/src/Data/Jwt/Tools.hs b/libs/jwt-tools/src/Data/Jwt/Tools.hs index a38cc02c9fd..e9c3ce549de 100644 --- a/libs/jwt-tools/src/Data/Jwt/Tools.hs +++ b/libs/jwt-tools/src/Data/Jwt/Tools.hs @@ -42,6 +42,7 @@ where import Control.Exception hiding (handle) import Control.Monad.Trans.Except import Data.ByteString.Conversion +import Data.ByteString.UTF8 qualified as UTF8 import Foreign.C.String (CString, newCString, peekCString) import Foreign.Ptr (Ptr, nullPtr) import Imports @@ -163,7 +164,7 @@ generateDpopToken dpopProof uid cid handle displayName tid domain nonce uri meth domainCStr <- toCStr domain nonceCStr <- toCStr nonce uriCStr <- toCStr uri - methodCStr <- liftIO $ newCString $ cs $ methodToBS method + methodCStr <- liftIO $ newCString $ UTF8.toString $ methodToBS method backendPubkeyBundleCStr <- toCStr backendPubkeyBundle -- log all variable inputs (can comment in if need to generate new test data) @@ -205,7 +206,7 @@ generateDpopToken dpopProof uid cid handle displayName tid domain nonce uri meth toCStr = liftIO . newCString . toStr where toStr :: a -> String - toStr = cs . toByteString' + toStr = UTF8.toString . toByteString' methodToBS :: StdMethod -> ByteString methodToBS = \case @@ -221,8 +222,8 @@ generateDpopToken dpopProof uid cid handle displayName tid domain nonce uri meth toResult :: Maybe Word8 -> Maybe String -> Either DPoPTokenGenerationError ByteString -- the only valid cases are when the error=0 (meaning no error) or nothing and the token is not null -toResult (Just 0) (Just token) = Right $ cs token -toResult Nothing (Just token) = Right $ cs token +toResult (Just 0) (Just token) = Right $ UTF8.fromString token +toResult Nothing (Just token) = Right $ UTF8.fromString token -- errors toResult (Just errNo) _ = Left $ fromInt (fromIntegral errNo) where diff --git a/libs/jwt-tools/test/Spec.hs b/libs/jwt-tools/test/Spec.hs index 2e0afb3dc13..664c18d3874 100644 --- a/libs/jwt-tools/test/Spec.hs +++ b/libs/jwt-tools/test/Spec.hs @@ -18,6 +18,7 @@ import Control.Monad.Trans.Except import Data.ByteString.Char8 (split) import Data.Jwt.Tools +import Data.String.Conversions import Imports import Test.Hspec From ba6113b3e060d1b463a4fcfa5125bc2ccc8f6252 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 10:53:13 +0200 Subject: [PATCH 12/28] Drop 'cs' from federator --- services/federator/default.nix | 5 +++++ services/federator/federator.cabal | 3 +++ services/federator/src/Federator/Discovery.hs | 2 +- services/federator/src/Federator/ExternalServer.hs | 2 +- services/federator/src/Federator/Health.hs | 11 ++++++++++- services/federator/src/Federator/InternalServer.hs | 3 ++- services/federator/src/Federator/Response.hs | 3 ++- services/federator/src/Federator/Service.hs | 2 +- .../test/integration/Test/Federator/IngressSpec.hs | 1 + .../federator/test/integration/Test/Federator/Util.hs | 1 + .../test/unit/Test/Federator/ExternalServer.hs | 1 + 11 files changed, 28 insertions(+), 6 deletions(-) diff --git a/services/federator/default.nix b/services/federator/default.nix index 5cb5b5b2830..423926f9509 100644 --- a/services/federator/default.nix +++ b/services/federator/default.nix @@ -52,6 +52,7 @@ , servant-client , servant-client-core , servant-server +, string-conversions , tasty , tasty-hunit , tasty-quickcheck @@ -61,6 +62,7 @@ , transformers , types-common , unix +, utf8-string , uuid , wai , wai-extra @@ -120,6 +122,7 @@ mkDerivation { transformers types-common unix + utf8-string uuid wai wai-utilities @@ -154,6 +157,7 @@ mkDerivation { QuickCheck random servant-client-core + string-conversions tasty-hunit text types-common @@ -188,6 +192,7 @@ mkDerivation { servant-client servant-client-core servant-server + string-conversions tasty tasty-hunit tasty-quickcheck diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index 0a0767edeb2..4fa411b3be0 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -147,6 +147,7 @@ library , transformers , types-common , unix + , utf8-string , uuid , wai , wai-utilities @@ -303,6 +304,7 @@ executable federator-integration , QuickCheck , random , servant-client-core + , string-conversions , tasty-hunit , text , types-common @@ -404,6 +406,7 @@ test-suite federator-tests , servant-client , servant-client-core , servant-server + , string-conversions , tasty , tasty-hunit , tasty-quickcheck diff --git a/services/federator/src/Federator/Discovery.hs b/services/federator/src/Federator/Discovery.hs index 9050125e68c..901042f86ba 100644 --- a/services/federator/src/Federator/Discovery.hs +++ b/services/federator/src/Federator/Discovery.hs @@ -96,7 +96,7 @@ runFederatorDiscovery = interpret $ \case -- FUTUREWORK(federation): This string conversion is wrong, we should encode -- this using IDNA encoding or expect domain to be bytestring everywhere -- (https://wearezeta.atlassian.net/browse/SQCORE-912) - domainSrv d = cs $ "_wire-server-federator._tcp." <> domainText d + domainSrv d = Text.encodeUtf8 $ "_wire-server-federator._tcp." <> domainText d lookupDomainByDNS :: ( Member DNSLookup r, diff --git a/services/federator/src/Federator/ExternalServer.hs b/services/federator/src/Federator/ExternalServer.hs index 513bf5d73e8..4a2f83d4c5f 100644 --- a/services/federator/src/Federator/ExternalServer.hs +++ b/services/federator/src/Federator/ExternalServer.hs @@ -148,7 +148,7 @@ callInward component (RPC rpc) mReqId originDomain (CertHeader cert) wreq = do rid <- case mReqId of Just r -> pure r Nothing -> do - localRid <- liftIO $ RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- liftIO $ RequestId . Text.encodeUtf8 . UUID.toText <$> UUID.nextRandom info $ "request-id" .= localRid ~~ "method" .= Wai.requestMethod wreq diff --git a/services/federator/src/Federator/Health.hs b/services/federator/src/Federator/Health.hs index 7a2228b74d0..857a3e56415 100644 --- a/services/federator/src/Federator/Health.hs +++ b/services/federator/src/Federator/Health.hs @@ -1,5 +1,7 @@ module Federator.Health where +import Data.ByteString (fromStrict) +import Data.ByteString.UTF8 qualified as UTF8 import Imports import Network.HTTP.Client import Network.HTTP.Types.Status qualified as HTTP @@ -20,4 +22,11 @@ status mgr otherName otherPort False = do res <- liftIO $ httpNoBody req mgr if HTTP.statusIsSuccessful $ responseStatus res then pure NoContent - else throwError Servant.err500 {Servant.errBody = otherName <> " server responded with status code = " <> cs (show (responseStatus res))} + else + throwError + Servant.err500 + { Servant.errBody = + otherName + <> " server responded with status code = " + <> (fromStrict . UTF8.fromString . show . responseStatus $ res) + } diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 13dd401f3b6..ef6cbd0cce4 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -27,6 +27,7 @@ import Data.Domain import Data.Id import Data.Metrics.Servant qualified as Metrics import Data.Proxy +import Data.Text.Encoding qualified as T import Data.UUID as UUID import Data.UUID.V4 as UUID import Federator.Env @@ -117,7 +118,7 @@ callOutward mReqId targetDomain component (RPC path) req = do rid <- case mReqId of Just r -> pure r Nothing -> do - localRid <- liftIO $ RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- liftIO $ RequestId . T.encodeUtf8 . UUID.toText <$> UUID.nextRandom info $ "request-id" .= localRid ~~ "method" .= Wai.requestMethod req diff --git a/services/federator/src/Federator/Response.hs b/services/federator/src/Federator/Response.hs index 04662a1da3a..6f70df5a390 100644 --- a/services/federator/src/Federator/Response.hs +++ b/services/federator/src/Federator/Response.hs @@ -29,6 +29,7 @@ import Control.Lens import Control.Monad.Codensity import Data.ByteString.Builder import Data.Kind +import Data.Text qualified as T import Federator.Discovery import Federator.Env import Federator.Error @@ -172,7 +173,7 @@ getFederationDomainConfigs :: Env -> IO FedUp.FederationDomainConfigs getFederationDomainConfigs env = do let mgr = env ^. httpManager Endpoint h p = env ^. service $ Brig - baseurl = BaseUrl Http (cs h) (fromIntegral p) "" + baseurl = BaseUrl Http (T.unpack h) (fromIntegral p) "" clientEnv = mkClientEnv mgr baseurl FedUp.getFederationDomainConfigs clientEnv >>= \case Right v -> pure v diff --git a/services/federator/src/Federator/Service.hs b/services/federator/src/Federator/Service.hs index 691f4629dff..b4f859d52bf 100644 --- a/services/federator/src/Federator/Service.hs +++ b/services/federator/src/Federator/Service.hs @@ -94,7 +94,7 @@ interpretServiceHTTP = interpret $ \case path = rpcPath, requestHeaders = [ ("Content-Type", "application/json"), - (originDomainHeaderName, cs (domainText domain)), + (originDomainHeaderName, Text.encodeUtf8 (domainText domain)), (RPC.requestIdName, unRequestId rid) ] <> headers diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index e8eb7151c7e..62b4f1b7401 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -25,6 +25,7 @@ import Data.Binary.Builder import Data.Domain import Data.Id import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent)) +import Data.String.Conversions import Data.Text.Encoding qualified as Text import Federator.Discovery import Federator.Monitor (FederationSetupError) diff --git a/services/federator/test/integration/Test/Federator/Util.hs b/services/federator/test/integration/Test/Federator/Util.hs index 6d8a61f0093..549590cb6af 100644 --- a/services/federator/test/integration/Test/Federator/Util.hs +++ b/services/federator/test/integration/Test/Federator/Util.hs @@ -37,6 +37,7 @@ import Data.Aeson.Types qualified as Aeson import Data.ByteString.Char8 qualified as C8 import Data.Id import Data.Misc +import Data.String.Conversions import Data.Text qualified as Text import Data.UUID qualified as UUID import Data.UUID.V4 qualified as UUID diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index 48680d09d33..ec0b0438e24 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -24,6 +24,7 @@ import Data.ByteString qualified as BS import Data.Default import Data.Domain import Data.Sequence as Seq +import Data.String.Conversions import Data.Text.Encoding qualified as Text import Federator.Discovery import Federator.Error.ServerError (ServerError (..)) From af8c37fcce8e05e87cb54a8fdb680405a040e50c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 16 Apr 2024 13:23:06 +0200 Subject: [PATCH 13/28] Drop 'cs' from spar --- services/spar/default.nix | 6 ++ .../src/Spar/DataMigration/V2_UserV2.hs | 8 ++- services/spar/spar.cabal | 4 ++ services/spar/src/Spar/API.hs | 15 +++- services/spar/src/Spar/App.hs | 71 +++++++++++++------ services/spar/src/Spar/Data/Instances.hs | 21 ++++-- services/spar/src/Spar/Error.hs | 47 +++++++++--- services/spar/src/Spar/Intra/BrigApp.hs | 4 +- services/spar/src/Spar/Intra/Galley.hs | 3 +- services/spar/src/Spar/Orphans.hs | 3 +- services/spar/src/Spar/Run.hs | 7 +- services/spar/src/Spar/Scim.hs | 10 ++- services/spar/src/Spar/Scim/Auth.hs | 8 ++- services/spar/src/Spar/Scim/User.hs | 45 ++++++++---- services/spar/src/Spar/Sem/SAML2/Library.hs | 9 ++- services/spar/src/Spar/Sem/Utils.hs | 9 ++- .../spar/test-integration/Test/LoggingSpec.hs | 1 + .../spar/test-integration/Test/MetricsSpec.hs | 1 + .../test-integration/Test/Spar/APISpec.hs | 1 + .../test-integration/Test/Spar/AppSpec.hs | 1 + .../Test/Spar/Scim/AuthSpec.hs | 1 + .../Test/Spar/Scim/UserSpec.hs | 1 + services/spar/test-integration/Util/Core.hs | 1 + services/spar/test-integration/Util/Scim.hs | 1 + services/spar/test/Arbitrary.hs | 1 + .../spar/test/Test/Spar/Intra/BrigSpec.hs | 1 + 26 files changed, 212 insertions(+), 68 deletions(-) diff --git a/services/spar/default.nix b/services/spar/default.nix index f31e52c6ff1..ff861547cec 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -59,6 +59,7 @@ , servant-openapi3 , servant-server , silently +, string-conversions , tasty-hunit , text , text-latin1 @@ -67,6 +68,7 @@ , transformers , types-common , uri-bytestring +, utf8-string , uuid , vector , wai @@ -125,6 +127,7 @@ mkDerivation { transformers types-common uri-bytestring + utf8-string uuid wai wai-utilities @@ -179,6 +182,7 @@ mkDerivation { servant servant-server silently + string-conversions tasty-hunit text time @@ -186,6 +190,7 @@ mkDerivation { transformers types-common uri-bytestring + utf8-string uuid vector wai-extra @@ -220,6 +225,7 @@ mkDerivation { saml2-web-sso servant servant-openapi3 + string-conversions time tinylog types-common diff --git a/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs b/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs index ae532696d8d..ac7d49efca6 100644 --- a/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs +++ b/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs @@ -21,12 +21,14 @@ module Spar.DataMigration.V2_UserV2 (migration) where import Cassandra import qualified Conduit as C +import qualified Data.ByteString.UTF8 as UTF8 import Data.Conduit import qualified Data.Conduit.Combinators as CC import Data.Conduit.Internal (zipSources) import qualified Data.Conduit.List as CL import Data.Id import qualified Data.Map.Strict as Map +import qualified Data.Text as T import Data.Time (UTCTime) import Imports import qualified SAML2.WebSSO as SAML @@ -173,16 +175,16 @@ filterResolved resolver migMapInv = mbAssoc <- await for_ mbAssoc $ \(new@(issuer, nid), olds) -> do let yieldOld (nameId, uid) = yield (issuer, nid, nameId, uid) - let issuerURI = cs . serializeURIRef' . _fromIssuer $ issuer + let issuerURI = UTF8.toString . serializeURIRef' . _fromIssuer $ issuer case olds of [] -> pure () [old] -> yieldOld old (old1 : old2 : rest) -> lift (resolver new (List2 old1 old2 rest)) >>= \case Left _ -> - lift $ logError $ unwords ["Couldnt resolve collisision of", issuerURI, cs (unNormalizedUNameID nid), show olds] + lift $ logError $ unwords ["Couldnt resolve collisision of", issuerURI, T.unpack (unNormalizedUNameID nid), show olds] Right old -> do - lift $ logInfo $ unwords ["Resolved collision", issuerURI, cs (unNormalizedUNameID nid), show (fmap snd olds), "to", show (snd old)] + lift $ logInfo $ unwords ["Resolved collision", issuerURI, T.unpack (unNormalizedUNameID nid), show (fmap snd olds), "to", show (snd old)] yieldOld old go diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 43e9582ceda..daa07906416 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -189,6 +189,7 @@ library , transformers , types-common , uri-bytestring + , utf8-string , uuid , wai , wai-utilities @@ -377,6 +378,7 @@ executable spar-integration , servant-server , silently , spar + , string-conversions , tasty-hunit , text , time @@ -472,6 +474,7 @@ executable spar-migrate-data , tinylog , types-common , uri-bytestring + , utf8-string default-language: Haskell2010 @@ -626,6 +629,7 @@ test-suite spec , servant , servant-openapi3 , spar + , string-conversions , time , tinylog , types-common diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 8f27fab4dbc..ae3a3d94d90 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -55,7 +55,9 @@ import Data.Id import Data.Proxy import Data.Range import qualified Data.Set as Set +import Data.Text.Encoding.Error import qualified Data.Text.Lazy as T +import Data.Text.Lazy.Encoding import Data.Time import Imports import Polysemy @@ -357,7 +359,7 @@ idpGetRaw zusr idpid = do _ <- authorizeIdP zusr idp IdPRawMetadataStore.get idpid >>= \case Just txt -> pure $ RawIdPMetadata txt - Nothing -> throwSparSem $ SparIdPNotFound (cs $ show idpid) + Nothing -> throwSparSem $ SparIdPNotFound (T.pack $ show idpid) idpGetAll :: ( Member Random r, @@ -702,7 +704,10 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J where errUnknownIdP = SAML.UnknownIdP $ enc uri where - enc = cs . toLazyByteString . URI.serializeURIRef + enc = + decodeUtf8With lenientDecode + . toLazyByteString + . URI.serializeURIRef uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Sem r a -> Sem r a @@ -723,7 +728,11 @@ authorizeIdP :: Maybe UserId -> IdP -> Sem r (UserId, TeamId) -authorizeIdP Nothing _ = throw (SAML.CustomError $ SparNoPermission (cs $ show CreateUpdateDeleteIdp)) +authorizeIdP Nothing _ = + throw + ( SAML.CustomError $ + SparNoPermission (T.pack $ show CreateUpdateDeleteIdp) + ) authorizeIdP (Just zusr) idp = do let teamid = idp ^. SAML.idpExtraInfo . team GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index eb51bd4232c..722b65ab91c 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -43,11 +43,17 @@ import Control.Lens hiding ((.=)) import Control.Monad.Except import Data.Aeson as Aeson (encode, object, (.=)) import Data.Aeson.Text as Aeson (encodeToLazyText) +import Data.ByteString (toStrict) import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.CaseInsensitive as CI import Data.Id +import qualified Data.Text as Text import Data.Text.Ascii (encodeBase64, toText) +import qualified Data.Text.Encoding as Text +import Data.Text.Encoding.Error import qualified Data.Text.Lazy as LText +import qualified Data.Text.Lazy.Encoding as LText import Imports hiding (MonadReader, asks, log) import qualified Network.HTTP.Types.Status as Http import qualified Network.Wai.Utilities.Error as Wai @@ -182,7 +188,9 @@ createSamlUserWithId :: Role -> Sem r () createSamlUserWithId teamid buid suid role = do - uname <- either (throwSparSem . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) + uname <- + either (throwSparSem . SparBadUserName . LText.pack) pure $ + Intra.mkUserName Nothing (UrefOnly suid) buid' <- BrigAccess.createSAML suid buid teamid uname ManagedByWire Nothing Nothing Nothing role assert (buid == buid') $ pure () SAMLUserStore.insert suid buid @@ -212,7 +220,7 @@ autoprovisionSamlUser idp buid suid = do guardReplacedIdP :: Sem r () guardReplacedIdP = do unless (isNothing $ idp ^. idpExtraInfo . replacedBy) $ do - throwSparSem $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId) + throwSparSem $ SparCannotCreateUsersOnReplacedIdP (LText.fromStrict . SAML.idPIdToST $ idp ^. idpId) -- IdPs in teams with scim tokens are not allowed to auto-provision. guardScimTokens :: Sem r () @@ -284,7 +292,7 @@ verdictHandler aresp verdict idp = do -- [...] If the containing message is in response to an , then -- the InResponseTo attribute MUST match the request's ID. Logger.log Logger.Debug $ "entering verdictHandler: " <> show (aresp, verdict) - reqid <- either (throwSparSem . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp + reqid <- either (throwSparSem . SparNoRequestRefInResponse . LText.pack) pure $ SAML.rspInResponseTo aresp format :: Maybe VerdictFormat <- VerdictFormatStore.get reqid resp <- case format of Just VerdictFormatWeb -> @@ -337,8 +345,17 @@ catchVerdictErrors = (`catch` hndlr) hndlr err = do waiErr <- renderSparErrorWithLogging err pure $ case waiErr of - Right (werr :: Wai.Error) -> VerifyHandlerError (cs $ Wai.label werr) (cs $ Wai.message werr) - Left (serr :: ServerError) -> VerifyHandlerError "unknown-error" (cs (errReasonPhrase serr) <> " " <> cs (errBody serr)) + Right (werr :: Wai.Error) -> + VerifyHandlerError + (LText.toStrict $ Wai.label werr) + (LText.toStrict $ Wai.message werr) + Left (serr :: ServerError) -> + VerifyHandlerError + "unknown-error" + ( Text.pack (errReasonPhrase serr) + <> " " + <> (Text.decodeUtf8With lenientDecode . toStrict . errBody $ serr) + ) -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and @@ -397,7 +414,7 @@ verdictHandlerResultCore idp = \case SAML.AccessGranted uref -> do uid :: UserId <- do let team' = idp ^. idpExtraInfo . team - err = SparUserRefInNoOrMultipleTeams . cs . show $ uref + err = SparUserRefInNoOrMultipleTeams . LText.pack . show $ uref getUserByUrefUnsafe uref >>= \case Just usr -> do if userTeam usr == Just team' @@ -438,12 +455,12 @@ verdictHandlerWeb = forbiddenPage errlbl reasons = ServerError { errHTTPCode = 200, - errReasonPhrase = cs errlbl, -- (not sure what this is used for) + errReasonPhrase = Text.unpack errlbl, -- (not sure what this is used for) errBody = easyHtml $ "" <> " wire:sso:error:" - <> cs errlbl + <> LText.fromStrict errlbl <> "" <> "