tmp-proc-redis (empty) → 0.5.0.0
raw patch · 8 files changed
+316/−0 lines, 8 filesdep +basedep +bytestringdep +hedissetup-changed
Dependencies added: base, bytestring, hedis, hspec, hspec-tmp-proc, text, tmp-proc, tmp-proc-redis
Files
- ChangeLog.md +6/−0
- LICENSE +30/−0
- README.md +14/−0
- Setup.hs +2/−0
- src/System/TmpProc/Docker/Redis.hs +114/−0
- test/Spec.hs +12/−0
- test/Test/TmpProc/Docker/RedisSpec.hs +82/−0
- tmp-proc-redis.cabal +56/−0
+ ChangeLog.md view
@@ -0,0 +1,6 @@+# Revision history for tmp-proc-redis++## 0.5.0.0 -- 2021-09-28++* First version. Extracted from an unreleased version of the tmp-proc library+* Initial upload to hackage
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2021, Tim Emiola++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 Tim Emiola 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,14 @@+# tmp-proc-redis++`tmp-proc-redis` provides an example of using `tmp-proc` to launch dockerized+Redis in integration tests.++It provides an instance of [Proc][1] for launching the Redis database docker image,+but also allows++ * configuration of simple reset behaviour to be enabled in tests+ * an instance of [Conn][2] that simplifies opening connections to the database from+ tests that use `tmp-proc`++[1]: https://hackage.haskell.org/package/tmp-proc-0.5.0.0/docs/System-TmpProc-Docker.html#t:Proc+[2]: https://hackage.haskell.org/package/tmp-proc-0.5.0.0/docs/System-TmpProc-Docker.html#t:Conn
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/System/TmpProc/Docker/Redis.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_HADDOCK prune not-home #-}+{-|+Copyright : (c) 2020-2021 Tim Emiola+SPDX-License-Identifier: BSD3+Maintainer : Tim Emiola <adetokunbo@users.noreply.github.com >++Provides an instance of 'Proc' that launches @redis@ as a @tmp proc@.++The instance this module provides can be used in integration tests as is.++It's also possible to write other instances that launch @redis@ in different+ways; for those, this instance can be used as a reference example.++-}++module System.TmpProc.Docker.Redis+ ( -- * 'Proc' instance+ TmpRedis(..)++ -- * Useful definitions+ , aProc+ , aHandle+ , KeyName++ -- * Re-exports+ , module System.TmpProc+ )+where++import Control.Exception (catch)+import Control.Monad (void)+import qualified Data.ByteString.Char8 as C8+import qualified Data.Text as Text++import Database.Redis (ConnectTimeout, Connection,+ checkedConnect, del, disconnect,+ parseConnectInfo, runRedis)++import System.TmpProc (Connectable (..), HList (..), HandlesOf,+ HostIpAddress, Pinged (..), Proc (..),+ ProcHandle (..), SvcURI, startupAll,+ withTmpConn)+++{-| A singleton 'HList' containing an example 'TmpRedis'. -}+aProc :: HList '[TmpRedis]+aProc = TmpRedis [] `HCons` HNil+++{-| An 'HList' that just contains the handle created from 'aProc'. -}+aHandle :: IO (HandlesOf '[TmpRedis])+aHandle = startupAll aProc+++-- | The name of a key in redis.+type KeyName = C8.ByteString+++{-| Provides the capability to launch a redis instance as @tmp proc@.++The constructor receives the names of keys to be dropped on 'reset'.++-}+data TmpRedis = TmpRedis [KeyName]+++{-| Specifies how to run @redis@ as a @tmp proc@. -}+instance Proc TmpRedis where+ type Image TmpRedis = "redis:5.0"+ type Name TmpRedis = "a-redis-db"++ uriOf = mkUri'+ runArgs = []+ ping = toPinged . flip withTmpConn (const $ pure ())+ reset = clearKeys+++{-| Specifies how to connect to a tmp @redis@ service. -}+instance Connectable TmpRedis where+ type Conn TmpRedis = Connection++ closeConn = disconnect+ openConn = openConn'+++openConn' :: ProcHandle TmpRedis -> IO Connection+openConn' handle = case parseConnectInfo $ C8.unpack $ hUri handle of+ Left _ -> fail $ "invalid redis uri: " ++ (C8.unpack $ hUri handle)+ Right x -> checkedConnect x+++toPinged :: IO a -> IO Pinged+toPinged action = ((action >> pure OK)+ `catch` (\(_ :: ConnectTimeout) -> pure NotOK))+ `catch` (\(_ :: IOError) -> pure NotOK)++++mkUri' :: HostIpAddress -> SvcURI+mkUri' ip = "redis://" <> (C8.pack $ Text.unpack ip) <> "/"+++clearKeys :: ProcHandle TmpRedis -> IO ()+clearKeys handle@(ProcHandle {hProc}) =+ let go (TmpRedis []) = pure ()+ go (TmpRedis keys) = withTmpConn handle $ \c -> runRedis c $ void $ del keys+ in+ go hProc
+ test/Spec.hs view
@@ -0,0 +1,12 @@+module Main (main) where++import Test.Hspec++import System.IO+import qualified Test.TmpProc.Docker.RedisSpec as RD++main :: IO ()+main = do+ hSetBuffering stdin NoBuffering+ hSetBuffering stdout NoBuffering+ hspec RD.spec
+ test/Test/TmpProc/Docker/RedisSpec.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}+module Test.TmpProc.Docker.RedisSpec where++import Test.Hspec+import Test.Hspec.TmpProc++import Control.Exception (onException)+import Control.Monad.IO.Class (liftIO)+import qualified Data.ByteString.Char8 as C8+import Data.Proxy (Proxy (..))+import qualified Data.Text as Text+import Database.Redis (exists, runRedis, setex)++import System.TmpProc.Docker.Redis++spec :: Spec+spec = tdescribe desc $ do+ beforeAll setupHandles $ afterAll terminateAll $ do+ context "when using the Proc from the HList by its 'Name'" $ do++ context "ixPing" $ do++ it "should succeed" $ \hs+ -> ixPing @"a-redis-db" Proxy hs `shouldReturn` OK++ context "ixReset" $ do++ context "before resetting, the test key" $ do+ it "should exist" $ \hs+ -> (checkTestKey $ handleOf @"a-redis-db" Proxy hs) `shouldReturn` True++ it "should succeed" $ \hs+ -> ixReset @"a-redis-db" Proxy hs `shouldReturn` ()++ context "after resetting, the test key" $ do+ it "should not exist" $ \hs+ -> (checkTestKey $ handleOf @"a-redis-db" Proxy hs) `shouldReturn` False+++theProc :: HList '[TmpRedis]+theProc = TmpRedis [testKey] `HCons` HNil+++setupHandles :: IO (HList '[ProcHandle TmpRedis])+setupHandles = do+ hs <- startupAll theProc+ initRedis hs `onException` terminateAll hs+ pure hs+++initRedis :: HList '[ProcHandle TmpRedis] -> IO ()+initRedis = addTestKeyValue . handleOf @"a-redis-db" Proxy+++addTestKeyValue :: ProcHandle TmpRedis -> IO ()+addTestKeyValue handle = withTmpConn handle $ \conn -> do+ liftIO (runRedis conn $ setex testKey 100 testValue) >>= \case+ Left e -> fail $ "redis operation failed: " ++ show e+ Right _ -> pure ()+++testKey :: C8.ByteString+testKey = "test.redis.key"+++testValue :: C8.ByteString+testValue = "the test value"+++checkTestKey :: ProcHandle TmpRedis -> IO Bool+checkTestKey handle = withTmpConn handle $ \conn -> do+ liftIO (runRedis conn $ exists testKey) >>= \case+ Left e -> fail $ "redis operation failed: " ++ show e+ Right x -> pure x+++desc :: String+desc = "Tmp.Proc:Redis:" ++ Text.unpack (nameOf $ TmpRedis [])
+ tmp-proc-redis.cabal view
@@ -0,0 +1,56 @@+cabal-version: 3.0+name: tmp-proc-redis+version: 0.5.0.0+synopsis: Shows how to run redis as a tmp proc+description:+ An example of using tmp-proc to launch dockerized redis in integration tests.++license: BSD-3-Clause+license-file: LICENSE+copyright: 2021 Tim Emiola+author: Tim Emiola+maintainer: adetokunbo@users.noreply.github.com+category: testing, docker+bug-reports: https://github.com/adetokunbo/tmp-proc/issues+build-type: Simple+extra-source-files:+ ChangeLog.md+ README.md+tested-with:+ GHC == 8.10.5++source-repository head+ type: git+ location: https://github.com/adetokunbo/tmp-proc.git++library+ exposed-modules: System.TmpProc.Docker.Redis+ hs-source-dirs: src+ build-depends:+ , base >=4.11 && <4.16+ , bytestring >=0.10.8.2 && <0.12+ , hedis >=0.10.4 && <0.15+ , text ^>=1.2.3+ , tmp-proc >=0.5.0.0 && <0.6.0.0++ default-language: Haskell2010+ ghc-options: -fno-ignore-asserts -Wall++test-suite integration-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules: Test.TmpProc.Docker.RedisSpec+ hs-source-dirs: test+ build-depends:+ , base+ , bytestring+ , hedis+ , hspec+ , hspec-tmp-proc+ , text+ , tmp-proc+ , tmp-proc-redis++ default-language: Haskell2010+ ghc-options:+ -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts -Wall