arbor-postgres (empty) → 0.0.1

raw patch · 9 files changed

+193/−0 lines, 9 filesdep +basedep +generic-lensdep +lenssetup-changed

Dependencies added: base, generic-lens, lens, network-uri, optparse-applicative, postgresql-simple, text

Files

• ChangeLog.md +3/−0
• LICENSE +21/−0
• README.md +4/−0
• Setup.hs +2/−0
• arbor-postgres.cabal +49/−0
• src/Arbor/Postgres/Config.hs +43/−0
• src/Arbor/Postgres/Core.hs +49/−0
• src/Arbor/Postgres/Env.hs +13/−0
• src/Arbor/Postgres/Password.hs +9/−0

@@ -0,0 +1,3 @@+# Changelog for arbor-postgres++## Unreleased changes

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Arbor Networks++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,4 @@+# arbor-postgres++Convenience types and functions to make `postgresql-simple` easier and+less error-prone to use.

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

@@ -0,0 +1,49 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 7a648493a1802368bb2f1a09b72f5ee62b46affb3916b8846f6d9d0d6e8c8b84++name:           arbor-postgres+version:        0.0.1+synopsis:       Convenience types and functions for postgresql-simple.+description:    Please see the README on Github at <https://github.com/arbor/arbor-postgres#readme>+category:       Services+homepage:       https://github.com/arbor/arbor-postgres#readme+bug-reports:    https://github.com/arbor/arbor-postgres/issues+author:         Arbor Networks+maintainer:     mayhem@arbor.net+copyright:      Arbor Networks+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/arbor/arbor-postgres++library+  hs-source-dirs:+      src+  default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , generic-lens >=1.0.0.2 && <2+    , lens >=4.16 && <5+    , network-uri >=2.6 && <3+    , optparse-applicative >=0.14 && <0.15+    , postgresql-simple >=0.5 && <0.6+    , text >=1.2 && <1.3+  exposed-modules:+      Arbor.Postgres.Config+      Arbor.Postgres.Core+      Arbor.Postgres.Env+      Arbor.Postgres.Password+  other-modules:+      Paths_arbor_postgres+  default-language: Haskell2010

@@ -0,0 +1,43 @@+{-# LANGUAGE ApplicativeDo   #-}+{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE RecordWildCards #-}++module Arbor.Postgres.Config where++import Arbor.Postgres.Password+import Data.Semigroup          ((<>))+import Data.Text               (Text)+import GHC.Generics+import Options.Applicative++data PostgresConfig = PostgresConfig+  { host     :: Text+  , database :: Text+  , user     :: Text+  , password :: Maybe Password+  } deriving (Eq, Show, Generic)++optsPostgresConfig :: String -> Parser PostgresConfig+optsPostgresConfig prefix = do+  host <- strOption+    (  long (prefix <> "-db-host")+    <> metavar "DB_HOST"+    <> help "The postgres hostname"+    )+  database <- strOption+    (  long (prefix <> "-db-name")+    <> metavar "DB_NAME"+    <> help "The postgres db name"+    )+  user <- strOption+    (  long (prefix <> "-db-user")+    <> metavar "DB_USER"+    <> help "The postgres user"+    )+  password <- optional $ Password <$> strOption+    (  long (prefix <> "-db-password")+    <> metavar "DB_PASSWORD"+    <> help "The postgres password"+    )+  return PostgresConfig {..}+

@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE TypeApplications #-}++module Arbor.Postgres.Core where++import Arbor.Postgres.Config     (PostgresConfig)+import Arbor.Postgres.Password+import Control.Lens+import Data.Generics.Product.Any+import Data.Monoid               ((<>))+import Data.String+import Network.URI++import qualified Arbor.Postgres.Env         as E+import qualified Data.Text                  as T+import qualified Data.Text.Encoding         as T+import qualified Database.PostgreSQL.Simple as PGS++connectPostgres :: PostgresConfig -> IO E.PostgresEnv+connectPostgres postgresConfig = do+  let host     = postgresConfig ^. the @"host"+  let dbname   = postgresConfig ^. the @"database"+  let user     = postgresConfig ^. the @"user"+  let mPassword = postgresConfig ^. the @"password"+  let kvPassword = case mPassword of+        Just (Password password) -> [("password", password)]+        Nothing                  -> []+  let kvs = [("host", host), ("dbname", dbname), ("user", user)] <> kvPassword+  let kvStrings = kvs <&> (\(k, v) -> k <> "='" <> v <> "'")+  conn <- PGS.connectPostgreSQL $ T.encodeUtf8 $ T.intercalate " " kvStrings+  return $ E.PostgresEnv conn (mkConnectionString postgresConfig)++newtype Table = Table+  { table :: T.Text }+  deriving (IsString, Show)++mkConnectionString :: PostgresConfig -> URI+mkConnectionString config = do+  let host = config ^. the @"host" & T.unpack+  let dbname = config ^. the @"database" & T.unpack+  let auth = pure $ URIAuth "" host ":5432"+  let q = ""+  let frag = ""+  URI "postgresql:" auth ("/" <> dbname) q frag++mkResourceURI :: URI -> Table -> [(T.Text, T.Text)] -> URI+mkResourceURI uri (Table tbl) kvs = do+  let q = "?" <> T.intercalate "&" (uncurry (\k v -> k <> "=" <> v) <$> (("table", tbl) : kvs)) & T.unpack+  uri { uriQuery = q }

@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveGeneric #-}++module Arbor.Postgres.Env where++import GHC.Generics+import Network.URI++import qualified Database.PostgreSQL.Simple as PGS++data PostgresEnv = PostgresEnv+  { conn       :: PGS.Connection+  , connString :: URI+  } deriving Generic

@@ -0,0 +1,9 @@+module Arbor.Postgres.Password where++import Data.Text (Text)++newtype Password = Password Text+  deriving Eq++instance Show Password where+  showsPrec _ _ = ("********" ++)