-- | Internal module. Not part of the public API.
module Database.Bolty.Connection.Version
  ( boltVersionsToSpec
  , Version(..)
  ) where

import           Data.Bits           (shiftL, (.|.))
import           Data.Kind           (Type)
import           Data.List           (foldl', sort)
import           Data.Maybe          (catMaybes)
import           Data.Word           (Word8, Word32)
import qualified Data.ByteString     as BS
import qualified Data.Text           as T
import qualified Validation          as V
import           TextShow            (showt)


-- | A BOLT protocol version (major.minor).
type Version :: Type
data Version = Version
  { Version -> Word8
minor :: Word8
  , Version -> Word8
major :: Word8
  }
  deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq)

instance Ord Version where
  compare :: Version -> Version -> Ordering
compare Version{minor :: Version -> Word8
minor = Word8
minorA, major :: Version -> Word8
major = Word8
majorA} Version{minor :: Version -> Word8
minor = Word8
minorB, major :: Version -> Word8
major = Word8
majorB} =
    let compare_major :: Ordering
compare_major = Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word8
majorA Word8
majorB
    in if Ordering
compare_major Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ then
         Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word8
minorA Word8
minorB
       else
         Ordering
compare_major


validateVersion :: Version -> Maybe T.Text
validateVersion :: Version -> Maybe Text
validateVersion Version{Word8
minor :: Version -> Word8
minor :: Word8
minor, Word8
major :: Version -> Word8
major :: Word8
major}
  | Word8
major Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
4                = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bolt protocol versions below 4.4 are not supported"
  | Word8
major Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 Bool -> Bool -> Bool
&& Word8
minor Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
4  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bolt protocol version 4.4 is the minimum supported minor; 4.0-4.3 are not supported"
  | Word8
major Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 Bool -> Bool -> Bool
&& Word8
minor Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
4  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bolt protocol version 4 does not have any minor versions higher than 4 (4.4 is the highest minor)"
  | Word8
major Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
5 Bool -> Bool -> Bool
&& Word8
minor Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
4  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The driver supports up to Bolt 5.4"
  | Word8
major Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
5                = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The latest supported Bolt major version is 5, please open a github issue for support for later protocols"
  | Bool
otherwise                = Maybe Text
forall a. Maybe a
Nothing

-- | Validate and compact a list of BOLT versions into a 4-element handshake spec.
boltVersionsToSpec :: [Version] -> V.Validation [T.Text] [Word32]
boltVersionsToSpec :: [Version] -> Validation [Text] [Word32]
boltVersionsToSpec [] = [Text] -> Validation [Text] [Word32]
forall e a. e -> Validation e a
V.Failure [Text
"Specify at least one protocol version"]
boltVersionsToSpec [Version]
versions =
  let errors :: [(Version, T.Text)]
      errors :: [(Version, Text)]
errors = [Maybe (Version, Text)] -> [(Version, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Version, Text)] -> [(Version, Text)])
-> [Maybe (Version, Text)] -> [(Version, Text)]
forall a b. (a -> b) -> a -> b
$ (Version -> Maybe (Version, Text))
-> [Version] -> [Maybe (Version, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Version
x -> (Text -> (Version, Text)) -> Maybe Text -> Maybe (Version, Text)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
e -> (Version
x, Text
e)) (Maybe Text -> Maybe (Version, Text))
-> Maybe Text -> Maybe (Version, Text)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Text
validateVersion Version
x) [Version]
versions
      version_error_to_string :: (Version, T.Text) -> T.Text
      version_error_to_string :: (Version, Text) -> Text
version_error_to_string (Version{Word8
minor :: Version -> Word8
minor :: Word8
minor, Word8
major :: Version -> Word8
major :: Word8
major}, Text
err) = ByteString -> Text
forall a. TextShow a => a -> Text
showt (Word8 -> ByteString
BS.singleton Word8
major) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. TextShow a => a -> Text
showt (Word8 -> ByteString
BS.singleton Word8
minor) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
  in if Bool -> Bool
not ([(Version, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Version, Text)]
errors) then
        [Text] -> Validation [Text] [Word32]
forall e a. e -> Validation e a
V.Failure ([Text] -> Validation [Text] [Word32])
-> [Text] -> Validation [Text] [Word32]
forall a b. (a -> b) -> a -> b
$ ((Version, Text) -> Text) -> [(Version, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Version, Text) -> Text
version_error_to_string [(Version, Text)]
errors
      else
        let ws :: [Word32]
ws = [Version] -> [Word32]
compactVersions [Version]
versions
        in if [Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word32]
ws Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 then
             [Text] -> Validation [Text] [Word32]
forall e a. e -> Validation e a
V.Failure [Text
"Could not make a version specification, try specifying less versions"]
           else
             [Word32] -> Validation [Text] [Word32]
forall e a. a -> Validation e a
V.Success ([Word32] -> Validation [Text] [Word32])
-> [Word32] -> Validation [Text] [Word32]
forall a b. (a -> b) -> a -> b
$ [Word32]
ws [Word32] -> [Word32] -> [Word32]
forall a. Semigroup a => a -> a -> a
<> Int -> Word32 -> [Word32]
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word32]
ws) (Word32
0 :: Word32)


word8ToWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word8ToWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word8ToWord32 Word8
a Word8
b Word8
c Word8
d
    = (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d

compactVersions :: [Version] -> [Word32]
compactVersions :: [Version] -> [Word32]
compactVersions [Version]
versions =
  let (Maybe (Version, Word8)
trailing, [Word32]
acc) = ((Maybe (Version, Word8), [Word32])
 -> Version -> (Maybe (Version, Word8), [Word32]))
-> (Maybe (Version, Word8), [Word32])
-> [Version]
-> (Maybe (Version, Word8), [Word32])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Maybe (Version, Word8), [Word32])
-> Version -> (Maybe (Version, Word8), [Word32])
f (Maybe (Version, Word8)
forall a. Maybe a
Nothing, []) ([Version] -> (Maybe (Version, Word8), [Word32]))
-> [Version] -> (Maybe (Version, Word8), [Word32])
forall a b. (a -> b) -> a -> b
$ [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version]) -> [Version] -> [Version]
forall a b. (a -> b) -> a -> b
$ [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort [Version]
versions
  in [Word32]
acc [Word32] -> [Word32] -> [Word32]
forall a. Semigroup a => a -> a -> a
<> [Word32]
-> ((Version, Word8) -> [Word32])
-> Maybe (Version, Word8)
-> [Word32]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Version, Word8)
p -> [(Version, Word8) -> Word32
versionAndBelowToWord (Version, Word8)
p]) Maybe (Version, Word8)
trailing
  where versionAndBelowToWord :: (Version, Word8) -> Word32
        versionAndBelowToWord :: (Version, Word8) -> Word32
versionAndBelowToWord (Version{Word8
minor :: Version -> Word8
minor :: Word8
minor, Word8
major :: Version -> Word8
major :: Word8
major}, Word8
versions_below) = Word8 -> Word8 -> Word8 -> Word8 -> Word32
word8ToWord32 Word8
0 Word8
versions_below Word8
minor Word8
major

        f :: (Maybe (Version, Word8), [Word32]) -> Version -> (Maybe (Version, Word8), [Word32])
        f :: (Maybe (Version, Word8), [Word32])
-> Version -> (Maybe (Version, Word8), [Word32])
f (Maybe (Version, Word8)
previous, [Word32]
acc) current :: Version
current@Version{minor :: Version -> Word8
minor = Word8
minorCurrent, major :: Version -> Word8
major = Word8
majorCurrent} =
            let supportsVersionCompression :: Bool
supportsVersionCompression = (Word8
majorCurrent Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 Bool -> Bool -> Bool
&& Word8
minorCurrent Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
3) Bool -> Bool -> Bool
|| Word8
majorCurrent Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
4
            in  if Bool -> Bool
not Bool
supportsVersionCompression then
                  case Maybe (Version, Word8)
previous of
                    Maybe (Version, Word8)
Nothing -> (Maybe (Version, Word8)
forall a. Maybe a
Nothing, [Word32]
acc [Word32] -> [Word32] -> [Word32]
forall a. Semigroup a => a -> a -> a
<> [(Version, Word8) -> Word32
versionAndBelowToWord (Version
current, Word8
0)])
                    Just (Version, Word8)
p -> (Maybe (Version, Word8)
forall a. Maybe a
Nothing, [Word32]
acc [Word32] -> [Word32] -> [Word32]
forall a. Semigroup a => a -> a -> a
<> [(Version, Word8) -> Word32
versionAndBelowToWord (Version, Word8)
p, (Version, Word8) -> Word32
versionAndBelowToWord (Version
current, Word8
0)])
                else
                  case Maybe (Version, Word8)
previous of
                    Just (p :: Version
p@(Version{minor :: Version -> Word8
minor = Word8
minorLast, major :: Version -> Word8
major = Word8
majorLast}), Word8
versions_below) ->
                      if Word8
majorLast Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
majorCurrent Bool -> Bool -> Bool
&& Word8
minorCurrent Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
minorLast Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
versions_below Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1 then
                        ((Version, Word8) -> Maybe (Version, Word8)
forall a. a -> Maybe a
Just (Version
p, Word8
versions_below Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1), [Word32]
acc)
                      else
                        ((Version, Word8) -> Maybe (Version, Word8)
forall a. a -> Maybe a
Just (Version
current, Word8
0), [Word32]
acc [Word32] -> [Word32] -> [Word32]
forall a. Semigroup a => a -> a -> a
<> [(Version, Word8) -> Word32
versionAndBelowToWord (Version
p, Word8
versions_below)])
                    Maybe (Version, Word8)
Nothing -> ((Version, Word8) -> Maybe (Version, Word8)
forall a. a -> Maybe a
Just (Version
current, Word8
0), [Word32]
acc)