commit f7a61dcddc26f441713133aa1f470315c36e59ac
parent b4d6e9c9d1935e5081f7e0f2b5f7d9a98f6857a7
Author: James Eversole <james@eversole.co>
Date: Fri, 1 Jul 2022 20:34:29 -0500
Organize application logic by core/feature breakouts, add dhall configuration support and add a range of new config options in the Reader, add example configuration/deployment files
Diffstat:
15 files changed, 260 insertions(+), 22 deletions(-)
diff --git a/.dockerignore b/.dockerignore
@@ -0,0 +1,2 @@
+.stack-work
+data/
diff --git a/.gitignore b/.gitignore
@@ -1,4 +1,7 @@
+data/
+bin/
+/config.dhall
+/Dockerfile
+docker-stack.yml
.stack-work/
-./data
-./config.dhall
*~
diff --git a/Purr.cabal b/Purr.cabal
@@ -19,13 +19,38 @@ extra-source-files:
library
exposed-modules:
+ Core.Configuration
+ Core.HTTP
+ Core.Mongo
+ Core.Types
+ Feature.Handlers
Lib
other-modules:
Paths_Purr
hs-source-dirs:
src
+ default-extensions:
+ OverloadedStrings
+ GeneralizedNewtypeDeriving
+ DeriveGeneric
+ ConstraintKinds
+ FlexibleContexts
+ FlexibleInstances
+ ScopedTypeVariables
build-depends:
- base >=4.7 && <5
+ AesonBson ==0.4.1
+ , aeson >=2.0.0.0
+ , base >=4.7
+ , bson >=0.3
+ , dhall >=1.40 && <1.41.2
+ , http-types >=0.12.3
+ , iso8601-time >=0.1.5
+ , mongoDB >=2.7.1.1
+ , mtl >=2.2.2
+ , scotty ==0.12
+ , text >=1.2
+ , time >=1.9
+ , wai-extra >=3.1.12.1
default-language: Haskell2010
executable Purr-exe
@@ -34,10 +59,30 @@ executable Purr-exe
Paths_Purr
hs-source-dirs:
app
+ default-extensions:
+ OverloadedStrings
+ GeneralizedNewtypeDeriving
+ DeriveGeneric
+ ConstraintKinds
+ FlexibleContexts
+ FlexibleInstances
+ ScopedTypeVariables
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
- Purr
- , base >=4.7 && <5
+ AesonBson ==0.4.1
+ , Purr
+ , aeson >=2.0.0.0
+ , base >=4.7
+ , bson >=0.3
+ , dhall >=1.40 && <1.41.2
+ , http-types >=0.12.3
+ , iso8601-time >=0.1.5
+ , mongoDB >=2.7.1.1
+ , mtl >=2.2.2
+ , scotty ==0.12
+ , text >=1.2
+ , time >=1.9
+ , wai-extra >=3.1.12.1
default-language: Haskell2010
test-suite Purr-test
@@ -47,8 +92,28 @@ test-suite Purr-test
Paths_Purr
hs-source-dirs:
test
+ default-extensions:
+ OverloadedStrings
+ GeneralizedNewtypeDeriving
+ DeriveGeneric
+ ConstraintKinds
+ FlexibleContexts
+ FlexibleInstances
+ ScopedTypeVariables
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
- Purr
- , base >=4.7 && <5
+ AesonBson ==0.4.1
+ , Purr
+ , aeson >=2.0.0.0
+ , base >=4.7
+ , bson >=0.3
+ , dhall >=1.40 && <1.41.2
+ , http-types >=0.12.3
+ , iso8601-time >=0.1.5
+ , mongoDB >=2.7.1.1
+ , mtl >=2.2.2
+ , scotty ==0.12
+ , text >=1.2
+ , time >=1.9
+ , wai-extra >=3.1.12.1
default-language: Haskell2010
diff --git a/app/Main.hs b/app/Main.hs
@@ -1,6 +1,7 @@
module Main where
-import Lib
+import Prelude
+import qualified Lib
main :: IO ()
-main = someFunc
+main = Lib.main
diff --git a/examples/Dockerfile b/examples/Dockerfile
@@ -0,0 +1,11 @@
+FROM haskell:9.0.2
+
+WORKDIR /app
+ADD . /app
+
+RUN stack setup
+RUN stack build --copy-bins --local-bin-path ./
+
+EXPOSE 3000
+
+CMD ./Purr-exe
diff --git a/examples/config.dhall b/examples/config.dhall
@@ -0,0 +1,10 @@
+-- /config.dhall
+{ hostname = "localhost"
+, port = +3001
+, environment = "development"
+, adminDB = "admin"
+, dataDB = "data"
+, collection = "store"
+, mongoUsername = "root"
+, mongoPassword = "REPLACEME"
+}
diff --git a/package.yaml b/package.yaml
@@ -9,6 +9,15 @@ extra-source-files:
- README.md
- ChangeLog.md
+default-extensions:
+- OverloadedStrings
+- GeneralizedNewtypeDeriving
+- DeriveGeneric
+- ConstraintKinds
+- FlexibleContexts
+- FlexibleInstances
+- ScopedTypeVariables
+
# Metadata used when publishing your package
# synopsis: Short description of your package
# category: Web
@@ -19,7 +28,19 @@ extra-source-files:
description: https://git.eversole.co/James/Purr
dependencies:
-- base >= 4.7 && < 5
+- aeson >= 2.0.0.0
+- AesonBson == 0.4.1
+- bson >= 0.3
+- base >= 4.7
+- dhall >= 1.40 && < 1.41.2
+- http-types >= 0.12.3
+- iso8601-time >= 0.1.5
+- mongoDB >= 2.7.1.1
+- mtl >= 2.2.2
+- scotty == 0.12
+- time >= 1.9
+- text >= 1.2
+- wai-extra >= 3.1.12.1
library:
source-dirs: src
diff --git a/src/Core/Configuration.hs b/src/Core/Configuration.hs
@@ -0,0 +1,11 @@
+module Core.Configuration ( main ) where
+
+import Core.Types
+
+import Dhall
+
+instance FromDhall DhallConfig
+
+main :: IO DhallConfig
+main = do
+ input auto "./config.dhall"
diff --git a/src/Core/HTTP.hs b/src/Core/HTTP.hs
@@ -0,0 +1,14 @@
+module Core.HTTP ( app ) where
+
+import Core.Types
+
+import Feature.Handlers as RES
+
+import Network.Wai.Middleware.RequestLogger (logStdoutDev)
+import Web.Scotty.Trans
+
+app :: PurrApp ()
+app = do
+ middleware logStdoutDev
+
+ get "/" RES.root
diff --git a/src/Core/Mongo.hs b/src/Core/Mongo.hs
@@ -0,0 +1,20 @@
+module Core.Mongo ( mongoSetup, tempGetDocs ) where
+
+import Core.Types
+
+import Control.Monad.Reader (MonadIO)
+import Database.MongoDB
+import Prelude
+
+mongoSetup :: DhallConfig -> IO MongoContext
+mongoSetup conf = do
+ mongoCon <- connect $ host (hostname conf)
+ let adminCon = MongoContext mongoCon master (adminDB conf)
+ access (mongoPipe adminCon) (mongoAccessMode adminCon) (mongoDatabase adminCon) (auth (mongoUsername conf) (mongoPassword conf))
+ return $ MongoContext mongoCon master (dataDB conf)
+
+tempGetDocs :: MonadIO m => AppConfig -> m [Document]
+tempGetDocs appConfig = access (mongoPipe db) (mongoAccessMode db) (mongoDatabase db) $ find (select [] (collection conf)) >>= rest
+ where
+ db = dbconn appConfig
+ conf = res appConfig
diff --git a/src/Core/Types.hs b/src/Core/Types.hs
@@ -0,0 +1,34 @@
+module Core.Types where
+
+import qualified Data.Text.Lazy as LT
+
+import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
+import Data.Text
+import Database.MongoDB (MongoContext)
+import GHC.Generics (Generic)
+import Numeric.Natural (Natural)
+import Web.Scotty.Trans (ScottyT, ActionT)
+
+type PurrApp a = ScottyT LT.Text ConfigM a
+type PurrAction a = ActionT LT.Text ConfigM a
+
+newtype ConfigM a = ConfigM
+ { runConfigM :: ReaderT AppConfig IO a
+ } deriving (Applicative, Functor, Monad, MonadIO, MonadReader AppConfig)
+
+data AppConfig = AppConfig
+ { res :: DhallConfig
+ , dbconn :: MongoContext
+ }
+
+data DhallConfig = DhallConfig
+ { hostname :: String
+ , port :: Int
+ , environment :: Text
+ , adminDB :: Text
+ , dataDB :: Text
+ , collection :: Text
+ , mongoUsername :: Text
+ , mongoPassword :: Text
+ } deriving (Generic, Show)
+
diff --git a/src/Feature/Handlers.hs b/src/Feature/Handlers.hs
@@ -0,0 +1,18 @@
+module Feature.Handlers ( root ) where
+
+import Core.Types
+import qualified Core.Mongo as DB
+
+import Control.Monad.Reader (ask, lift)
+import Data.AesonBson (aesonify)
+import Data.Bson (Document, Field (..), Value (Array, Doc))
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import Web.Scotty.Trans (json)
+import Prelude hiding (id)
+
+root :: PurrAction ()
+root = do
+ config <- lift $ ask
+ docs <- DB.tempGetDocs config
+ json $ aesonify ["allDocs" := Array (map Doc docs)]
diff --git a/src/Lib.hs b/src/Lib.hs
@@ -1,6 +1,23 @@
-module Lib
- ( someFunc
- ) where
+module Lib ( main ) where
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
+import Core.Types
+import qualified Core.Configuration as Configuration
+import qualified Core.HTTP as HTTP
+import qualified Core.Mongo as DB
+
+import Control.Monad.Reader (liftIO, runReaderT)
+import Database.MongoDB (MongoContext)
+import GHC.Natural (popCountNatural)
+import Web.Scotty.Trans (scottyT)
+import Prelude hiding (id)
+
+main :: IO ()
+main = do
+ dhallConf <- liftIO Configuration.main
+ dataDB <- liftIO $ DB.mongoSetup dhallConf
+ let config = AppConfig { res = dhallConf
+ , dbconn = dataDB
+ }
+ scottyT (port dhallConf) (flip runApp config) HTTP.app where
+ runApp :: ConfigM a -> AppConfig -> IO a
+ runApp m c = runReaderT (runConfigM m) c
diff --git a/stack.yaml b/stack.yaml
@@ -35,12 +35,9 @@ packages:
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
-# extra-deps:
-# - acme-missiles-0.3
-# - git: https://github.com/commercialhaskell/stack.git
-# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#
-# extra-deps: []
+extra-deps:
+- AesonBson-0.4.1@sha256:30a4ecb39e8da94dc1e1e8945eb0d4e33a833ae4342841b3c87c56b5918a90a1,1398
+- bson-generic-0.0.9@sha256:ea6685daa618b2bbe6e189c33e195e812501baf42f53183eedc16f011690895a,817
# Override default flag values for local packages and extra-deps
# flags: {}
diff --git a/stack.yaml.lock b/stack.yaml.lock
@@ -3,7 +3,21 @@
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
-packages: []
+packages:
+- completed:
+ hackage: AesonBson-0.4.1@sha256:30a4ecb39e8da94dc1e1e8945eb0d4e33a833ae4342841b3c87c56b5918a90a1,1398
+ pantry-tree:
+ size: 378
+ sha256: 10c7444de357f7fc1473542d8b3307811420889be32d5a2033d0dbc2d32a375d
+ original:
+ hackage: AesonBson-0.4.1@sha256:30a4ecb39e8da94dc1e1e8945eb0d4e33a833ae4342841b3c87c56b5918a90a1,1398
+- completed:
+ hackage: bson-generic-0.0.9@sha256:ea6685daa618b2bbe6e189c33e195e812501baf42f53183eedc16f011690895a,817
+ pantry-tree:
+ size: 220
+ sha256: 46d452c35c2c762af25bf4d85b5248a94cbbe5b282bc4b1217d0ab3451011ae9
+ original:
+ hackage: bson-generic-0.0.9@sha256:ea6685daa618b2bbe6e189c33e195e812501baf42f53183eedc16f011690895a,817
snapshots:
- completed:
size: 618740
