Signing.hs

module Signing where

data SignedMessage = SignedMessage
  { messageLength :: CSize
  , messageForeignPtr :: ForeignPtr CUChar
  , signatureForeignPtr :: ForeignPtr CUChar
  }
  deriving stock
    ( Eq
      -- ^ @since 0.0.1.0
    , Ord
      -- ^ @since 0.0.1.0
    , Show
      -- ^ @since 0.0.1.0
    )

instance Storable SignedMessage where
  sizeOf (SignedMessage{messageLength}) =
    sizeOf (undefined :: CSize) + fromIntegral messageLength + sizeOf cryptoSignBytes

  alignment _ = alignment (undefined :: CSize)

  poke ptr (SignedMessage messageLength messageForeignPtr signatureForeignPtr) =
    Foreign.withForeignPtr messageForeignPtr $ \messagePtr ->
      Foreign.withForeignPtr signatureForeignPtr $ \signaturePtr -> do
        Foreign.pokeByteOff ptr 0 messageLength
        Foreign.pokeByteOff ptr (sizeOf messageLength + 1) messagePtr
        Foreign.pokeByteOff ptr (sizeOf messagePtr + 1) signaturePtr

  peek ptr = do
    (messageLength :: CSize) <- Foreign.peek (Foreign.castPtr ptr)
    messageForeignPtr <- mallocForeignPtrBytes @CUChar (fromIntegral messageLength)
    signatureForeignPtr <- mallocForeignPtrBytes @CUChar (fromIntegral cryptoSignBytes)
    withForeignPtr messageForeignPtr $ \messagePtr ->
      withForeignPtr signatureForeignPtr $ \signaturePtr -> do
        -- Copy the message
        let movedMessagePtr = plusPtr ptr (fromIntegral @CSize @Int messageLength)
            messageStart = sizeOf messageLength
            messageEnd = fromIntegral @CSize @Int messageLength - 1
        traverse_
          ( \index ->
              peek @CUChar (plusPtr movedMessagePtr index)
                >>= poke (plusPtr messagePtr index)
          )
          [messageStart .. messageEnd]

        -- Copy the signature
        -- Foreign.copyArray signaturePtr (Foreign.castPtr ptr) (fromIntegral cryptoSignBytes)
        let signatureStart = messageEnd
        let movedsignaturePtr = plusPtr movedMessagePtr messageEnd
        let signatureEnd = fromIntegral @CSize @Int cryptoSignBytes
        traverse_
          ( \index ->
              peek @CUChar (plusPtr movedsignaturePtr index)
                >>= poke (plusPtr signaturePtr index)
          )
          [signatureStart .. signatureEnd]
    pure $ SignedMessage messageLength messageForeignPtr signatureForeignPtr

undefined_error.txt

  
    ━━━ Exception (ErrorCall) ━━━
    Prelude.undefined
    CallStack (from HasCallStack):
      error, called at libraries/base/GHC/Err.hs:74:14 in base:GHC.Err
      undefined, called at libraries/base/Foreign/Marshal/Array.hs:86:49 in base:Foreign.Marshal.Array
  
    This failure can be reproduced by running:
    > recheck (Size 0) (Seed 4438969370936790283 8332183577313219779) <property>