{-|
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 :: ByteString -> ByteString -> Int -> IO Bool
constantTimeCompare ByteString
x ByteString
y Int
len =
    ByteString -> (Ptr Word8 -> CSize -> IO Bool) -> IO Bool
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
x ((Ptr Word8 -> CSize -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> CSize -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
xPtr CSize
_xlen ->
    ByteString -> (Ptr Word8 -> CSize -> IO Bool) -> IO Bool
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
y ((Ptr Word8 -> CSize -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> CSize -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
yPtr CSize
_ylen -> do
      CInt
result <- ConstPtr Word8 -> ConstPtr Word8 -> CSize -> IO CInt
botan_constant_time_compare
        (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
xPtr)
        (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
yPtr)
        (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
      case CInt
result 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

scrubMem ::
     Ptr a    -- ^ __mem__
  -> Int      -- ^ __bytes__
  -> IO ()
scrubMem :: forall a. Ptr a -> Int -> IO ()
scrubMem Ptr a
ptr Int
sz = HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Any -> CSize -> IO CInt
forall a. Ptr a -> CSize -> IO CInt
botan_scrub_mem (Ptr a -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

data HexEncodingFlags =
    HexUpperCase
  | HexLowerCase

hexEncodingFlags :: HexEncodingFlags -> Word32
hexEncodingFlags :: HexEncodingFlags -> Word32
hexEncodingFlags HexEncodingFlags
HexUpperCase = Word32
forall a. (Eq a, Num a) => a
BOTAN_FFI_HEX_UPPER_CASE
hexEncodingFlags HexEncodingFlags
HexLowerCase = Word32
forall a. (Eq a, Num a) => a
BOTAN_FFI_HEX_LOWER_CASE

hexEncode ::
     ByteString           -- ^ __x__
  -> HexEncodingFlags     -- ^ __flags__
  -> IO Text              -- ^ __y__
hexEncode :: ByteString -> HexEncodingFlags -> IO Text
hexEncode ByteString
bytes HexEncodingFlags
flags =
    (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 -> IO Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (Ptr Word8 -> CSize -> IO ByteString) -> IO ByteString
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
bytes ((Ptr Word8 -> CSize -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr CSize
bytesLen ->
    Int -> (Ptr CChar -> IO ()) -> IO ByteString
forall byte. Int -> (Ptr byte -> IO ()) -> IO ByteString
allocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ CSize
2 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
* CSize
bytesLen) ((Ptr CChar -> IO ()) -> IO ByteString)
-> (Ptr CChar -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
hexPtr ->
    HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ ConstPtr Word8 -> CSize -> Ptr CChar -> Word32 -> IO CInt
botan_hex_encode
      (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
bytesPtr)
      CSize
bytesLen
      Ptr CChar
hexPtr
      (HexEncodingFlags -> Word32
hexEncodingFlags HexEncodingFlags
flags)

hexDecode ::
     Text             -- ^ __hex_str__
  -> IO ByteString    -- ^ __out__
hexDecode :: Text -> IO ByteString
hexDecode Text
txt =
    ByteString
-> (Ptr CChar -> CSize -> IO ByteString) -> IO ByteString
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen (Text -> ByteString
Text.encodeUtf8 Text
txt) ((Ptr CChar -> CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
hexPtr CSize
hexLen ->
    (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr Ptr CSize
szPtr ->
    ConstPtr CChar -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_hex_decode
      (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
hexPtr)
      CSize
hexLen
      Ptr Word8
bytesPtr
      Ptr CSize
szPtr

base64Encode ::
     ByteString   -- ^ __x__
  -> IO Text      -- ^ __out__
base64Encode :: ByteString -> IO Text
base64Encode ByteString
bytes =
    (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 -> IO Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (Ptr Word8 -> CSize -> IO ByteString) -> IO ByteString
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
bytes ((Ptr Word8 -> CSize -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr CSize
bytesLen ->
    (Ptr CChar -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQueryingCString ((Ptr CChar -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr CChar -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
base64Ptr Ptr CSize
szPtr ->
    ConstPtr Word8 -> CSize -> Ptr CChar -> Ptr CSize -> IO CInt
botan_base64_encode
      (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
bytesPtr)
      CSize
bytesLen
      Ptr CChar
base64Ptr
      Ptr CSize
szPtr

base64Decode ::
     Text             -- ^ __base64_str__
  -> IO ByteString    -- ^ __out__
base64Decode :: Text -> IO ByteString
base64Decode Text
txt =
    ByteString
-> (Ptr CChar -> CSize -> IO ByteString) -> IO ByteString
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen (Text -> ByteString
Text.encodeUtf8 Text
txt) ((Ptr CChar -> CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
base64Ptr CSize
base64Len ->
    (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
        Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
szPtr CSize
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.
        CInt
code <- Int -> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
0 ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
sentinelPtr ->
            ConstPtr CChar -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_base64_decode (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
base64Ptr) CSize
base64Len Ptr Word8
sentinelPtr Ptr CSize
szPtr
        case CInt
code of
            CInt
BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -> do
                Int
sz <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
szPtr
                ByteString
bs <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
forall byte. Int -> (Ptr byte -> IO ()) -> IO ByteString
allocBytes Int
sz ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr ->
                    HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ ConstPtr CChar -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_base64_decode
                      (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
base64Ptr) CSize
base64Len Ptr Word8
outPtr Ptr CSize
szPtr
                Int
actual <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
szPtr
                ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! Int -> ByteString -> ByteString
BS.take Int
actual ByteString
bs
            CInt
_ -> CInt -> IO ByteString
forall a. HasCallStack => CInt -> IO a
throwBotanError CInt
code