{-|
Module      : Botan.Low.Version
Description : Botan version info
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX
-}

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

import Data.Bool

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe as ByteString

import qualified Data.Text as Text
import qualified Data.Text.Foreign as Text

import System.IO.Unsafe

import Botan.Bindings.Version

import Botan.Low.Prelude
import Botan.Low.Error (throwBotanCatchingSuccess)
import GHC.Generics ((:.:)(unComp1))

-- 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 :: IO Int
botanFFIAPIVersion :: IO Int
botanFFIAPIVersion = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word32
botan_ffi_api_version

-- | 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 -> IO Bool
botanFFISupportsAPI :: Int -> IO Bool
botanFFISupportsAPI Int
version = do
    CInt
supports <- Word32 -> IO CInt
botan_ffi_supports_api (Word32 -> IO CInt) -> Word32 -> IO CInt
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
version
    case CInt
supports of
        CInt
0 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        CInt
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
-- TODO: botanFFISupportsAPI = throwBotanCatchingSuccess . botan_ffi_supports_api . fromIntegral
--      AFTER renaming current throwBotanCatchingSuccess to throwBotanCatchingInvalidIdentifier

botanVersionString :: IO ByteString
botanVersionString :: IO ByteString
botanVersionString = IO (ConstPtr CChar)
botan_version_string IO (ConstPtr CChar)
-> (ConstPtr CChar -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ByteString
peekCString (CString -> IO ByteString)
-> (ConstPtr CChar -> CString) -> ConstPtr CChar -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstPtr CChar -> CString
forall a. ConstPtr a -> Ptr a
unConstPtr

-- | Returns the major version of the library
botanVersionMajor :: IO Int
botanVersionMajor :: IO Int
botanVersionMajor = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word32
botan_version_major

-- | Returns the minor version of the library
botanVersionMinor :: IO Int
botanVersionMinor :: IO Int
botanVersionMinor = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word32
botan_version_minor

-- | Returns the patch version of the library
botanVersionPatch :: IO Int
botanVersionPatch :: IO Int
botanVersionPatch = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word32
botan_version_patch

-- | Returns the date this version was released as an integer YYYYMMDD, or 0 if an unreleased version
botanVersionDatestamp :: IO Int
botanVersionDatestamp :: IO Int
botanVersionDatestamp = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word32
botan_version_datestamp