Update continued: Replacing mkBindings with BotanObject
Picking up where we left off yesterday, its time for some code! We’re going to replace the mkBindings function with something more compact.
Minor aside - upgrading Memorable
Per yesterday’s discussion, mkBindings takes 2 newtype constructors-getter pairs (one wraps a Ptr, the other a ForeignPtr), and a FinalizerPtr for the destructor. All of the botan context objects follow this pattern, so we’re going to just codify this as a typeclass, making it a lot easier to wrangle.
Preparing today’s update involved making a few small changes to the Memorable class:
class ... => Memorable memo where
-- Added
type MemRep memo :: Type
-- Changed
withMem :: memo -> (Mem memo (MemRep memo) -> IO a) -> IO a
We have added a new MemRep associated type family, for the underlying memory type - so for ByteString, which is a Ptr Word8, Mem is Ptr, and MemRep is Word8, respectively. This allows us to not care whether a Memory type is monomorphic (eg, ByteString) or polymorphic (eg ForeignPtr). I had suspected that this would be necessary sooner or later, per earlier notes on the wildcard a parameter in withMem, which has now become fixed to MemRep memo.
NOTE: This change in general does have implications that I am still pondering, such as no longer being 1:1 drop-in compatible with memory:ByteArrayAccess.withByteArray, but I’d rather allow non-castable memory types and require that you use castPtr, than the inverse, and it seems so much more sensible that if we allocate a ByteString with a length corresponding to a number of bytes, then when we access the pointer of that bytestring it should be a Ptr Word8, and we should have to cast when we want anything else. It is more type-safe, and the longer I think about it, the more confused I am as to why memory did it that way.
Back to refactoring Botan.Low.RNG
Now, we’re going to start with a bit of a fresh slate - no Internal.ByteString or Make or Remake, just the bindings and our new supporting Memory classes:
-- Used to define BotanObject
{-# LANGUAGE AllowAmbiguousTypes #-}
import Botan.Bindings.ConstPtr (ConstPtr (..))
import Botan.Bindings.RNG
import Control.Monad (void)
import Control.Exception (mask_)
import Data.Kind
import Data.ByteString (ByteString)
import Foreign.Ptr (Ptr)
import qualified Foreign.Ptr as Ptr
import qualified Foreign.Storable as Ptr
import Foreign.ForeignPtr (ForeignPtr, FinalizerPtr)
import qualified Foreign.ForeignPtr as ForeignPtr
import Foreign.C.Types (CInt)
import Foreign.Marshal.Alloc (alloca)
-- This vvv is really the only 'new' import
-- I could actually pull in even more but this suffices
import Memory.Memory
import Memory.Pointer
There are a few things to note immediately - because RNG and BotanRNG are just a ForeignPtr and a Ptr respectively, they actually conform to Memorable.
BotanRNG gets an orphan instance since it is declared in Botan.Bindings.RNG.
instance Memorable BotanRNG where
type Mem BotanRNG = Ptr
type MemRep BotanRNG = BotanRNGStruct
withMem (MkBotanRNG ptr) action = action ptr
Our definition of RNG hasn’t changed, it just gets its new Memorable instance.
newtype RNG = MkRNG { foreignPtr :: ForeignPtr BotanRNGStruct }
instance Memorable RNG where
type Mem RNG = ForeignPtr
type MemRep RNG = BotanRNGStruct
withMem (MkRNG fptr) action = action fptr
Now comes the bit of the code where before we would use mkBindings to generate these functions:
withRNG :: RNG -> (BotanRNG -> IO a) -> IO a
rngDestroy :: RNG -> IO ()
createRNG :: (Ptr BotanRNG -> IO CInt) -> IO RNG
Since all these do is pack and unpack pointers and finalizers, we are going to codify it as a typeclass instead of an awkward function that returns functions - that means we need to take a look at mkBindings itself, to see how it works:
mkBindings
:: (Storable botan)
=> (Ptr struct -> botan) -- mkBotan
-> (botan -> Ptr struct) -- runBotan
-> (ForeignPtr struct -> object) -- mkForeign
-> (object -> ForeignPtr struct) -- runForeign
-> FinalizerPtr struct -- destroy / finalizer
-> ( object -> (botan -> IO a) -> IO a -- withObject
, object -> IO () -- destroyObject
, (Ptr botan -> IO CInt) -> IO object -- createObject
)
mkBindings mkBotan runBotan mkForeign runForeign destroy = bindings where
bindings = (withObject, objectDestroy, createObject)
newObject botan = do
foreignPtr <- newForeignPtr destroy (runBotan botan)
return $ mkForeign foreignPtr
withObject object f = withForeignPtr (runForeign object) (f . mkBotan)
objectDestroy object = finalizeForeignPtr (runForeign object)
createObject = mkCreateObject newObject
mkCreateObject
:: (Storable botan)
=> (botan -> IO object)
-> (Ptr botan-> IO CInt)
-> IO object
mkCreateObject newObject init = mask_ $ alloca $ \ outPtr -> do
throwBotanIfNegative_ $ init outPtr
out <- peek outPtr
newObject out
I think it is about the most confusing code I have ever written. That’s because botan requires that we allocate a pointer to a pointer to an opaque struct*, that it fills, that we have to peek at, attach a finalizer to, and wrap it up, all while handling a potential allocation or initialization failure. Luckily we were fairly smart - we use mask_ and alloca for the ptr-ptr, it is really just confusing as to when things are what, and that type definition is some horror upon the deep.
* Technically, a pointer to the CApiFFI-enforced newtype-wrapper over a pointer to an opaque struct, that we must first unwrap before rewrapping…
So lets clean that up with a little more of our recently-favorite hammer, TypeFamilies, shall we?
NOTE: Data families would also work, if we redefined Bindings and Low as a single module, and if CApiFFI / CTYPE allowed it (no idea if it does)
class
( Memorable a
, Memorable (BotanPtr a)
, Mem a ~ ForeignPtr
, Mem (BotanPtr a) ~ Ptr
, MemRep a ~ BotanStruct a
, MemRep (BotanPtr a) ~ BotanStruct a
) => BotanObject a where
type family BotanStruct a :: Type
type family BotanPtr a :: Type
toBotanPtr :: Ptr (BotanStruct a) -> BotanPtr a
toBotan :: ForeignPtr (BotanStruct a) -> a
botanFinalizer :: FinalizerPtr (BotanStruct a)
withBotanPtr :: a -> (BotanPtr a -> IO b) -> IO b
createBotan :: (Ptr (BotanPtr a) -> IO CInt) -> IO a
destroyBotan :: a -> IO ()
Lets take a moment to clarify the way this works: BotanStruct Foo now refers to BotanFooStruct, and BotanPtr Foo is now a Memorable, who’s mem is a Ptr and who’s rep is a BotanFooStruct. We just codified a relationship between the wrapper types such that the Foo type (which is a Memorable ForeignPtr BotanFooStruct) ties them all together., that’s all. It feels odd to declare a type family and then immediately force-constrain it, but remember, we’re actually constraining the corresponding Mem and MemRep types to be relevant to each other.
Then, once you deal with your types, we can fill in the functions with reasonable defaults:
-- class BotanObject a continued
withBotanPtr :: a -> (BotanPtr a -> IO b) -> IO b
withBotanPtr botan action =
withMem botan $ \ fptr -> do
withMem fptr $ \ ptr -> do
action (toBotanPtr @a ptr)
createBotan :: (Ptr (BotanPtr a) -> IO CInt) -> IO a
createBotan init = mask_ $ alloca $ \ ptrPtr -> do
throwBotanIfNegative_ $ init (Ptr.castPtr ptrPtr) -- NOTE: Can be defined without this cast
ptr <- Ptr.peek ptrPtr
fptr <- ForeignPtr.newForeignPtr (botanFinalizer @a) ptr
return $ toBotan fptr
destroyBotan :: a -> IO ()
destroyBotan botan = withMem botan ForeignPtr.finalizeForeignPtr
The noted cast turns a Ptr (Ptr BotanFooStruct) into a Ptr (BotanPtr Foo) for the init method, which we could avoid by applying a Ptr.Storable (BotanPtr a) constraint to the BotanObject a instead - we just cast it knowing that it is a newtype over the pointer we want. Then we just get the pointer out from the temporary ptr-ptr, stick it in a ForeignPtr with our finalizer, before finally returning the wrapped foreign pointer.
NOTE: Ideally I’d be doing something like withMem ptrPtr $ \ ptr -> throwBotanIfNegative_ $ init (toBotanPtr @a ptr) but (as part of the aforementioned repercussions of de-wilding withMem) the withMem implementation for Ptr is currently simply id meaning we can’t use it on a ptr-ptr like we expected - to fix that we would need to relax Memorable (Ptr a) to Memorable (Ptr (Ptr a)) which I might in the near future.
So, how well does this work? Let’s define our instance for RNG - it should be reasonably similar to how difficult it will be for other Botan objects, so this will give idea of how hard this will be to apply to the rest of the library:
instance BotanObject RNG where
type BotanStruct RNG = BotanRNGStruct
type BotanPtr RNG = BotanRNG
toBotanPtr ptr = MkBotanRNG ptr
toBotan fptr = MkRNG fptr
botanFinalizer = botan_rng_destroy
And that’s it! RNG no longer needs mkBindings, this does all of the same work - toBotanPtr and toBotan act as constructors, withMem acts as a getter / pattern match, and the finalizer is our destructor!
Way less complicated! 
Next up, we’ll be dealing with the helper methods, such as mkCreateObjectCString in:
rngInit :: RNGType -> IO RNG
rngInit = mkCreateObjectCString createBotan botan_rng_init
Nominally, there is nothing wrong with this, aside from mkCreateObjectCString being a part of mkBindings, and thus, is no longer imported. However, it is just a thin wrapper around createBotan that calls withMem over a bytestring before passing it as an additional argument - very reader / profunctor-ish, possibly unnecessary or kept after refactoring to also use the Memory classes.
We will get to that next time, as we continue finishing our refactor of the RNG module.
