DB.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE BangPatterns #-}
module Monitor.DB where

import Data.ByteString (ByteString)
import qualified Data.Vector as V

import qualified Hasql.Session as HaSQL
import qualified Hasql.Statement as HaSQL
import qualified Hasql.Decoders as D
import qualified Hasql.Encoders as E

import Monitor.DataModel

decodeAssertResultless :: D.Result Bool
decodeAssertResultless = (\() -> True) <$> D.noResult

decodeAssertNull :: D.Result Bool
decodeAssertNull = test . V.toList <$> D.rowVector (D.column (D.nullable (D.custom (\_ _ -> Right ()))))
  where
    test [] = True
    test [Nothing] = True
    test _ = False

decodeAssertNotNull :: D.Result Bool
decodeAssertNotNull = not <$> decodeAssertNull

decodeAssertTrue :: D.Result Bool
decodeAssertTrue = test <$> D.rowMaybe (D.column (D.nullable D.bool))
  where
    test Nothing = False
    test (Just Nothing) = False
    test (Just (Just a)) = a

decodeAssertFalse :: D.Result Bool
decodeAssertFalse = test <$> D.rowMaybe (D.column (D.nullable D.bool))
  where
    test Nothing = False
    test (Just Nothing) = False
    test (Just (Just a)) = not a

decodeAssertZero :: D.Result Bool
decodeAssertZero = test <$> D.rowMaybe (D.column (D.nullable D.int4))
  where
    test Nothing = False
    test (Just Nothing) = False
    test (Just (Just a)) = a == 0

session :: Assertion -> ByteString -> HaSQL.Session Bool
session assertion sql = HaSQL.statement () $ case assertion of
  AssertNull -> HaSQL.Statement sql E.noParams decodeAssertNull False
  AssertNotNull -> HaSQL.Statement sql E.noParams decodeAssertNotNull False
  AssertZero -> HaSQL.Statement sql E.noParams decodeAssertZero False
  AssertTrue -> HaSQL.Statement sql E.noParams decodeAssertTrue False
  AssertFalse -> HaSQL.Statement sql E.noParams decodeAssertFalse False
  AssertResultless -> HaSQL.Statement sql E.noParams decodeAssertResultless False

runSQL :: PureJob -> Monitor JobFeedback
runSQL PureJob{..} = do
  conn <- asks dbConnection
  !result <- liftIO $ HaSQL.run (session pureJobAssertion pureJobSQL) conn
  return $ case result of
    Left (HaSQL.QueryError _ _ (HaSQL.ClientError err)) ->
      ConnectionError (show err)
    Left (HaSQL.QueryError _ _ (HaSQL.ResultError err)) ->
      QueryError (show err)
    Right assertionResult -> AssertionResult assertionResult