{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UnboxedTuples #-}

module Cardano.Crypto.PackedBytes
  ( PackedBytes(..)
  , packBytes
  , packBytesMaybe
  , packPinnedBytes
  , unpackBytes
  , unpackPinnedBytes
  , xorPackedBytes
  ) where

import Codec.Serialise (Serialise(..))
import Codec.Serialise.Decoding (decodeBytes)
import Codec.Serialise.Encoding (encodeBytes)
import Control.DeepSeq
import Control.Monad (guard)
import Control.Monad.Primitive
import Data.Bits
import Data.ByteString
import Data.ByteString.Internal as BS (accursedUnutterablePerformIO,
                                       fromForeignPtr, toForeignPtr)
import Data.ByteString.Short.Internal as SBS
import Data.Primitive.ByteArray
import Data.Primitive.PrimArray (PrimArray(..), imapPrimArray, indexPrimArray)
import Data.Typeable
import Foreign.ForeignPtr
import Foreign.Ptr (castPtr)
import Foreign.Storable (peekByteOff)
import GHC.Exts
import GHC.ForeignPtr (ForeignPtr(ForeignPtr), ForeignPtrContents(PlainPtr))
#if MIN_VERSION_base(4,15,0)
import GHC.ForeignPtr (unsafeWithForeignPtr)
#endif
import GHC.ST
import GHC.TypeLits
import GHC.Word
import NoThunks.Class

#include "MachDeps.h"


data PackedBytes (n :: Nat) where
  PackedBytes8  :: {-# UNPACK #-} !Word64
                -> PackedBytes 8
  PackedBytes28 :: {-# UNPACK #-} !Word64
                -> {-# UNPACK #-} !Word64
                -> {-# UNPACK #-} !Word64
                -> {-# UNPACK #-} !Word32
                -> PackedBytes 28
  PackedBytes32 :: {-# UNPACK #-} !Word64
                -> {-# UNPACK #-} !Word64
                -> {-# UNPACK #-} !Word64
                -> {-# UNPACK #-} !Word64
                -> PackedBytes 32
  PackedBytes# :: ByteArray# -> PackedBytes n

deriving via OnlyCheckWhnfNamed "PackedBytes" (PackedBytes n) instance NoThunks (PackedBytes n)

instance Eq (PackedBytes n) where
  PackedBytes8 Word64
x == :: PackedBytes n -> PackedBytes n -> Bool
== PackedBytes8 Word64
y = Word64
x Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y
  PackedBytes28 Word64
x0 Word64
x1 Word64
x2 Word32
x3 == PackedBytes28 Word64
y0 Word64
y1 Word64
y2 Word32
y3 =
    Word64
x0 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y0 Bool -> Bool -> Bool
&& Word64
x1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y1 Bool -> Bool -> Bool
&& Word64
x2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y2 Bool -> Bool -> Bool
&& Word32
x3 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
y3
  PackedBytes32 Word64
x0 Word64
x1 Word64
x2 Word64
x3 == PackedBytes32 Word64
y0 Word64
y1 Word64
y2 Word64
y3 =
    Word64
x0 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y0 Bool -> Bool -> Bool
&& Word64
x1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y1 Bool -> Bool -> Bool
&& Word64
x2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y2 Bool -> Bool -> Bool
&& Word64
x3 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y3
  PackedBytes n
x1 == PackedBytes n
x2 = PackedBytes n -> ShortByteString
forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes PackedBytes n
x1 ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PackedBytes n -> ShortByteString
forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes PackedBytes n
x2
  {-# INLINE (==) #-}

instance Ord (PackedBytes n) where
  compare :: PackedBytes n -> PackedBytes n -> Ordering
compare (PackedBytes8 Word64
x) (PackedBytes8 Word64
y) = Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x Word64
y
  compare (PackedBytes28 Word64
x0 Word64
x1 Word64
x2 Word32
x3) (PackedBytes28 Word64
y0 Word64
y1 Word64
y2 Word32
y3) =
    Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x0 Word64
y0 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x1 Word64
y1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x2 Word64
y2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word32
x3 Word32
y3
  compare (PackedBytes32 Word64
x0 Word64
x1 Word64
x2 Word64
x3) (PackedBytes32 Word64
y0 Word64
y1 Word64
y2 Word64
y3) =
    Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x0 Word64
y0 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x1 Word64
y1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x2 Word64
y2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
x3 Word64
y3
  compare PackedBytes n
x1 PackedBytes n
x2 = ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PackedBytes n -> ShortByteString
forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes PackedBytes n
x1) (PackedBytes n -> ShortByteString
forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes PackedBytes n
x2)
  {-# INLINE compare #-}

instance NFData (PackedBytes n) where
  rnf :: PackedBytes n -> ()
rnf PackedBytes8  {} = ()
  rnf PackedBytes28 {} = ()
  rnf PackedBytes32 {} = ()
  rnf PackedBytes#  {} = ()

instance Serialise (PackedBytes n) where
  encode :: PackedBytes n -> Encoding
encode = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (PackedBytes n -> ByteString) -> PackedBytes n -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedBytes n -> ByteString
forall (n :: Nat). PackedBytes n -> ByteString
unpackPinnedBytes
  decode :: Decoder s (PackedBytes n)
decode = ByteString -> PackedBytes n
forall (n :: Nat). ByteString -> PackedBytes n
packPinnedBytesN (ByteString -> PackedBytes n)
-> Decoder s ByteString -> Decoder s (PackedBytes n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes

xorPackedBytes :: PackedBytes n -> PackedBytes n -> PackedBytes n
xorPackedBytes :: PackedBytes n -> PackedBytes n -> PackedBytes n
xorPackedBytes (PackedBytes8 Word64
x) (PackedBytes8 Word64
y) = Word64 -> PackedBytes 8
PackedBytes8 (Word64
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y)
xorPackedBytes (PackedBytes28 Word64
x0 Word64
x1 Word64
x2 Word32
x3) (PackedBytes28 Word64
y0 Word64
y1 Word64
y2 Word32
y3) =
  Word64 -> Word64 -> Word64 -> Word32 -> PackedBytes 28
PackedBytes28 (Word64
x0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y0) (Word64
x1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y1) (Word64
x2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y2) (Word32
x3 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
y3)
xorPackedBytes (PackedBytes32 Word64
x0 Word64
x1 Word64
x2 Word64
x3) (PackedBytes32 Word64
y0 Word64
y1 Word64
y2 Word64
y3) =
  Word64 -> Word64 -> Word64 -> Word64 -> PackedBytes 32
PackedBytes32 (Word64
x0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y0) (Word64
x1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y1) (Word64
x2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y2) (Word64
x3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
y3)
xorPackedBytes (PackedBytes# ByteArray#
ba1#) (PackedBytes# ByteArray#
ba2#) =
  let pa1 :: PrimArray Word8
pa1 = ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
ba1# :: PrimArray Word8
      pa2 :: PrimArray Word8
pa2 = ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
ba2# :: PrimArray Word8
   in case (Int -> Word8 -> Word8) -> PrimArray Word8 -> PrimArray Word8
forall a b.
(Prim a, Prim b) =>
(Int -> a -> b) -> PrimArray a -> PrimArray b
imapPrimArray (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor (Word8 -> Word8 -> Word8)
-> (Int -> Word8) -> Int -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimArray Word8 -> Int -> Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word8
pa1) PrimArray Word8
pa2 of
        PrimArray ByteArray#
pa# -> ByteArray# -> PackedBytes n
forall (n :: Nat). ByteArray# -> PackedBytes n
PackedBytes# ByteArray#
pa#
xorPackedBytes PackedBytes n
_ PackedBytes n
_ =
  String -> PackedBytes n
forall a. HasCallStack => String -> a
error String
"Impossible case. GHC can't figure out that pattern match is exhaustive."
{-# INLINE xorPackedBytes #-}


withMutableByteArray :: Int -> (forall s . MutableByteArray s -> ST s ()) -> ByteArray
withMutableByteArray :: Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
withMutableByteArray Int
n forall s. MutableByteArray s -> ST s ()
f = do
  (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
mba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
n
    MutableByteArray s -> ST s ()
forall s. MutableByteArray s -> ST s ()
f MutableByteArray s
mba
    MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
mba
{-# INLINE withMutableByteArray #-}

withPinnedMutableByteArray :: Int -> (forall s . MutableByteArray s -> ST s ()) -> ByteArray
withPinnedMutableByteArray :: Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
withPinnedMutableByteArray Int
n forall s. MutableByteArray s -> ST s ()
f = do
  (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
mba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newPinnedByteArray Int
n
    MutableByteArray s -> ST s ()
forall s. MutableByteArray s -> ST s ()
f MutableByteArray s
mba
    MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
mba
{-# INLINE withPinnedMutableByteArray #-}

unpackBytes :: PackedBytes n -> ShortByteString
unpackBytes :: PackedBytes n -> ShortByteString
unpackBytes = ByteArray -> ShortByteString
byteArrayToShortByteString (ByteArray -> ShortByteString)
-> (PackedBytes n -> ByteArray) -> PackedBytes n -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> PackedBytes n -> ByteArray
forall (n :: Nat).
(Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> PackedBytes n -> ByteArray
unpackBytesWith Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
withMutableByteArray
{-# INLINE unpackBytes #-}

unpackPinnedBytes :: PackedBytes n -> ByteString
unpackPinnedBytes :: PackedBytes n -> ByteString
unpackPinnedBytes = ByteArray -> ByteString
byteArrayToByteString (ByteArray -> ByteString)
-> (PackedBytes n -> ByteArray) -> PackedBytes n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> PackedBytes n -> ByteArray
forall (n :: Nat).
(Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> PackedBytes n -> ByteArray
unpackBytesWith Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
withPinnedMutableByteArray
{-# INLINE unpackPinnedBytes #-}


unpackBytesWith ::
     (Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray)
  -> PackedBytes n
  -> ByteArray
unpackBytesWith :: (Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> PackedBytes n -> ByteArray
unpackBytesWith Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
allocate (PackedBytes8 Word64
w) =
  Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
allocate Int
8  ((forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
mba -> MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
0 Word64
w
unpackBytesWith Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
allocate (PackedBytes28 Word64
w0 Word64
w1 Word64
w2 Word32
w3) =
  Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
allocate Int
28 ((forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
mba -> do
    MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
0  Word64
w0
    MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
8  Word64
w1
    MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
16 Word64
w2
    MutableByteArray s -> Int -> Word32 -> ST s ()
forall s. MutableByteArray s -> Int -> Word32 -> ST s ()
writeWord32BE MutableByteArray s
mba Int
24 Word32
w3
unpackBytesWith Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
allocate (PackedBytes32 Word64
w0 Word64
w1 Word64
w2 Word64
w3) =
  Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
allocate Int
32 ((forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
mba -> do
    MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
0  Word64
w0
    MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
8  Word64
w1
    MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
16 Word64
w2
    MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
24 Word64
w3
unpackBytesWith Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
_ (PackedBytes# ByteArray#
ba#) = ByteArray# -> ByteArray
ByteArray ByteArray#
ba#
{-# INLINE unpackBytesWith #-}


packBytes8 :: ShortByteString -> Int -> PackedBytes 8
packBytes8 :: ShortByteString -> Int -> PackedBytes 8
packBytes8 (SBS ByteArray#
ba#) Int
offset =
  let ba :: ByteArray
ba = ByteArray# -> ByteArray
ByteArray ByteArray#
ba#
   in Word64 -> PackedBytes 8
PackedBytes8 (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba Int
offset)
{-# INLINE packBytes8 #-}

packBytes28 :: ShortByteString -> Int -> PackedBytes 28
packBytes28 :: ShortByteString -> Int -> PackedBytes 28
packBytes28 (SBS ByteArray#
ba#) Int
offset =
  let ba :: ByteArray
ba = ByteArray# -> ByteArray
ByteArray ByteArray#
ba#
  in Word64 -> Word64 -> Word64 -> Word32 -> PackedBytes 28
PackedBytes28
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba Int
offset)
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16))
       (ByteArray -> Int -> Word32
indexWord32BE ByteArray
ba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24))
{-# INLINE packBytes28 #-}

packBytes32 :: ShortByteString -> Int -> PackedBytes 32
packBytes32 :: ShortByteString -> Int -> PackedBytes 32
packBytes32 (SBS ByteArray#
ba#) Int
offset =
  let ba :: ByteArray
ba = ByteArray# -> ByteArray
ByteArray ByteArray#
ba#
  in Word64 -> Word64 -> Word64 -> Word64 -> PackedBytes 32
PackedBytes32
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba Int
offset)
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16))
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24))
{-# INLINE packBytes32 #-}

packBytes :: forall n . KnownNat n => ShortByteString -> Int -> PackedBytes n
packBytes :: ShortByteString -> Int -> PackedBytes n
packBytes sbs :: ShortByteString
sbs@(SBS ByteArray#
ba#) Int
offset =
  let px :: Proxy n
px = Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n
      n :: Int
n = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
px)
      ba :: ByteArray
ba = ByteArray# -> ByteArray
ByteArray ByteArray#
ba#
   in case Proxy n -> Proxy 8 -> Maybe (n :~: 8)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 8
forall k (t :: k). Proxy t
Proxy :: Proxy 8) of
        Just n :~: 8
Refl -> ShortByteString -> Int -> PackedBytes 8
packBytes8 ShortByteString
sbs Int
offset
        Maybe (n :~: 8)
Nothing -> case Proxy n -> Proxy 28 -> Maybe (n :~: 28)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 28
forall k (t :: k). Proxy t
Proxy :: Proxy 28) of
          Just n :~: 28
Refl -> ShortByteString -> Int -> PackedBytes 28
packBytes28 ShortByteString
sbs Int
offset
          Maybe (n :~: 28)
Nothing -> case Proxy n -> Proxy 32 -> Maybe (n :~: 32)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 32
forall k (t :: k). Proxy t
Proxy :: Proxy 32) of
            Just n :~: 32
Refl -> ShortByteString -> Int -> PackedBytes 32
packBytes32 ShortByteString
sbs Int
offset
            Maybe (n :~: 32)
Nothing
              | Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
              , ByteArray -> Int
sizeofByteArray ByteArray
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> ByteArray# -> PackedBytes n
forall (n :: Nat). ByteArray# -> PackedBytes n
PackedBytes# ByteArray#
ba#
            Maybe (n :~: 32)
Nothing ->
              let !(ByteArray ByteArray#
slice#) = ByteArray -> Int -> Int -> ByteArray
cloneByteArray ByteArray
ba Int
offset Int
n
               in ByteArray# -> PackedBytes n
forall (n :: Nat). ByteArray# -> PackedBytes n
PackedBytes# ByteArray#
slice#
{-# INLINE[1] packBytes #-}

{-# RULES
"packBytes8"  packBytes = packBytes8
"packBytes28" packBytes = packBytes28
"packBytes32" packBytes = packBytes32
  #-}

-- | Construct `PackedBytes` from a `ShortByteString` and a non-negative offset
-- in number of bytes from the beginning. This function is safe.
packBytesMaybe :: forall n . KnownNat n => ShortByteString -> Int -> Maybe (PackedBytes n)
packBytesMaybe :: ShortByteString -> Int -> Maybe (PackedBytes n)
packBytesMaybe ShortByteString
bs Int
offset = do
  let bufferSize :: Int
bufferSize = ShortByteString -> Int
SBS.length ShortByteString
bs
      size :: Int
size = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# n
forall k (a :: k). Proxy# a
proxy# @n))
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bufferSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset)
  PackedBytes n -> Maybe (PackedBytes n)
forall a. a -> Maybe a
Just (PackedBytes n -> Maybe (PackedBytes n))
-> PackedBytes n -> Maybe (PackedBytes n)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int -> PackedBytes n
forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> PackedBytes n
packBytes ShortByteString
bs Int
offset


packPinnedBytes8 :: ByteString -> PackedBytes 8
packPinnedBytes8 :: ByteString -> PackedBytes 8
packPinnedBytes8 ByteString
bs = ByteString -> (Ptr Any -> IO (PackedBytes 8)) -> PackedBytes 8
forall b a. ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr ByteString
bs ((Word64 -> PackedBytes 8) -> IO Word64 -> IO (PackedBytes 8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> PackedBytes 8
PackedBytes8 (IO Word64 -> IO (PackedBytes 8))
-> (Ptr Any -> IO Word64) -> Ptr Any -> IO (PackedBytes 8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
`peekWord64BE` Int
0))
{-# INLINE packPinnedBytes8 #-}

packPinnedBytes28 :: ByteString -> PackedBytes 28
packPinnedBytes28 :: ByteString -> PackedBytes 28
packPinnedBytes28 ByteString
bs =
  ByteString -> (Ptr Any -> IO (PackedBytes 28)) -> PackedBytes 28
forall b a. ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr ByteString
bs ((Ptr Any -> IO (PackedBytes 28)) -> PackedBytes 28)
-> (Ptr Any -> IO (PackedBytes 28)) -> PackedBytes 28
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ptr ->
    Word64 -> Word64 -> Word64 -> Word32 -> PackedBytes 28
PackedBytes28
      (Word64 -> Word64 -> Word64 -> Word32 -> PackedBytes 28)
-> IO Word64 -> IO (Word64 -> Word64 -> Word32 -> PackedBytes 28)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr Any
ptr Int
0
      IO (Word64 -> Word64 -> Word32 -> PackedBytes 28)
-> IO Word64 -> IO (Word64 -> Word32 -> PackedBytes 28)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr Any
ptr Int
8
      IO (Word64 -> Word32 -> PackedBytes 28)
-> IO Word64 -> IO (Word32 -> PackedBytes 28)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr Any
ptr Int
16
      IO (Word32 -> PackedBytes 28) -> IO Word32 -> IO (PackedBytes 28)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Any -> Int -> IO Word32
forall a. Ptr a -> Int -> IO Word32
peekWord32BE Ptr Any
ptr Int
24
{-# INLINE packPinnedBytes28 #-}

packPinnedBytes32 :: ByteString -> PackedBytes 32
packPinnedBytes32 :: ByteString -> PackedBytes 32
packPinnedBytes32 ByteString
bs =
  ByteString -> (Ptr Any -> IO (PackedBytes 32)) -> PackedBytes 32
forall b a. ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr ByteString
bs ((Ptr Any -> IO (PackedBytes 32)) -> PackedBytes 32)
-> (Ptr Any -> IO (PackedBytes 32)) -> PackedBytes 32
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ptr -> Word64 -> Word64 -> Word64 -> Word64 -> PackedBytes 32
PackedBytes32 (Word64 -> Word64 -> Word64 -> Word64 -> PackedBytes 32)
-> IO Word64 -> IO (Word64 -> Word64 -> Word64 -> PackedBytes 32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr Any
ptr Int
0
                                                   IO (Word64 -> Word64 -> Word64 -> PackedBytes 32)
-> IO Word64 -> IO (Word64 -> Word64 -> PackedBytes 32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr Any
ptr Int
8
                                                   IO (Word64 -> Word64 -> PackedBytes 32)
-> IO Word64 -> IO (Word64 -> PackedBytes 32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr Any
ptr Int
16
                                                   IO (Word64 -> PackedBytes 32) -> IO Word64 -> IO (PackedBytes 32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Any -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr Any
ptr Int
24
{-# INLINE packPinnedBytes32 #-}

packPinnedBytesN :: ByteString -> PackedBytes n
packPinnedBytesN :: ByteString -> PackedBytes n
packPinnedBytesN ByteString
bs =
  case ByteString -> ShortByteString
toShort ByteString
bs of
    SBS ByteArray#
ba# -> ByteArray# -> PackedBytes n
forall (n :: Nat). ByteArray# -> PackedBytes n
PackedBytes# ByteArray#
ba#
{-# INLINE packPinnedBytesN #-}


packPinnedBytes :: forall n . KnownNat n => ByteString -> PackedBytes n
packPinnedBytes :: ByteString -> PackedBytes n
packPinnedBytes ByteString
bs =
  let px :: Proxy n
px = Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n
   in case Proxy n -> Proxy 8 -> Maybe (n :~: 8)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 8
forall k (t :: k). Proxy t
Proxy :: Proxy 8) of
        Just n :~: 8
Refl -> ByteString -> PackedBytes 8
packPinnedBytes8 ByteString
bs
        Maybe (n :~: 8)
Nothing -> case Proxy n -> Proxy 28 -> Maybe (n :~: 28)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 28
forall k (t :: k). Proxy t
Proxy :: Proxy 28) of
          Just n :~: 28
Refl -> ByteString -> PackedBytes 28
packPinnedBytes28 ByteString
bs
          Maybe (n :~: 28)
Nothing -> case Proxy n -> Proxy 32 -> Maybe (n :~: 32)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 32
forall k (t :: k). Proxy t
Proxy :: Proxy 32) of
            Just n :~: 32
Refl -> ByteString -> PackedBytes 32
packPinnedBytes32 ByteString
bs
            Maybe (n :~: 32)
Nothing   -> ByteString -> PackedBytes n
forall (n :: Nat). ByteString -> PackedBytes n
packPinnedBytesN ByteString
bs
{-# INLINE[1] packPinnedBytes #-}

{-# RULES
"packPinnedBytes8"  packPinnedBytes = packPinnedBytes8
"packPinnedBytes28" packPinnedBytes = packPinnedBytes28
"packPinnedBytes32" packPinnedBytes = packPinnedBytes32
  #-}


--- Primitive architecture agnostic helpers

#if WORD_SIZE_IN_BITS == 64

indexWord64BE :: ByteArray -> Int -> Word64
indexWord64BE :: ByteArray -> Int -> Word64
indexWord64BE (ByteArray ByteArray#
ba#) (I# Int#
i#) =
#ifdef WORDS_BIGENDIAN
  W64# (indexWord8ArrayAsWord64# ba# i#)
#else
  Word# -> Word64
W64# (Word# -> Word#
byteSwap64# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord64# ByteArray#
ba# Int#
i#))
#endif
{-# INLINE indexWord64BE #-}

peekWord64BE :: Ptr a -> Int -> IO Word64
peekWord64BE :: Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
i =
#ifndef WORDS_BIGENDIAN
  Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
#endif
  Ptr Any -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (Ptr a -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
i
{-# INLINE peekWord64BE #-}


writeWord64BE :: MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE :: MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE (MutableByteArray MutableByteArray# s
mba#) (I# Int#
i#) (W64# Word#
w#) =
  (State# (PrimState (ST s)) -> State# (PrimState (ST s))) -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord64# MutableByteArray# s
mba# Int#
i# Word#
wbe#)
  where
#ifdef WORDS_BIGENDIAN
    !wbe# = w#
#else
    !wbe# :: Word#
wbe# = Word# -> Word#
byteSwap64# Word#
w#
#endif
{-# INLINE writeWord64BE #-}

#elif WORD_SIZE_IN_BITS == 32

indexWord64BE :: ByteArray -> Int -> Word64
indexWord64BE ba i =
  (fromIntegral (indexWord32BE ba i) `shiftL` 32) .|. fromIntegral (indexWord32BE ba (i + 4))
{-# INLINE indexWord64BE #-}

peekWord64BE :: Ptr a -> Int -> IO Word64
peekWord64BE ptr i = do
  u <- peekWord32BE ptr i
  l <- peekWord32BE ptr (i + 4)
  pure ((fromIntegral u `shiftL` 32) .|. fromIntegral l)
{-# INLINE peekWord64BE #-}

writeWord64BE :: MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE mba i w64 = do
  writeWord32BE mba i (fromIntegral (w64 `shiftR` 32))
  writeWord32BE mba (i + 4) (fromIntegral w64)
{-# INLINE writeWord64BE #-}

#else
#error "Unsupported architecture"
#endif


indexWord32BE :: ByteArray -> Int -> Word32
indexWord32BE :: ByteArray -> Int -> Word32
indexWord32BE (ByteArray ByteArray#
ba#) (I# Int#
i#) =
#ifdef WORDS_BIGENDIAN
  w32
#else
  Word32 -> Word32
byteSwap32 Word32
w32
#endif
  where
    w32 :: Word32
w32 = Word# -> Word32
W32# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord32# ByteArray#
ba# Int#
i#)
{-# INLINE indexWord32BE #-}

peekWord32BE :: Ptr a -> Int -> IO Word32
peekWord32BE :: Ptr a -> Int -> IO Word32
peekWord32BE Ptr a
ptr Int
i =
#ifndef WORDS_BIGENDIAN
  Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
#endif
  Ptr Any -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (Ptr a -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
i
{-# INLINE peekWord32BE #-}


writeWord32BE :: MutableByteArray s -> Int -> Word32 -> ST s ()
writeWord32BE :: MutableByteArray s -> Int -> Word32 -> ST s ()
writeWord32BE (MutableByteArray MutableByteArray# s
mba#) (I# Int#
i#) Word32
w =
  (State# (PrimState (ST s)) -> State# (PrimState (ST s))) -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba# Int#
i# Word#
w#)
  where
#ifdef WORDS_BIGENDIAN
    !(W32# w#) = w
#else
    !(W32# Word#
w#) = Word32 -> Word32
byteSwap32 Word32
w
#endif
{-# INLINE writeWord32BE #-}

byteArrayToShortByteString :: ByteArray -> ShortByteString
byteArrayToShortByteString :: ByteArray -> ShortByteString
byteArrayToShortByteString (ByteArray ByteArray#
ba#) = ByteArray# -> ShortByteString
SBS ByteArray#
ba#
{-# INLINE byteArrayToShortByteString #-}

byteArrayToByteString :: ByteArray -> ByteString
byteArrayToByteString :: ByteArray -> ByteString
byteArrayToByteString ByteArray
ba
  | ByteArray -> Bool
isByteArrayPinned ByteArray
ba =
    ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ByteArray -> ForeignPtr Word8
forall a. ByteArray -> ForeignPtr a
pinnedByteArrayToForeignPtr ByteArray
ba) Int
0 (ByteArray -> Int
sizeofByteArray ByteArray
ba)
  | Bool
otherwise = ShortByteString -> ByteString
SBS.fromShort (ByteArray -> ShortByteString
byteArrayToShortByteString ByteArray
ba)
{-# INLINE byteArrayToByteString #-}

pinnedByteArrayToForeignPtr :: ByteArray -> ForeignPtr a
pinnedByteArrayToForeignPtr :: ByteArray -> ForeignPtr a
pinnedByteArrayToForeignPtr (ByteArray ByteArray#
ba#) =
  Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (ByteArray# -> MutableByteArray# RealWorld
unsafeCoerce# ByteArray#
ba#))
{-# INLINE pinnedByteArrayToForeignPtr #-}

-- Usage of `accursedUnutterablePerformIO` here is safe because we only use it
-- for indexing into an immutable `ByteString`, which is analogous to
-- `Data.ByteString.index`.  Make sure you know what you are doing before using
-- this function.
unsafeWithByteStringPtr :: ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr :: ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr ByteString
bs Ptr b -> IO a
f =
  IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$
    case ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr ByteString
bs of
      (ForeignPtr Word8
fp, Int
offset, Int
_) ->
        ForeignPtr b -> (Ptr b -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr (ForeignPtr Word8 -> Int -> ForeignPtr b
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
offset) Ptr b -> IO a
f
{-# INLINE unsafeWithByteStringPtr #-}

#if !MIN_VERSION_base(4,15,0)
-- | A compatibility wrapper for 'GHC.ForeignPtr.unsafeWithForeignPtr' provided
-- by GHC 9.0.1 and later.
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr = ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
{-# INLINE unsafeWithForeignPtr #-}
#endif