do some todos

cardano-crypto-class/memory-example/Main.hs

@@ -75,7 +75,6 @@ example args alloc = do
     -- compare with
     -- Crypto.Hash.SHA256> hash "\x00\x00\x00\x00\x00\x00\xde\xad\x00\x00\x00\x00\x00\x00\xc0\xd
     -- (cryptohash-sha256)
-    -- TODO: write proper tests.
     traceMLockedForeignPtr hash
 
     -- force finalizers

cardano-crypto-class/src/Cardano/Crypto/PinnedSizedBytes.hs

@@ -68,11 +68,11 @@ import Cardano.Crypto.Libsodium.C (c_sodium_compare)
 --
 -- I'm sorry for adding more types for bytes. :(
 --
-data PinnedSizedBytes (n :: Nat) = PinnedSizedBytes ByteArray
+data PinnedSizedBytes (n :: Nat) = PSB ByteArray
   deriving NoUnexpectedThunks via OnlyCheckIsWHNF "PinnedSizedBytes" (PinnedSizedBytes n)
 
 instance Show (PinnedSizedBytes n) where
-    showsPrec _ (PinnedSizedBytes ba)
+    showsPrec _ (PSB ba)
         = showChar '"'
         . foldrByteArray (\w acc -> show8 w . acc) id ba
         . showChar '"'
@@ -86,7 +86,7 @@ instance KnownNat n => Eq (PinnedSizedBytes n) where
     x == y = compare x y == EQ
 
 instance KnownNat n => Ord (PinnedSizedBytes n) where
-    compare (PinnedSizedBytes x) (PinnedSizedBytes y) = unsafeDupablePerformIO $ do
+    compare (PSB x) (PSB y) = unsafeDupablePerformIO $ do
         res <- c_sodium_compare (byteArrayContents x) (byteArrayContents y) size
         return (compare res 0)
       where
@@ -119,7 +119,7 @@ instance KnownNat n => IsString (PinnedSizedBytes n) where
 
 -- | See 'fromBytes'.
 toBytes :: PinnedSizedBytes n -> [Word8]
-toBytes (PinnedSizedBytes ba) = foldrByteArray (:) [] ba
+toBytes (PSB ba) = foldrByteArray (:) [] ba
 
 psbToByteString :: PinnedSizedBytes n -> BS.ByteString
 psbToByteString = BS.pack . toBytes
@@ -136,7 +136,7 @@ psbToByteString = BS.pack . toBytes
 -- [3,4,5,6]
 -- 
 fromBytes :: forall n. KnownNat n => [Word8] -> PinnedSizedBytes n
-fromBytes ws0 = PinnedSizedBytes (pinnedByteArrayFromListN size ws)
+fromBytes ws0 = PSB (pinnedByteArrayFromListN size ws)
   where
     size :: Int
     size = fromInteger (natVal (Proxy :: Proxy n))
@@ -147,14 +147,18 @@ fromBytes ws0 = PinnedSizedBytes (pinnedByteArrayFromListN size ws)
         $ (++ repeat 0)
         $ reverse ws0
 
--- TODO: more efficient impl
+-- This is not efficient, but we don't use this in non-tests
 psbFromByteString :: KnownNat n => BS.ByteString -> PinnedSizedBytes n
 psbFromByteString = fromBytes . BS.unpack
 
--- TODO: more efficient impl
 psbFromByteStringCheck :: forall n. KnownNat n => BS.ByteString -> Maybe (PinnedSizedBytes n)
 psbFromByteStringCheck bs 
-    | BS.length bs == size = Just (PinnedSizedBytes (pinnedByteArrayFromListN size (BS.unpack bs)))
+    | BS.length bs == size = Just $ unsafeDupablePerformIO $
+        BS.useAsCString bs $ \(Ptr addr#) -> do
+            marr@(MutableByteArray marr#) <- newPinnedByteArray size
+            primitive_ $ copyAddrToByteArray# addr# marr# 0# (case size of I# s -> s)
+            arr <- unsafeFreezeByteArray marr
+            return (PSB arr)
     | otherwise            = Nothing
   where
     size :: Int
@@ -173,18 +177,18 @@ instance KnownNat n => Storable (PinnedSizedBytes n) where
         marr@(MutableByteArray marr#) <- newPinnedByteArray size
         primitive_ $ copyAddrToByteArray# addr# marr# 0# (case size of I# s -> s)
         arr <- unsafeFreezeByteArray marr
-        return (PinnedSizedBytes arr)
+        return (PSB arr)
 
-    poke p (PinnedSizedBytes arr) = do
+    poke p (PSB arr) = do
         let size :: Int
             size = fromInteger (natVal (Proxy :: Proxy n))
         copyByteArrayToAddr (castPtr p) arr 0 size
 
 psbUseAsCPtr :: PinnedSizedBytes n -> (Ptr Word8 -> IO r) -> IO r
-psbUseAsCPtr (PinnedSizedBytes ba) k = k (byteArrayContents ba)
+psbUseAsCPtr (PSB ba) k = k (byteArrayContents ba)
 
 psbUseAsSizedPtr :: PinnedSizedBytes n -> (SizedPtr n -> IO r) -> IO r
-psbUseAsSizedPtr (PinnedSizedBytes ba) k = k (SizedPtr $ castPtr $ byteArrayContents ba)
+psbUseAsSizedPtr (PSB ba) k = k (SizedPtr $ castPtr $ byteArrayContents ba)
 
 psbCreate :: forall n. KnownNat n => (Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes n)
 psbCreate k = do
@@ -193,7 +197,7 @@ psbCreate k = do
     mba <- newPinnedByteArray size
     k (mutableByteArrayContents mba)
     arr <- unsafeFreezeByteArray mba
-    return (PinnedSizedBytes arr)
+    return (PSB arr)
 
 psbCreateSized :: forall n. KnownNat n => (SizedPtr n -> IO ()) -> IO (PinnedSizedBytes n)
 psbCreateSized k = psbCreate (k . SizedPtr . castPtr)