{-# LANGUAGE UndecidableInstances #-}
module IHP.DataSync.REST.Controller where

import IHP.ControllerPrelude hiding (OrderByClause)
import IHP.DataSync.REST.Types
import Data.Aeson
import qualified Database.PostgreSQL.Simple.ToField as PG
import qualified Database.PostgreSQL.Simple.Types as PG
import qualified Database.PostgreSQL.Simple as PG
import qualified Data.Vector as Vector
import qualified Data.ByteString.Char8 as ByteString
import qualified Control.Exception as Exception
import IHP.DataSync.RowLevelSecurity
import IHP.DataSync.DynamicQuery
import IHP.DataSync.Types
import Network.HTTP.Types (status400)
import IHP.DataSync.DynamicQueryCompiler
import qualified Data.Text as Text
import qualified Data.Scientific as Scientific

import qualified Data.ByteString.Builder as ByteString
import qualified Data.Aeson.Encoding.Internal as Aeson
import qualified Data.Aeson.KeyMap as Aeson
import qualified Data.Aeson.Key as Aeson


instance (
    PG.ToField (PrimaryKey (GetTableName CurrentUserRecord))
    , Show (PrimaryKey (GetTableName CurrentUserRecord))
    , HasNewSessionUrl CurrentUserRecord
    , Typeable CurrentUserRecord
    , HasField "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord))
    ) => Controller ApiController where
    action :: (?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::ApiController) =>
ApiController -> IO ()
action CreateRecordAction { Text
table :: Text
table :: ApiController -> Text
table } = do
        (?modelContext::ModelContext) => Text -> IO TableWithRLS
Text -> IO TableWithRLS
ensureRLSEnabled Text
table

        let payload :: Value
payload = Value
(?context::ControllerContext) => Value
requestBodyJSON

        case Value
payload of
            Object Object
hashMap -> do
                let query :: Query
query = Query
"INSERT INTO ? ? VALUES ? RETURNING *"
                let columns :: [Text]
columns = Object
hashMap
                        Object -> (Object -> [Key]) -> [Key]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Object -> [Key]
forall v. KeyMap v -> [Key]
Aeson.keys
                        [Key] -> ([Key] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Key -> Text) -> [Key] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
fieldNameToColumnName (Text -> Text) -> (Key -> Text) -> Key -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> Text
Aeson.toText)

                let values :: [Action]
values = Object
hashMap
                        Object -> (Object -> [Value]) -> [Value]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Object -> [Value]
forall v. KeyMap v -> [v]
Aeson.elems
                        [Value] -> ([Value] -> [Action]) -> [Action]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Value -> Action) -> [Value] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Action
aesonValueToPostgresValue

                let params :: (Identifier, In [Identifier], In [Action])
params = (Text -> Identifier
PG.Identifier Text
table, [Identifier] -> In [Identifier]
forall a. a -> In a
PG.In ((Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
PG.Identifier [Text]
columns), [Action] -> In [Action]
forall a. a -> In a
PG.In [Action]
values)

                Either EnhancedSqlError [[Field]]
result :: Either EnhancedSqlError [[Field]] <- IO [[Field]] -> IO (Either EnhancedSqlError [[Field]])
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try do
                    Query -> (Identifier, In [Identifier], In [Action]) -> IO [[Field]]
forall parameters userId result.
(?modelContext::ModelContext, ToRow parameters,
 ?context::ControllerContext,
 userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ToField userId, FromRow result) =>
Query -> parameters -> IO [result]
sqlQueryWithRLS Query
query (Identifier, In [Identifier], In [Action])
params

                case Either EnhancedSqlError [[Field]]
result of
                    Left EnhancedSqlError
error -> EnhancedSqlError -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderErrorJson EnhancedSqlError
error
                    Right [[Field]]
result -> [[Field]] -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderJson [[Field]]
result

            Array Array
objects -> do
                let query :: Query
query = Query
"INSERT INTO ? ? ? RETURNING *"
                let columns :: [Text]
columns = Array
objects
                        Array -> (Array -> [Value]) -> [Value]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Array -> [Value]
forall a. Vector a -> [a]
Vector.toList
                        [Value] -> ([Value] -> Maybe Value) -> Maybe Value
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Value] -> Maybe Value
forall a. [a] -> Maybe a
head
                        Maybe Value -> (Maybe Value -> Value) -> Value
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case
                            Just Value
value -> Value
value
                            Maybe Value
Nothing -> Text -> Value
forall a. Text -> a
error Text
"Atleast one record is required"
                        Value -> (Value -> Object) -> Object
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case
                            Object Object
hashMap -> Object
hashMap
                            Value
otherwise -> Text -> Object
forall a. Text -> a
error Text
"Expected object"
                        Object -> (Object -> [Key]) -> [Key]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Object -> [Key]
forall v. KeyMap v -> [Key]
Aeson.keys
                        [Key] -> ([Key] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Key -> Text) -> [Key] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
fieldNameToColumnName (Text -> Text) -> (Key -> Text) -> Key -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> Text
Aeson.toText)

                let values :: [[Action]]
values = Array
objects
                        Array -> (Array -> [Value]) -> [Value]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Array -> [Value]
forall a. Vector a -> [a]
Vector.toList
                        [Value] -> ([Value] -> [[Action]]) -> [[Action]]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Value -> [Action]) -> [Value] -> [[Action]]
forall a b. (a -> b) -> [a] -> [b]
map (\Value
object ->
                                Value
object
                                Value -> (Value -> Object) -> Object
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case
                                    Object Object
hashMap -> Object
hashMap
                                    Value
otherwise -> Text -> Object
forall a. Text -> a
error Text
"Expected object"
                                Object -> (Object -> [Value]) -> [Value]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Object -> [Value]
forall v. KeyMap v -> [v]
Aeson.elems
                                [Value] -> ([Value] -> [Action]) -> [Action]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Value -> Action) -> [Value] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Action
aesonValueToPostgresValue
                            )


                let params :: (Identifier, In [Identifier], Values [Action])
params = (Text -> Identifier
PG.Identifier Text
table, [Identifier] -> In [Identifier]
forall a. a -> In a
PG.In ((Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
PG.Identifier [Text]
columns), [QualifiedIdentifier] -> [[Action]] -> Values [Action]
forall a. [QualifiedIdentifier] -> [a] -> Values a
PG.Values [] [[Action]]
values)

                [[Field]]
result :: [[Field]] <- Query
-> (Identifier, In [Identifier], Values [Action]) -> IO [[Field]]
forall parameters userId result.
(?modelContext::ModelContext, ToRow parameters,
 ?context::ControllerContext,
 userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ToField userId, FromRow result) =>
Query -> parameters -> IO [result]
sqlQueryWithRLS Query
query (Identifier, In [Identifier], Values [Action])
params
                [[Field]] -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderJson [[Field]]
result



    action UpdateRecordAction { Text
table :: ApiController -> Text
table :: Text
table, UUID
id :: UUID
id :: ApiController -> UUID
id } = do
        (?modelContext::ModelContext) => Text -> IO TableWithRLS
Text -> IO TableWithRLS
ensureRLSEnabled Text
table

        let payload :: Object
payload = Value
(?context::ControllerContext) => Value
requestBodyJSON
                Value -> (Value -> Object) -> Object
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case
                    Object Object
hashMap -> Object
hashMap

        let columns :: [Identifier]
columns = Object
payload
                Object -> (Object -> [Key]) -> [Key]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Object -> [Key]
forall v. KeyMap v -> [Key]
Aeson.keys
                [Key] -> ([Key] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Key -> Text) -> [Key] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
fieldNameToColumnName (Text -> Text) -> (Key -> Text) -> Key -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> Text
Aeson.toText)
                [Text] -> ([Text] -> [Identifier]) -> [Identifier]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
PG.Identifier

        let values :: [Action]
values = Object
payload
                Object -> (Object -> [Value]) -> [Value]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Object -> [Value]
forall v. KeyMap v -> [v]
Aeson.elems
                [Value] -> ([Value] -> [Action]) -> [Action]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Value -> Action) -> [Value] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Action
aesonValueToPostgresValue

        let keyValues :: [(Identifier, Action)]
keyValues = [Identifier] -> [Action] -> [(Identifier, Action)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
columns [Action]
values

        let setCalls :: ByteString
setCalls = [(Identifier, Action)]
keyValues
                [(Identifier, Action)]
-> ([(Identifier, Action)] -> [ByteString]) -> [ByteString]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Identifier, Action) -> ByteString)
-> [(Identifier, Action)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(Identifier, Action)
_ -> ByteString
"? = ?")
                [ByteString] -> ([ByteString] -> ByteString) -> ByteString
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
", "
        let query :: ByteString
query = ByteString
"UPDATE ? SET " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
setCalls ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" WHERE id = ? RETURNING *"

        let params :: [Action]
params = [Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Text -> Identifier
PG.Identifier Text
table)]
                [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> ([[Action]] -> [Action]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (((Identifier, Action) -> [Action])
-> [(Identifier, Action)] -> [[Action]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Identifier
key, Action
value) -> [Identifier -> Action
forall a. ToField a => a -> Action
PG.toField Identifier
key, Action
value]) [(Identifier, Action)]
keyValues))
                [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [UUID -> Action
forall a. ToField a => a -> Action
PG.toField UUID
id]

        [[Field]]
result :: [[Field]] <- Query -> [Action] -> IO [[Field]]
forall parameters userId result.
(?modelContext::ModelContext, ToRow parameters,
 ?context::ControllerContext,
 userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ToField userId, FromRow result) =>
Query -> parameters -> IO [result]
sqlQueryWithRLS (ByteString -> Query
PG.Query ByteString
query) [Action]
params

        Maybe [Field] -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderJson ([[Field]] -> Maybe [Field]
forall a. [a] -> Maybe a
head [[Field]]
result)

    -- DELETE /api/:table/:id
    action DeleteRecordAction { Text
table :: ApiController -> Text
table :: Text
table, UUID
id :: ApiController -> UUID
id :: UUID
id } = do
        (?modelContext::ModelContext) => Text -> IO TableWithRLS
Text -> IO TableWithRLS
ensureRLSEnabled Text
table

        Query -> (Identifier, UUID) -> IO Int64
forall parameters userId.
(?modelContext::ModelContext, ToRow parameters,
 ?context::ControllerContext,
 userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ToField userId) =>
Query -> parameters -> IO Int64
sqlExecWithRLS Query
"DELETE FROM ? WHERE id = ?" (Text -> Identifier
PG.Identifier Text
table, UUID
id)

        Bool -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderJson Bool
True

    -- GET /api/:table/:id
    action ShowRecordAction { Text
table :: ApiController -> Text
table :: Text
table, UUID
id :: ApiController -> UUID
id :: UUID
id } = do
        (?modelContext::ModelContext) => Text -> IO TableWithRLS
Text -> IO TableWithRLS
ensureRLSEnabled Text
table

        [[Field]]
result :: [[Field]] <- Query -> (Identifier, UUID) -> IO [[Field]]
forall parameters userId result.
(?modelContext::ModelContext, ToRow parameters,
 ?context::ControllerContext,
 userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ToField userId, FromRow result) =>
Query -> parameters -> IO [result]
sqlQueryWithRLS Query
"SELECT * FROM ? WHERE id = ?" (Text -> Identifier
PG.Identifier Text
table, UUID
id)

        Maybe [Field] -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderJson ([[Field]] -> Maybe [Field]
forall a. [a] -> Maybe a
head [[Field]]
result)

    -- GET /api/:table
    -- GET /api/:table?orderBy=createdAt
    -- GET /api/:table?fields=id,title
    action ListRecordsAction { Text
table :: ApiController -> Text
table :: Text
table } = do
        (?modelContext::ModelContext) => Text -> IO TableWithRLS
Text -> IO TableWithRLS
ensureRLSEnabled Text
table

        let (Query
theQuery, [Action]
theParams) = DynamicSQLQuery -> (Query, [Action])
compileQuery ((?context::ControllerContext) => Text -> DynamicSQLQuery
Text -> DynamicSQLQuery
buildDynamicQueryFromRequest Text
table)
        [[Field]]
result :: [[Field]] <- Query -> [Action] -> IO [[Field]]
forall parameters userId result.
(?modelContext::ModelContext, ToRow parameters,
 ?context::ControllerContext,
 userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ToField userId, FromRow result) =>
Query -> parameters -> IO [result]
sqlQueryWithRLS Query
theQuery [Action]
theParams

        [[Field]] -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderJson [[Field]]
result

buildDynamicQueryFromRequest :: Text -> DynamicSQLQuery
buildDynamicQueryFromRequest Text
table = DynamicSQLQuery
    { Text
table :: Text
table :: Text
table
    , selectedColumns :: SelectedColumns
selectedColumns = SelectedColumns -> ByteString -> SelectedColumns
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault SelectedColumns
SelectAll ByteString
"fields"
    , whereCondition :: Maybe ConditionExpression
whereCondition = Maybe ConditionExpression
forall a. Maybe a
Nothing
    , orderByClause :: [OrderByClause]
orderByClause = ByteString -> [OrderByClause]
forall valueType.
(?context::ControllerContext, NFData valueType,
 ParamReader valueType) =>
ByteString -> [valueType]
paramList ByteString
"orderBy"
    , distinctOnColumn :: Maybe ByteString
distinctOnColumn = ByteString -> Maybe ByteString
forall paramType.
(?context::ControllerContext, ParamReader (Maybe paramType)) =>
ByteString -> Maybe paramType
paramOrNothing ByteString
"distinctOnColumn"
    , limit :: Maybe Int
limit = ByteString -> Maybe Int
forall paramType.
(?context::ControllerContext, ParamReader (Maybe paramType)) =>
ByteString -> Maybe paramType
paramOrNothing ByteString
"limit"
    , offset :: Maybe Int
offset = ByteString -> Maybe Int
forall paramType.
(?context::ControllerContext, ParamReader (Maybe paramType)) =>
ByteString -> Maybe paramType
paramOrNothing ByteString
"offset"
    }

instance ParamReader SelectedColumns where
    readParameter :: ByteString -> Either ByteString SelectedColumns
readParameter ByteString
byteString = SelectedColumns -> Either ByteString SelectedColumns
forall a. a -> Either ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectedColumns -> Either ByteString SelectedColumns)
-> SelectedColumns -> Either ByteString SelectedColumns
forall a b. (a -> b) -> a -> b
$
        ByteString
byteString
            ByteString -> (ByteString -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs
            Text -> (Text -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Char -> Bool) -> Text -> [Text]
Text.split (\Char
char -> Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')
            [Text] -> ([Text] -> SelectedColumns) -> SelectedColumns
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> SelectedColumns
SelectSpecific

instance ParamReader OrderByClause where
    readParameter :: ByteString -> Either ByteString OrderByClause
readParameter ByteString
byteString = case Char -> ByteString -> [ByteString]
ByteString.split Char
',' ByteString
byteString of
            [ByteString
orderByColumn, ByteString
order] -> do
                OrderByDirection
orderByDirection <- ByteString -> Either ByteString OrderByDirection
forall {a} {a}.
(Eq a, Semigroup a, IsString a, IsString a,
 ConvertibleStrings a a) =>
a -> Either a OrderByDirection
parseOrder ByteString
order
                OrderByClause -> Either ByteString OrderByClause
forall a. a -> Either ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderByClause { ByteString
orderByColumn :: ByteString
orderByColumn :: ByteString
orderByColumn, OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection }
            [ByteString
orderByColumn] -> OrderByClause -> Either ByteString OrderByClause
forall a. a -> Either ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderByClause { ByteString
orderByColumn :: ByteString
orderByColumn :: ByteString
orderByColumn, orderByDirection :: OrderByDirection
orderByDirection = OrderByDirection
Asc }
        where
            parseOrder :: a -> Either a OrderByDirection
parseOrder a
"asc" = OrderByDirection -> Either a OrderByDirection
forall a b. b -> Either a b
Right OrderByDirection
Asc
            parseOrder a
"desc" = OrderByDirection -> Either a OrderByDirection
forall a b. b -> Either a b
Right OrderByDirection
Desc
            parseOrder a
otherwise = a -> Either a OrderByDirection
forall a b. a -> Either a b
Left (a
"Invalid order " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a -> a
forall a b. ConvertibleStrings a b => a -> b
cs a
otherwise)

instance ToJSON PG.SqlError where
    toJSON :: SqlError -> Value
toJSON PG.SqlError { ByteString
sqlState :: ByteString
sqlState :: SqlError -> ByteString
sqlState, ByteString
sqlErrorMsg :: ByteString
sqlErrorMsg :: SqlError -> ByteString
sqlErrorMsg, ByteString
sqlErrorDetail :: ByteString
sqlErrorDetail :: SqlError -> ByteString
sqlErrorDetail, ByteString
sqlErrorHint :: ByteString
sqlErrorHint :: SqlError -> ByteString
sqlErrorHint } = [Pair] -> Value
object
                [ Key
"state" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
sqlState) :: Text)
                , Key
"errorMsg" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
sqlErrorMsg) :: Text)
                , Key
"errorDetail" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
sqlErrorDetail) :: Text)
                , Key
"errorHint" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
sqlErrorHint) :: Text)
                ]
        where
            fieldValueToJSON :: DynamicValue -> Value
fieldValueToJSON (IntValue Int
value) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
value
            fieldValueToJSON (TextValue Text
value) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
value
            fieldValueToJSON (BoolValue Bool
value) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
value
            fieldValueToJSON (UUIDValue UUID
value) = UUID -> Value
forall a. ToJSON a => a -> Value
toJSON UUID
value
            fieldValueToJSON (DateTimeValue UTCTime
value) = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
value

instance ToJSON EnhancedSqlError where
    toJSON :: EnhancedSqlError -> Value
toJSON EnhancedSqlError { SqlError
sqlError :: SqlError
sqlError :: EnhancedSqlError -> SqlError
sqlError } = SqlError -> Value
forall a. ToJSON a => a -> Value
toJSON SqlError
sqlError

renderErrorJson :: (?context :: ControllerContext) => Data.Aeson.ToJSON json => json -> IO ()
renderErrorJson :: forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderErrorJson json
json = Status -> json -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
Status -> json -> IO ()
renderJsonWithStatusCode Status
status400 json
json
{-# INLINABLE renderErrorJson #-}

aesonValueToPostgresValue :: Value -> PG.Action
aesonValueToPostgresValue :: Value -> Action
aesonValueToPostgresValue (String Text
text) = Text -> Action
forall a. ToField a => a -> Action
PG.toField Text
text
aesonValueToPostgresValue (Bool Bool
value) = Bool -> Action
forall a. ToField a => a -> Action
PG.toField Bool
value
aesonValueToPostgresValue (Number Scientific
value) = case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
value of -- Hacky, we should make this function "Schema.sql"-aware in the future
    Left (Double
floating :: Double) -> Double -> Action
forall a. ToField a => a -> Action
PG.toField Double
floating
    Right (Integer
integer :: Integer) -> Integer -> Action
forall a. ToField a => a -> Action
PG.toField Integer
integer
aesonValueToPostgresValue Value
Data.Aeson.Null = Null -> Action
forall a. ToField a => a -> Action
PG.toField Null
PG.Null
aesonValueToPostgresValue (Data.Aeson.Array Array
values) = PGArray Value -> Action
forall a. ToField a => a -> Action
PG.toField ([Value] -> PGArray Value
forall a. [a] -> PGArray a
PG.PGArray (Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
values))
aesonValueToPostgresValue object :: Value
object@(Object Object
values) =
    let
        tryDecodeAsPoint :: Maybe Point
        tryDecodeAsPoint :: Maybe Point
tryDecodeAsPoint = do
                Value
xValue <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Aeson.lookup Key
"x" Object
values
                Value
yValue <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Aeson.lookup Key
"y" Object
values
                Double
x <- case Value
xValue of
                        Number Scientific
number -> Double -> Maybe Double
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
number)
                        Value
otherwise -> Maybe Double
forall a. Maybe a
Nothing
                Double
y <- case Value
yValue of
                        Number Scientific
number -> Double -> Maybe Double
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
number)
                        Value
otherwise -> Maybe Double
forall a. Maybe a
Nothing
                Point -> Maybe Point
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point { Double
x :: Double
x :: Double
x, Double
y :: Double
y :: Double
y }
    in
        -- This is really hacky and is mostly duck typing. We should refactor this in the future to
        -- become more type aware by passing the DDL of the table to 'aesonValueToPostgresValue'.
        if Object -> Int
forall v. KeyMap v -> Int
Aeson.size Object
values Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
            then Action -> Maybe Action -> Action
forall a. a -> Maybe a -> a
fromMaybe (Value -> Action
forall a. ToField a => a -> Action
PG.toField (Value -> Action) -> Value -> Action
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
object) (Point -> Action
forall a. ToField a => a -> Action
PG.toField (Point -> Action) -> Maybe Point -> Maybe Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Point
tryDecodeAsPoint)
            else Value -> Action
forall a. ToField a => a -> Action
PG.toField (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
object)


instance ToJSON GraphQLResult where
    toJSON :: GraphQLResult -> Value
toJSON GraphQLResult { Int
requestId :: Int
requestId :: GraphQLResult -> Int
requestId, UndecodedJSON
graphQLResult :: UndecodedJSON
graphQLResult :: GraphQLResult -> UndecodedJSON
graphQLResult } = [Pair] -> Value
object [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"GraphQLResult" :: Text), Key
"requestId" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
requestId, Key
"graphQLResult" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"" :: Text) ]
    toEncoding :: GraphQLResult -> Encoding
toEncoding GraphQLResult { Int
requestId :: GraphQLResult -> Int
requestId :: Int
requestId, UndecodedJSON
graphQLResult :: GraphQLResult -> UndecodedJSON
graphQLResult :: UndecodedJSON
graphQLResult } = [Encoding] -> Encoding
forall a. [Encoding' a] -> Encoding' a
Aeson.econcat
        [ Builder -> Encoding
forall a. Builder -> Encoding' a
Aeson.unsafeToEncoding Builder
"{\"tag\":\"GraphQLResult\",\"requestId\":"
        , Int -> Encoding
Aeson.int Int
requestId
        , Builder -> Encoding
forall a. Builder -> Encoding' a
Aeson.unsafeToEncoding Builder
",\"graphQLResult\":"
        , UndecodedJSON -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding UndecodedJSON
graphQLResult
        , Builder -> Encoding
forall a. Builder -> Encoding' a
Aeson.unsafeToEncoding Builder
"}"
        ]
instance ToJSON UndecodedJSON where
    toJSON :: UndecodedJSON -> Value
toJSON (UndecodedJSON ByteString
_) = Text -> Value
forall a. Text -> a
error Text
"Not implemented"
    toEncoding :: UndecodedJSON -> Encoding
toEncoding (UndecodedJSON ByteString
json) = Builder -> Encoding
forall a. Builder -> Encoding' a
Aeson.unsafeToEncoding (ByteString -> Builder
ByteString.byteString ByteString
json)