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/.
 -}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Test.System.Win32.Dpapi.Internal (blobTests) where

import Control.Monad (when)
import Foreign (Ptr, Storable (peek), alignPtr, alignment, alloca, castPtr, minusPtr, nullPtr, plusPtr, poke, sizeOf, with)
import Foreign.C (CChar)
import System.Win32.Dpapi.Internal
import System.Win32.Types (BYTE, DWORD)
import Test.HUnit

blobTests :: Test
blobTests = "System.Win32.Dpapi.Internal" ~: [sizeOfDataBlob, alignmentDataBlob, nullPtrForByteString, sizeofBYTECCharSame, checkBlobLayoutPoke, checkBlobLayoutPeek]

#if mingw32_HOST_OS
#if x86_64_HOST_ARCH || aarch64_HOST_ARCH
-- 64-bit Windows
c_SIZEOF_DataBlob :: Int
c_SIZEOF_DataBlob = 16
c_ALIGNMENT_DataBlob :: Int
c_ALIGNMENT_DataBlob = 8
#else
-- 32-bit Windows
c_SIZEOF_DataBlob :: Int
c_SIZEOF_DataBlob = 8
c_ALIGNMENT_DataBlob :: Int
c_ALIGNMENT_DataBlob = 4
#endif
#else
#endif
sizeOfDataBlob :: Test
sizeOfDataBlob = "sizeOfDataBlob" ~: c_SIZEOF_DataBlob ~=? sizeOf (undefined :: DataBlob)

alignmentDataBlob :: Test
alignmentDataBlob = "alignmentDataBlob" ~: c_ALIGNMENT_DataBlob ~=? alignment (undefined :: DataBlob)

nullPtrForByteString :: Test
nullPtrForByteString = "nullPtrForByteString" ~: withBlobFromByteString "" $ \(DataBlob len ptr) -> do
  len @?= 0
  when (ptr == nullPtr) $ assertFailure "should not have received nullPtr"

sizeofBYTECCharSame :: Test
sizeofBYTECCharSame =
  "sizeofBYTECCharSame"
    ~: when (sizeOf (undefined :: BYTE) /= sizeOf (undefined :: CChar))
    $ assertFailure "BYTE and CChar are not the same size"

checkBlobLayoutPoke :: Test
checkBlobLayoutPoke = "checkBlobLayoutPoke" ~: with (DataBlob 1234 (plusPtr nullPtr 0xdeadbeef)) $ \ptr -> do
  len <- peek $ castPtr ptr
  (1234 :: DWORD) @=? len
  let ptrOffset = alignPtr (plusPtr ptr 1) (alignment (undefined :: Ptr ()))
  (ptrOffset `minusPtr` ptr) @?= c_ALIGNMENT_DataBlob
  dat <- peek ptrOffset
  (plusPtr nullPtr 0xdeadbeef :: Ptr ()) @=? dat

checkBlobLayoutPeek :: Test
checkBlobLayoutPeek = "checkBlobLayoutPeek" ~: alloca $ \ptr -> do
  poke (castPtr ptr) (9876 :: DWORD)
  let ptrOffset = alignPtr (plusPtr ptr 1) (alignment (undefined :: Ptr ()))
  poke (castPtr ptrOffset) (nullPtr `plusPtr` 0xfeedf00d)

  (DataBlob len bytes) <- peek ptr
  9876 @=? len
  plusPtr nullPtr 0xfeedf00d @=? bytes