{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} module Test.TmpProc.Docker.RedisSpec where 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 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 = only $ TmpRedis [testKey] 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 [])