module Database.PostgreSQL.Query.SqlBuilder.Types
(
SqlBuilderResult(..)
, builderResultPure
, FieldOption(..)
, LogMasker
, defaultLogMasker
, hugeFieldsMasker
) where
import Blaze.ByteString.Builder (Builder)
import Database.PostgreSQL.Query.Import
import Language.Haskell.TH.Lift
import qualified Blaze.ByteString.Builder as BB
import qualified Data.ByteString as BS
data SqlBuilderResult = SqlBuilderResult
{ SqlBuilderResult -> Builder
sbQueryString :: Builder
, SqlBuilderResult -> Builder
sbLogString :: Builder
} deriving (Typeable, (forall x. SqlBuilderResult -> Rep SqlBuilderResult x)
-> (forall x. Rep SqlBuilderResult x -> SqlBuilderResult)
-> Generic SqlBuilderResult
forall x. Rep SqlBuilderResult x -> SqlBuilderResult
forall x. SqlBuilderResult -> Rep SqlBuilderResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SqlBuilderResult x -> SqlBuilderResult
$cfrom :: forall x. SqlBuilderResult -> Rep SqlBuilderResult x
Generic)
instance Semigroup SqlBuilderResult where
(SqlBuilderResult Builder
a Builder
b) <> :: SqlBuilderResult -> SqlBuilderResult -> SqlBuilderResult
<> (SqlBuilderResult Builder
a' Builder
b') =
Builder -> Builder -> SqlBuilderResult
SqlBuilderResult (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a') (Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b')
instance Monoid SqlBuilderResult where
mempty :: SqlBuilderResult
mempty = Builder -> Builder -> SqlBuilderResult
SqlBuilderResult Builder
forall a. Monoid a => a
mempty Builder
forall a. Monoid a => a
mempty
mappend :: SqlBuilderResult -> SqlBuilderResult -> SqlBuilderResult
mappend = SqlBuilderResult -> SqlBuilderResult -> SqlBuilderResult
forall a. Semigroup a => a -> a -> a
(<>)
builderResultPure :: Builder -> SqlBuilderResult
builderResultPure :: Builder -> SqlBuilderResult
builderResultPure Builder
b = Builder -> Builder -> SqlBuilderResult
SqlBuilderResult Builder
b Builder
b
data FieldOption
= FieldDefault
| FieldMasked
deriving (FieldOption -> FieldOption -> Bool
(FieldOption -> FieldOption -> Bool)
-> (FieldOption -> FieldOption -> Bool) -> Eq FieldOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldOption -> FieldOption -> Bool
$c/= :: FieldOption -> FieldOption -> Bool
== :: FieldOption -> FieldOption -> Bool
$c== :: FieldOption -> FieldOption -> Bool
Eq, Eq FieldOption
Eq FieldOption
-> (FieldOption -> FieldOption -> Ordering)
-> (FieldOption -> FieldOption -> Bool)
-> (FieldOption -> FieldOption -> Bool)
-> (FieldOption -> FieldOption -> Bool)
-> (FieldOption -> FieldOption -> Bool)
-> (FieldOption -> FieldOption -> FieldOption)
-> (FieldOption -> FieldOption -> FieldOption)
-> Ord FieldOption
FieldOption -> FieldOption -> Bool
FieldOption -> FieldOption -> Ordering
FieldOption -> FieldOption -> FieldOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldOption -> FieldOption -> FieldOption
$cmin :: FieldOption -> FieldOption -> FieldOption
max :: FieldOption -> FieldOption -> FieldOption
$cmax :: FieldOption -> FieldOption -> FieldOption
>= :: FieldOption -> FieldOption -> Bool
$c>= :: FieldOption -> FieldOption -> Bool
> :: FieldOption -> FieldOption -> Bool
$c> :: FieldOption -> FieldOption -> Bool
<= :: FieldOption -> FieldOption -> Bool
$c<= :: FieldOption -> FieldOption -> Bool
< :: FieldOption -> FieldOption -> Bool
$c< :: FieldOption -> FieldOption -> Bool
compare :: FieldOption -> FieldOption -> Ordering
$ccompare :: FieldOption -> FieldOption -> Ordering
$cp1Ord :: Eq FieldOption
Ord, Int -> FieldOption -> ShowS
[FieldOption] -> ShowS
FieldOption -> String
(Int -> FieldOption -> ShowS)
-> (FieldOption -> String)
-> ([FieldOption] -> ShowS)
-> Show FieldOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldOption] -> ShowS
$cshowList :: [FieldOption] -> ShowS
show :: FieldOption -> String
$cshow :: FieldOption -> String
showsPrec :: Int -> FieldOption -> ShowS
$cshowsPrec :: Int -> FieldOption -> ShowS
Show, Typeable, (forall x. FieldOption -> Rep FieldOption x)
-> (forall x. Rep FieldOption x -> FieldOption)
-> Generic FieldOption
forall x. Rep FieldOption x -> FieldOption
forall x. FieldOption -> Rep FieldOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldOption x -> FieldOption
$cfrom :: forall x. FieldOption -> Rep FieldOption x
Generic)
deriveLift ''FieldOption
type LogMasker = FieldOption -> Builder -> Builder
defaultLogMasker :: LogMasker
defaultLogMasker :: LogMasker
defaultLogMasker FieldOption
FieldDefault Builder
bb = Builder
bb
defaultLogMasker FieldOption
FieldMasked Builder
_ = Builder
"'<MASKED BY POSTGRESQL-QUERY>'"
hugeFieldsMasker :: Int -> LogMasker
hugeFieldsMasker :: Int -> LogMasker
hugeFieldsMasker Int
maxsize FieldOption
_ Builder
bb =
let bl :: Int
bl = ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toByteString Builder
bb
in if Int
bl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxsize
then String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String
"'<STRING SIZE: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" MASKED BY POSTGRESQL-QUERY>'"
else Builder
bb