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

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

import Data.Bool

import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import qualified Data.ByteString as ByteString

import System.IO.Unsafe

import Botan.Bindings.Utility

import Botan.Low.Error
import Botan.Low.Prelude
import Botan.Low.Make (allocBytesQuerying, allocBytesQueryingCString)

-- NOTE: Use of Text is unique here - leave for Text for `botan`

-- | 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 = do
    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 -> do
        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)
                CSize
xlen
            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)

type HexEncodingFlags = Word32

pattern HexUpperCase    -- ^ NOTE: Not an actual flag
    ,   HexLowerCase
    ::  HexEncodingFlags

pattern $mHexUpperCase :: forall {r}. HexEncodingFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bHexUpperCase :: HexEncodingFlags
HexUpperCase = BOTAN_FFI_HEX_UPPER_CASE
pattern $mHexLowerCase :: forall {r}. HexEncodingFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bHexLowerCase :: HexEncodingFlags
HexLowerCase = BOTAN_FFI_HEX_LOWER_CASE

-- | Performs hex encoding of binary data in x of size len bytes. The output buffer out must be of at least x*2 bytes in size. If flags contains BOTAN_FFI_HEX_LOWER_CASE, hex encoding will only contain lower-case letters, upper-case letters otherwise. Returns 0 on success, 1 otherwise.
-- DISCUSS: Handling of positive return code / BOTAN_FFI_INVALID_VERIFIER?
-- DISCUSS: Use of Text.decodeUtf8 - bad, partial function! - but safe here?
hexEncode
    :: ByteString           -- ^ __x__
    -> HexEncodingFlags     -- ^ __flags__
    -> IO Text              -- ^ __y__
hexEncode :: ByteString -> HexEncodingFlags -> IO Text
hexEncode ByteString
bytes HexEncodingFlags
flags =  ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    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 -> do
        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 -> do
            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 -> HexEncodingFlags -> 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
flags

-- | "Hex decode some data"
-- DISCUSS: Return value, maybe vs exception
-- DISCUSS: Botan documentation is lacking here
-- WARNING: Does not actually check that len is a multiple of 2
hexDecode
    :: Text             -- ^ __hex_str__
    -> IO ByteString    -- ^ __out__
hexDecode :: Text -> IO ByteString
hexDecode Text
txt = do
    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 -> do
        (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 -> do
            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

-- NOTE: Does not check tht base64Len == peek sizePtr
base64Encode
    :: ByteString   -- ^ __x__
    -> IO Text      -- ^ __out__
base64Encode :: ByteString -> IO Text
base64Encode ByteString
bytes = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    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 -> do
        (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 -> do
            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

-- | Ditto everything hexDecode
base64Decode
    :: Text             -- ^ __base64_str__
    -> IO ByteString    -- ^ __out__
base64Decode :: Text -> IO ByteString
base64Decode Text
txt = do
    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 -> do
        (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQueryingCString ((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 -> do
            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
bytesPtr
                Ptr CSize
szPtr