Helpers.hs

-- | 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 = inRange (-16, 128 - 1)

-- | Check whether a tag byte represents a tiny word (inline integer).
isTinyWord :: Word8 -> Bool
isTinyWord = liftA2 (||) (< textConst) (>= 240)

-- | Check whether a tag byte represents a tiny text (length embedded in tag).
isTinyText :: Word8 -> Bool
isTinyText = liftA2 (&&) (>= textConst) (< listConst)

-- | Check whether a tag byte represents a tiny list (length embedded in tag).
isTinyList :: Word8 -> Bool
isTinyList = liftA2 (&&) (>= listConst) (< dictConst)

-- | Check whether a tag byte represents a tiny dictionary (length embedded in tag).
isTinyDict :: Word8 -> Bool
isTinyDict = liftA2 (&&) (>= dictConst) (< structConst)

-- | Check whether a tag byte represents a tiny structure (length embedded in tag).
isTinyStruct :: Word8 -> Bool
isTinyStruct = liftA2 (&&) (>= structConst) (< nullCode)

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

-- | Check whether a tag byte is a boolean marker (true or false).
isBool :: Word8 -> Bool
isBool = liftA2 (||) (== trueCode) (== falseCode)

-- | Check whether a tag byte represents any integer encoding.
isInt :: Word8 -> Bool
isInt = do x <- liftA2 (||) (== int8Code) (== 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 = (== doubleCode)

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

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

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

-- | Check whether a tag byte represents any structure encoding.
isStruct :: Word8 -> Bool
isStruct = liftA3 (\x y z -> x || y || z) (== struct8Code) (== struct16Code) isTinyStruct

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

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

-- | Extract the minor version from a negotiated version Word32.
versionMinor :: Word32 -> Word8
versionMinor v = fromIntegral ((v `shiftR` 8) .&. 0xFF)

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

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

-- = Constants

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

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

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

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

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

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

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

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

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

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

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

-- = Other helpers

-- | Convert any 'Integral' value to 'Int'.
toInt :: Integral a => a -> Int
toInt = fromIntegral

-- | Extract the size from the low nibble of a tag byte.
getSize :: Word8 -> Int
getSize x = fromIntegral $ x .&. 15

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

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