{-|
Module      : Database.PostgreSQL.Replicant.Types.Lsn
Description : Types and parsers for LSNs
Copyright   : (c) James King, 2020, 2021
License     : BSD3
Maintainer  : james@agentultra.com
Stability   : experimental
Portability : POSIX

/Log Sequence Number/ or LSN is a pointer to a place inside of a WAL
log file.  It contains the file name and an offset in bytes encoded in
two parts.

LSNs can be serialized into 64-bit big-endian numbers in the binary
protocol but are also represented textually in query results and other
places.

This module follows a similar convention to many containers libraries
and should probably be imported qualified to avoid name clashes if
needed.

See: https://www.postgresql.org/docs/10/datatype-pg-lsn.html
-}
module Database.PostgreSQL.Replicant.Types.Lsn where

import Data.Aeson
import Data.Attoparsec.ByteString.Char8
import Data.Bits
import Data.Bits.Extras
import Data.ByteString (ByteString ())
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Builder as Builder
import Data.ByteString.Lazy.Builder.ASCII (word32Hex)
import Data.Serialize
import Data.Word
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GHC.Int

data LSN = LSN
  { LSN -> Int32
filepart :: !Int32 -- ^ Filepart
  , LSN -> Int32
offset :: !Int32 -- ^ Offset
  }
  deriving (Int -> LSN -> ShowS
[LSN] -> ShowS
LSN -> String
(Int -> LSN -> ShowS)
-> (LSN -> String) -> ([LSN] -> ShowS) -> Show LSN
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LSN] -> ShowS
$cshowList :: [LSN] -> ShowS
show :: LSN -> String
$cshow :: LSN -> String
showsPrec :: Int -> LSN -> ShowS
$cshowsPrec :: Int -> LSN -> ShowS
Show, LSN -> LSN -> Bool
(LSN -> LSN -> Bool) -> (LSN -> LSN -> Bool) -> Eq LSN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LSN -> LSN -> Bool
$c/= :: LSN -> LSN -> Bool
== :: LSN -> LSN -> Bool
$c== :: LSN -> LSN -> Bool
Eq)

instance Ord LSN where
  compare :: LSN -> LSN -> Ordering
compare (LSN Int32
l0 Int32
r0) (LSN Int32
l1 Int32
r1) =
    Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int32
l0 Int32
l1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int32
r0 Int32
r1

instance Serialize LSN where
  put :: Putter LSN
put = Putter Int64
putInt64be Putter Int64 -> (LSN -> Int64) -> Putter LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> Int64
toInt64
  get :: Get LSN
get = Int64 -> LSN
fromInt64 (Int64 -> LSN) -> Get Int64 -> Get LSN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be

instance ToJSON LSN where
  toJSON :: LSN -> Value
toJSON = Text -> Value
String (Text -> Value) -> (LSN -> Text) -> LSN -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toUpper (Text -> Text) -> (LSN -> Text) -> LSN -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (LSN -> ByteString) -> LSN -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> ByteString
toByteString

instance FromJSON LSN where
  parseJSON :: Value -> Parser LSN
parseJSON = String -> (Text -> Parser LSN) -> Value -> Parser LSN
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LSN" ((Text -> Parser LSN) -> Value -> Parser LSN)
-> (Text -> Parser LSN) -> Value -> Parser LSN
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
    case ByteString -> Either String LSN
fromByteString (ByteString -> Either String LSN)
-> (Text -> ByteString) -> Text -> Either String LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> Either String LSN) -> Text -> Either String LSN
forall a b. (a -> b) -> a -> b
$ Text
txt of
      Left String
err  -> String -> Parser LSN
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
      Right LSN
lsn -> LSN -> Parser LSN
forall (f :: * -> *) a. Applicative f => a -> f a
pure LSN
lsn

-- | Convert an LSN to a 64-bit integer
toInt64 :: LSN -> Int64
toInt64 :: LSN -> Int64
toInt64 (LSN Int32
filePart Int32
offSet) =
  let r :: Word64
r = Int32 -> Word64
forall a. Integral a => a -> Word64
w64 Int32
filePart Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32
  in Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ Word64
r Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
offSet

-- | Convert a 64-bit integer to an LSN
fromInt64 :: Int64 -> LSN
fromInt64 :: Int64 -> LSN
fromInt64 Int64
x =
  let mask :: Word64
mask = Word32 -> Word64
forall a. Integral a => a -> Word64
w64 (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Bounded Word32 => Word32
forall a. Bounded a => a
maxBound @Word32
      offSet :: Int32
offSet = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> (Word64 -> Word32) -> Word64 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word32
forall a. Integral a => a -> Word32
w32 (Word64 -> Int32) -> Word64 -> Int32
forall a b. (a -> b) -> a -> b
$ Word64
mask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x
      filePart :: Int32
filePart = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int32) -> Int64 -> Int32
forall a b. (a -> b) -> a -> b
$ Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32
  in Int32 -> Int32 -> LSN
LSN Int32
filePart Int32
offSet

lsnParser :: Parser LSN
lsnParser :: Parser LSN
lsnParser = Int32 -> Int32 -> LSN
LSN (Int32 -> Int32 -> LSN)
-> Parser ByteString Int32 -> Parser ByteString (Int32 -> LSN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Int32
forall a. (Integral a, Bits a) => Parser a
hexadecimal Parser ByteString Int32
-> Parser ByteString Char -> Parser ByteString Int32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
'/') Parser ByteString (Int32 -> LSN)
-> Parser ByteString Int32 -> Parser LSN
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int32
forall a. (Integral a, Bits a) => Parser a
hexadecimal

fromByteString :: ByteString -> Either String LSN
fromByteString :: ByteString -> Either String LSN
fromByteString = Parser LSN -> ByteString -> Either String LSN
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser LSN
lsnParser

-- | Note that as of bytestring ~0.10.12.0 we don't have upper-case
-- hex encoders but the patch to add them has been merged and when
-- available we should switch to them
toByteString :: LSN -> ByteString
toByteString :: LSN -> ByteString
toByteString (LSN Int32
filepart Int32
off) = ByteString -> ByteString
BL.toStrict
  (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
  ( Word32 -> Builder
word32Hex (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
filepart)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char7 Char
'/'
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Hex (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
off)
  )

-- | Add a number of bytes to an LSN
add :: LSN -> Int64 -> LSN
add :: LSN -> Int64 -> LSN
add LSN
lsn Int64
bytes = Int64 -> LSN
fromInt64 (Int64 -> LSN) -> (LSN -> Int64) -> LSN -> LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
bytes) (Int64 -> Int64) -> (LSN -> Int64) -> LSN -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> Int64
toInt64 (LSN -> LSN) -> LSN -> LSN
forall a b. (a -> b) -> a -> b
$ LSN
lsn

-- | Subtract a number of bytes from an LSN
sub :: LSN -> Int64 -> LSN
sub :: LSN -> Int64 -> LSN
sub LSN
lsn Int64
bytes = Int64 -> LSN
fromInt64 (Int64 -> LSN) -> (LSN -> Int64) -> LSN -> LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64) -> Int64 -> Int64 -> Int64
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) Int64
bytes (Int64 -> Int64) -> (LSN -> Int64) -> LSN -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> Int64
toInt64 (LSN -> LSN) -> LSN -> LSN
forall a b. (a -> b) -> a -> b
$ LSN
lsn

-- | Subtract two LSN's to calculate the difference of bytes between
-- them.
subLsn :: LSN -> LSN -> Int64
subLsn :: LSN -> LSN -> Int64
subLsn LSN
lsn1 LSN
lsn2 = LSN -> Int64
toInt64 LSN
lsn1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- LSN -> Int64
toInt64 LSN
lsn2