tsweb 0.1.1 → 0.1.2

raw patch · 5 files changed

+63/−40 lines, 5 filesnew-component:exe:tsweb

Files

• README.md +3/−3
• src/Example/Types.hs +0/−2
• src/TsWeb/Db.hs +2/−33
• src/TsWeb/Db/Beam.hs +54/−0
• tsweb.cabal +4/−2

@@ -16,7 +16,7 @@  TsWeb views run with minimal rights; by default they do not have access to the database nor do they have any user information initialized. A view's type-signature enumerates its requirements, and those requirements are specified in+signature enumerates its requirements, and those requirements are granted by the view's routing. For example, a view that needs read-write database access, an admin user, and a route to the index URL might have this type signature: @@ -38,7 +38,7 @@ ``` runroute readonlypool readwritepool $   path #index root (getpost indexView) .-  path #myview "mine" (dbwrite $ getpost $ auth adminP yview)+  path #myview "mine" (dbwrite $ getpost $ auth adminP myview) ```  See the docs for "TsWeb.Routing" and "TsWeb.Routing.Auth" for more details.@@ -87,7 +87,7 @@ users :: Has "root" lts (Path '[] 'Open) => TsActionCtxT lts xs sess a users = do   root <- showPath #root-  text $ "GET users, root is, " \<\> root+  text $ "GET users, root is, " <> root  usersPost :: TsActionCtxT lts xs sess a usersPost = text "POST to users!"

@@ -1,7 +1,5 @@ module Example.Types where -import qualified TsWeb.Db- import TsWeb.Db (QueryResult(..), queryMaybe) import TsWeb.Routing.Auth (Authorize(..)) import TsWeb.Session (UserData(..))

@@ -1,4 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-} {-| Description: Beam actions for Spock @@ -16,12 +15,9 @@ -}  module TsWeb.Db-  ( module Database.Beam-  , TxOpt(..)+  ( TxOpt(..)   , QueryResult(..)   , ExecResult(..)-  , runSelectReturningList-  , runSelectReturningOne   , query   , queryMaybe   , queryList@@ -31,45 +27,18 @@ import qualified TsWeb.Types.Db as Db  import TsWeb.Action (getExtra)+import TsWeb.Db.Beam import TsWeb.Types (TsActionCtxT) import TsWeb.Types.Db (ReadOnlyPool, ReadWritePool) -import qualified Database.Beam as Beam- import Control.Exception (catch, try) import Data.HVect (ListContains)-import Database.Beam hiding (runSelectReturningList, runSelectReturningOne) import Database.Beam.Postgres (Pg, Postgres) import Database.PostgreSQL.Simple (SqlError(..)) import Database.PostgreSQL.Simple.Errors   ( ConstraintViolation(..)   , constraintViolationE   )--#if MIN_VERSION_beam_core(0, 8, 0)-type Sel a = SqlSelect Postgres a-#else-import Database.Beam.Postgres (PgSelectSyntax)-type Sel a = SqlSelect PgSelectSyntax a-#endif--class ReadOnlyM m where-  runSelectReturningOne ::-       FromBackendRow Postgres a => Sel a -> m (Maybe a)-  runSelectReturningList ::-       FromBackendRow Postgres a => Sel a -> m [a]--instance ReadOnlyM Pg where-  runSelectReturningOne = Beam.runSelectReturningOne-  runSelectReturningList = Beam.runSelectReturningList--newtype RoPg a = RoPg-  { _fromRoPg :: Pg a-  } deriving (Functor, Applicative, Monad)--instance ReadOnlyM RoPg where-  runSelectReturningOne = RoPg . Beam.runSelectReturningOne-  runSelectReturningList = RoPg . Beam.runSelectReturningList  -- | Transaction option: provide WithTx to wrap operations in BEGIN/COMMIT, or -- NoTx to skip that.

@@ -0,0 +1,54 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-}+{-|+Description: ++-}+module TsWeb.Db.Beam+  ( module Database.Beam+  , RoPg(..)+  , ReadOnlyM(..)+  , Sel+  ) where++import qualified Database.Beam as Beam++import Database.Beam hiding (runSelectReturningList, runSelectReturningOne)+#if MIN_VERSION_beam_core(0, 8, 0)+import Database.Beam.Postgres (Pg, Postgres)+#else+import Database.Beam.Postgres (Pg, Postgres, PgSelectSyntax)+#endif++-- | Type alias to handle the beam 0.7 - 0.8 API change that replaced+-- PgSelectSyntax with just plain Postgres.+#if MIN_VERSION_beam_core(0, 8, 0)+type Sel a = SqlSelect Postgres a+#else+type Sel a = SqlSelect PgSelectSyntax a+#endif++-- | class of read-only Beam operations - this has one obvious instance in+-- 'Database.Beam.Postgres.Pg' itself, plus it lets us create a read-only alias+-- in order to restrict views to only reading from the database pool (where+-- appropriate).+class ReadOnlyM m where+  runSelectReturningOne ::+       FromBackendRow Postgres a => Sel a -> m (Maybe a)+  runSelectReturningList ::+       FromBackendRow Postgres a => Sel a -> m [a]++instance ReadOnlyM Pg where+  runSelectReturningOne = Beam.runSelectReturningOne+  runSelectReturningList = Beam.runSelectReturningList++-- | newtype wrapper around 'Database.Beam.Postgres.Pg' that only exports+-- read-only operations (currently runSelectReturningOne and+-- runSelectReturningList).+newtype RoPg a = RoPg+  { _fromRoPg :: Pg a+  } deriving (Functor, Applicative, Monad)++instance ReadOnlyM RoPg where+  runSelectReturningOne = RoPg . Beam.runSelectReturningOne+  runSelectReturningList = RoPg . Beam.runSelectReturningList+

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                tsweb-version:             0.1.1+version:             0.1.2 synopsis:            An API binding Web.Spock to Database.Beam -- description:          license:             BSD3@@ -19,6 +19,7 @@ library   exposed-modules:     TsWeb.Action                      , TsWeb.Db+                     , TsWeb.Db.Beam                      , TsWeb.Routing.Auth                      , TsWeb.Routing.Clay                      , TsWeb.Routing@@ -67,12 +68,13 @@   default-language:    Haskell2010   ghc-options:         -Wall -executable example+executable tsweb   main-is: Example/Main.hs   other-modules:       Example.Types                      , Example.Views                      , TsWeb.Action                      , TsWeb.Db+                     , TsWeb.Db.Beam                      , TsWeb.Routing                      , TsWeb.Routing.Auth                      , TsWeb.Routing.Clay