esqueleto-pgcrypto (empty) → 0.1.0.0
raw patch · 9 files changed
+389/−0 lines, 9 filesdep +QuickCheckdep +basedep +esqueletosetup-changed
Dependencies added: QuickCheck, base, esqueleto, esqueleto-pgcrypto, hspec, monad-logger, persistent, persistent-postgresql, text, transformers, unliftio
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +48/−0
- Setup.hs +2/−0
- esqueleto-pgcrypto.cabal +57/−0
- src/Database/Esqueleto/PostgreSQL/Pgcrypto.hs +113/−0
- test/Model.hs +36/−0
- test/Spec.hs +37/−0
- test/Utils.hs +63/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for esqueleto-pgcrypto++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2021++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.
+ README.md view
@@ -0,0 +1,48 @@+# esqueleto-pgcrypto++Esqueleto support for the pgcrypto PostgreSQL module ++````haskell+share+ [mkPersist sqlSettings]+ [persistLowerCase|+ UserAccount json+ name T.Text+ UniqueName name+ passwordHash T.Text+ deriving Show Read Eq++-- insert a `PersistField` using pgcrypto's `crypt` function for password hashing+insertUserAccount = insertSelect $ + pure $+ UserAccount+ <# val "username"+ <&> toCrypt (BF Nothing) "1234password"++login name pwd = select $ do+ user <- from $ Table UserAccount+ where_ $ user ^. UserAccountName ==. val name+ &&. fromCrypt (user ^. UserAccountPasswordHash) pwd+ pure user++````++## Tests++To run tests you will need a `pgctest` named postgresql database listening on port 5432.++The connection details are++````haskell+"host=localhost port=5432 user=pgctest password=pgctest dbname=pgctest"+````++You can crete this instace as follows:++````bash+$ sudo -u postgres createuser --superuser pgctest +$ sudo -u postgres createdb pgctest+$ sudo -u postgres psql+# set the password of pgctest to pgctest+postgres=# \password pgctest +````
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ esqueleto-pgcrypto.cabal view
@@ -0,0 +1,57 @@+cabal-version: 1.12+name: esqueleto-pgcrypto+version: 0.1.0.0+license: BSD3+license-file: LICENSE+copyright: 2021 Kyriakos Papachrysanthou+maintainer: papachrysanthou.k@gmail.com+author: Kyriakos Papachrysanthou+homepage: https://github.com/3kyro/esqueleto-pgcrypto#readme+bug-reports: https://github.com/3kyro/esqueleto-pgcrypto/issues+synopsis: Esqueleto support for the pgcrypto PostgreSQL module+description:+ Please see the README on GitHub at <https://github.com/3kyro/esqueleto-pgcrypto#readme>++category: Database+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/3kyro/esqueleto-pgcrypto++library+ exposed-modules: Database.Esqueleto.PostgreSQL.Pgcrypto+ hs-source-dirs: src+ other-modules: Paths_esqueleto_pgcrypto+ default-language: Haskell2010+ build-depends:+ base >=4.13 && <5,+ esqueleto >=3.5.2.2 && <3.6,+ text >=1.2.4.1 && <1.3++test-suite esqueleto-pgcrypto-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ Model+ Utils+ Paths_esqueleto_pgcrypto++ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.14.2 && <2.15,+ base >=4.13 && <5,+ esqueleto >=3.5.2.2 && <3.6,+ esqueleto-pgcrypto -any,+ hspec >=2.7.10 && <2.8,+ monad-logger >=0.3.36 && <0.4,+ persistent >=2.13.1.2 && <2.14,+ persistent-postgresql >=2.13.1.0 && <2.14,+ text >=1.2.4.1 && <1.3,+ transformers >=0.5.6.2 && <0.6,+ unliftio >=0.2.20 && <0.3
+ src/Database/Esqueleto/PostgreSQL/Pgcrypto.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module contains functions specific to the [pgcrypto](https://www.postgresql.org/docs/current/pgcrypto.html) module++module Database.Esqueleto.PostgreSQL.Pgcrypto+ (HashAlgorithm(..),+ toCrypt,+ fromCrypt,+ ) where++import qualified Data.Text.Internal.Builder as TLB+import Database.Esqueleto.Experimental (toPersistValue)+import Database.Esqueleto.Internal.Internal++{- | pgcrypto hashing algorithms+see: https://www.postgresql.org/docs/current/pgcrypto.html++`bf` and `xdes` algorithms have an optional iterations count parameter. All limitations and considerations+mentioned in the `pgcrypto` module documentation regarding iteration count apply. It is possible to supply+an invalid iteration count, which will lead to an sql error.++/Requires/ the pgcrypto module.++-}+data HashAlgorithm+ = BF (Maybe Word)+ | MD5+ | XDES (Maybe Word)+ | DES+ deriving (Eq, Show)++{- | (@crypt()@) Calculate a crypt-like hash from the provided password++/Requires/ the pgcrypto module.++/WARNING/: Using `toCrypt` may leak sensitive data via logging. Filtering logs in production environments+when using `toCrypt`, such as using `filterLogger` on `monad-logger` based stacks is highly advised.++example:++@+share+ [mkPersist sqlSettings]+ [persistLowerCase|+ UserAccount json+ name T.Text+ UniqueName name+ passwordHash T.Text+ deriving Show Read Eq++insertSelect $ do+ pure $+ UserAccount+ <# val "username"+ <&> toCrypt (BF Nothing) "1234password"+@++-}+toCrypt :: SqlString s => HashAlgorithm -> s -> SqlExpr (Value s)+toCrypt algorithm pass =+ let alg = case algorithm of+ BF mIterCount ->+ "'bf'" <> case mIterCount of+ Nothing -> mempty+ Just iterCount ->+ "," <> TLB.fromString (show iterCount)+ MD5 -> "'md5'"+ XDES mIterCount ->+ "'xdes'" <> case mIterCount of+ Nothing -> mempty+ Just iterCount ->+ "," <> TLB.fromString (show iterCount)+ DES -> "'des'"+ in ERaw noMeta $ \_ _ -> ("crypt (?, gen_salt(" <> alg <> "))", [toPersistValue pass])++{- | (@crypt()@) Retrieve a hashed password++/Requires/ the pgcrypto module.++example:++@+share+ [mkPersist sqlSettings]+ [persistLowerCase|+ UserAccount json+ name T.Text+ UniqueName name+ passwordHash T.Text+ deriving Show Read Eq+++login name pwd = select $ do+ user <- from $ Table UserAccount+ where_ $ user ^. UserAccountName ==. val name+ &&. fromCrypt (user ^. UserAccountPasswordHash) pwd+ pure user+@++-}+fromCrypt :: SqlString s => SqlExpr (Value s) -> s -> SqlExpr (Value Bool)+fromCrypt expr pass =+ expr+ ==. ERaw+ noMeta+ ( \_ info ->+ let name = columnName expr info+ in ("crypt (?, " <> name <> ")", [toPersistValue pass])+ )+ where+ columnName (ERaw _ f) info =+ fst $ f Never info
+ test/Model.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module Model where++import Database.Esqueleto.Experimental+import Database.Persist.Sql+import Database.Persist.TH++share+ [mkPersist sqlSettings, mkMigrate "migrateAll"]+ [persistUpperCase|+ User+ username String+ passwordHash String+ deriving Eq Show Ord+|]
+ test/Spec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++import Database.Esqueleto.Experimental+import qualified Database.Esqueleto.PostgreSQL.Pgcrypto as PGC+import Model+import Test.Hspec+import Utils++main :: IO ()+main = hspec spec++spec :: Spec+spec = beforeAll mkConnectionPool $ do+ testCrypt++testCrypt :: SpecDb+testCrypt =+ describe "Crypt password hashing functions" $ do+ itDb "authenticates a user" $ do+ rawExecute "CREATE EXTENSION IF NOT EXISTS pgcrypto" []+ _ <- insertSelect $ do+ pure $+ User+ <# val "name"+ <&> PGC.toCrypt (PGC.BF $ Just 6) "1234password"+ authenticated <-+ select $ do+ user' <- from $ table @User+ where_ $+ user' ^. UserUsername ==. val "name"+ &&. PGC.fromCrypt (user' ^. UserPasswordHash) "1234password"+ pure user'+ let authUser = entityVal $ head authenticated+ asserting $ do+ userUsername authUser `shouldBe` "name"+ userPasswordHash authUser `shouldNotBe` "1234password"
+ test/Utils.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}++module Utils where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Logger+import Control.Monad.Trans.Reader+import Database.Esqueleto.Experimental+import Database.Persist.Postgresql (createPostgresqlPool)+import Model+import Test.Hspec+import UnliftIO++mkConnectionPool :: IO ConnectionPool+mkConnectionPool = do+ pool <-+ runStderrLoggingT $+ createPostgresqlPool+ "host=localhost port=5432 user=pgctest password=pgctest dbname=pgctest"+ 4+ flip runSqlPool pool $ do+ migrateIt+ pure pool++migrateIt :: MonadUnliftIO m => SqlPersistT m ()+migrateIt = mapReaderT runNoLoggingT $ do+ void $+ runMigrationSilent $ do+ migrateAll+ cleanDB++cleanDB ::+ forall m.+ (MonadIO m) =>+ SqlPersistT m ()+cleanDB =+ delete $ from (table @User) >> pure ()++type SpecDb = SpecWith ConnectionPool++asserting :: MonadIO f => IO () -> SqlPersistT f ()+asserting = liftIO++itDb ::+ HasCallStack =>+ String ->+ SqlPersistT IO x ->+ SpecDb+itDb message action =+ it message $ \connection -> do+ void $ testDb connection action++testDb :: ConnectionPool -> SqlPersistT IO a -> IO a+testDb conn action =+ liftIO $+ flip runSqlPool conn $ do+ a <- action+ transactionUndo+ pure a