content: {-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,
               BangPatterns, MagicHash #-}
  
  -- | Test case for #5486
  -- Test case reduced from HsOpenSSL package BN module
  module Bad where
  
  import           Control.Exception hiding (try)
  import           Foreign
  import qualified Data.ByteString as BS
  
  import           Foreign.C.Types
  import           GHC.Base
  import           GHC.Integer.GMP.Internals
  
  newtype BigNum = BigNum (Ptr BIGNUM)
  data BIGNUM
  
  data ByteArray = BA  !ByteArray#
  data MBA       = MBA !(MutableByteArray# RealWorld)
  
  foreign import ccall unsafe "BN_free"
          _free :: Ptr BIGNUM -> IO ()
  
  foreign import ccall unsafe "BN_bn2mpi"
          _bn2mpi :: Ptr BIGNUM -> Ptr CChar -> IO CInt
  
  foreign import ccall unsafe "memcpy"
          _copy_in :: ByteArray# -> Ptr () -> CSize -> IO ()
  
  foreign import ccall unsafe "memcpy"
          _copy_out :: Ptr () -> ByteArray# -> CSize -> IO ()
  
  unwrapBN :: BigNum -> Ptr BIGNUM
  unwrapBN (BigNum p) = p
  
  wrapBN :: Ptr BIGNUM -> BigNum
  wrapBN = BigNum
  
  bnToInteger :: BigNum -> IO Integer
  bnToInteger bn = do
    nlimbs <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) (unwrapBN bn) :: IO CInt
    case nlimbs of
      0 -> return 0
      1 -> do (I# i) <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) (unwrapBN bn) >>= peek
              negative <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) (unwrapBN bn) :: IO CInt
              if negative == 0
                 then return $ S# i
                 else return $ 0 - (S# i)
      _ -> do
        let !(I# nlimbsi) = fromIntegral nlimbs
            !(I# limbsize) = ((8))
        (MBA arr) <- newByteArray (nlimbsi *# limbsize)
        (BA ba) <- freezeByteArray arr
        limbs <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) (unwrapBN bn)
        _ <- _copy_in ba limbs $ fromIntegral $ nlimbs * ((8))
        negative <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) (unwrapBN bn) :: IO CInt
        if negative == 0
           then return $ J# nlimbsi ba
           else return $ 0 - (J# nlimbsi ba)
  
  newByteArray :: Int# -> IO MBA
  newByteArray sz = IO $ \s ->
    case newByteArray# sz s of { (# s', arr #) ->
    (# s', MBA arr #) }
  
  freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray
  freezeByteArray arr = IO $ \s ->
    case unsafeFreezeByteArray# arr s of { (# s', arr' #) ->
    (# s', BA arr' #) }
  
  integerToBN :: Integer -> IO BigNum
  integerToBN (S# 0#) = do
    bnptr <- mallocBytes ((24))
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) bnptr nullPtr
    let one :: CInt
        one = 1
        zero :: CInt
        zero = 0
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) bnptr one
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) bnptr zero
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) bnptr zero
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) bnptr zero
    return (wrapBN bnptr)
  
  integerToBN (S# v) = do
    bnptr <- mallocBytes ((24))
    limbs <- malloc :: IO (Ptr CULong)
    poke limbs $ fromIntegral $ abs $ I# v
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) bnptr limbs
    let one :: CInt
        one = 1
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) bnptr one
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) bnptr one
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) bnptr one
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) bnptr (if (I# v) < 0 then one else 0)
    return (wrapBN bnptr)
  
  integerToBN v@(J# nlimbs_ bytearray)
    | v >= 0 = do
        let nlimbs = (I# nlimbs_)
        bnptr <- mallocBytes ((24))
        limbs <- mallocBytes (((8)) * nlimbs)
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) bnptr limbs
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) bnptr (1 :: CInt)
        _ <- _copy_out limbs bytearray (fromIntegral $ ((8)) * nlimbs)
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) bnptr ((fromIntegral nlimbs) :: CInt)
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) bnptr ((fromIntegral nlimbs) :: CInt)
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) bnptr (0 :: CInt)
        return (wrapBN bnptr)
    | otherwise = do bnptr <- integerToBN (0-v)
                     ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) (unwrapBN bnptr) (1 :: CInt)
                     return bnptr
  
  integerToMPI :: Integer -> IO BS.ByteString
  integerToMPI v = bracket (integerToBN v) (_free . unwrapBN) bnToMPI
  
  bnToMPI :: BigNum -> IO BS.ByteString
  bnToMPI bn = do
    bytes <- _bn2mpi (unwrapBN bn) nullPtr
    allocaBytes (fromIntegral bytes) (\buffer -> do
      _ <- _bn2mpi (unwrapBN bn) buffer
      BS.packCStringLen (buffer, fromIntegral bytes))
  
  