Util.hs

{-# LANGUAGE FlexibleContexts #-}

-- | Helpers to move bytes between Haskell and the C library safely.
--
-- Most mistakes in C bindings are about memory: passing a buffer of the wrong
-- size, letting the C side write into a 'ByteString' that other code shares,
-- or leaking a buffer when an exception is thrown. Every binding goes through
-- these functions, which check lengths before calling C, give the C library
-- fresh buffers to write into, and free them on every path. This module is
-- internal and has no API stability guarantee.
module Crypto.Secp256k1.Internal.Util where

import Control.Exception (onException)
import Crypto.Secp256k1.Internal.ForeignTypes (Seed32)
import Data.Base16.Types (extractBase16)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Base16 (decodeBase16, encodeBase16, parseBase16)
import qualified Data.ByteString.Unsafe as BU
import Data.String.Conversions (ConvertibleStrings, cs)
import Foreign (Ptr, castPtr, copyBytes, free, mallocBytes)
import Foreign.C (CSize (..))
import System.Entropy (getEntropy)

-- | Decode hex, or 'Nothing' if the string is not valid hex.
decodeHex :: (ConvertibleStrings a ByteString) => a -> Maybe ByteString
decodeHex str =
  case parseBase16 $ cs str of
    Right b16 -> Just $ decodeBase16 b16
    Left _ -> Nothing

-- | Show bytes as a quoted hex string.
showsHex :: ByteString -> ShowS
showsHex = shows . extractBase16 . encodeBase16

-- | Pass the bytes of a 'ByteString' to C without copying them. Only for
-- arguments that the C library reads and never writes: writing would change a
-- 'ByteString' that may be shared.
unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b
unsafeUseByteString bs f =
  BU.unsafeUseAsCStringLen bs $ \(b, l) ->
    f (castPtr b, fromIntegral l)

-- | Pass a copy of the bytes of a 'ByteString' to C.
useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b
useByteString bs f =
  BS.useAsCStringLen bs $ \(b, l) ->
    f (castPtr b, fromIntegral l)

-- | Like 'unsafeUseByteString', for an argument that the C library reads as a
-- fixed number of bytes. A 'ByteString' of any other length would make the
-- library read outside the buffer, so this raises an error instead. The name
-- is the Haskell type, for the error message.
useFixedByteString ::
  String -> Int -> ByteString -> ((Ptr a, CSize) -> IO b) -> IO b
useFixedByteString name len bs f
  | BS.length bs == len = unsafeUseByteString bs f
  | otherwise = wrongLength name len bs

-- | Raise the error for a value of the wrong length. The name is the Haskell
-- type, for the error message.
wrongLength :: String -> Int -> ByteString -> a
wrongLength name len bs =
  error $
    name
      ++ " must be "
      ++ show len
      ++ " bytes long, got "
      ++ show (BS.length bs)

-- | Allocate a buffer of the given size for the C library to fill. The buffer
-- becomes the result when the action reports success. It is freed when the
-- action reports failure or throws.
withOutput :: Int -> (Ptr a -> IO Bool) -> IO (Maybe ByteString)
withOutput len f = do
  ptr <- mallocBytes len
  ok <- f ptr `onException` free ptr
  if ok
    then Just <$> unsafePackByteString (ptr, fromIntegral len)
    else free ptr >> return Nothing

-- | Like 'withOutput', for a C function that always fills the buffer.
fillOutput :: Int -> (Ptr a -> IO ()) -> IO ByteString
fillOutput len f = do
  ptr <- mallocBytes len
  f ptr `onException` free ptr
  unsafePackByteString (ptr, fromIntegral len)

-- | Like 'withOutput', with the buffer starting as a copy of a fixed-size
-- input that the C library modifies in place. The input is left untouched.
withCopy ::
  String -> Int -> ByteString -> (Ptr a -> IO Bool) -> IO (Maybe ByteString)
withCopy name len bs f =
  useFixedByteString name len bs $ \(src, _) ->
    withOutput len $ \dst -> do
      copyBytes dst (castPtr src) len
      f dst

-- | Take ownership of a @malloc@'ed buffer as a 'ByteString', without copying.
unsafePackByteString :: (Ptr a, CSize) -> IO ByteString
unsafePackByteString (b, l) =
  BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l)

-- | Copy a C buffer into a new 'ByteString'.
packByteString :: (Ptr a, CSize) -> IO ByteString
packByteString (b, l) =
  BS.packCStringLen (castPtr b, fromIntegral l)

-- | Pass 32 bytes from the operating system's secure random source to C.
withRandomSeed :: (Ptr Seed32 -> IO a) -> IO a
withRandomSeed go = do
  bs <- getEntropy 32
  useByteString bs $ go . fst