Utility.hs

{-|
Module      : Botan.Low.Utility
Description : Utility functions
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX

This module is based on the [Utility
Functions](https://botan.randombit.net/handbook/api_ref/ffi.html#utility-functions)
section of the C Botan FFI documentation.
-}

module Botan.Low.Utility (
    constantTimeCompare
  , scrubMem
  , HexEncodingFlags(..)
  , hexEncode
  , hexDecode
  , base64Encode
  , base64Decode
  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.Error
import           Botan.Bindings.Utility
import           Botan.Low.Error.Internal
import           Botan.Low.Internal.ByteString
import           Botan.Low.Make
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.Text (Text)
import qualified Data.Text.Encoding as Text
import           Data.Word
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable

-- | Returns 0 if x[0..len] == y[0..len], -1 otherwise.
constantTimeCompare ::
     ByteString   -- ^ __x__
  -> ByteString   -- ^ __y__
  -> Int          -- ^ __len__
  -> IO Bool
constantTimeCompare x y len =
    asBytesLen x $ \ xPtr _xlen ->
    asBytesLen y $ \ yPtr _ylen -> do
      result <- botan_constant_time_compare
        (ConstPtr xPtr)
        (ConstPtr yPtr)
        (fromIntegral len)
      case result of
        0 -> return True
        _ -> return False

scrubMem ::
     Ptr a    -- ^ __mem__
  -> Int      -- ^ __bytes__
  -> IO ()
scrubMem ptr sz = throwBotanIfNegative_ $ botan_scrub_mem (castPtr ptr) (fromIntegral sz)

data HexEncodingFlags =
    HexUpperCase
  | HexLowerCase

hexEncodingFlags :: HexEncodingFlags -> Word32
hexEncodingFlags HexUpperCase = BOTAN_FFI_HEX_UPPER_CASE
hexEncodingFlags HexLowerCase = BOTAN_FFI_HEX_LOWER_CASE

hexEncode ::
     ByteString           -- ^ __x__
  -> HexEncodingFlags     -- ^ __flags__
  -> IO Text              -- ^ __y__
hexEncode bytes flags =
    fmap Text.decodeUtf8 $
    asBytesLen bytes $ \ bytesPtr bytesLen ->
    allocBytes (fromIntegral $ 2 * bytesLen) $ \ hexPtr ->
    throwBotanIfNegative_ $ botan_hex_encode
      (ConstPtr bytesPtr)
      bytesLen
      hexPtr
      (hexEncodingFlags flags)

hexDecode ::
     Text             -- ^ __hex_str__
  -> IO ByteString    -- ^ __out__
hexDecode txt =
    asBytesLen (Text.encodeUtf8 txt) $ \ hexPtr hexLen ->
    allocBytesQuerying $ \ bytesPtr szPtr ->
    botan_hex_decode
      (ConstPtr hexPtr)
      hexLen
      bytesPtr
      szPtr

base64Encode ::
     ByteString   -- ^ __x__
  -> IO Text      -- ^ __out__
base64Encode bytes =
    fmap Text.decodeUtf8 $
    asBytesLen bytes $ \ bytesPtr bytesLen ->
    allocBytesQueryingCString $ \ base64Ptr szPtr ->
    botan_base64_encode
      (ConstPtr bytesPtr)
      bytesLen
      base64Ptr
      szPtr

base64Decode ::
     Text             -- ^ __base64_str__
  -> IO ByteString    -- ^ __out__
base64Decode txt =
    asBytesLen (Text.encodeUtf8 txt) $ \ base64Ptr base64Len ->
    alloca $ \ szPtr -> do
        poke szPtr 0
        -- Botan 3.12.0 added an any_null_pointers guard on botan_base64_decode that
        -- rejects a NULL out, so use a non-null zero-byte sentinel for the size-query call.
        code <- allocaBytes 0 $ \ sentinelPtr ->
            botan_base64_decode (ConstPtr base64Ptr) base64Len sentinelPtr szPtr
        case code of
            BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -> do
                sz <- fromIntegral <$> peek szPtr
                bs <- allocBytes sz $ \ outPtr ->
                    throwBotanIfNegative_ $ botan_base64_decode
                      (ConstPtr base64Ptr) base64Len outPtr szPtr
                actual <- fromIntegral <$> peek szPtr
                return $! BS.take actual bs
            _ -> throwBotanError code