Use "::unknown" type casts to overcome binary protocol restrictions

Fixes #112

src/App.hs

@@ -14,7 +14,6 @@ import Data.HashMap.Strict (keys, elems, filterWithKey, toList)
 import Data.String.Conversions (cs)
 import Data.List (sortBy)
 import Data.Functor.Identity
-import Data.Scientific (isInteger, formatScientific, FPFormat(..))
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as BL
 
@@ -223,13 +222,6 @@ handleJsonObj reqBody handler = do
         jErr = encode . object $
           [("error", String "Expecting a JSON object")]
 
-unquoted :: Value -> Text
-unquoted (String t) = t
-unquoted (Number n) =
-  cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
-unquoted (Bool b) = cs . show $ b
-unquoted _ = ""
-
 data TableOptions = TableOptions {
   tblOptcolumns :: [Column]
 , tblOptpkey :: [Text]

src/Main.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import Paths_dbapi (version)
+import Paths_postgrest (version)
 
 import App
 import Middleware
@@ -29,10 +29,14 @@ main = do
 
   unless (configSecure conf) $
     putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
-  Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
+  Prelude.putStrLn $ "Listening on port " ++
+    (show $ configPort conf :: String)
 
-  let pgSettings = H.Postgres (cs $ configDbHost conf) (fromIntegral $ configDbPort conf)
-                     (cs $ configDbUser conf) (cs $ configDbPass conf) (cs $ configDbName conf)
+  let pgSettings = H.ParamSettings (cs $ configDbHost conf)
+                     (fromIntegral $ configDbPort conf)
+                     (cs $ configDbUser conf)
+                     (cs $ configDbPass conf)
+                     (cs $ configDbName conf)
 
   sessSettings <- maybe (fail "Improper session settings") return $
                     H.sessionSettings (fromIntegral $ configPool conf) 30

src/PgQuery.hs

@@ -18,6 +18,7 @@ import Control.Monad (join)
 import Data.String.Conversions (cs)
 import qualified Data.Aeson as JSON
 import qualified Data.List as L
+import Data.Scientific (isInteger, formatScientific, FPFormat(..))
 
 type DynamicSQL = (BS.ByteString, [H.StatementArgument H.Postgres], All)
 
@@ -99,9 +100,12 @@ insertInto t cols vals =
   ("insert into " <> fromQt t <> " (" <>
     cs (intercalate ", " (map pgFmtIdent cols)) <>
     ") values (" <>
-    cs (intercalate ", " (map (const "?") vals)) <>
-    ") returning row_to_json(" <> fromQt t <> ".*)"
-  , map pgParam vals
+    cs (
+      intercalate ", " (map
+        ((<> "::unknown") . pgFmtLit . unquoted)
+        vals)
+    ) <> ") returning row_to_json(" <> fromQt t <> ".*)"
+  , []
   , mempty
   )
 
@@ -112,8 +116,12 @@ insertSelect t cols vals =
   ("insert into " <> fromQt t <> " (" <>
     cs (intercalate ", " (map pgFmtIdent cols)) <>
     ") select " <>
-    cs (intercalate ", " (map (const "?") vals))
-  , map pgParam vals
+    cs (
+      intercalate ", " (map
+        ((<> "::unknown") . pgFmtLit . unquoted)
+        vals)
+    )
+  , []
   , mempty
   )
 
@@ -122,14 +130,18 @@ update t cols vals =
   ("update " <> fromQt t <> " set (" <>
     cs (intercalate ", " (map pgFmtIdent cols)) <>
     ") = (" <>
-    cs (intercalate ", " (map (const "?") vals)) <> ")"
-  , map pgParam vals
+    cs (
+      intercalate ", " (map
+        ((<> "::unknown") . pgFmtLit . unquoted)
+        vals)
+    ) <> ")"
+  , []
   , mempty
   )
 
 wherePred :: Net.QueryItem -> DynamicSQL
 wherePred (col, predicate) =
-  (" " <> cs (pgFmtIdent $ cs col) <> " " <> op <> " " <> cs (pgFmtLit value) <> " ", [], mempty)
+  (" " <> cs (pgFmtIdent $ cs col) <> " " <> op <> " " <> cs (pgFmtLit value) <> "::unknown ", [], mempty)
 
   where
     opCode:rest = split (=='.') $ cs $ fromMaybe "." predicate
@@ -189,10 +201,20 @@ trimNullChars = Data.Text.takeWhile (/= '\x0')
 fromQt :: QualifiedTable -> BS.ByteString
 fromQt t = cs $ pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t)
 
+unquoted :: JSON.Value -> Text
+unquoted (JSON.String t) = t
+unquoted (JSON.Number n) =
+  cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = cs . show $ b
+unquoted _ = ""
+
 pgParam :: JSON.Value -> H.StatementArgument H.Postgres
-pgParam (JSON.Number n) = H.renderValue n
+pgParam (JSON.Number n) = H.renderValue
+  (cs $ formatScientific Fixed
+       (if isInteger n then Just 0 else Nothing) n :: Text)
 pgParam (JSON.String s) = H.renderValue s
-pgParam (JSON.Bool      b) = H.renderValue b
-pgParam JSON.Null       = H.renderValue (Nothing :: Maybe String)
+pgParam (JSON.Bool      b) = H.renderValue $
+  if b then "t" else "f" :: Text
+pgParam JSON.Null       = H.renderValue (Nothing :: Maybe Text)
 pgParam (JSON.Object o) = H.renderValue $ JSON.encode o
 pgParam (JSON.Array  a) = H.renderValue $ JSON.encode a

src/PgStructure.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE QuasiQuotes, OverloadedStrings,
+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
              MultiParamTypeClasses, ScopedTypeVariables #-}
 module PgStructure where