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

import IHP.ControllerPrelude
import IHP.DataSync.REST.Types
import Data.Aeson
import Data.Aeson.TH
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.HashMap.Strict as HashMap
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

instance (
    PG.ToField (PrimaryKey (GetTableName CurrentUserRecord))
    , Show (PrimaryKey (GetTableName CurrentUserRecord))
    , HasNewSessionUrl CurrentUserRecord
    , Typeable CurrentUserRecord
    , HasField "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord))
    ) => Controller ApiController where
    action :: ApiController -> IO ()
action CreateRecordAction { Text
$sel:table:CreateRecordAction :: ApiController -> Text
table :: 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 -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Object -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys
                        [Text] -> ([Text] -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
fieldNameToColumnName

                let values :: [Action]
values = Object
hashMap
                        Object -> (Object -> [Value]) -> [Value]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Object -> [Value]
forall k v. HashMap k v -> [v]
HashMap.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 SqlError [[Field]]
result :: Either PG.SqlError [[Field]] <- IO [[Field]] -> IO (Either SqlError [[Field]])
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try do
                    ((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]]
forall userId result.
(ToField userId, userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO result) -> IO result
withRLS do
                        Query -> (Identifier, In [Identifier], In [Action]) -> IO [[Field]]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r, Show q) =>
Query -> q -> IO [r]
sqlQuery Query
query (Identifier, In [Identifier], In [Action])
params

                case Either SqlError [[Field]]
result of
                    Left SqlError
error -> SqlError -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderErrorJson SqlError
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 -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Object -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys
                        [Text] -> ([Text] -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
fieldNameToColumnName

                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 k v. HashMap k v -> [v]
HashMap.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]] <- ((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]]
forall userId result.
(ToField userId, userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO result) -> IO result
withRLS (((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]])
-> ((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]]
forall a b. (a -> b) -> a -> b
$ Query
-> (Identifier, In [Identifier], Values [Action]) -> IO [[Field]]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r, Show q) =>
Query -> q -> IO [r]
sqlQuery 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 :: Text
$sel:table:CreateRecordAction :: ApiController -> Text
table, UUID
$sel:id:CreateRecordAction :: ApiController -> UUID
id :: 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 -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Object -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys
                [Text] -> ([Text] -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
fieldNameToColumnName
                [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 k v. HashMap k v -> [v]
HashMap.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]] <- ((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]]
forall userId result.
(ToField userId, userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO result) -> IO result
withRLS (((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]])
-> ((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]]
forall a b. (a -> b) -> a -> b
$ Query -> [Action] -> IO [[Field]]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r, Show q) =>
Query -> q -> IO [r]
sqlQuery (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 :: Text
$sel:table:CreateRecordAction :: ApiController -> Text
table, UUID
id :: UUID
$sel:id:CreateRecordAction :: ApiController -> UUID
id } = do
        (?modelContext::ModelContext) => Text -> IO TableWithRLS
Text -> IO TableWithRLS
ensureRLSEnabled Text
table

        ((?modelContext::ModelContext) => IO Int64) -> IO Int64
forall userId result.
(ToField userId, userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO result) -> IO result
withRLS do
            Query -> (Identifier, UUID) -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q, Show q) =>
Query -> q -> IO Int64
sqlExec 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 :: Text
$sel:table:CreateRecordAction :: ApiController -> Text
table, UUID
id :: UUID
$sel:id:CreateRecordAction :: ApiController -> UUID
id } = do
        (?modelContext::ModelContext) => Text -> IO TableWithRLS
Text -> IO TableWithRLS
ensureRLSEnabled Text
table

        [[Field]]
result :: [[Field]] <- ((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]]
forall userId result.
(ToField userId, userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO result) -> IO result
withRLS do
            Query -> (Identifier, UUID) -> IO [[Field]]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r, Show q) =>
Query -> q -> IO [r]
sqlQuery 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 :: Text
$sel:table:CreateRecordAction :: ApiController -> 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]] <- ((?modelContext::ModelContext) => IO [[Field]]) -> IO [[Field]]
forall userId result.
(ToField userId, userId ~ Id' (GetTableName CurrentUserRecord),
 Show (PrimaryKey (GetTableName CurrentUserRecord)),
 HasNewSessionUrl CurrentUserRecord, Typeable CurrentUserRecord,
 ?context::ControllerContext,
 HasField
   "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord)),
 ?modelContext::ModelContext) =>
((?modelContext::ModelContext) => IO result) -> IO result
withRLS (Query -> [Action] -> IO [[Field]]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r, Show q) =>
Query -> q -> IO [r]
sqlQuery 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
-> SelectedColumns
-> Maybe Condition
-> [OrderByClause]
-> Maybe Text
-> Maybe Text
-> DynamicSQLQuery
DynamicSQLQuery
    { Text
$sel:table:DynamicSQLQuery :: Text
table :: Text
table
    , $sel:selectedColumns:DynamicSQLQuery :: SelectedColumns
selectedColumns = SelectedColumns -> ByteString -> SelectedColumns
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault SelectedColumns
SelectAll ByteString
"fields"
    , $sel:whereCondition:DynamicSQLQuery :: Maybe Condition
whereCondition = Maybe Condition
forall a. Maybe a
Nothing
    , $sel:orderByClause:DynamicSQLQuery :: [OrderByClause]
orderByClause = ByteString -> [OrderByClause]
forall valueType.
(?context::ControllerContext, NFData valueType,
 ParamReader valueType) =>
ByteString -> [valueType]
paramList ByteString
"orderBy"
    , $sel:limitClause:DynamicSQLQuery :: Maybe Text
limitClause = Maybe Text
forall a. Maybe a
Nothing
    , $sel:offsetClause:DynamicSQLQuery :: Maybe Text
offsetClause = Maybe Text
forall a. Maybe a
Nothing
    }

instance ParamReader SelectedColumns where
    readParameter :: ByteString -> Either ByteString SelectedColumns
readParameter ByteString
byteString = SelectedColumns -> Either ByteString SelectedColumns
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 (f :: * -> *) a. Applicative f => a -> f a
pure OrderByClause :: ByteString -> OrderByDirection -> OrderByClause
OrderByClause { ByteString
$sel:orderByColumn:OrderByClause :: ByteString
orderByColumn :: ByteString
orderByColumn, OrderByDirection
$sel:orderByDirection:OrderByClause :: OrderByDirection
orderByDirection :: OrderByDirection
orderByDirection }
            [ByteString
orderByColumn] -> OrderByClause -> Either ByteString OrderByClause
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderByClause :: ByteString -> OrderByDirection -> OrderByClause
OrderByClause { ByteString
orderByColumn :: ByteString
$sel:orderByColumn:OrderByClause :: ByteString
orderByColumn, $sel:orderByDirection:OrderByClause :: 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 :: SqlError -> ByteString
sqlState :: ByteString
sqlState, ByteString
sqlErrorMsg :: SqlError -> ByteString
sqlErrorMsg :: ByteString
sqlErrorMsg, ByteString
sqlErrorDetail :: SqlError -> ByteString
sqlErrorDetail :: ByteString
sqlErrorDetail, ByteString
sqlErrorHint :: SqlError -> ByteString
sqlErrorHint :: ByteString
sqlErrorHint } = [Pair] -> Value
object
                [ Text
"state" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ((ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
sqlState) :: Text)
                , Text
"errorMsg" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ((ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
sqlErrorMsg) :: Text)
                , Text
"errorDetail" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ((ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
sqlErrorDetail) :: Text)
                , Text
"errorHint" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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

renderErrorJson :: (?context :: ControllerContext) => Data.Aeson.ToJSON json => json -> IO ()
renderErrorJson :: 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