diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/System/TmpProc/Docker/Redis.hs b/src/System/TmpProc/Docker/Redis.hs new file mode 100644 --- /dev/null +++ b/src/System/TmpProc/Docker/Redis.hs @@ -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 + +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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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 diff --git a/test/Test/TmpProc/Docker/RedisSpec.hs b/test/Test/TmpProc/Docker/RedisSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/TmpProc/Docker/RedisSpec.hs @@ -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 []) diff --git a/tmp-proc-redis.cabal b/tmp-proc-redis.cabal new file mode 100644 --- /dev/null +++ b/tmp-proc-redis.cabal @@ -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