RedisSpec.hs

{-# 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
  ( HList
  , HandlesOf
  , Pinged (..)
  , ProcHandle
  , handleOf
  , ixPing
  , ixReset
  , nameOf
  , only
  , startupAll
  , terminateAll
  , withTmpConn
  )
import System.TmpProc.Docker.Redis (TmpRedis (..))
import Test.Hspec
import Test.Hspec.TmpProc (tdescribe)


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 (HandlesOf '[TmpRedis])
setupHandles = do
  hs' <- startupAll theProc
  initRedis hs' `onException` terminateAll hs'
  pure hs'


initRedis :: HandlesOf '[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 [])