c2hs fails to produce the correct alignment

[Kleidukos]

I am producing bindings for libsodium, and especially the following struct:

#ifndef CRYPTO_ALIGN
# if defined(__INTEL_COMPILER) || defined(_MSC_VER)
#  define CRYPTO_ALIGN(x) __declspec(align(x))
# else
#  define CRYPTO_ALIGN(x) __attribute__ ((aligned(x)))
# endif
#endif

typedef struct CRYPTO_ALIGN(64) crypto_generichash_blake2b_state {
    unsigned char opaque[384];
} crypto_generichash_blake2b_state;

Here is my Types.chs file:

Types.chs

module Cryptography.LibSodium.Hash.Types 
  ( Blake2bState(..)
  ) where

import Data.Array.Storable (StorableArray, withStorableArray)
import Data.Array.MArray (newListArray)
import Foreign (Storable(..))
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Data.Word (Word8)
import Foreign.C.Types (CSize, CUChar (..))
import Data.Foldable (traverse_)

import Cryptography.LibSodium.Orphans ()
#include "sodium.h"

-- | Wrapper holding the state for the Blake2b hashing algorithm.
--
-- C counterpart:
--
-- > typedef struct CRYPTO_ALIGN(64) crypto_generichash_blake2b_state {
-- >     unsigned char opaque[384];
-- > } crypto_generichash_blake2b_state;
--
-- @since 0.0.1.0
newtype Blake2bState = Blake2bState { getBlake2bState :: StorableArray CSize CUChar}

-- @since 0.0.1.0
instance Storable Blake2bState where
  sizeOf _ = {#sizeof crypto_generichash_blake2b_state #}

  alignment _ = {#alignof crypto_generichash_blake2b_state #}

  peek :: Ptr Blake2bState -> IO Blake2bState
  peek p = Blake2bState <$> ({#get crypto_generichash_blake2b_state.opaque #} p)
  -- Previous implementation, kept for comparison
  -- peek ptr = do
  --   let bytePtr :: Ptr Word8 = castPtr ptr
  --   xs <- traverse (\i -> peek (plusPtr bytePtr i)) [0..383]
  --   Blake2bState <$> newListArray (0, 383) xs

  poke :: Ptr Blake2bState -> Blake2bState -> IO ()
  poke ptr (Blake2bState arr) = withStorableArray arr (go bytePtr)
    where
    bytePtr :: Ptr CUChar
    bytePtr = castPtr ptr

    go :: Ptr CUChar -> Ptr CUChar -> IO ()
    go outPtr arrPtr = traverse_
      (\i -> peek @CUChar (plusPtr arrPtr i) >>= poke (plusPtr outPtr i)) [0..383]

{#pointer *crypto_generichash_blake2b_state as Blake2bStatePtr -> Blake2bState#}

And here is the generated Haskell code

Types.hs

-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Cryptography/LibSodium/Hash/Types.chs" #-}
module Cryptography.LibSodium.Hash.Types 
  ( Blake2bState(..)
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Data.Array.Storable (StorableArray, withStorableArray)
import Data.Array.MArray (newListArray)
import Foreign (Storable(..))
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Data.Word (Word8)
import Foreign.C.Types (CSize, CUChar (..))
import Data.Foldable (traverse_)

import Cryptography.LibSodium.Orphans ()


-- | Wrapper holding the state for the Blake2b hashing algorithm.
--
-- C counterpart:
--
-- > typedef struct CRYPTO_ALIGN(64) crypto_generichash_blake2b_state {
-- >     unsigned char opaque[384];
-- > } crypto_generichash_blake2b_state;
--
-- @since 0.0.1.0
newtype Blake2bState = Blake2bState { getBlake2bState :: StorableArray CSize CUChar}

-- @since 0.0.1.0
instance Storable Blake2bState where
  sizeOf _ = 384
{-# LINE 29 "src/Cryptography/LibSodium/Hash/Types.chs" #-}


  alignment _ = 1
{-# LINE 31 "src/Cryptography/LibSodium/Hash/Types.chs" #-}


  peek :: Ptr Blake2bState -> IO Blake2bState
  peek p = Blake2bState <$> ((\ptr -> do {return $ ptr `C2HSImp.plusPtr` 0 :: IO (C2HSImp.Ptr C2HSImp.CUChar)}) p)
  -- Previous implementation, kept for comparison
  -- peek ptr = do
  --   let bytePtr :: Ptr Word8 = castPtr ptr
  --   xs <- traverse (\i -> peek (plusPtr bytePtr i)) [0..383]
  --   Blake2bState <$> newListArray (0, 383) xs

  poke :: Ptr Blake2bState -> Blake2bState -> IO ()
  poke ptr (Blake2bState arr) = withStorableArray arr (go bytePtr)
    where
    bytePtr :: Ptr CUChar
    bytePtr = castPtr ptr

    go :: Ptr CUChar -> Ptr CUChar -> IO ()
    go outPtr arrPtr = traverse_
      (\i -> peek @CUChar (plusPtr arrPtr i) >>= poke (plusPtr outPtr i)) [0..383]

type Blake2bStatePtr = C2HSImp.Ptr (Blake2bState)
{-# LINE 50 "src/Cryptography/LibSodium/Hash/Types.chs" #-}

As you can see, the alignment in the Storable instance is 1 instead of 64. Could this be caused by the use of a macro or is this a red herring?

[deech]

This is happening because currently c2hs ignores all aligned (and packed) GNU specific attributes. In this particular case 1 is accidentally correct because 384 is a multiple of 64 and so the field will naturally align at a 64 bit boundary. I'm not sure when I'll have time to add support for them.

[Kleidukos]

@deech If you have an idea of how to do it maybe I can take a shot at it?

[deech]

Yes absolutely, the addition would start where we calculate struct and struct field alignments and sizes and affect calculations downstream of that. The GNU specific packed and aligned attributes are passed along in a CAttr, you can read more about them in the GCC manual. I can even walk you through the code that currently exists if you like. Brace yourself, this is a relatively involved change. :smile:

The other option is we simply don't support alignment attributes in c2hs and actually error in their presence although I would suspect this would break a bunch of code in the wild.

[deech]

Yet another option is to generate a C file that includes the header and print the values we need using the builtin sizeof, alignof and offsetof. We do this currently to get the size of a bool. Honestly if we can reliably generate the file this might be the best approach.

[deech]

@Kleidukos Are you still interested in working on this issue? I'm happy to help you with it.

[Kleidukos]

@deech I would love some help on that one. :)

[deech]

Cool! Send an email to the last maintainer address listed on the Hackage page and we can set up a time to jump on a call and we can talk through options.

[deech]

I started a small repo to capture and run alignment and sizeof test cases, feel free to fork it and add more. Once the feature is complete we can port them back to this repo.

[Kleidukos]

@kozross :point_up:

[deech]

Bump

[kozross]

@deech @Kleidukos and I are looking at the example and working out a way forward: thanks for that!

[deech]

@Kleidukos @kozross Are you still planning on working this issue? Is there anything I can do to help?

[Kleidukos]

@deech We had to pause a bit this last month but I'd like to work on it again. :) We'll ping you it ever is blocked by something big. In the meantime if someone submits a PR with a fix, don't wait for us!

[Kleidukos]

@deech Coming back to say that it is going to be quite hard for me to bring this to completion. If you ever feel like fixing it, do feel free. :) Thank you for your support in any case!