module Botan.Version
( botanFFIAPIVersion
, botanFFISupportsAPI
, botanVersionText
, botanVersionMajor
, botanVersionMinor
, botanVersionPatch
, botanVersionDatestamp
) where

import System.IO.Unsafe

import qualified Botan.Low.Version as Low

import qualified Data.Text.Encoding as Text

import Botan.Prelude

-- https://botan.randombit.net/handbook/api_ref/ffi.html#versioning

-- | Returns the version of the currently supported FFI API. This is expressed in the form YYYYMMDD of the release date of this version of the API.
botanFFIAPIVersion :: Int
botanFFIAPIVersion :: Int
botanFFIAPIVersion = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO IO Int
Low.botanFFIAPIVersion

-- | Returns 0 iff the FFI version specified is supported by this library. Otherwise returns -1. The expression botan_ffi_supports_api(botan_ffi_api_version()) will always evaluate to 0. A particular version of the library may also support other (older) versions of the FFI API.
botanFFISupportsAPI :: Int -> Bool
botanFFISupportsAPI :: Int -> Bool
botanFFISupportsAPI Int
version = IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> IO Bool
Low.botanFFISupportsAPI Int
version

-- | Returns a free-form string describing the version. The return value is a statically allocated string.
botanVersionText :: Text
botanVersionText :: Text
botanVersionText = IO Text -> Text
forall a. IO a -> a
unsafeDupablePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ (ByteString -> Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Text.decodeUtf8 IO ByteString
Low.botanVersionString

-- | Returns the major version of the library
botanVersionMajor :: Int
botanVersionMajor :: Int
botanVersionMajor = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO IO Int
Low.botanVersionMajor

-- | Returns the minor version of the library
botanVersionMinor :: Int
botanVersionMinor :: Int
botanVersionMinor = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO IO Int
Low.botanVersionMinor

-- | Returns the patch version of the library
botanVersionPatch :: Int
botanVersionPatch :: Int
botanVersionPatch = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO IO Int
Low.botanVersionPatch

-- | Returns the date this version was released as an integer YYYYMMDD, or 0 if an unreleased version
botanVersionDatestamp :: Int
botanVersionDatestamp :: Int
botanVersionDatestamp = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO IO Int
Low.botanVersionDatestamp