diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 61a335aa0..e828ccc14 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -85,8 +85,7 @@ import PostgREST.Workers (connectionWorker, listener) import qualified PostgREST.ContentType as ContentType import qualified PostgREST.DbStructure.Proc as Proc -import Protolude hiding (Handler, toS) -import Protolude.Conv (toS) +import Protolude hiding (Handler) data RequestContext = RequestContext @@ -134,7 +133,7 @@ serverSettings AppConfig{..} = defaultSettings & setHost (fromString $ toS configServerHost) & setPort configServerPort - & setServerName (toS $ "postgrest/" <> prettyVersion) + & setServerName ("postgrest/" <> prettyVersion) -- | PostgREST application postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application @@ -191,7 +190,7 @@ postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do ApiRequest.userApiRequest conf dbStructure req body -- The JWT must be checked before touching the db - jwtClaims <- Auth.jwtClaims conf (toS iJWT) time + jwtClaims <- Auth.jwtClaims conf (toUtf8Lazy iJWT) time let handleReq apiReq = @@ -271,14 +270,14 @@ handleRead headersOnly identifier context@RequestContext{..} = do [ contentRange , ( "Content-Location" , "/" - <> toS (qiName identifier) - <> if BS.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS + <> toUtf8 (qiName identifier) + <> if BS.null iCanonicalQS then mempty else "?" <> iCanonicalQS ) ] ++ contentTypeHeaders context failNotSingular iAcceptContentType queryTotal . response status headers $ - if headersOnly then mempty else toS body + if headersOnly then mempty else LBS.fromStrict body readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64) readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery = @@ -315,7 +314,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do Just ( HTTP.hLocation , "/" - <> toS qiName + <> toUtf8 qiName <> HTTP.renderSimpleQuery True (splitKeyValue <$> resFields) ) , Just . RangeQuery.contentRangeH 1 0 $ @@ -328,7 +327,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do failNotSingular iAcceptContentType resQueryTotal $ if iPreferRepresentation == Full then - response HTTP.status201 (headers ++ contentTypeHeaders context) (toS resBody) + response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict resBody) else response HTTP.status201 headers mempty @@ -350,7 +349,7 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do failNotSingular iAcceptContentType resQueryTotal $ if fullRepr then - response status (contentTypeHeaders context ++ [contentRangeHeader]) (toS resBody) + response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict resBody) else response status [contentRangeHeader] mempty @@ -374,7 +373,7 @@ handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do return $ if iPreferRepresentation == Full then - response HTTP.status200 (contentTypeHeaders context) (toS resBody) + response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict resBody) else response HTTP.status204 (contentTypeHeaders context) mempty @@ -392,7 +391,7 @@ handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do if iPreferRepresentation == Full then response HTTP.status200 (contentTypeHeaders context ++ [contentRangeHeader]) - (toS resBody) + (LBS.fromStrict resBody) else response HTTP.status204 [contentRangeHeader] mempty @@ -460,7 +459,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do failNotSingular iAcceptContentType queryTotal $ response status (contentTypeHeaders context ++ [contentRange]) - (if invMethod == InvHead then mempty else toS body) + (if invMethod == InvHead then mempty else LBS.fromStrict body) handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest _) = do @@ -482,7 +481,7 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure return $ Wai.responseLBS HTTP.status200 (ContentType.toHeader CTOpenAPI : maybeToList (profileHeader apiRequest)) - (if headersOnly then mempty else toS body) + (if headersOnly then mempty else body) txMode :: ApiRequest -> SQL.Mode txMode ApiRequest{..} = @@ -606,7 +605,7 @@ rawContentTypes AppConfig{..} = profileHeader :: ApiRequest -> Maybe HTTP.Header profileHeader ApiRequest{..} = - (,) "Content-Profile" <$> (toS <$> iProfile) + (,) "Content-Profile" <$> (toUtf8 <$> iProfile) splitKeyValue :: ByteString -> (ByteString, ByteString) splitKeyValue kv = diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index b6d463333..e5131eeb2 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -30,8 +30,8 @@ import qualified Crypto.JOSE.Types as JOSE import qualified Crypto.JWT as JWT import qualified Data.Aeson as JSON import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Lazy as LBS import qualified Data.Configurator as C import qualified Data.Map.Strict as M import qualified Data.Text as T @@ -59,7 +59,7 @@ import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi, toQi) import PostgREST.Request.Types (JoinType (..)) -import Protolude hiding (Proxy, toList) +import Protolude hiding (Proxy, toList) data AppConfig = AppConfig diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index c942f71fc..5108298ac 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -12,6 +12,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Strict as M import qualified Data.HashSet.InsOrd as Set import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Control.Arrow ((&&&)) import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList) @@ -324,7 +325,7 @@ postgrestSpec rels pds ti (s, h, p, b) sd pks = (mempty :: Swagger) & basePath ?~ T.unpack b & schemes ?~ [s'] & info .~ ((mempty :: Info) - & version .~ prettyVersion + & version .~ T.decodeUtf8 prettyVersion & title .~ "PostgREST API" & description ?~ d) & externalDocs ?~ ((mempty :: ExternalDocs) diff --git a/src/PostgREST/Version.hs b/src/PostgREST/Version.hs index 0d8ca669e..4a9a37f48 100644 --- a/src/PostgREST/Version.hs +++ b/src/PostgREST/Version.hs @@ -4,7 +4,8 @@ module PostgREST.Version , prettyVersion ) where -import qualified Data.Text as T +import qualified Data.ByteString as BS +import qualified Data.Text as T import Data.Version (showVersion, versionBranch) import Development.GitRev (gitHash) @@ -16,15 +17,15 @@ import Protolude -- | User friendly version number such as '1.1.1'. -- Pre-release versions are tagged as such, e.g., '1.1.1.1 (pre-release)'. -- If a git hash is available, it's added to the version, e.g., '1.1.1 (abcdef0)'. -prettyVersion :: Text +prettyVersion :: ByteString prettyVersion = - T.pack (showVersion version) <> preRelease <> gitRev + toUtf8 (showVersion version) <> preRelease <> gitRev where gitRev = if $(gitHash) == ("UNKNOWN" :: Text) then mempty else - " (" <> T.take 7 $(gitHash) <> ")" + " (" <> BS.take 7 $(gitHash) <> ")" preRelease = if isPreRelease then " (pre-release)" else mempty