{-|
Module      : Mdbx.Types
Copyright   : (c) 2021 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Types used by the library. Mainly re exports the types generated by c2hs in the
FFI module, while it also adds some types used by the high level interface.
-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Mdbx.Types (
  -- * Re-exported from FFI
  MdbxEnv,
  MdbxTxn,
  MdbxDbi,
  MdbxVal(..),
  MdbxEnvMode(..),
  MdbxEnvFlags(..),
  MdbxTxnFlags(..),
  MdbxDbFlags(..),
  MdbxPutFlags(..),
  MdbxCursorOp(..),
  -- * High level interface
  MdbxEnvGeometry(..),
  MdbxItem(..),
  -- * Helper types
  NullByteString(..),
  NullText(..)
) where

import Data.ByteString (ByteString, packCStringLen, useAsCStringLen)
import Data.ByteString.Short (ShortByteString)
import Data.Default
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text.Foreign (fromPtr, useAsPtr)
import Foreign.Ptr (castPtr)

import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Short as BSH
import qualified Data.Text as T

import Mdbx.FFI

{-|
Geometry of the database. The most important parameter is the maximum size, that
defaults to 1024Mb. All other values default to -1, meaning the current value
will be kept.
-}
data MdbxEnvGeometry = MdbxEnvGeometry {
  -- | Minimum DB size in bytes.
  MdbxEnvGeometry -> Int
envSizeMin :: Int,
  -- | Current DB size in bytes.
  MdbxEnvGeometry -> Int
envSizeNow :: Int,
  -- | Maximum DB size in bytes.
  MdbxEnvGeometry -> Int
envSizeMax :: Int,
  {-|
  Step growth size of the database in bytes. Must be greater than zero to allow
  for growth.
  -}
  MdbxEnvGeometry -> Int
envGrowthStep :: Int,
  {-|
  Step shrink size of the database in bytes. Must be greater than zero to allow
  for shrinkage and lower than envGrowthStep to avoid immediate shrinking after
  growth.
  -}
  MdbxEnvGeometry -> Int
envShrinkThreshold :: Int,
  {-|
  Page size of the database in bytes. In general it should not be changed after
  the database was created.
  -}
  MdbxEnvGeometry -> Int
envPageSize :: Int
} deriving (MdbxEnvGeometry -> MdbxEnvGeometry -> Bool
(MdbxEnvGeometry -> MdbxEnvGeometry -> Bool)
-> (MdbxEnvGeometry -> MdbxEnvGeometry -> Bool)
-> Eq MdbxEnvGeometry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MdbxEnvGeometry -> MdbxEnvGeometry -> Bool
$c/= :: MdbxEnvGeometry -> MdbxEnvGeometry -> Bool
== :: MdbxEnvGeometry -> MdbxEnvGeometry -> Bool
$c== :: MdbxEnvGeometry -> MdbxEnvGeometry -> Bool
Eq, Int -> MdbxEnvGeometry -> ShowS
[MdbxEnvGeometry] -> ShowS
MdbxEnvGeometry -> String
(Int -> MdbxEnvGeometry -> ShowS)
-> (MdbxEnvGeometry -> String)
-> ([MdbxEnvGeometry] -> ShowS)
-> Show MdbxEnvGeometry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MdbxEnvGeometry] -> ShowS
$cshowList :: [MdbxEnvGeometry] -> ShowS
show :: MdbxEnvGeometry -> String
$cshow :: MdbxEnvGeometry -> String
showsPrec :: Int -> MdbxEnvGeometry -> ShowS
$cshowsPrec :: Int -> MdbxEnvGeometry -> ShowS
Show)

instance Default MdbxEnvGeometry where
  def :: MdbxEnvGeometry
def = MdbxEnvGeometry :: Int -> Int -> Int -> Int -> Int -> Int -> MdbxEnvGeometry
MdbxEnvGeometry {
    envSizeMin :: Int
envSizeMin = -Int
1,
    envSizeNow :: Int
envSizeNow = -Int
1,
    envSizeMax :: Int
envSizeMax = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024,
    envGrowthStep :: Int
envGrowthStep = -Int
1,
    envShrinkThreshold :: Int
envShrinkThreshold = -Int
1,
    envPageSize :: Int
envPageSize = -Int
1
  }

{-|
Converts an instance to/from the representation needed by libmdbx. This type is
used for both keys and values. The fields on the type must be strict, otherwise
unexpected crashes due to lazy IO delaying low level memory access may happen.

Only 'ByteString', 'Text' instances are provided, since they are commonly used
as the key when storing/retrieving a value.

For your own types, in general, you will want to use a serialization library
such as <https://hackage.haskell.org/package/binary binary>, and apply the
newtype deriving via trick.

'Mdbx.Binary.MdbxItemBinary' is provided to simplify using 'Data.Store.Binary'
instances as keys or values with libmdbx, while 'Mdbx.Store.MdbxItemStore'
provides the same functionality for 'Data.Store.Store' instances. With those
helpers, creating custom types compatible with libmdbx is easy:

@
data User = User {
  _username :: !Text,
  _password :: !Text
} deriving (Eq, Show, Generic, Store)

deriving via (MdbxItemBinary User) instance MdbxItem User
@

__Note 1:__ if you plan on using a custom type as the key, be careful if it
contains 'Text' or 'ByteString' instances, since these types have a length field
which is serialized before the data. This causes issues when using libmdbx,
since it depends on key ordering and the length field will make shorter
instances lower than longer ones, even if the content indicates the opposite.
You can use the provided 'NullByteString' or 'NullText' types if your data type
is an instance of 'Data.Binary.Binary' or 'Data.Store.Store'. Otherwise, it is
simpler to use 'Text' or 'ByteString' as the key.

__Note 2:__ If your key type contains Word16 or longer fields, you should make
it an instance of 'Data.Binary.Binary', not 'Data.Store.Store', since Store uses
platform dependent endianess and this affects libmdbx's comparison functions.
Given Binary uses network order (big endian) for encoding, the comparison
functions will work as expected. Failing to do this may cause unexpected issues
when retrieving data, in particular when using cursors.

__Note 3:__ The behavior when using signed integers or floating point numbers as
part of the key is undefined. To be able to use these types in the key, you
should store them as a Word of the appropriate size and convert them with the
conversion functions included in `Module.API`.
-}
class MdbxItem i where
  {-|
  Converts a block of memory provided by libmdbx to a user data type. There are
  no guarantees provided by the library that the block of memory matches the
  expected type; a crash can happen when trying to deserialize an incorrect
  type.
  -}
  fromMdbxVal :: MdbxVal -> IO i
  {-|
  Converts a user data type to a block of memory.
  -}
  toMdbxVal :: i -> (MdbxVal -> IO b) -> IO b

instance MdbxItem Text where
  fromMdbxVal :: MdbxVal -> IO Text
fromMdbxVal (MdbxVal CULong
sz Ptr ()
ptr) =
    Ptr Word16 -> I16 -> IO Text
fromPtr (Ptr () -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr) (CULong -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
sz I16 -> I16 -> I16
forall a. Integral a => a -> a -> a
`div` I16
2)

  toMdbxVal :: Text -> (MdbxVal -> IO b) -> IO b
toMdbxVal Text
val MdbxVal -> IO b
fn = Text -> (Ptr Word16 -> I16 -> IO b) -> IO b
forall a. Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
useAsPtr Text
val ((Ptr Word16 -> I16 -> IO b) -> IO b)
-> (Ptr Word16 -> I16 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ptr I16
size ->
    MdbxVal -> IO b
fn (MdbxVal -> IO b) -> MdbxVal -> IO b
forall a b. (a -> b) -> a -> b
$ CULong -> Ptr () -> MdbxVal
MdbxVal (I16 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
size CULong -> CULong -> CULong
forall a. Num a => a -> a -> a
* CULong
2) (Ptr Word16 -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
ptr)

instance MdbxItem ByteString where
  fromMdbxVal :: MdbxVal -> IO ByteString
fromMdbxVal (MdbxVal CULong
sz Ptr ()
ptr) =
    CStringLen -> IO ByteString
packCStringLen (Ptr () -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr, CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
sz)

  toMdbxVal :: ByteString -> (MdbxVal -> IO b) -> IO b
toMdbxVal ByteString
val MdbxVal -> IO b
fn = ByteString -> (CStringLen -> IO b) -> IO b
forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen ByteString
val ((CStringLen -> IO b) -> IO b) -> (CStringLen -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
size) ->
    MdbxVal -> IO b
fn (MdbxVal -> IO b) -> MdbxVal -> IO b
forall a b. (a -> b) -> a -> b
$ CULong -> Ptr () -> MdbxVal
MdbxVal (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr)

{-|
Newtype wrapping a 'ByteString' that provides a 'Data.Binary.Binary' instance
using NULL terminated C strings, which allows for using them as part of a custom
data type representing a key.

This is not possible with regular 'ByteString' and 'Text' instances since their
'Data.Binary.Binary' instances are serialized with the size field first. Given
that libmdbx compares keys as an unstructured sequence of bytes, this can cause
issues since longer strings are considered greater than shorter ones, even if
their content indicates otherwise.
-}
newtype NullByteString = NullByteString {
  NullByteString -> ShortByteString
unNullByteString :: ShortByteString
} deriving newtype (NullByteString -> NullByteString -> Bool
(NullByteString -> NullByteString -> Bool)
-> (NullByteString -> NullByteString -> Bool) -> Eq NullByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NullByteString -> NullByteString -> Bool
$c/= :: NullByteString -> NullByteString -> Bool
== :: NullByteString -> NullByteString -> Bool
$c== :: NullByteString -> NullByteString -> Bool
Eq, Eq NullByteString
Eq NullByteString
-> (NullByteString -> NullByteString -> Ordering)
-> (NullByteString -> NullByteString -> Bool)
-> (NullByteString -> NullByteString -> Bool)
-> (NullByteString -> NullByteString -> Bool)
-> (NullByteString -> NullByteString -> Bool)
-> (NullByteString -> NullByteString -> NullByteString)
-> (NullByteString -> NullByteString -> NullByteString)
-> Ord NullByteString
NullByteString -> NullByteString -> Bool
NullByteString -> NullByteString -> Ordering
NullByteString -> NullByteString -> NullByteString
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
min :: NullByteString -> NullByteString -> NullByteString
$cmin :: NullByteString -> NullByteString -> NullByteString
max :: NullByteString -> NullByteString -> NullByteString
$cmax :: NullByteString -> NullByteString -> NullByteString
>= :: NullByteString -> NullByteString -> Bool
$c>= :: NullByteString -> NullByteString -> Bool
> :: NullByteString -> NullByteString -> Bool
$c> :: NullByteString -> NullByteString -> Bool
<= :: NullByteString -> NullByteString -> Bool
$c<= :: NullByteString -> NullByteString -> Bool
< :: NullByteString -> NullByteString -> Bool
$c< :: NullByteString -> NullByteString -> Bool
compare :: NullByteString -> NullByteString -> Ordering
$ccompare :: NullByteString -> NullByteString -> Ordering
$cp1Ord :: Eq NullByteString
Ord)

instance Show NullByteString where
  show :: NullByteString -> String
show (NullByteString ShortByteString
nbs) = ByteString -> String
BC.unpack (ShortByteString -> ByteString
BSH.fromShort ShortByteString
nbs)

instance IsString NullByteString where
  fromString :: String -> NullByteString
fromString = ShortByteString -> NullByteString
NullByteString (ShortByteString -> NullByteString)
-> (String -> ShortByteString) -> String -> NullByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
BSH.toShort (ByteString -> ShortByteString)
-> (String -> ByteString) -> String -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack

{-|
Newtype wrapping a 'Text' that provides a 'Data.Binary.Binary' instance using
NULL terminated C strings, which allows for using them as part of a custom data
type representing a key.

Check 'NullByteString' for the rationale.
-}
newtype NullText = NullText {
  NullText -> Text
unNullText :: Text
} deriving newtype (NullText -> NullText -> Bool
(NullText -> NullText -> Bool)
-> (NullText -> NullText -> Bool) -> Eq NullText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NullText -> NullText -> Bool
$c/= :: NullText -> NullText -> Bool
== :: NullText -> NullText -> Bool
$c== :: NullText -> NullText -> Bool
Eq, Eq NullText
Eq NullText
-> (NullText -> NullText -> Ordering)
-> (NullText -> NullText -> Bool)
-> (NullText -> NullText -> Bool)
-> (NullText -> NullText -> Bool)
-> (NullText -> NullText -> Bool)
-> (NullText -> NullText -> NullText)
-> (NullText -> NullText -> NullText)
-> Ord NullText
NullText -> NullText -> Bool
NullText -> NullText -> Ordering
NullText -> NullText -> NullText
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
min :: NullText -> NullText -> NullText
$cmin :: NullText -> NullText -> NullText
max :: NullText -> NullText -> NullText
$cmax :: NullText -> NullText -> NullText
>= :: NullText -> NullText -> Bool
$c>= :: NullText -> NullText -> Bool
> :: NullText -> NullText -> Bool
$c> :: NullText -> NullText -> Bool
<= :: NullText -> NullText -> Bool
$c<= :: NullText -> NullText -> Bool
< :: NullText -> NullText -> Bool
$c< :: NullText -> NullText -> Bool
compare :: NullText -> NullText -> Ordering
$ccompare :: NullText -> NullText -> Ordering
$cp1Ord :: Eq NullText
Ord)

instance Show NullText where
  show :: NullText -> String
show (NullText Text
nts) = Text -> String
T.unpack Text
nts

instance IsString NullText where
  fromString :: String -> NullText
fromString = Text -> NullText
NullText (Text -> NullText) -> (String -> Text) -> String -> NullText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack