Start of Sprint 2

.gitignore

@@ -17,3 +17,4 @@ cabal.sandbox.config
 *.eventlog
 .stack-work/
 cabal.project.local
+Conf.hs

ServantOpaleye/stack.yaml

@@ -63,4 +63,4 @@ extra-package-dbs: []
 # extra-lib-dirs: [/path/to/dir]
 # 
 # Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
+# compiler-check: newer-minor

SpockOpaleye/SpockOpaleye.cabal

@@ -15,26 +15,42 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  exposed-modules:     Lib,
-                       TenantApi,
+  exposed-modules:     TenantApi,
                        UserApi,
                        RoleApi,
-                       OpaleyeDef,
-                       CryptoDef,
                        JsonInstances,
                        Validations,
-                       DataTypes
+                       Conf,
+                       UserServices,
+                       Email
   build-depends:       base >= 4.7 && < 5
+                      ,appcore
+                      ,smtp-mail
+                      ,lifted-base
+                      ,airbrake
+                      ,here
+                      ,filepath
+                      ,mime-mail >= 0.4.12
                       ,product-profunctors
+                      ,profunctors
                       ,bytestring
                       ,opaleye
+                      ,time
+                      ,old-time
+                      ,network
                       ,postgresql-simple
                       ,bcrypt
                       ,text
                       ,lens
                       ,mtl
+                      ,transformers
+                      ,time
+                      ,vector
                       ,Spock >=0.11
                       ,aeson
+                      ,unordered-containers
+                      ,template-haskell
+                      ,lifted-base
   default-language:    Haskell2010
 
 executable SpockOpaleye-exe
@@ -43,13 +59,27 @@ executable SpockOpaleye-exe
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-incomplete-patterns
   build-depends:       base
                      , postgresql-simple
+                     , airbrake
+                     , bytestring
+                     , appcore
+                     , here
+                     , mime-mail
+                     , filepath
+                     , smtp-mail
+                     , network
+                     , old-time
                      , SpockOpaleye
                      , Spock >=0.11
                      , mtl
+                     , transformers
                      , lens
                      , text
+                     , time
                      , bcrypt
+                     , vector
                      , aeson
+                     , unordered-containers
+                     , lifted-base
   default-language:    Haskell2010
 
 test-suite SpockOpaleye-test

SpockOpaleye/app/Main.hs

@@ -1,23 +1,38 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TemplateHaskell       #-}
 
 module Main where
-
+import           AppCore
 import           Database.PostgreSQL.Simple
-import           DataTypes
 import           JsonInstances              ()
 import           TenantApi
 import           Validations
 
+import           Email
 import           Web.Spock
 import           Web.Spock.Config
 
+import           Control.Monad.Reader
+import           Control.Monad.Writer
+import qualified Control.Monad.Reader as R
 import qualified Data.Text                  as T
+import           Data.Time
+import           Prelude                    hiding (id)
+import           UserServices
+import           Control.Monad.Trans.Except
+import           Control.Exception.Lifted
+import           Airbrake
+import           Airbrake.WebRequest
+import           Data.ByteString (ByteString)
 
-data MySession =
-  EmptySession
+data MySession = EmptySession
 
 data MyAppState = DummyAppState
 
+data AppResult a = AppOk a | AppErr T.Text
+
 connectDb :: IO Connection
 connectDb = connect defaultConnectInfo { connectDatabase = "haskell-webapps" }
 
@@ -30,19 +45,41 @@ main = do
       DummyAppState
   runSpock 8080 (spock spockCfg app)
 
+runAppM :: AppM a -> Connection -> IO (AppResult a)
+runAppM x conn = do
+  user <- getTestUser
+  r <- runExceptT $ handle throwE $ runReaderT (runWriterT x) (conn, Just $ getTestTenant, Just $ user)
+  case r of 
+    Right (item, lg) -> do
+      return $ AppOk item
+    Left ex -> do
+      let message = T.pack $ show ex
+      return $ AppErr message
+
+runWithLogging :: ActionT (WebStateM Connection MySession MyAppState) (AppResult a)
+               -> (a -> ActionT (WebStateM Connection MySession MyAppState) ())
+               -> ActionT (WebStateM Connection MySession MyAppState) ()
+runWithLogging act sact = do
+  r <- act
+  case r of
+    AppOk rOk -> sact rOk
+    AppErr msg -> do
+      r <- request
+      liftIO $ notifyReq conf (waiRequestToRequest r) (Error "Uncaught exception" msg) (("Filename", 5):|[])
+      json $ T.pack "There was an error. Please try again later"
+  where
+      conf = airbrakeConf "61a1adfc070a9be9f21e43f586bbf5f7" "Env"
+
 app :: SpockM Connection MySession MyAppState ()
 app = do
-  post ("tenants/new") $
-    do maybe_tenant_incoming <- jsonBody
-       maybe_newtenant <-
-         case maybe_tenant_incoming of
-           Just incoming_tenant -> do
-             result <-
-               runQuery (\conn -> validateIncomingTenant conn incoming_tenant)
-             case result of
-               Valid -> runQuery (\conn -> create_tenant conn incoming_tenant)
-               _ -> return Nothing
-           Nothing -> return Nothing
-       case maybe_newtenant of
-         Just tenant -> json tenant
-         _           -> json $ T.pack "Tenant not created"
+  get ("tenants") $ do
+    runWithLogging (runQuery $ runAppM readTenants) (\tenants ->json tenants)
+  post ("tenants/new") $ runWithLogging (do
+      maybeTenantIncoming <- jsonBody
+      runQuery $ runAppM $ do
+        case maybeTenantIncoming of
+            Just incomingTenant -> doCreateTenant incomingTenant
+            Nothing -> return $ Left $ T.pack "Unrecognized input"
+      ) (\et -> case et of
+        Right new_tenant -> json new_tenant
+        Left message     -> json message)

SpockOpaleye/appcore/LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2016
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

SpockOpaleye/appcore/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

SpockOpaleye/appcore/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc

SpockOpaleye/appcore/appcore.cabal

@@ -0,0 +1,67 @@
+name:                appcore
+version:             0.1.0.0
+synopsis:            Initial project template from stack
+description:         Please see README.md
+homepage:            https://github.com/githubuser/appcore#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Author name here
+maintainer:          example@example.com
+copyright:           2016 Author name here
+category:            Web
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+                       ,src/User
+                       ,src/Role
+                       ,src/Tenant
+  exposed-modules:     AppCore
+  other-modules:       Auditable
+                       ,AuditableTH
+                       ,CryptoDef
+                       ,OpaleyeDef
+                       ,UserDefs
+                       ,TenantDefs
+                       ,RoleDefs
+                       ,Lenses
+                       ,UserId
+                       ,TenantId
+                       ,Utils
+                       ,AppM
+                       ,ApiBase
+                       ,UserApi
+                       ,TenantApi
+  build-depends:       base >= 4.7 && < 5
+                       , aeson
+                       , transformers
+                       , text
+                       , lens
+                       , time
+                       , old-time
+                       , product-profunctors
+                       , profunctors
+                       , vector
+                       , bytestring
+                       , opaleye
+                       , postgresql-simple
+                       , template-haskell
+                       , unordered-containers
+                       , bcrypt
+                       , mtl
+  default-language:    Haskell2010
+
+test-suite appcore-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , appcore
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/githubuser/appcore