tmp-proc-redis 0.5.1.4 → 0.5.3.0

raw patch · 4 files changed

+87/−71 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• src/System/TmpProc/Docker/Redis.hs +48/−39
• test/Test/TmpProc/Docker/RedisSpec.hs +23/−27
• tmp-proc-redis.cabal +7/−5

@@ -1,5 +1,12 @@ # Revision history for tmp-proc-redis +`tmp-proc-redis` uses [PVP Versioning][1].++## 0.5.3.0 -- 2023-08-11++* Use the new `only` constructor+* Refactor the integration test+ ## 0.5.1.4 -- 2023-07-12  * Extend the version bounds of bytestring to allow 0.12@@ -20,3 +27,5 @@  * First version. Extracted from an unreleased version of the tmp-proc library * Initial upload to hackage++[1]: https://pvp.haskell.org

@@ -1,11 +1,12 @@-{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns        #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeFamilies          #-}+{-# 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 >@@ -16,12 +17,10 @@  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(..)+    TmpRedis (..)      -- * Useful definitions   , aProc@@ -33,27 +32,40 @@   ) where -import           Control.Exception     (catch)-import           Control.Monad         (void)+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)+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+  , only+  , startupAll+  , withTmpConn+  )  -{-| A singleton 'HList' containing an example 'TmpRedis'. -}+-- | A singleton 'HList' containing an example 'TmpRedis'. aProc :: HList '[TmpRedis]-aProc = TmpRedis [] `HCons` HNil+aProc = only $ TmpRedis []  -{-| An 'HList' that just contains the handle created from 'aProc'. -}+-- | An 'HList' that just contains the handle created from 'aProc'. aHandle :: IO (HandlesOf '[TmpRedis]) aHandle = startupAll aProc @@ -62,53 +74,50 @@ type KeyName = C8.ByteString  -{-| Provides the capability to launch a redis instance as @tmp proc@.+{- | 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]+newtype TmpRedis = TmpRedis [KeyName]  -{-| Specifies how to run @redis@ as a @tmp proc@. -}+-- | 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. -}+-- | 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)+  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)-+toPinged action =+  ( (action >> pure OK)+      `catch` (\(_ :: ConnectTimeout) -> pure NotOK)+  )+    `catch` (\(_ :: IOError) -> pure NotOK)   mkUri' :: HostIpAddress -> SvcURI-mkUri' ip =  "redis://" <> (C8.pack $ Text.unpack ip) <> "/"+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+   in go hProc

@@ -1,48 +1,44 @@-{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} -{-# 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+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+        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 exist" $ \hs ->+            checkTestKey (handleOf @"a-redis-db" Proxy hs) `shouldReturn` True -        it "should succeed" $ \hs-          -> ixReset @"a-redis-db" Proxy hs `shouldReturn` ()+        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+          it "should not exist" $ \hs ->+            checkTestKey (handleOf @"a-redis-db" Proxy hs) `shouldReturn` False   theProc :: HList '[TmpRedis]-theProc = TmpRedis [testKey] `HCons` HNil+theProc = only $ TmpRedis [testKey]   setupHandles :: IO (HList '[ProcHandle TmpRedis])@@ -59,7 +55,7 @@ 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+    Left e -> fail $ "redis operation failed: " ++ show e     Right _ -> pure ()  @@ -74,7 +70,7 @@ 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+    Left e -> fail $ "redis operation failed: " ++ show e     Right x -> pure x  

@@ -1,9 +1,9 @@ cabal-version:      3.0 name:               tmp-proc-redis-version:            0.5.1.4-synopsis:           Shows how to run redis as a tmp proc+version:            0.5.3.0+synopsis:           Launch Redis in docker using tmp-proc description:-  An example of using tmp-proc to launch dockerized redis in integration tests.+  Demos how to use tmp-proc to run Redis in docker in a unittest.  license:            BSD-3-Clause license-file:       LICENSE@@ -18,13 +18,15 @@   README.md tested-with:   GHC == 8.8.4-  GHC == 8.10.5   GHC == 8.10.7-  GHC == 9.2.2+  GHC == 9.0.2+  GHC == 9.2.8+  GHC == 9.4.5  source-repository head   type:     git   location: https://github.com/adetokunbo/tmp-proc.git+  subdir:   tmp-proc-redis  library   exposed-modules:  System.TmpProc.Docker.Redis