From f7a61dcddc26f441713133aa1f470315c36e59ac Mon Sep 17 00:00:00 2001 From: James Eversole Date: Fri, 1 Jul 2022 20:34:29 -0500 Subject: [PATCH] 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 --- .dockerignore | 2 ++ .gitignore | 7 ++-- Purr.cabal | 75 ++++++++++++++++++++++++++++++++++++--- app/Main.hs | 5 +-- examples/Dockerfile | 11 ++++++ examples/config.dhall | 10 ++++++ package.yaml | 23 +++++++++++- src/Core/Configuration.hs | 11 ++++++ src/Core/HTTP.hs | 14 ++++++++ src/Core/Mongo.hs | 20 +++++++++++ src/Core/Types.hs | 34 ++++++++++++++++++ src/Feature/Handlers.hs | 18 ++++++++++ src/Lib.hs | 27 +++++++++++--- stack.yaml | 9 ++--- stack.yaml.lock | 16 ++++++++- 15 files changed, 260 insertions(+), 22 deletions(-) create mode 100644 .dockerignore create mode 100644 examples/Dockerfile create mode 100644 examples/config.dhall create mode 100644 src/Core/Configuration.hs create mode 100644 src/Core/HTTP.hs create mode 100644 src/Core/Mongo.hs create mode 100644 src/Core/Types.hs create mode 100644 src/Feature/Handlers.hs diff --git a/.dockerignore b/.dockerignore new file mode 100644 index 0000000..98d1d9a --- /dev/null +++ b/.dockerignore @@ -0,0 +1,2 @@ +.stack-work +data/ diff --git a/.gitignore b/.gitignore index 22a6389..c435316 100644 --- 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 index 4392a25..c1675b4 100644 --- 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 index de1c1ab..e4a53d8 100644 --- 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 new file mode 100644 index 0000000..6b732cc --- /dev/null +++ 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 new file mode 100644 index 0000000..dbbba7b --- /dev/null +++ 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 index b671b7a..3d0646e 100644 --- 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 new file mode 100644 index 0000000..6f88f68 --- /dev/null +++ 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 new file mode 100644 index 0000000..c9be776 --- /dev/null +++ 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 new file mode 100644 index 0000000..46f1d45 --- /dev/null +++ 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 new file mode 100644 index 0000000..91192e5 --- /dev/null +++ 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 new file mode 100644 index 0000000..4a33ddf --- /dev/null +++ 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 index d36ff27..7ea3dce 100644 --- 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 index 6a97795..eba5820 100644 --- 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 index b608c4e..496ef46 100644 --- 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