{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# 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 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 forall a. Eq a => a -> a -> Bool
== Word64
y0 Bool -> Bool -> Bool
&& Word64
x1 forall a. Eq a => a -> a -> Bool
== Word64
y1 Bool -> Bool -> Bool
&& Word64
x2 forall a. Eq a => a -> a -> Bool
== Word64
y2 Bool -> Bool -> Bool
&& Word32
x3 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 forall a. Eq a => a -> a -> Bool
== Word64
y0 Bool -> Bool -> Bool
&& Word64
x1 forall a. Eq a => a -> a -> Bool
== Word64
y1 Bool -> Bool -> Bool
&& Word64
x2 forall a. Eq a => a -> a -> Bool
== Word64
y2 Bool -> Bool -> Bool
&& Word64
x3 forall a. Eq a => a -> a -> Bool
== Word64
y3
  PackedBytes n
x1 == PackedBytes n
x2 = forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes PackedBytes n
x1 forall a. Eq a => a -> a -> Bool
== 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) = 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) =
    forall a. Ord a => a -> a -> Ordering
compare Word64
x0 Word64
y0 forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Word64
x1 Word64
y1 forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Word64
x2 Word64
y2 forall a. Semigroup a => a -> a -> a
<> 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) =
    forall a. Ord a => a -> a -> Ordering
compare Word64
x0 Word64
y0 forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Word64
x1 Word64
y1 forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Word64
x2 Word64
y2 forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Word64
x3 Word64
y3
  compare PackedBytes n
x1 PackedBytes n
x2 = forall a. Ord a => a -> a -> Ordering
compare (forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes PackedBytes n
x1) (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). PackedBytes n -> ByteString
unpackPinnedBytes
  decode :: forall s. Decoder s (PackedBytes n)
decode = forall (n :: Nat). ByteString -> PackedBytes n
packPinnedBytesN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s ByteString
decodeBytes

xorPackedBytes :: PackedBytes n -> PackedBytes n -> PackedBytes n
xorPackedBytes :: forall (n :: Nat). PackedBytes n -> PackedBytes n -> PackedBytes n
xorPackedBytes (PackedBytes8 Word64
x) (PackedBytes8 Word64
y) = Word64 -> PackedBytes 8
PackedBytes8 (Word64
x 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 forall a. Bits a => a -> a -> a
`xor` Word64
y0) (Word64
x1 forall a. Bits a => a -> a -> a
`xor` Word64
y1) (Word64
x2 forall a. Bits a => a -> a -> a
`xor` Word64
y2) (Word32
x3 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 forall a. Bits a => a -> a -> a
`xor` Word64
y0) (Word64
x1 forall a. Bits a => a -> a -> a
`xor` Word64
y1) (Word64
x2 forall a. Bits a => a -> a -> a
`xor` Word64
y2) (Word64
x3 forall a. Bits a => a -> a -> a
`xor` Word64
y3)
xorPackedBytes (PackedBytes# ByteArray#
ba1#) (PackedBytes# ByteArray#
ba2#) =
  let pa1 :: PrimArray Word8
pa1 = forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
ba1# :: PrimArray Word8
      pa2 :: PrimArray Word8
pa2 = forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
ba2# :: PrimArray Word8
   in case forall a b.
(Prim a, Prim b) =>
(Int -> a -> b) -> PrimArray a -> PrimArray b
imapPrimArray (forall a. Bits a => a -> a -> a
xor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word8
pa1) PrimArray Word8
pa2 of
        PrimArray ByteArray#
pa# -> forall (n :: Nat). ByteArray# -> PackedBytes n
PackedBytes# ByteArray#
pa#
xorPackedBytes PackedBytes n
_ 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
mba <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
n
    forall s. MutableByteArray s -> ST s ()
f MutableByteArray s
mba
    forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
mba <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newPinnedByteArray Int
n
    forall s. MutableByteArray s -> ST s ()
f MutableByteArray s
mba
    forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
mba
{-# INLINE withPinnedMutableByteArray #-}

unpackBytes :: PackedBytes n -> ShortByteString
unpackBytes :: forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes = ByteArray -> ShortByteString
byteArrayToShortByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (n :: Nat). PackedBytes n -> ByteString
unpackPinnedBytes = ByteArray -> ByteString
byteArrayToByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (n :: Nat).
(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 a b. (a -> b) -> a -> b
$ \MutableByteArray s
mba -> 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 a b. (a -> b) -> a -> b
$ \MutableByteArray s
mba -> do
    forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
0  Word64
w0
    forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
8  Word64
w1
    forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
16 Word64
w2
    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 a b. (a -> b) -> a -> b
$ \MutableByteArray s
mba -> do
    forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
0  Word64
w0
    forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
8  Word64
w1
    forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
16 Word64
w2
    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 forall a. Num a => a -> a -> a
+ Int
8))
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset forall a. Num a => a -> a -> a
+ Int
16))
       (ByteArray -> Int -> Word32
indexWord32BE ByteArray
ba (Int
offset 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 forall a. Num a => a -> a -> a
+ Int
8))
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset forall a. Num a => a -> a -> a
+ Int
16))
       (ByteArray -> Int -> Word64
indexWord64BE ByteArray
ba (Int
offset forall a. Num a => a -> a -> a
+ Int
24))
{-# INLINE packBytes32 #-}

packBytes :: forall n . KnownNat n => ShortByteString -> Int -> PackedBytes n
packBytes :: forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> PackedBytes n
packBytes sbs :: ShortByteString
sbs@(SBS ByteArray#
ba#) Int
offset =
  let px :: Proxy n
px = forall {k} (t :: k). Proxy t
Proxy :: Proxy n
      n :: Int
n = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
px)
      ba :: ByteArray
ba = ByteArray# -> ByteArray
ByteArray ByteArray#
ba#
   in case forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (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 forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (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 forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (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 forall a. Eq a => a -> a -> Bool
== Int
0
              , ByteArray -> Int
sizeofByteArray ByteArray
ba forall a. Eq a => a -> a -> Bool
== Int
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 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 :: forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> Maybe (PackedBytes n)
packBytesMaybe ShortByteString
bs Int
offset = do
  let bufferSize :: Int
bufferSize = ShortByteString -> Int
SBS.length ShortByteString
bs
      size :: Int
size = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall {k} (a :: k). Proxy# a
proxy# @n))
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
offset forall a. Ord a => a -> a -> Bool
>= Int
0)
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
size forall a. Ord a => a -> a -> Bool
<= Int
bufferSize forall a. Num a => a -> a -> a
- Int
offset)
  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall b a. ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr ByteString
bs (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> PackedBytes 8
PackedBytes8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ptr a -> Int -> IO Word64
`peekWord64BE` Int
0))
{-# INLINE packPinnedBytes8 #-}

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

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


packPinnedBytes :: forall n . KnownNat n => ByteString -> PackedBytes n
packPinnedBytes :: forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes ByteString
bs =
  let px :: Proxy n
px = forall {k} (t :: k). Proxy t
Proxy :: Proxy n
   in case forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (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 forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (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 forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (forall {k} (t :: k). Proxy t
Proxy :: Proxy 32) of
            Just n :~: 32
Refl -> ByteString -> PackedBytes 32
packPinnedBytes32 ByteString
bs
            Maybe (n :~: 32)
Nothing   -> 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 :: forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
i =
#ifndef WORDS_BIGENDIAN
  Word64 -> Word64
byteSwap64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
#endif
  forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
i
{-# INLINE peekWord64BE #-}


writeWord64BE :: MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE :: forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE (MutableByteArray MutableByteArray# s
mba#) (I# Int#
i#) (W64# Word#
w#) =
  forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (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 = Word32# -> Word32
W32# (ByteArray# -> Int# -> Word32#
indexWord8ArrayAsWord32# ByteArray#
ba# Int#
i#)
{-# INLINE indexWord32BE #-}

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


writeWord32BE :: MutableByteArray s -> Int -> Word32 -> ST s ()
writeWord32BE :: forall s. MutableByteArray s -> Int -> Word32 -> ST s ()
writeWord32BE (MutableByteArray MutableByteArray# s
mba#) (I# Int#
i#) Word32
w =
  forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall d.
MutableByteArray# d -> Int# -> Word32# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba# Int#
i# Word32#
w#)
  where
#ifdef WORDS_BIGENDIAN
    !(W32# w#) = w
#else
    !(W32# Word32#
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 (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 :: forall a. ByteArray -> ForeignPtr a
pinnedByteArrayToForeignPtr (ByteArray ByteArray#
ba#) =
  forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (unsafeCoerce# :: forall a b. a -> b
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 :: forall b a. ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr ByteString
bs Ptr b -> IO a
f =
  forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
    case ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr ByteString
bs of
      (ForeignPtr Word8
fp, Int
offset, Int
_) ->
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr (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 = withForeignPtr
{-# INLINE unsafeWithForeignPtr #-}
#endif