-- | Internal module. Not part of the public API.
module Database.Bolty.Value.Helpers
  ( -- * Checkers
    isTinyInt, isTinyWord, isTinyText, isTinyList, isTinyDict, isTinyStruct
  , isNull, isBool, isInt, isDouble, isDict, isText, isList, isStruct
  , isNewVersion
    -- * Version helpers
  , versionMajor, versionMinor
  , supportsLogonLogoff, supportsTelemetry
    -- * Constants
  , nullCode, falseCode, trueCode
  , int8Code, int16Code, int32Code, int64Code, doubleCode
  , textConst, text8Code, text16Code, text32Code
  , listConst, list8Code, list16Code, list32Code
  , dictConst, dict8Code, dict16Code, dict32Code
  , structConst, struct8Code, struct16Code
  , sigNode, sigRel, sigURel, sigPath
  , sigDate, sigTime, sigLocalTime, sigDateTime, sigDateTimeZoneId, sigLocalDateTime, sigDuration
  , sigPoint2D, sigPoint3D
  , sigInit, sigHello, sigRun, sigAFail, sigReset, sigDAll, sigPAll, sigGBye
  , sigSucc, sigFail, sigRecs, sigIgn
    -- * Helpers
  , toInt, getSize, inRange, isIntX
  ) where

import           Control.Applicative (liftA3)
import           Data.Bits           ((.&.), shiftR)
import           Data.Word           (Word8, Word32)

-- = Checkers

-- | Check whether a value fits in the PackStream tiny integer range @[-16, 127]@.
isTinyInt :: Integral a => a -> Bool
isTinyInt :: forall a. Integral a => a -> Bool
isTinyInt = (a, a) -> a -> Bool
forall a. Ord a => (a, a) -> a -> Bool
inRange (-a
16, a
128 a -> a -> a
forall a. Num a => a -> a -> a
- a
1)

-- | Check whether a tag byte represents a tiny word (inline integer).
isTinyWord :: Word8 -> Bool
isTinyWord :: Word8 -> Bool
isTinyWord = (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
textConst) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
240)

-- | Check whether a tag byte represents a tiny text (length embedded in tag).
isTinyText :: Word8 -> Bool
isTinyText :: Word8 -> Bool
isTinyText = (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
textConst) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
listConst)

-- | Check whether a tag byte represents a tiny list (length embedded in tag).
isTinyList :: Word8 -> Bool
isTinyList :: Word8 -> Bool
isTinyList = (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
listConst) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
dictConst)

-- | Check whether a tag byte represents a tiny dictionary (length embedded in tag).
isTinyDict :: Word8 -> Bool
isTinyDict :: Word8 -> Bool
isTinyDict = (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
dictConst) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
structConst)

-- | Check whether a tag byte represents a tiny structure (length embedded in tag).
isTinyStruct :: Word8 -> Bool
isTinyStruct :: Word8 -> Bool
isTinyStruct = (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
structConst) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
nullCode)

-- | Check whether a tag byte is the null marker.
isNull :: Word8 -> Bool
isNull :: Word8 -> Bool
isNull = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nullCode)

-- | Check whether a tag byte is a boolean marker (true or false).
isBool :: Word8 -> Bool
isBool :: Word8 -> Bool
isBool = (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
trueCode) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
falseCode)

-- | Check whether a tag byte represents any integer encoding.
isInt :: Word8 -> Bool
isInt :: Word8 -> Bool
isInt = do x <- (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
int8Code) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
int16Code)
           y <- liftA2 (||) (== int32Code) (== int64Code)
           z <- isTinyWord
           pure $ x || y || z

-- | Check whether a tag byte is the double (float64) marker.
isDouble :: Word8 -> Bool
isDouble :: Word8 -> Bool
isDouble = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleCode)

-- | Check whether a tag byte represents any dictionary encoding.
isDict :: Word8 -> Bool
isDict :: Word8 -> Bool
isDict = do x <- (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict8Code) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict16Code)
            y <- liftA2 (||) (== dict32Code) isTinyDict
            pure $ x || y

-- | Check whether a tag byte represents any text encoding.
isText :: Word8 -> Bool
isText :: Word8 -> Bool
isText = do x <- (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text8Code) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text16Code)
            y <- liftA2 (||) (== text32Code) isTinyText
            pure $ x || y

-- | Check whether a tag byte represents any list encoding.
isList :: Word8 -> Bool
isList :: Word8 -> Bool
isList = do x <- (Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall a b c.
(a -> b -> c) -> (Word8 -> a) -> (Word8 -> b) -> Word8 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list8Code) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list16Code)
            y <- liftA2 (||) (== list32Code) isTinyList
            pure $ x || y

-- | Check whether a tag byte represents any structure encoding.
isStruct :: Word8 -> Bool
isStruct :: Word8 -> Bool
isStruct = (Bool -> Bool -> Bool -> Bool)
-> (Word8 -> Bool)
-> (Word8 -> Bool)
-> (Word8 -> Bool)
-> Word8
-> Bool
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\Bool
x Bool
y Bool
z -> Bool
x Bool -> Bool -> Bool
|| Bool
y Bool -> Bool -> Bool
|| Bool
z) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
struct8Code) (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
struct16Code) Word8 -> Bool
isTinyStruct

-- | Check whether a negotiated version uses the new (v3+) handshake format.
isNewVersion :: Word32 -> Bool
isNewVersion :: Word32 -> Bool
isNewVersion Word32
v = (Word32
v Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
255) Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
3

-- | Extract the major version from a negotiated version Word32.
-- The server responds with [0, 0, minor, major].
versionMajor :: Word32 -> Word8
versionMajor :: Word32 -> Word8
versionMajor Word32
v = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
v Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)

-- | Extract the minor version from a negotiated version Word32.
versionMinor :: Word32 -> Word8
versionMinor :: Word32 -> Word8
versionMinor Word32
v = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)

-- | Bolt 5.1+ uses LOGON/LOGOFF instead of credentials in HELLO.
supportsLogonLogoff :: Word32 -> Bool
supportsLogonLogoff :: Word32 -> Bool
supportsLogonLogoff Word32
v = Word32 -> Word8
versionMajor Word32
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
5 Bool -> Bool -> Bool
&& Word32 -> Word8
versionMinor Word32
v Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
1

-- | Bolt 5.4+ supports the TELEMETRY message.
supportsTelemetry :: Word32 -> Bool
supportsTelemetry :: Word32 -> Bool
supportsTelemetry Word32
v = Word32 -> Word8
versionMajor Word32
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
5 Bool -> Bool -> Bool
&& Word32 -> Word8
versionMinor Word32
v Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
4

-- = Constants

-- | Tag bytes for null, false, and true.
nullCode, falseCode, trueCode :: Word8
nullCode :: Word8
nullCode  = Word8
192
falseCode :: Word8
falseCode = Word8
194
trueCode :: Word8
trueCode  = Word8
195

-- | Tag bytes for integer and double encodings.
int8Code, int16Code, int32Code, int64Code, doubleCode :: Word8
int8Code :: Word8
int8Code   = Word8
200
int16Code :: Word8
int16Code  = Word8
201
int32Code :: Word8
int32Code  = Word8
202
int64Code :: Word8
int64Code  = Word8
203
doubleCode :: Word8
doubleCode = Word8
193

-- | Tag bytes for text encodings (tiny base and sized variants).
textConst, text8Code, text16Code, text32Code :: Word8
textConst :: Word8
textConst  = Word8
128
text8Code :: Word8
text8Code  = Word8
208
text16Code :: Word8
text16Code = Word8
209
text32Code :: Word8
text32Code = Word8
210

-- | Tag bytes for list encodings (tiny base and sized variants).
listConst, list8Code, list16Code, list32Code :: Word8
listConst :: Word8
listConst  = Word8
144
list8Code :: Word8
list8Code  = Word8
212
list16Code :: Word8
list16Code = Word8
213
list32Code :: Word8
list32Code = Word8
214

-- | Tag bytes for dictionary encodings (tiny base and sized variants).
dictConst, dict8Code, dict16Code, dict32Code :: Word8
dictConst :: Word8
dictConst  = Word8
160
dict8Code :: Word8
dict8Code  = Word8
216
dict16Code :: Word8
dict16Code = Word8
217
dict32Code :: Word8
dict32Code = Word8
218

-- | Tag bytes for structure encodings (tiny base and sized variants).
structConst, struct8Code, struct16Code :: Word8
structConst :: Word8
structConst  = Word8
176
struct8Code :: Word8
struct8Code  = Word8
220
struct16Code :: Word8
struct16Code = Word8
221

-- | Structure signature bytes for graph types (Node, Relationship, UnboundRelationship, Path).
sigNode, sigRel, sigURel, sigPath :: Word8
sigNode :: Word8
sigNode = Word8
78
sigRel :: Word8
sigRel  = Word8
82
sigURel :: Word8
sigURel = Word8
114
sigPath :: Word8
sigPath = Word8
80

-- | Structure signature bytes for temporal types.
sigDate, sigTime, sigLocalTime, sigDateTime, sigDateTimeZoneId, sigLocalDateTime, sigDuration :: Word8
sigDate :: Word8
sigDate            = Word8
0x44  -- 68
sigTime :: Word8
sigTime            = Word8
0x54  -- 84
sigLocalTime :: Word8
sigLocalTime       = Word8
0x74  -- 116
sigDateTime :: Word8
sigDateTime        = Word8
0x49  -- 73  (BOLT v5+)
sigDateTimeZoneId :: Word8
sigDateTimeZoneId  = Word8
0x69  -- 105 (BOLT v5+)
sigLocalDateTime :: Word8
sigLocalDateTime   = Word8
0x64  -- 100 (BOLT v5+)
sigDuration :: Word8
sigDuration        = Word8
0x45  -- 69

-- | Structure signature bytes for spatial point types.
sigPoint2D, sigPoint3D :: Word8
sigPoint2D :: Word8
sigPoint2D = Word8
0x58  -- 88
sigPoint3D :: Word8
sigPoint3D = Word8
0x59  -- 89

-- | Structure signature bytes for client request messages.
sigInit, sigHello, sigRun, sigAFail, sigReset, sigDAll, sigPAll, sigGBye :: Word8
sigInit :: Word8
sigInit  = Word8
1
sigHello :: Word8
sigHello = Word8
1
sigRun :: Word8
sigRun   = Word8
16
sigAFail :: Word8
sigAFail = Word8
14
sigReset :: Word8
sigReset = Word8
15
sigDAll :: Word8
sigDAll  = Word8
47
sigPAll :: Word8
sigPAll  = Word8
63
sigGBye :: Word8
sigGBye  = Word8
2

-- | Structure signature bytes for server response messages.
sigSucc, sigFail, sigRecs, sigIgn :: Word8
sigSucc :: Word8
sigSucc = Word8
112
sigFail :: Word8
sigFail = Word8
127
sigRecs :: Word8
sigRecs = Word8
113
sigIgn :: Word8
sigIgn  = Word8
126

-- = Other helpers

-- | Convert any 'Integral' value to 'Int'.
toInt :: Integral a => a -> Int
toInt :: forall a. Integral a => a -> Int
toInt = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Extract the size from the low nibble of a tag byte.
getSize :: Word8 -> Int
getSize :: Word8 -> Int
getSize Word8
x = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15

-- | Check whether a value lies in the half-open interval @[low, up)@.
inRange :: Ord a => (a, a) -> a -> Bool
inRange :: forall a. Ord a => (a, a) -> a -> Bool
inRange (a
low, a
up) a
x = a
low a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
up

-- | Check whether a value fits in a signed integer with @p@ bits.
isIntX :: Integral x => x -> x -> Bool
isIntX :: forall x. Integral x => x -> x -> Bool
isIntX x
p = (x, x) -> x -> Bool
forall a. Ord a => (a, a) -> a -> Bool
inRange (-(x
2 x -> x -> x
forall a b. (Num a, Integral b) => a -> b -> a
^ (x
px -> x -> x
forall a. Num a => a -> a -> a
-x
1)), x
2 x -> x -> x
forall a b. (Num a, Integral b) => a -> b -> a
^ (x
px -> x -> x
forall a. Num a => a -> a -> a
-x
1) x -> x -> x
forall a. Num a => a -> a -> a
- x
1)