Initial implementation of cardano-mempool (#336)

Added cardano-mempool package to the repo, which will later be used in KES secure forgetting and mlocking the memory. See #255

cabal.project

@@ -22,6 +22,7 @@ packages:
   cardano-crypto-praos
   cardano-crypto-tests
   cardano-strict-containers
+  cardano-mempool
   heapwords
   measures
   orphans-deriving-via

cardano-mempool/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Changelog for `cardano-mempool`
+
+## 0.1.0.0
+
+* Initial release

cardano-mempool/README.md

@@ -0,0 +1,9 @@
+# cardano-mempool
+
+Thread-safe lock-free memory pool.
+
+Memory management utility that allows allocating large chunks of memory at once while
+using it at a fine grain smaller block level.
+
+The particular use cases in Cardano is to allocate one large page of memlocked memory and
+treat it as many smaller regions for secure storage of private keys.

cardano-mempool/Setup.hs

@@ -0,0 +1,6 @@
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
+#endif
+

cardano-mempool/app/Main.hs

@@ -0,0 +1,5 @@
+module Main where
+
+
+main :: IO ()
+main = pure ()

cardano-mempool/bench/Bench.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Main where
+
+import Foreign.Marshal.Alloc
+import GHC.TypeLits
+import Criterion.Main
+import Cardano.Memory.Pool
+import Foreign.ForeignPtr
+import Control.DeepSeq
+import UnliftIO.Async (pooledReplicateConcurrently)
+import Control.Monad
+
+instance NFData (Pool n) where
+  rnf !_ = ()
+
+instance NFData (ForeignPtr a) where
+  rnf !_ = ()
+
+initHaskellPool :: KnownNat n => Int -> IO (Pool n)
+initHaskellPool n = initPool n mallocForeignPtrBytes (const (pure ()))
+
+cmallocForeignPtr :: Int -> IO (ForeignPtr a)
+cmallocForeignPtr n = do
+  ptr <- mallocBytes n
+  newForeignPtr finalizerFree ptr
+
+main :: IO ()
+main = do
+  let n = 10240
+      blockSize = 32
+  defaultMain
+    [ bgroup "Sequential"
+      [ env (initHaskellPool @32 (n `div` 64)) $ \pool ->
+          bench "ForeignPtr (Pool)" $ nfIO (replicateM n (grabNextBlock pool))
+      , bench "ForeignPtr (ByteArray)" $
+          nfIO (replicateM n (mallocForeignPtrBytes blockSize))
+      , bench "ForeignPtr (malloc)" $
+          nfIO (replicateM n (cmallocForeignPtr blockSize))
+      ]
+    , bgroup "Concurrent"
+      [ env (initHaskellPool @32 (n `div` 64)) $ \pool ->
+          bench "ForeignPtr (Pool)" $ nfIO (pooledReplicateConcurrently n (grabNextBlock pool))
+      , bench "ForeignPtr (ByteArray)" $
+          nfIO (pooledReplicateConcurrently n (mallocForeignPtrBytes blockSize))
+      , bench "ForeignPtr (malloc)" $
+          nfIO (pooledReplicateConcurrently n (cmallocForeignPtr blockSize))
+      ]
+    ]

cardano-mempool/cardano-mempool.cabal

@@ -0,0 +1,78 @@
+name:                cardano-mempool
+version:             0.1.0.0
+synopsis:            Short description
+description:         Lock-free threadsafe pinned memory pool
+homepage:            https://github.com/input-output-hk/cardano-base
+license:             BSD3
+author:              IOHK
+maintainer:          operations@iohk.io
+copyright:           2022 IOHK
+category:            Memory
+build-type:          Simple
+extra-source-files:  README.md
+                   , CHANGELOG.md
+cabal-version:       1.18
+tested-with:         GHC == 8.10.7
+                   , GHC == 9.2.4
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Cardano.Memory.Pool
+
+  other-modules:
+  build-depends:       base >= 4.8 && < 5
+                     , primitive
+                     , pvar
+
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+                       -Wincomplete-record-updates
+                       -Wincomplete-uni-patterns
+                       -Wredundant-constraints
+
+test-suite tests
+  type:               exitcode-stdio-1.0
+  hs-source-dirs:     tests
+  main-is:            Main.hs
+  other-modules:      Common
+                    , Test.Cardano.Memory.PoolTests
+  build-depends:      base
+                    , async
+                    , cardano-mempool
+                    , primitive
+                    , pvar
+                    , random
+                    , reflection
+                    , tasty
+                    , tasty-quickcheck
+                    , tasty-hunit
+                    , QuickCheck
+
+  default-language:   Haskell2010
+  ghc-options:        -Wall
+                      -Wincomplete-record-updates
+                      -Wincomplete-uni-patterns
+                      -Wredundant-constraints
+                      -fno-warn-orphans
+                      -threaded
+                      -with-rtsopts=-N
+
+benchmark bench
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      bench
+  main-is:             Bench.hs
+  ghc-options:         -Wall
+                       -threaded
+                       -O2
+                       -with-rtsopts=-N
+  build-depends:       base
+                     , cardano-mempool
+                     , criterion
+                     , deepseq
+                     , unliftio
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/input-output-hk/cardano-base
+  subdir:   cardano-mempool