Internal.hs

{-
 - This Source Code Form is subject to the terms of the Mozilla Public
 - License, v. 2.0. If a copy of the MPL was not distributed with this
 - file, You can obtain one at https://mozilla.org/MPL/2.0/.
 -}

-- | You probably do not need these, they are only exposed for the benefit of testing.
module System.Win32.Dpapi.Internal (DataBlob (..), withBlobFromByteString, byteStringFromBlob) where

import Data.ByteString
import Foreign.Ptr (Ptr, alignPtr, castPtr, minusPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable (..))
import System.Win32.Types (BYTE, DWORD)

-- | The struct that is passed to the C functions, a length and a pointer to bytes.
data DataBlob = DataBlob
  { cbData :: DWORD,
    pbData :: Ptr BYTE
  }

instance Storable DataBlob where
  sizeOf _ = offsetOfPbData + sizeOf (undefined :: Ptr BYTE)
  alignment _ = max (alignment (undefined :: Ptr BYTE)) (alignment (undefined :: DWORD))
  peek ptr = do
    size <- peekByteOff ptr 0
    bytes <- peekByteOff ptr offsetOfPbData
    pure $ DataBlob size bytes
  poke ptr (DataBlob size bytes) = do
    pokeByteOff ptr 0 size
    pokeByteOff ptr offsetOfPbData bytes

offsetOfPbData :: Int
offsetOfPbData = (nullPtr `plusPtr` (sizeOf (undefined :: DWORD) + 1)) `alignPtr` alignment (undefined :: Ptr BYTE) `minusPtr` nullPtr

withBlobFromByteString :: ByteString -> (DataBlob -> IO a) -> IO a
withBlobFromByteString bs with =
  useAsCStringLen bs (\(ptr, len) -> with $ DataBlob (fromIntegral len) (castPtr ptr))

byteStringFromBlob :: DataBlob -> IO ByteString
byteStringFromBlob (DataBlob len ptr) = packCStringLen (castPtr ptr, fromIntegral len)