Remove extraneous files
This commit is contained in:
calebmer
@@ -1,129 +0,0 @@
|
|||||||
module Main where
|
|
||||||
|
|
||||||
|
|
||||||
import PostgREST.App
|
|
||||||
import PostgREST.Config (AppConfig (..),
|
|
||||||
minimumPgVersion,
|
|
||||||
prettyVersion,
|
|
||||||
readOptions)
|
|
||||||
import PostgREST.Error (errResponse, PgError)
|
|
||||||
import PostgREST.Middleware
|
|
||||||
import PostgREST.DbStructure
|
|
||||||
import PostgREST.Types
|
|
||||||
|
|
||||||
import Control.Monad (unless)
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Data.Aeson (encode)
|
|
||||||
import Data.Functor.Identity
|
|
||||||
import Data.Monoid ((<>))
|
|
||||||
import Data.String.Conversions (cs)
|
|
||||||
import Data.Text (Text)
|
|
||||||
import qualified Hasql as H
|
|
||||||
import qualified Hasql.Postgres as P
|
|
||||||
import Network.Wai
|
|
||||||
import Network.Wai.Handler.Warp hiding (Connection)
|
|
||||||
import Network.Wai.Middleware.RequestLogger (logStdout)
|
|
||||||
import System.IO (BufferMode (..),
|
|
||||||
hSetBuffering, stderr,
|
|
||||||
stdin, stdout)
|
|
||||||
-- import Data.Maybe (mapMaybe)
|
|
||||||
-- import Data.List (subsequences)
|
|
||||||
-- import Control.Monad (join)
|
|
||||||
-- import PostgREST.QueryBuilder
|
|
||||||
-- import GHC.Exts (groupWith)
|
|
||||||
|
|
||||||
|
|
||||||
isServerVersionSupported :: H.Session P.Postgres IO Bool
|
|
||||||
isServerVersionSupported = do
|
|
||||||
Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
|
|
||||||
return $ read (cs row) >= minimumPgVersion
|
|
||||||
|
|
||||||
hasqlError :: PgError -> IO a
|
|
||||||
hasqlError = error . cs . encode
|
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
hSetBuffering stdout LineBuffering
|
|
||||||
hSetBuffering stdin LineBuffering
|
|
||||||
hSetBuffering stderr NoBuffering
|
|
||||||
|
|
||||||
-- let dbString = "postgres://postgrest_test@localhost:5432/postgrest_test" :: String
|
|
||||||
-- conf = AppConfig dbString 3000 "postgrest_anonymous" "test" False "safe" 10 :: AppConfig
|
|
||||||
|
|
||||||
conf <- readOptions
|
|
||||||
let port = configPort conf
|
|
||||||
|
|
||||||
unless ("secret" /= configJwtSecret conf) $
|
|
||||||
putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
|
|
||||||
Prelude.putStrLn $ "Listening on port " ++
|
|
||||||
(show $ configPort conf :: String)
|
|
||||||
|
|
||||||
let pgSettings = P.StringSettings $ cs (configDatabase conf)
|
|
||||||
appSettings = setPort port
|
|
||||||
. setServerName (cs $ "postgrest/" <> prettyVersion)
|
|
||||||
$ defaultSettings
|
|
||||||
middle = logStdout . defaultMiddle
|
|
||||||
|
|
||||||
poolSettings <- maybe (fail "Improper session settings") return $
|
|
||||||
H.poolSettings (fromIntegral $ configPool conf) 30
|
|
||||||
pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
|
|
||||||
|
|
||||||
supportedOrError <- H.session pool isServerVersionSupported
|
|
||||||
either hasqlError
|
|
||||||
(\supported ->
|
|
||||||
unless supported $
|
|
||||||
error (
|
|
||||||
"Cannot run in this PostgreSQL version, PostgREST needs at least "
|
|
||||||
<> show minimumPgVersion)
|
|
||||||
) supportedOrError
|
|
||||||
|
|
||||||
-- what was this code for?
|
|
||||||
-- roleOrError <- H.session pool $ do
|
|
||||||
-- Identity (role :: Text) <- H.tx Nothing $ H.singleEx
|
|
||||||
-- [H.stmt|SELECT SESSION_USER|]
|
|
||||||
-- return role
|
|
||||||
-- authenticator <- either hasqlError return roleOrError
|
|
||||||
|
|
||||||
let txSettings = Just (H.ReadCommitted, Just True)
|
|
||||||
metadata <- H.session pool $ H.tx txSettings $ do
|
|
||||||
tabs <- allTables
|
|
||||||
rels <- allRelations
|
|
||||||
cols <- allColumns rels
|
|
||||||
keys <- allPrimaryKeys
|
|
||||||
return (tabs, rels, cols, keys)
|
|
||||||
|
|
||||||
|
|
||||||
db <- either hasqlError
|
|
||||||
(\(tabs, rels, cols, keys) ->
|
|
||||||
|
|
||||||
return DbStructure {
|
|
||||||
dbTables=tabs
|
|
||||||
, dbColumns=cols
|
|
||||||
, dbRelations=rels
|
|
||||||
, dbPrimaryKeys=keys
|
|
||||||
}
|
|
||||||
) metadata
|
|
||||||
runSettings appSettings $ middle $ \ req respond -> do
|
|
||||||
body <- strictRequestBody req
|
|
||||||
resOrError <- liftIO $ H.session pool $ H.tx txSettings $
|
|
||||||
runWithClaims conf (app db conf body) req
|
|
||||||
either (respond . errResponse) respond resOrError
|
|
||||||
|
|
||||||
--let allRels = relations db
|
|
||||||
-- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels
|
|
||||||
-- combinations k ns = filter ((k==).length) (subsequences ns)
|
|
||||||
|
|
||||||
--print $ findRelation allRels "test" "projects" "users"
|
|
||||||
--mapM_ print $ mapMaybe link2Relation links
|
|
||||||
|
|
||||||
-- where
|
|
||||||
-- groupFn :: Relation -> Text
|
|
||||||
-- groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
|
|
||||||
-- link2Relation [
|
|
||||||
-- Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
|
|
||||||
-- Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc}
|
|
||||||
-- ]
|
|
||||||
-- | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
|
|
||||||
-- | otherwise = Nothing
|
|
||||||
-- link2Relation _ = Nothing
|
|
||||||
-43
@@ -1,43 +0,0 @@
|
|||||||
arr = eitherDecode "[{\"a\":10},{\"a\":20}]" :: Either String Value
|
|
||||||
ob = eitherDecode "{\"a\":10}"::Either String Value
|
|
||||||
|
|
||||||
rc :: Request
|
|
||||||
rc = Request {
|
|
||||||
-- | Request method such as GET.
|
|
||||||
requestMethod = "POST"
|
|
||||||
, pathInfo = ["menagerie"]
|
|
||||||
, requestHeaders = [("Content-Type", "text/csv")] -- :: H.RequestHeaders
|
|
||||||
}
|
|
||||||
bc :: BL.ByteString
|
|
||||||
bc = [str|integer->sub->sub2,double,varchar,boolean,date,money,enum
|
|
||||||
|13,3.14159,testing!,false,1900-01-01,$3.99,foo
|
|
||||||
|12,0.1,NULL,true,1929-10-01,12,bar
|
|
||||||
|]
|
|
||||||
|
|
||||||
rj :: Request
|
|
||||||
rj = Request {
|
|
||||||
-- | Request method such as GET.
|
|
||||||
requestMethod = "POST"
|
|
||||||
, pathInfo = ["menagerie"]
|
|
||||||
, requestHeaders = [("Content-Type", "application/json")] -- :: H.RequestHeaders
|
|
||||||
}
|
|
||||||
bj :: BL.ByteString
|
|
||||||
bj = [str|{
|
|
||||||
| "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
|
|
||||||
| , "boolean": false, "date": "1900-01-01", "money": "$3.99"
|
|
||||||
| , "enum": "foo"
|
|
||||||
|}
|
|
||||||
|]
|
|
||||||
bj2 :: BL.ByteString
|
|
||||||
bj2 = [str|[
|
|
||||||
|{
|
|
||||||
| "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
|
|
||||||
| , "boolean": false, "date": "1900-01-01", "money": "$3.99"
|
|
||||||
| , "enum": "foo"
|
|
||||||
|},
|
|
||||||
|{
|
|
||||||
| "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
|
|
||||||
| , "boolean": false, "date": "1900-01-01", "money": "$3.99"
|
|
||||||
| , "enum": "foo"
|
|
||||||
|}]
|
|
||||||
|]
|
|
||||||
Reference in New Issue
Block a user