module ClickHaskell.Primitive.Serialization where

-- GHC included
import Control.Applicative (liftA2)
import Control.DeepSeq (NFData)
import Data.Binary.Get
import Data.Bits (Bits (setBit, unsafeShiftL, unsafeShiftR, (.&.), (.|.)), xor)
import Data.ByteString.Builder
import Data.Int (Int64)
import Data.Type.Bool (Not)
import Data.Type.Equality (type (==))
import Data.Typeable (Proxy (..))
import Data.Word (Word64)
import GHC.Generics (C1, D1, Generic (..), K1 (K1), M1 (M1), Meta (MetaSel), Rec0, S1, type (:*:) (..))
import GHC.TypeLits (KnownNat, Nat, natVal)
import Prelude hiding (liftA2)


-------------------------------------------------------------------------------
-- * Core serialization class
-------------------------------------------------------------------------------

class Serializable chType
  where
  default serialize :: (Generic chType, GSerial (Rep chType)) => ProtocolRevision -> chType -> Builder
  serialize :: ProtocolRevision -> chType -> Builder
  serialize ProtocolRevision
rev = ProtocolRevision -> Rep chType (ZonkAny 0) -> Builder
forall p. ProtocolRevision -> Rep chType p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev (Rep chType (ZonkAny 0) -> Builder)
-> (chType -> Rep chType (ZonkAny 0)) -> chType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> Rep chType (ZonkAny 0)
forall x. chType -> Rep chType x
forall a x. Generic a => a -> Rep a x
from

  {-# INLINE deserialize #-}
  default deserialize :: (Generic chType, GSerial (Rep chType)) => ProtocolRevision -> Get chType
  deserialize :: ProtocolRevision -> Get chType
  deserialize ProtocolRevision
rev = Rep chType (ZonkAny 1) -> chType
forall a x. Generic a => Rep a x -> a
forall x. Rep chType x -> chType
to (Rep chType (ZonkAny 1) -> chType)
-> Get (Rep chType (ZonkAny 1)) -> Get chType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (Rep chType (ZonkAny 1))
forall p. ProtocolRevision -> Get (Rep chType p)
forall (f :: * -> *) p. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev

{-# INLINE replicateGet #-}
replicateGet :: Serializable chType => ProtocolRevision -> UVarInt -> Get [chType]
replicateGet :: forall chType.
Serializable chType =>
ProtocolRevision -> UVarInt -> Get [chType]
replicateGet ProtocolRevision
rev UVarInt
cnt0 = UVarInt -> Get [chType]
loopGet UVarInt
cnt0
  where
  loopGet :: UVarInt -> Get [chType]
loopGet UVarInt
cnt
    | UVarInt
cnt UVarInt -> UVarInt -> Bool
forall a. Eq a => a -> a -> Bool
== UVarInt
0  = [chType] -> Get [chType]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    | Bool
otherwise = (chType -> [chType] -> [chType])
-> Get chType -> Get [chType] -> Get [chType]
forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (ProtocolRevision -> Get chType
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev) (UVarInt -> Get [chType]
loopGet (UVarInt
cnt UVarInt -> UVarInt -> UVarInt
forall a. Num a => a -> a -> a
- UVarInt
1))

instance Serializable prim => Serializable [prim] where
  serialize :: ProtocolRevision -> [prim] -> Builder
serialize ProtocolRevision
rev [prim]
list
    =  forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> Int -> UVarInt
forall a b. (a -> b) -> a -> b
$ [prim] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [prim]
list)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (prim -> Builder) -> [prim] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @prim ProtocolRevision
rev) [prim]
list
  deserialize :: ProtocolRevision -> Get [prim]
deserialize ProtocolRevision
rev = do
    len <- forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    replicateGet @prim rev len
  {-# INLINE deserialize #-}

instance Serializable () where
  serialize :: ProtocolRevision -> () -> Builder
serialize ProtocolRevision
_ () = Builder
""
  deserialize :: ProtocolRevision -> Get ()
deserialize ProtocolRevision
_ = () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


class ToQueryPart chType where
  toQueryPart :: chType -> Builder

class IsChType chType
  where
  -- | Shows database original type name
  --
  -- @
  -- chTypeName \@ChString = \"String\"
  -- chTypeName \@(Nullable UInt32) = \"Nullable(UInt32)\"
  -- @
  chTypeName :: String

  defaultValueOfTypeName :: chType

class ToChType chType userType    where
  toChType   :: userType -> chType
  fromChType :: chType -> userType

instance {-# OVERLAPPABLE #-} (IsChType chType, chType ~ inputType) => ToChType chType inputType where
  toChType :: inputType -> chType
toChType = inputType -> chType
inputType -> inputType
forall a. a -> a
id
  fromChType :: chType -> inputType
fromChType = chType -> chType
chType -> inputType
forall a. a -> a
id


-- ** Generics

class GSerial f where
  gSerialize :: ProtocolRevision -> f p -> Builder
  gDeserialize :: ProtocolRevision -> Get (f p)

instance GSerial f => GSerial (D1 c (C1 c2 f)) where
  gSerialize :: forall p. ProtocolRevision -> D1 c (C1 c2 f) p -> Builder
gSerialize ProtocolRevision
rev (M1 (M1 f p
re)) = ProtocolRevision -> f p -> Builder
forall p. ProtocolRevision -> f p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev f p
re
  {-# INLINE gSerialize #-}
  gDeserialize :: forall p. ProtocolRevision -> Get (D1 c (C1 c2 f) p)
gDeserialize ProtocolRevision
rev = C1 c2 f p -> M1 D c (C1 c2 f) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (C1 c2 f p -> M1 D c (C1 c2 f) p)
-> (f p -> C1 c2 f p) -> f p -> M1 D c (C1 c2 f) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f p -> C1 c2 f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D c (C1 c2 f) p)
-> Get (f p) -> Get (M1 D c (C1 c2 f) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get (f p)
forall p. ProtocolRevision -> Get (f p)
forall (f :: * -> *) p. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev
  {-# INLINE gDeserialize #-}

instance (GSerial left1,  GSerial right) => GSerial (left1 :*: right) where
  gSerialize :: forall p. ProtocolRevision -> (:*:) left1 right p -> Builder
gSerialize ProtocolRevision
rev (left1 p
l :*: right p
r) = ProtocolRevision -> left1 p -> Builder
forall p. ProtocolRevision -> left1 p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev left1 p
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> right p -> Builder
forall p. ProtocolRevision -> right p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev right p
r
  {-# INLINE gSerialize #-}
  gDeserialize :: forall p. ProtocolRevision -> Get ((:*:) left1 right p)
gDeserialize ProtocolRevision
rev = do
    (left1 p -> right p -> (:*:) left1 right p)
-> Get (left1 p) -> Get (right p) -> Get ((:*:) left1 right p)
forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 left1 p -> right p -> (:*:) left1 right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
      (ProtocolRevision -> Get (left1 p)
forall p. ProtocolRevision -> Get (left1 p)
forall (f :: * -> *) p. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev)
      (ProtocolRevision -> Get (right p)
forall p. ProtocolRevision -> Get (right p)
forall (f :: * -> *) p. GSerial f => ProtocolRevision -> Get (f p)
gDeserialize ProtocolRevision
rev)
  {-# INLINE gDeserialize #-}

instance
  (Serializable chType, Not (sel == "server_revision") ~ True)
  =>
  GSerial (S1 ('MetaSel ('Just sel) a b c) (Rec0 chType)) where
  gSerialize :: forall p.
ProtocolRevision
-> S1 ('MetaSel ('Just sel) a b c) (Rec0 chType) p -> Builder
gSerialize ProtocolRevision
rev (M1 (K1 chType
re)) = ProtocolRevision -> chType -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev chType
re
  {-# INLINE gSerialize #-}
  gDeserialize :: forall p.
ProtocolRevision
-> Get (S1 ('MetaSel ('Just sel) a b c) (Rec0 chType) p)
gDeserialize ProtocolRevision
rev = Rec0 chType p -> M1 S ('MetaSel ('Just sel) a b c) (Rec0 chType) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 chType p
 -> M1 S ('MetaSel ('Just sel) a b c) (Rec0 chType) p)
-> (chType -> Rec0 chType p)
-> chType
-> M1 S ('MetaSel ('Just sel) a b c) (Rec0 chType) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chType -> Rec0 chType p
forall k i c (p :: k). c -> K1 i c p
K1 (chType -> M1 S ('MetaSel ('Just sel) a b c) (Rec0 chType) p)
-> Get chType
-> Get (M1 S ('MetaSel ('Just sel) a b c) (Rec0 chType) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @chType ProtocolRevision
rev
  {-# INLINE gDeserialize #-}


instance {-# OVERLAPPING #-}
  GSerial right
  =>
  GSerial (S1 ('MetaSel ('Just "server_revision") a b c) (Rec0 ProtocolRevision) :*: right)
  where
  gSerialize :: forall p.
ProtocolRevision
-> (:*:)
     (S1
        ('MetaSel ('Just "server_revision") a b c) (Rec0 ProtocolRevision))
     right
     p
-> Builder
gSerialize ProtocolRevision
rev (M1 (K1 (MkProtocolRevision UVarInt
server_rev)) :*: right p
right)= do
    ProtocolRevision -> UVarInt -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev UVarInt
server_rev Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> right p -> Builder
forall p. ProtocolRevision -> right p -> Builder
forall (f :: * -> *) p.
GSerial f =>
ProtocolRevision -> f p -> Builder
gSerialize ProtocolRevision
rev right p
right
  {-# INLINE gSerialize #-}
  gDeserialize :: forall p.
ProtocolRevision
-> Get
     ((:*:)
        (S1
           ('MetaSel ('Just "server_revision") a b c) (Rec0 ProtocolRevision))
        right
        p)
gDeserialize ProtocolRevision
rev = do
    chosenRev <- ProtocolRevision -> ProtocolRevision -> ProtocolRevision
forall a. Ord a => a -> a -> a
min ProtocolRevision
rev (ProtocolRevision -> ProtocolRevision)
-> (UVarInt -> ProtocolRevision) -> UVarInt -> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UVarInt -> ProtocolRevision
MkProtocolRevision (UVarInt -> ProtocolRevision)
-> Get UVarInt -> Get ProtocolRevision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    liftA2 (:*:)
      (pure . M1 . K1 $ chosenRev)
      (gDeserialize @right chosenRev)
  {-# INLINE gDeserialize #-}




-------------------------------------------------------------------------------
-- * Protocol parts
-------------------------------------------------------------------------------

-- ** UVarInt

{- |
  Unsigned variable-length quantity encoding

  Part of protocol implementation
-}
newtype UVarInt = MkUVarInt Word64
  deriving newtype (Int -> UVarInt -> ShowS
[UVarInt] -> ShowS
UVarInt -> String
(Int -> UVarInt -> ShowS)
-> (UVarInt -> String) -> ([UVarInt] -> ShowS) -> Show UVarInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UVarInt -> ShowS
showsPrec :: Int -> UVarInt -> ShowS
$cshow :: UVarInt -> String
show :: UVarInt -> String
$cshowList :: [UVarInt] -> ShowS
showList :: [UVarInt] -> ShowS
Show, UVarInt -> UVarInt -> Bool
(UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool) -> Eq UVarInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UVarInt -> UVarInt -> Bool
== :: UVarInt -> UVarInt -> Bool
$c/= :: UVarInt -> UVarInt -> Bool
/= :: UVarInt -> UVarInt -> Bool
Eq, Integer -> UVarInt
UVarInt -> UVarInt
UVarInt -> UVarInt -> UVarInt
(UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (Integer -> UVarInt)
-> Num UVarInt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: UVarInt -> UVarInt -> UVarInt
+ :: UVarInt -> UVarInt -> UVarInt
$c- :: UVarInt -> UVarInt -> UVarInt
- :: UVarInt -> UVarInt -> UVarInt
$c* :: UVarInt -> UVarInt -> UVarInt
* :: UVarInt -> UVarInt -> UVarInt
$cnegate :: UVarInt -> UVarInt
negate :: UVarInt -> UVarInt
$cabs :: UVarInt -> UVarInt
abs :: UVarInt -> UVarInt
$csignum :: UVarInt -> UVarInt
signum :: UVarInt -> UVarInt
$cfromInteger :: Integer -> UVarInt
fromInteger :: Integer -> UVarInt
Num, Eq UVarInt
UVarInt
Eq UVarInt =>
(UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> UVarInt
-> (Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> Bool)
-> (UVarInt -> Maybe Int)
-> (UVarInt -> Int)
-> (UVarInt -> Bool)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int -> UVarInt)
-> (UVarInt -> Int)
-> Bits UVarInt
Int -> UVarInt
UVarInt -> Bool
UVarInt -> Int
UVarInt -> Maybe Int
UVarInt -> UVarInt
UVarInt -> Int -> Bool
UVarInt -> Int -> UVarInt
UVarInt -> UVarInt -> UVarInt
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: UVarInt -> UVarInt -> UVarInt
.&. :: UVarInt -> UVarInt -> UVarInt
$c.|. :: UVarInt -> UVarInt -> UVarInt
.|. :: UVarInt -> UVarInt -> UVarInt
$cxor :: UVarInt -> UVarInt -> UVarInt
xor :: UVarInt -> UVarInt -> UVarInt
$ccomplement :: UVarInt -> UVarInt
complement :: UVarInt -> UVarInt
$cshift :: UVarInt -> Int -> UVarInt
shift :: UVarInt -> Int -> UVarInt
$crotate :: UVarInt -> Int -> UVarInt
rotate :: UVarInt -> Int -> UVarInt
$czeroBits :: UVarInt
zeroBits :: UVarInt
$cbit :: Int -> UVarInt
bit :: Int -> UVarInt
$csetBit :: UVarInt -> Int -> UVarInt
setBit :: UVarInt -> Int -> UVarInt
$cclearBit :: UVarInt -> Int -> UVarInt
clearBit :: UVarInt -> Int -> UVarInt
$ccomplementBit :: UVarInt -> Int -> UVarInt
complementBit :: UVarInt -> Int -> UVarInt
$ctestBit :: UVarInt -> Int -> Bool
testBit :: UVarInt -> Int -> Bool
$cbitSizeMaybe :: UVarInt -> Maybe Int
bitSizeMaybe :: UVarInt -> Maybe Int
$cbitSize :: UVarInt -> Int
bitSize :: UVarInt -> Int
$cisSigned :: UVarInt -> Bool
isSigned :: UVarInt -> Bool
$cshiftL :: UVarInt -> Int -> UVarInt
shiftL :: UVarInt -> Int -> UVarInt
$cunsafeShiftL :: UVarInt -> Int -> UVarInt
unsafeShiftL :: UVarInt -> Int -> UVarInt
$cshiftR :: UVarInt -> Int -> UVarInt
shiftR :: UVarInt -> Int -> UVarInt
$cunsafeShiftR :: UVarInt -> Int -> UVarInt
unsafeShiftR :: UVarInt -> Int -> UVarInt
$crotateL :: UVarInt -> Int -> UVarInt
rotateL :: UVarInt -> Int -> UVarInt
$crotateR :: UVarInt -> Int -> UVarInt
rotateR :: UVarInt -> Int -> UVarInt
$cpopCount :: UVarInt -> Int
popCount :: UVarInt -> Int
Bits, Int -> UVarInt
UVarInt -> Int
UVarInt -> [UVarInt]
UVarInt -> UVarInt
UVarInt -> UVarInt -> [UVarInt]
UVarInt -> UVarInt -> UVarInt -> [UVarInt]
(UVarInt -> UVarInt)
-> (UVarInt -> UVarInt)
-> (Int -> UVarInt)
-> (UVarInt -> Int)
-> (UVarInt -> [UVarInt])
-> (UVarInt -> UVarInt -> [UVarInt])
-> (UVarInt -> UVarInt -> [UVarInt])
-> (UVarInt -> UVarInt -> UVarInt -> [UVarInt])
-> Enum UVarInt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UVarInt -> UVarInt
succ :: UVarInt -> UVarInt
$cpred :: UVarInt -> UVarInt
pred :: UVarInt -> UVarInt
$ctoEnum :: Int -> UVarInt
toEnum :: Int -> UVarInt
$cfromEnum :: UVarInt -> Int
fromEnum :: UVarInt -> Int
$cenumFrom :: UVarInt -> [UVarInt]
enumFrom :: UVarInt -> [UVarInt]
$cenumFromThen :: UVarInt -> UVarInt -> [UVarInt]
enumFromThen :: UVarInt -> UVarInt -> [UVarInt]
$cenumFromTo :: UVarInt -> UVarInt -> [UVarInt]
enumFromTo :: UVarInt -> UVarInt -> [UVarInt]
$cenumFromThenTo :: UVarInt -> UVarInt -> UVarInt -> [UVarInt]
enumFromThenTo :: UVarInt -> UVarInt -> UVarInt -> [UVarInt]
Enum, Eq UVarInt
Eq UVarInt =>
(UVarInt -> UVarInt -> Ordering)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> Bool)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> Ord UVarInt
UVarInt -> UVarInt -> Bool
UVarInt -> UVarInt -> Ordering
UVarInt -> UVarInt -> UVarInt
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
$ccompare :: UVarInt -> UVarInt -> Ordering
compare :: UVarInt -> UVarInt -> Ordering
$c< :: UVarInt -> UVarInt -> Bool
< :: UVarInt -> UVarInt -> Bool
$c<= :: UVarInt -> UVarInt -> Bool
<= :: UVarInt -> UVarInt -> Bool
$c> :: UVarInt -> UVarInt -> Bool
> :: UVarInt -> UVarInt -> Bool
$c>= :: UVarInt -> UVarInt -> Bool
>= :: UVarInt -> UVarInt -> Bool
$cmax :: UVarInt -> UVarInt -> UVarInt
max :: UVarInt -> UVarInt -> UVarInt
$cmin :: UVarInt -> UVarInt -> UVarInt
min :: UVarInt -> UVarInt -> UVarInt
Ord, Num UVarInt
Ord UVarInt
(Num UVarInt, Ord UVarInt) => (UVarInt -> Rational) -> Real UVarInt
UVarInt -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: UVarInt -> Rational
toRational :: UVarInt -> Rational
Real, Enum UVarInt
Real UVarInt
(Real UVarInt, Enum UVarInt) =>
(UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> UVarInt)
-> (UVarInt -> UVarInt -> (UVarInt, UVarInt))
-> (UVarInt -> UVarInt -> (UVarInt, UVarInt))
-> (UVarInt -> Integer)
-> Integral UVarInt
UVarInt -> Integer
UVarInt -> UVarInt -> (UVarInt, UVarInt)
UVarInt -> UVarInt -> UVarInt
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: UVarInt -> UVarInt -> UVarInt
quot :: UVarInt -> UVarInt -> UVarInt
$crem :: UVarInt -> UVarInt -> UVarInt
rem :: UVarInt -> UVarInt -> UVarInt
$cdiv :: UVarInt -> UVarInt -> UVarInt
div :: UVarInt -> UVarInt -> UVarInt
$cmod :: UVarInt -> UVarInt -> UVarInt
mod :: UVarInt -> UVarInt -> UVarInt
$cquotRem :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
quotRem :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
$cdivMod :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
divMod :: UVarInt -> UVarInt -> (UVarInt, UVarInt)
$ctoInteger :: UVarInt -> Integer
toInteger :: UVarInt -> Integer
Integral, UVarInt
UVarInt -> UVarInt -> Bounded UVarInt
forall a. a -> a -> Bounded a
$cminBound :: UVarInt
minBound :: UVarInt
$cmaxBound :: UVarInt
maxBound :: UVarInt
Bounded, UVarInt -> ()
(UVarInt -> ()) -> NFData UVarInt
forall a. (a -> ()) -> NFData a
$crnf :: UVarInt -> ()
rnf :: UVarInt -> ()
NFData)

instance Serializable UVarInt where
  serialize :: ProtocolRevision -> UVarInt -> Builder
serialize ProtocolRevision
_ = UVarInt -> Builder
forall {t}. (Integral t, Bits t) => t -> Builder
goUVarIntSer
    where
    goUVarIntSer :: t -> Builder
goUVarIntSer t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0x80 = Word8 -> Builder
word8 (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i)
      | Bool
otherwise = Word8 -> Builder
word8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i) Int
7) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> Builder
goUVarIntSer (t
i t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7)
  deserialize :: ProtocolRevision -> Get UVarInt
deserialize ProtocolRevision
_ = Int -> UVarInt -> Get UVarInt
forall {a}. (Bits a, Num a) => Int -> a -> Get a
goUVarIntDeser Int
0 (UVarInt
0 :: UVarInt)
    where
    goUVarIntDeser :: Int -> a -> Get a
goUVarIntDeser Int
i a
o | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = do
      byte <- Get Word8
getWord8
      let o' = a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. ((Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7f) a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i))
      if byte .&. 0x80 == 0 then pure $! o' else goUVarIntDeser (i + 1) $! o'
    goUVarIntDeser Int
_ a
_ = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input exceeds varuint size"
  {-# INLINE deserialize #-}

newtype VarInt = MkVarInt Int64
  deriving newtype (Int -> VarInt -> ShowS
[VarInt] -> ShowS
VarInt -> String
(Int -> VarInt -> ShowS)
-> (VarInt -> String) -> ([VarInt] -> ShowS) -> Show VarInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarInt -> ShowS
showsPrec :: Int -> VarInt -> ShowS
$cshow :: VarInt -> String
show :: VarInt -> String
$cshowList :: [VarInt] -> ShowS
showList :: [VarInt] -> ShowS
Show, VarInt -> VarInt -> Bool
(VarInt -> VarInt -> Bool)
-> (VarInt -> VarInt -> Bool) -> Eq VarInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarInt -> VarInt -> Bool
== :: VarInt -> VarInt -> Bool
$c/= :: VarInt -> VarInt -> Bool
/= :: VarInt -> VarInt -> Bool
Eq, Integer -> VarInt
VarInt -> VarInt
VarInt -> VarInt -> VarInt
(VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt)
-> (VarInt -> VarInt)
-> (VarInt -> VarInt)
-> (Integer -> VarInt)
-> Num VarInt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: VarInt -> VarInt -> VarInt
+ :: VarInt -> VarInt -> VarInt
$c- :: VarInt -> VarInt -> VarInt
- :: VarInt -> VarInt -> VarInt
$c* :: VarInt -> VarInt -> VarInt
* :: VarInt -> VarInt -> VarInt
$cnegate :: VarInt -> VarInt
negate :: VarInt -> VarInt
$cabs :: VarInt -> VarInt
abs :: VarInt -> VarInt
$csignum :: VarInt -> VarInt
signum :: VarInt -> VarInt
$cfromInteger :: Integer -> VarInt
fromInteger :: Integer -> VarInt
Num, Eq VarInt
VarInt
Eq VarInt =>
(VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> VarInt
-> (Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> Bool)
-> (VarInt -> Maybe Int)
-> (VarInt -> Int)
-> (VarInt -> Bool)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int -> VarInt)
-> (VarInt -> Int)
-> Bits VarInt
Int -> VarInt
VarInt -> Bool
VarInt -> Int
VarInt -> Maybe Int
VarInt -> VarInt
VarInt -> Int -> Bool
VarInt -> Int -> VarInt
VarInt -> VarInt -> VarInt
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: VarInt -> VarInt -> VarInt
.&. :: VarInt -> VarInt -> VarInt
$c.|. :: VarInt -> VarInt -> VarInt
.|. :: VarInt -> VarInt -> VarInt
$cxor :: VarInt -> VarInt -> VarInt
xor :: VarInt -> VarInt -> VarInt
$ccomplement :: VarInt -> VarInt
complement :: VarInt -> VarInt
$cshift :: VarInt -> Int -> VarInt
shift :: VarInt -> Int -> VarInt
$crotate :: VarInt -> Int -> VarInt
rotate :: VarInt -> Int -> VarInt
$czeroBits :: VarInt
zeroBits :: VarInt
$cbit :: Int -> VarInt
bit :: Int -> VarInt
$csetBit :: VarInt -> Int -> VarInt
setBit :: VarInt -> Int -> VarInt
$cclearBit :: VarInt -> Int -> VarInt
clearBit :: VarInt -> Int -> VarInt
$ccomplementBit :: VarInt -> Int -> VarInt
complementBit :: VarInt -> Int -> VarInt
$ctestBit :: VarInt -> Int -> Bool
testBit :: VarInt -> Int -> Bool
$cbitSizeMaybe :: VarInt -> Maybe Int
bitSizeMaybe :: VarInt -> Maybe Int
$cbitSize :: VarInt -> Int
bitSize :: VarInt -> Int
$cisSigned :: VarInt -> Bool
isSigned :: VarInt -> Bool
$cshiftL :: VarInt -> Int -> VarInt
shiftL :: VarInt -> Int -> VarInt
$cunsafeShiftL :: VarInt -> Int -> VarInt
unsafeShiftL :: VarInt -> Int -> VarInt
$cshiftR :: VarInt -> Int -> VarInt
shiftR :: VarInt -> Int -> VarInt
$cunsafeShiftR :: VarInt -> Int -> VarInt
unsafeShiftR :: VarInt -> Int -> VarInt
$crotateL :: VarInt -> Int -> VarInt
rotateL :: VarInt -> Int -> VarInt
$crotateR :: VarInt -> Int -> VarInt
rotateR :: VarInt -> Int -> VarInt
$cpopCount :: VarInt -> Int
popCount :: VarInt -> Int
Bits, Int -> VarInt
VarInt -> Int
VarInt -> [VarInt]
VarInt -> VarInt
VarInt -> VarInt -> [VarInt]
VarInt -> VarInt -> VarInt -> [VarInt]
(VarInt -> VarInt)
-> (VarInt -> VarInt)
-> (Int -> VarInt)
-> (VarInt -> Int)
-> (VarInt -> [VarInt])
-> (VarInt -> VarInt -> [VarInt])
-> (VarInt -> VarInt -> [VarInt])
-> (VarInt -> VarInt -> VarInt -> [VarInt])
-> Enum VarInt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: VarInt -> VarInt
succ :: VarInt -> VarInt
$cpred :: VarInt -> VarInt
pred :: VarInt -> VarInt
$ctoEnum :: Int -> VarInt
toEnum :: Int -> VarInt
$cfromEnum :: VarInt -> Int
fromEnum :: VarInt -> Int
$cenumFrom :: VarInt -> [VarInt]
enumFrom :: VarInt -> [VarInt]
$cenumFromThen :: VarInt -> VarInt -> [VarInt]
enumFromThen :: VarInt -> VarInt -> [VarInt]
$cenumFromTo :: VarInt -> VarInt -> [VarInt]
enumFromTo :: VarInt -> VarInt -> [VarInt]
$cenumFromThenTo :: VarInt -> VarInt -> VarInt -> [VarInt]
enumFromThenTo :: VarInt -> VarInt -> VarInt -> [VarInt]
Enum, Eq VarInt
Eq VarInt =>
(VarInt -> VarInt -> Ordering)
-> (VarInt -> VarInt -> Bool)
-> (VarInt -> VarInt -> Bool)
-> (VarInt -> VarInt -> Bool)
-> (VarInt -> VarInt -> Bool)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> Ord VarInt
VarInt -> VarInt -> Bool
VarInt -> VarInt -> Ordering
VarInt -> VarInt -> VarInt
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
$ccompare :: VarInt -> VarInt -> Ordering
compare :: VarInt -> VarInt -> Ordering
$c< :: VarInt -> VarInt -> Bool
< :: VarInt -> VarInt -> Bool
$c<= :: VarInt -> VarInt -> Bool
<= :: VarInt -> VarInt -> Bool
$c> :: VarInt -> VarInt -> Bool
> :: VarInt -> VarInt -> Bool
$c>= :: VarInt -> VarInt -> Bool
>= :: VarInt -> VarInt -> Bool
$cmax :: VarInt -> VarInt -> VarInt
max :: VarInt -> VarInt -> VarInt
$cmin :: VarInt -> VarInt -> VarInt
min :: VarInt -> VarInt -> VarInt
Ord, Num VarInt
Ord VarInt
(Num VarInt, Ord VarInt) => (VarInt -> Rational) -> Real VarInt
VarInt -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: VarInt -> Rational
toRational :: VarInt -> Rational
Real, Enum VarInt
Real VarInt
(Real VarInt, Enum VarInt) =>
(VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> VarInt)
-> (VarInt -> VarInt -> (VarInt, VarInt))
-> (VarInt -> VarInt -> (VarInt, VarInt))
-> (VarInt -> Integer)
-> Integral VarInt
VarInt -> Integer
VarInt -> VarInt -> (VarInt, VarInt)
VarInt -> VarInt -> VarInt
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: VarInt -> VarInt -> VarInt
quot :: VarInt -> VarInt -> VarInt
$crem :: VarInt -> VarInt -> VarInt
rem :: VarInt -> VarInt -> VarInt
$cdiv :: VarInt -> VarInt -> VarInt
div :: VarInt -> VarInt -> VarInt
$cmod :: VarInt -> VarInt -> VarInt
mod :: VarInt -> VarInt -> VarInt
$cquotRem :: VarInt -> VarInt -> (VarInt, VarInt)
quotRem :: VarInt -> VarInt -> (VarInt, VarInt)
$cdivMod :: VarInt -> VarInt -> (VarInt, VarInt)
divMod :: VarInt -> VarInt -> (VarInt, VarInt)
$ctoInteger :: VarInt -> Integer
toInteger :: VarInt -> Integer
Integral, VarInt
VarInt -> VarInt -> Bounded VarInt
forall a. a -> a -> Bounded a
$cminBound :: VarInt
minBound :: VarInt
$cmaxBound :: VarInt
maxBound :: VarInt
Bounded, VarInt -> ()
(VarInt -> ()) -> NFData VarInt
forall a. (a -> ()) -> NFData a
$crnf :: VarInt -> ()
rnf :: VarInt -> ()
NFData)

instance Serializable VarInt where
  serialize :: ProtocolRevision -> VarInt -> Builder
serialize ProtocolRevision
rev (MkVarInt Int64
int64) =
    ProtocolRevision -> UVarInt -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (Word64 -> UVarInt
MkUVarInt (Int64 -> Word64
zigZagEncode Int64
int64))
    where
    zigZagEncode :: Int64 -> Word64
    zigZagEncode :: Int64 -> Word64
zigZagEncode Int64
i = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
`xor` (Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
63))
    {-# INLINE zigZagEncode #-}

  {-# INLINE deserialize #-}
  deserialize :: ProtocolRevision -> Get VarInt
deserialize ProtocolRevision
rev = do
    MkUVarInt u <- ProtocolRevision -> Get UVarInt
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
    pure $! MkVarInt (zigZagDecode u)
    where
    zigZagDecode :: Word64 -> Int64
    zigZagDecode :: Word64 -> Int64
zigZagDecode Word64
u =
      Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
u Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Word64
forall a. Num a => a -> a
negate (Word64
u Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1))
    {-# INLINE zigZagDecode #-}

-- >>> show major <> "." <> show minor <> "." <> show patch
-- "1.0.0"
major, minor, patch :: UVarInt
major :: UVarInt
major = UVarInt
1
minor :: UVarInt
minor = UVarInt
1
patch :: UVarInt
patch = UVarInt
0

newtype ProtocolRevision = MkProtocolRevision UVarInt
  deriving newtype (ProtocolRevision -> ProtocolRevision -> Bool
(ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> Eq ProtocolRevision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolRevision -> ProtocolRevision -> Bool
== :: ProtocolRevision -> ProtocolRevision -> Bool
$c/= :: ProtocolRevision -> ProtocolRevision -> Bool
/= :: ProtocolRevision -> ProtocolRevision -> Bool
Eq, Integer -> ProtocolRevision
ProtocolRevision -> ProtocolRevision
ProtocolRevision -> ProtocolRevision -> ProtocolRevision
(ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision)
-> (Integer -> ProtocolRevision)
-> Num ProtocolRevision
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
+ :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$c- :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
- :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$c* :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
* :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$cnegate :: ProtocolRevision -> ProtocolRevision
negate :: ProtocolRevision -> ProtocolRevision
$cabs :: ProtocolRevision -> ProtocolRevision
abs :: ProtocolRevision -> ProtocolRevision
$csignum :: ProtocolRevision -> ProtocolRevision
signum :: ProtocolRevision -> ProtocolRevision
$cfromInteger :: Integer -> ProtocolRevision
fromInteger :: Integer -> ProtocolRevision
Num, Eq ProtocolRevision
Eq ProtocolRevision =>
(ProtocolRevision -> ProtocolRevision -> Ordering)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> Bool)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> (ProtocolRevision -> ProtocolRevision -> ProtocolRevision)
-> Ord ProtocolRevision
ProtocolRevision -> ProtocolRevision -> Bool
ProtocolRevision -> ProtocolRevision -> Ordering
ProtocolRevision -> ProtocolRevision -> ProtocolRevision
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
$ccompare :: ProtocolRevision -> ProtocolRevision -> Ordering
compare :: ProtocolRevision -> ProtocolRevision -> Ordering
$c< :: ProtocolRevision -> ProtocolRevision -> Bool
< :: ProtocolRevision -> ProtocolRevision -> Bool
$c<= :: ProtocolRevision -> ProtocolRevision -> Bool
<= :: ProtocolRevision -> ProtocolRevision -> Bool
$c> :: ProtocolRevision -> ProtocolRevision -> Bool
> :: ProtocolRevision -> ProtocolRevision -> Bool
$c>= :: ProtocolRevision -> ProtocolRevision -> Bool
>= :: ProtocolRevision -> ProtocolRevision -> Bool
$cmax :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
max :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
$cmin :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
min :: ProtocolRevision -> ProtocolRevision -> ProtocolRevision
Ord, ProtocolRevision -> Get ProtocolRevision
ProtocolRevision -> ProtocolRevision -> Builder
(ProtocolRevision -> ProtocolRevision -> Builder)
-> (ProtocolRevision -> Get ProtocolRevision)
-> Serializable ProtocolRevision
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> ProtocolRevision -> Builder
serialize :: ProtocolRevision -> ProtocolRevision -> Builder
$cdeserialize :: ProtocolRevision -> Get ProtocolRevision
deserialize :: ProtocolRevision -> Get ProtocolRevision
Serializable)

mkRev :: forall nat . KnownNat nat => ProtocolRevision
mkRev :: forall (nat :: Nat). KnownNat nat => ProtocolRevision
mkRev = (Integer -> ProtocolRevision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ProtocolRevision)
-> (Proxy nat -> Integer) -> Proxy nat -> ProtocolRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy nat -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @nat)


-- ** Versioning

{- |
Protocol implementation part for backward compatilibity formalization

NB:

  Be carefull with `BeforeRevision` value.

  If **chosen protocol** revision would be >= **revisionNumber**
  then you would get an exception during serialization.

  To avoid this:

  1. On client side - provide `AfterRevision` with some empty value
  2. On proxy side - provide server-to-server packets mapping with fallbacks on revision upgrade

-}
data Revisioned (revisionNumber :: Nat) b a = BeforeRevision b | AfterRevision a

type SinceRevision after rev = Revisioned rev () after

instance
  (KnownNat revision, Serializable before, Serializable after)
  =>
  Serializable (Revisioned revision before after)
  where
  serialize :: ProtocolRevision -> Revisioned revision before after -> Builder
serialize ProtocolRevision
rev Revisioned revision before after
sinceRevVal =
    if ProtocolRevision
rev ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
< forall (nat :: Nat). KnownNat nat => ProtocolRevision
mkRev @revision
    then Builder
forall a. Monoid a => a
mempty
    else case Revisioned revision before after
sinceRevVal of
      BeforeRevision before
_b -> String -> Builder
forall a. HasCallStack => String -> a
error String
"Protocol-specific implementation error" -- Watch `Revisioned` note
      AfterRevision after
a -> ProtocolRevision -> after -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev after
a
  deserialize :: ProtocolRevision -> Get (Revisioned revision before after)
deserialize ProtocolRevision
rev =
    if ProtocolRevision
rev ProtocolRevision -> ProtocolRevision -> Bool
forall a. Ord a => a -> a -> Bool
< forall (nat :: Nat). KnownNat nat => ProtocolRevision
mkRev @revision
    then before -> Revisioned revision before after
forall (revisionNumber :: Nat) b a.
b -> Revisioned revisionNumber b a
BeforeRevision (before -> Revisioned revision before after)
-> Get before -> Get (Revisioned revision before after)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @before ProtocolRevision
rev
    else after -> Revisioned revision before after
forall (revisionNumber :: Nat) b a.
a -> Revisioned revisionNumber b a
AfterRevision (after -> Revisioned revision before after)
-> Get after -> Get (Revisioned revision before after)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @after ProtocolRevision
rev


{-
  Slightly modified C++ sources:
  https://github.com/ClickHouse/ClickHouse/blob/eb4a74d7412a1fcf52727cd8b00b365d6b9ed86c/src/Core/ProtocolDefines.h#L6
-}
type DBMS_TCP_PROTOCOL_VERSION = DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS;

type DBMS_MIN_REVISION_WITH_CLIENT_INFO = 54032;
type DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE = 54058;
type DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO = 54060;
type DBMS_MIN_REVISION_WITH_TABLES_STATUS = 54226;
type DBMS_MIN_REVISION_WITH_TIME_ZONE_PARAMETER_IN_DATETIME_DATA_TYPE = 54337;
type DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME = 54372;
type DBMS_MIN_REVISION_WITH_VERSION_PATCH = 54401;
type DBMS_MIN_REVISION_WITH_SERVER_LOGS = 54406;
type DBMS_MIN_REVISION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 54448;
type DBMS_MIN_MAJOR_VERSION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 21;
type DBMS_MIN_MINOR_VERSION_WITH_CURRENT_AGGREGATION_VARIANT_SELECTION_METHOD = 4;
type DBMS_MIN_REVISION_WITH_COLUMN_DEFAULTS_METADATA = 54410;
type DBMS_MIN_REVISION_WITH_LOW_CARDINALITY_TYPE = 54405;
type DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO = 54420;
type DBMS_MIN_REVISION_WITH_SETTINGS_SERIALIZED_AS_STRINGS = 54429;
type DBMS_MIN_REVISION_WITH_SCALARS = 54429;
type DBMS_MIN_REVISION_WITH_OPENTELEMETRY = 54442;
type DBMS_MIN_REVISION_WITH_AGGREGATE_FUNCTIONS_VERSIONING = 54452;
type DBMS_CLUSTER_INITIAL_PROCESSING_PROTOCOL_VERSION = 1;
type DBMS_CLUSTER_PROCESSING_PROTOCOL_VERSION_WITH_DATA_LAKE_METADATA = 2;
type DBMS_CLUSTER_PROCESSING_PROTOCOL_VERSION = 2;
type DATA_LAKE_TABLE_STATE_SNAPSHOT_PROTOCOL_VERSION = 1;
type DBMS_MIN_SUPPORTED_PARALLEL_REPLICAS_PROTOCOL_VERSION = 3;
type DBMS_PARALLEL_REPLICAS_MIN_VERSION_WITH_MARK_SEGMENT_SIZE_FIELD = 4;
type DBMS_PARALLEL_REPLICAS_MIN_VERSION_WITH_PROJECTION = 5;
type DBMS_PARALLEL_REPLICAS_PROTOCOL_VERSION = 5;
type DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS = 54453;
type DBMS_MIN_REVISION_WITH_QUERY_AND_LINE_NUMBERS = 54475;
type DBMS_MERGE_TREE_PART_INFO_VERSION = 1;
type DBMS_QUERY_PLAN_SERIALIZATION_VERSION = 0;
type DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET = 54441;
type DBMS_MIN_REVISION_WITH_X_FORWARDED_FOR_IN_CLIENT_INFO = 54443;
type DBMS_MIN_REVISION_WITH_REFERER_IN_CLIENT_INFO = 54447;
type DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH = 54448;
type DBMS_MIN_PROTOCOL_VERSION_WITH_INCREMENTAL_PROFILE_EVENTS = 54451;
type DBMS_MIN_REVISION_WITH_CUSTOM_SERIALIZATION = 54454;
type DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME = 54449;
type DBMS_MIN_PROTOCOL_VERSION_WITH_PROFILE_EVENTS_IN_INSERT = 54456;
type DBMS_MIN_PROTOCOL_VERSION_WITH_VIEW_IF_PERMITTED = 54457;
type DBMS_MIN_PROTOCOL_VERSION_WITH_ADDENDUM = 54458;
type DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY = 54458;
type DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS = 54459;
type DBMS_MIN_PROTOCOL_VERSION_WITH_SERVER_QUERY_TIME_IN_PROGRESS = 54460;
type DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES = 54461;
type DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2 = 54462;
type DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS = 54463;
type DBMS_MIN_PROTOCOL_VERSION_WITH_TIMEZONE_UPDATES = 54464;
type DBMS_MIN_REVISION_WITH_SPARSE_SERIALIZATION = 54465; -- ToDo
type DBMS_MIN_REVISION_WITH_SSH_AUTHENTICATION = 54466;
type DBMS_MIN_REVISION_WITH_TABLE_READ_ONLY_CHECK = 54467;
type DBMS_MIN_REVISION_WITH_SYSTEM_KEYWORDS_TABLE = 54468;
type DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION = 54469;
type DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS = 54470;
type DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL = 54471;
type DBMS_MIN_PROTOCOL_VERSION_WITH_INTERSERVER_EXTERNALLY_GRANTED_ROLES = 54472;
type DBMS_MIN_REVISION_WITH_V2_DYNAMIC_AND_JSON_SERIALIZATION = 54473;
type DBMS_MIN_REVISION_WITH_SERVER_SETTINGS = 54474;
type DBMS_MIN_REVISON_WITH_JWT_IN_INTERSERVER = 54476;
type DBMS_MIN_REVISION_WITH_QUERY_PLAN_SERIALIZATION = 54477;
type DBMS_MIN_REVISON_WITH_PARALLEL_BLOCK_MARSHALLING = 54478;
type DBMS_MIN_REVISION_WITH_VERSIONED_CLUSTER_FUNCTION_PROTOCOL = 54479;
type DBMS_MIN_REVISION_WITH_OUT_OF_ORDER_BUCKETS_IN_AGGREGATION = 54480;
type DBMS_MIN_REVISION_WITH_COMPRESSED_LOGS_PROFILE_EVENTS_COLUMNS = 54481;