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

{- FOURMOLU_DISABLE -}
module Cardano.Crypto.PackedBytes.Internal
  ( PackedBytes(..)
  , packBytes
  , packBytesMaybe
  , packByteString
  , packShortByteString
  , packShortByteStringWithOffset
  , packPinnedBytes
  , unpackAsByteArray
  , unpackBytes
  , unpackPinnedBytes
  , xorPackedBytes
  ) where

import Codec.CBOR.Decoding as D (decodeBytes)
import Cardano.Base.Bytes (byteArrayToByteString)
import Cardano.Binary (FromCBOR (..), ToCBOR (..), Size)
import Control.DeepSeq (NFData(..))
import Control.Monad (unless, when)
import Control.Monad.Primitive (primitive_)
import Control.Monad.Reader (MonadReader(ask), MonadTrans(lift))
import Control.Monad.State.Strict (MonadState(state))
import Data.Bits
import Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import Data.ByteString.Char8 as BS8
import Data.ByteString.Internal as BS (accursedUnutterablePerformIO, toForeignPtr)
import Data.ByteString.Short.Internal as SBS
import Data.MemPack (guardAdvanceUnpack, st_, MemPack(..), Pack(Pack))
import Data.MemPack.Buffer (Buffer(buffer), byteArrayToShortByteString)
import Data.Primitive.ByteArray
import Data.Primitive.PrimArray (PrimArray(..), imapPrimArray, indexPrimArray)
import Data.Typeable
import Foreign.ForeignPtr
import Foreign.Ptr (castPtr)
import Foreign.Storable (Storable(..))
import GHC.Exts
#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 KnownNat n => Show (PackedBytes n) where
  show :: PackedBytes n -> String
show PackedBytes n
pb =
    String
"(PackedBytes " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    Integer -> String
forall a. Show a => a -> String
show (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    String
" 0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> String
BS8.unpack (ByteString -> ByteString
Base16.encode (PackedBytes n -> ByteString
forall (n :: Nat). PackedBytes n -> ByteString
unpackPinnedBytes PackedBytes n
pb)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    String
")"

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

instance KnownNat n => MemPack (PackedBytes n) where
  packedByteCount :: PackedBytes n -> Int
packedByteCount = forall a. Num a => Integer -> a
fromInteger @Int (Integer -> Int)
-> (PackedBytes n -> Integer) -> PackedBytes n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedBytes n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal
  {-# INLINE packedByteCount #-}
  packM :: forall s. PackedBytes n -> Pack s ()
packM PackedBytes n
pb = do
    let !len :: Int
len@(I# Int#
len#) = PackedBytes n -> Int
forall a. MemPack a => a -> Int
packedByteCount PackedBytes n
pb
    i :: Int
i@(I# Int#
i#) <- (Int -> (Int, Int)) -> Pack s Int
forall a. (Int -> (a, Int)) -> Pack s a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Int -> (Int, Int)) -> Pack s Int)
-> (Int -> (Int, Int)) -> Pack s Int
forall a b. (a -> b) -> a -> b
$ \Int
i -> (Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
    mba :: MutableByteArray s
mba@(MutableByteArray MutableByteArray# s
mba#) <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    (MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ()
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ())
-> (MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ()
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
_ -> ST s () -> StateT Int (ST s) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> StateT Int (ST s) ())
-> ST s () -> StateT Int (ST s) ()
forall a b. (a -> b) -> a -> b
$ case PackedBytes n
pb of
      PackedBytes8 Word64
w -> MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
i Word64
w
      PackedBytes28 Word64
w0 Word64
w1 Word64
w2 Word32
w3 -> do
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
i        Word64
w0
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)  Word64
w1
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) Word64
w2
        MutableByteArray s -> Int -> Word32 -> ST s ()
forall s. MutableByteArray s -> Int -> Word32 -> ST s ()
writeWord32BE MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24) Word32
w3
      PackedBytes32 Word64
w0 Word64
w1 Word64
w2 Word64
w3 -> do
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba Int
i        Word64
w0
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)  Word64
w1
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) Word64
w2
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE MutableByteArray s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24) Word64
w3
      PackedBytes# ByteArray#
ba# ->
        (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
st_ (ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
ba# Int#
0# MutableByteArray# s
mba# Int#
i# Int#
len#)
  {-# INLINE packM #-}
  unpackM :: forall b s. Buffer b => Unpack s b (PackedBytes n)
unpackM = do
    let !len :: Int
len = forall a. Num a => Integer -> a
fromInteger @Int (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# n
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# n)
    curPos :: Int
curPos@(I# Int#
curPos#) <- Int -> Unpack s b Int
forall b s. Buffer b => Int -> Unpack s b Int
guardAdvanceUnpack Int
len
    b
buf <- Unpack s b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    PackedBytes n -> Unpack s b (PackedBytes n)
forall a. a -> Unpack s b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackedBytes n -> Unpack s b (PackedBytes n))
-> PackedBytes n -> Unpack s b (PackedBytes n)
forall a b. (a -> b) -> a -> b
$! b
-> (ByteArray# -> Int# -> PackedBytes n)
-> (Addr# -> PackedBytes n)
-> PackedBytes n
forall a. b -> (ByteArray# -> Int# -> a) -> (Addr# -> a) -> a
forall b a.
Buffer b =>
b -> (ByteArray# -> Int# -> a) -> (Addr# -> a) -> a
buffer b
buf
#if MIN_VERSION_mempack(0,2,0)
      (\ByteArray#
ba# Int#
off# -> ShortByteString -> Int -> PackedBytes n
forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> PackedBytes n
packBytes (ByteArray# -> ShortByteString
SBS.SBS ByteArray#
ba#) (Int
curPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# Int#
off#))
#else
      (\ba# -> packBytes (SBS.SBS ba#) curPos)
#endif
      -- Usage of `accursedUnutterablePerformIO` is safe below because there are no memory
      -- allocations happening that depend on the IO monad that we are excaping here. All
      -- IO actions are morally pure reads using pointers into the immutable
      -- memory. Furthermore, in the place where ByteArray is allocated in
      -- `packPinnedPtrN`, mutation and freezing are encapsulated with `runST` and is not
      -- related to the `IO` we are escaping.
      (\Addr#
addr# -> IO (PackedBytes n) -> PackedBytes n
forall a. IO a -> a
accursedUnutterablePerformIO (IO (PackedBytes n) -> PackedBytes n)
-> IO (PackedBytes n) -> PackedBytes n
forall a b. (a -> b) -> a -> b
$ Ptr Any -> IO (PackedBytes n)
forall (n :: Nat) a. KnownNat n => Ptr a -> IO (PackedBytes n)
packPinnedPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
curPos#)))
  {-# INLINE unpackM #-}

instance KnownNat n => ToCBOR (PackedBytes n) where
  toCBOR :: PackedBytes n -> Encoding
toCBOR = ShortByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ShortByteString -> Encoding)
-> (PackedBytes n -> ShortByteString) -> PackedBytes n -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedBytes n -> ShortByteString
forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes
  {-# INLINE toCBOR #-}

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PackedBytes n) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size Proxy (PackedBytes n)
proxy =
    (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ShortByteString -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr (Size -> Proxy t -> Size
forall a b. a -> b -> a
const Size
packedBytesSize) (PackedBytes n -> ShortByteString
forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes (PackedBytes n -> ShortByteString)
-> Proxy (PackedBytes n) -> Proxy ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PackedBytes n)
proxy)
    where
      packedBytesSize :: Size
      packedBytesSize :: Size
packedBytesSize = Integer -> Size
forall a. Num a => Integer -> a
fromInteger (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n))

instance KnownNat n => FromCBOR (PackedBytes n) where
  fromCBOR :: forall s. Decoder s (PackedBytes n)
fromCBOR = Decoder s ByteString
forall s. Decoder s ByteString
D.decodeBytes Decoder s ByteString
-> (ByteString -> Decoder s (PackedBytes n))
-> Decoder s (PackedBytes n)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Decoder s (PackedBytes n)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ByteString -> m (PackedBytes n)
packByteString
  {-# INLINE fromCBOR #-}

instance KnownNat n => Storable (PackedBytes n) where
  sizeOf :: PackedBytes n -> Int
sizeOf PackedBytes n
_ = forall a. Num a => Integer -> a
fromInteger @Int (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n))
  alignment :: PackedBytes n -> Int
alignment PackedBytes n
a =
    -- First explicit values for specialized cases to make alignment dead obvious
    case PackedBytes n -> Int
forall a. Storable a => a -> Int
sizeOf PackedBytes n
a of
      Int
0 -> Int
0
      Int
8 -> Int
8
      Int
28 -> Int
32
      Int
32 -> Int
32
      Int
n   -- Cache line on modern CPUs is 64 bytes, higher alignment is unnecessary
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
64 -> Int
64
          -- Size is already power of two or zero:
        | Int -> Int
forall a. Bits a => a -> Int
popCount Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 -> Int
n
          -- Otherwise set the next highest bit, making it the next closest power of two
        | Bool
otherwise -> Int -> Int
forall a. Bits a => Int -> a
bit (Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Int
n)

  poke :: Ptr (PackedBytes n) -> PackedBytes n -> IO ()
poke Ptr (PackedBytes n)
pbPtr = \case
    PackedBytes8 Word64
w -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (PackedBytes n) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes n)
pbPtr) Word64
w
    PackedBytes28 Word64
w0 Word64
w1 Word64
w2 Word32
w3 ->
      let ptr :: Ptr Word64
ptr = Ptr (PackedBytes n) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes n)
pbPtr
      in Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
ptr Word64
w0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
1 Word64
w1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
2 Word64
w2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Ptr Any -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr (PackedBytes n) -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes n)
pbPtr) (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) Word32
w3
    PackedBytes32 Word64
w0 Word64
w1 Word64
w2 Word64
w3 ->
      let ptr :: Ptr Word64
ptr = Ptr (PackedBytes n) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes n)
pbPtr
      in Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
ptr Word64
w0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
1 Word64
w1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
2 Word64
w2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
3 Word64
w3
    PackedBytes# ByteArray#
ba# -> do
      Ptr Word8 -> ByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteArray -> Int -> Int -> m ()
copyByteArrayToAddr (Ptr (PackedBytes n) -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes n)
pbPtr) (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#) Int
0 (forall a. Num a => Integer -> a
fromInteger @Int (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n)))
  {-# INLINE poke #-}
  peek :: Ptr (PackedBytes n) -> IO (PackedBytes n)
peek Ptr (PackedBytes n)
pbPtr =
    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) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 8
forall {k} (t :: k). Proxy t
Proxy :: Proxy 8) of
          Just n :~: 8
Refl -> Word64 -> PackedBytes n
Word64 -> PackedBytes 8
PackedBytes8 (Word64 -> PackedBytes n) -> IO Word64 -> IO (PackedBytes n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr (PackedBytes n) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes n)
pbPtr)
          Maybe (n :~: 8)
Nothing -> case Proxy n -> Proxy 28 -> Maybe (n :~: 28)
forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 28
forall {k} (t :: k). Proxy t
Proxy :: Proxy 28) of
            Just n :~: 28
Refl -> Ptr (PackedBytes 28) -> IO (PackedBytes 28)
peek28 Ptr (PackedBytes n)
Ptr (PackedBytes 28)
pbPtr
            Maybe (n :~: 28)
Nothing -> case Proxy n -> Proxy 32 -> Maybe (n :~: 32)
forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 32
forall {k} (t :: k). Proxy t
Proxy :: Proxy 32) of
              Just n :~: 32
Refl -> Ptr (PackedBytes 32) -> IO (PackedBytes 32)
peek32 Ptr (PackedBytes n)
Ptr (PackedBytes 32)
pbPtr
              Maybe (n :~: 32)
Nothing -> do
                let n :: Int
n = forall a. Num a => Integer -> a
fromInteger @Int (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n))
                MutableByteArray RealWorld
mba <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
n
                MutableByteArray (PrimState IO) -> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> Ptr a -> Int -> m ()
copyPtrToMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
mba Int
0 (Ptr (PackedBytes n) -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes n)
pbPtr :: Ptr Word8) Int
n
                ByteArray ByteArray#
ba# <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
mba
                PackedBytes n -> IO (PackedBytes n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackedBytes n -> IO (PackedBytes n))
-> PackedBytes n -> IO (PackedBytes n)
forall a b. (a -> b) -> a -> b
$ ByteArray# -> PackedBytes n
forall (n :: Nat). ByteArray# -> PackedBytes n
PackedBytes# ByteArray#
ba#
  {-# INLINE[1] peek #-}

peek28 :: Ptr (PackedBytes 28) -> IO (PackedBytes 28)
peek28 :: Ptr (PackedBytes 28) -> IO (PackedBytes 28)
peek28 Ptr (PackedBytes 28)
pbPtr = do
  let ptr :: Ptr Word64
ptr = Ptr (PackedBytes 28) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes 28)
pbPtr
  Word64
w0 <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
ptr
  Word64
w1 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
1
  Word64
w2 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
2
  Word32
w3 <- Ptr Any -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (Ptr (PackedBytes 28) -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes 28)
pbPtr) (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)
  PackedBytes 28 -> IO (PackedBytes 28)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackedBytes 28 -> IO (PackedBytes 28))
-> PackedBytes 28 -> IO (PackedBytes 28)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word32 -> PackedBytes 28
PackedBytes28 Word64
w0 Word64
w1 Word64
w2 Word32
w3
{-# INLINE peek28 #-}

peek32 :: Ptr (PackedBytes 32) -> IO (PackedBytes 32)
peek32 :: Ptr (PackedBytes 32) -> IO (PackedBytes 32)
peek32 Ptr (PackedBytes 32)
pbPtr = do
  let ptr :: Ptr Word64
ptr = Ptr (PackedBytes 32) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackedBytes 32)
pbPtr
  Word64
w0 <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
ptr
  Word64
w1 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
1
  Word64
w2 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
2
  Word64
w3 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
3
  PackedBytes 32 -> IO (PackedBytes 32)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackedBytes 32 -> IO (PackedBytes 32))
-> PackedBytes 32 -> IO (PackedBytes 32)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> PackedBytes 32
PackedBytes32 Word64
w0 Word64
w1 Word64
w2 Word64
w3
{-# INLINE peek32 #-}

{-# RULES
"peek28" peek = peek28
"peek32" peek = peek32
  #-}

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 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 #-}

unpackAsByteArray :: PackedBytes n -> ByteArray
unpackAsByteArray :: forall (n :: Nat). PackedBytes n -> ByteArray
unpackAsByteArray = (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 unpackAsByteArray #-}

unpackBytes :: PackedBytes n -> ShortByteString
unpackBytes :: forall (n :: Nat). 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 :: forall (n :: Nat). 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 :: 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 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 :: forall (n :: Nat).
KnownNat n =>
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) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 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) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 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) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 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 :: forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> Maybe (PackedBytes n)
packBytesMaybe = ShortByteString -> Int -> Maybe (PackedBytes n)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ShortByteString -> Int -> m (PackedBytes n)
packShortByteStringWithOffset
{-# INLINE packBytesMaybe #-}
{-# DEPRECATED packBytesMaybe "In favor of `packShortByteStringWithOffset`" #-}

-- | Construct `PackedBytes` from a `ShortByteString`. This function is safe and will fail
--  if the buffer size does not match expected size of packed bytes exactly.
--
-- @since 2.3.0.0
packByteString :: forall n m. (KnownNat n, MonadFail m) => ByteString -> m (PackedBytes n)
packByteString :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ByteString -> m (PackedBytes n)
packByteString = (ByteString -> Int)
-> (ByteString -> PackedBytes n) -> ByteString -> m (PackedBytes n)
forall b (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
(b -> Int) -> (b -> PackedBytes n) -> b -> m (PackedBytes n)
packedBytesSizeGuard ByteString -> Int
BS.length ByteString -> PackedBytes n
forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes
{-# INLINE packByteString #-}

-- | Construct `PackedBytes` from a `ShortByteString`. This function is safe and will fail
--  if the buffer size does not match expected size of packed bytes exactly.
--
-- @since 2.3.0.0
packShortByteString :: forall n m. (KnownNat n, MonadFail m) => ShortByteString -> m (PackedBytes n)
packShortByteString :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ShortByteString -> m (PackedBytes n)
packShortByteString = (ShortByteString -> Int)
-> (ShortByteString -> PackedBytes n)
-> ShortByteString
-> m (PackedBytes n)
forall b (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
(b -> Int) -> (b -> PackedBytes n) -> b -> m (PackedBytes n)
packedBytesSizeGuard ShortByteString -> Int
SBS.length (ShortByteString -> Int -> PackedBytes n
forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> PackedBytes n
`packBytes` Int
0)
{-# INLINE packShortByteString #-}

packedBytesSizeGuard ::
  forall b n m. (KnownNat n, MonadFail m) =>
  -- | Function for getting the size of the source buffer
  (b -> Int) ->
  -- | Function for packing the buffer in full
  (b -> PackedBytes n) ->
  -- | The actual buffer to be packed
  b ->
  m (PackedBytes n)
packedBytesSizeGuard :: forall b (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
(b -> Int) -> (b -> PackedBytes n) -> b -> m (PackedBytes n)
packedBytesSizeGuard b -> Int
getSizeOfBuffer b -> PackedBytes n
packBuffer b
buf = do
  let bufferSize :: Int
bufferSize = b -> Int
getSizeOfBuffer b
buf
      size :: Int
size = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n))
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bufferSize) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Number of bytes mismatch. Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
size String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" number of bytes, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
bufferSize
  PackedBytes n -> m (PackedBytes n)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackedBytes n -> m (PackedBytes n))
-> PackedBytes n -> m (PackedBytes n)
forall a b. (a -> b) -> a -> b
$ b -> PackedBytes n
packBuffer b
buf
{-# INLINE packedBytesSizeGuard #-}

-- | Construct `PackedBytes` from a `ShortByteString` and a non-negative offset in number of bytes
-- from the beginning. This function is safe, but it only checks whether there are enough
-- bytes. I.e. it doesn't enforce full buffer consumption. If you need to check that
-- buffer has no other data except what is being packed, then use `packShortByteString` instead
--
-- @since 2.2.4.0
packShortByteStringWithOffset ::
  forall n m. (KnownNat n, MonadFail m) =>
  ShortByteString ->
  -- ^ Buffer to read data from
  Int ->
  -- ^ Non-negative offset into the buffer, where packing will start from.
  m (PackedBytes n)
packShortByteStringWithOffset :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ShortByteString -> Int -> m (PackedBytes n)
packShortByteStringWithOffset 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' (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n))
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected non-negative offset, but got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
offset
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"Not enough data. Expected to read "
                   , Int -> String
forall a. Show a => a -> String
show Int
size
                   , String
" number of bytes, but supplied buffer has only "
                   , Int -> String
forall a. Show a => a -> String
show Int
bufferSize
                   , String
", which is not enough when reading from "
                   , Int -> String
forall a. Show a => a -> String
show Int
offset
                   , String
" offset."
                   ]
  PackedBytes n -> m (PackedBytes n)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackedBytes n -> m (PackedBytes n))
-> PackedBytes n -> m (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
{-# INLINE packShortByteStringWithOffset #-}


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

packPinnedPtr28 :: Ptr a -> IO (PackedBytes 28)
packPinnedPtr28 :: forall a. Ptr a -> IO (PackedBytes 28)
packPinnedPtr28 Ptr a
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 a -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
0
    IO (Word64 -> Word64 -> Word32 -> PackedBytes 28)
-> IO Word64 -> IO (Word64 -> Word32 -> PackedBytes 28)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr a -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
8
    IO (Word64 -> Word32 -> PackedBytes 28)
-> IO Word64 -> IO (Word32 -> PackedBytes 28)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr a -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
16
    IO (Word32 -> PackedBytes 28) -> IO Word32 -> IO (PackedBytes 28)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr a -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
peekWord32BE Ptr a
ptr Int
24
{-# INLINE packPinnedPtr28 #-}

packPinnedPtr32 :: Ptr a -> IO (PackedBytes 32)
packPinnedPtr32 :: forall a. Ptr a -> IO (PackedBytes 32)
packPinnedPtr32 Ptr a
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 a -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
0
                IO (Word64 -> Word64 -> Word64 -> PackedBytes 32)
-> IO Word64 -> IO (Word64 -> Word64 -> PackedBytes 32)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr a -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
8
                IO (Word64 -> Word64 -> PackedBytes 32)
-> IO Word64 -> IO (Word64 -> PackedBytes 32)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr a -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
16
                IO (Word64 -> PackedBytes 32) -> IO Word64 -> IO (PackedBytes 32)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr a -> Int -> IO Word64
forall a. Ptr a -> Int -> IO Word64
peekWord64BE Ptr a
ptr Int
24
{-# INLINE packPinnedPtr32 #-}

packPinnedPtrN :: forall n a. KnownNat n => Ptr a -> IO (PackedBytes n)
packPinnedPtrN :: forall (n :: Nat) a. KnownNat n => Ptr a -> IO (PackedBytes n)
packPinnedPtrN (Ptr Addr#
addr#) = PackedBytes n -> IO (PackedBytes n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackedBytes n -> IO (PackedBytes n))
-> PackedBytes n -> IO (PackedBytes n)
forall a b. (a -> b) -> a -> b
$! ByteArray# -> PackedBytes n
forall (n :: Nat). ByteArray# -> PackedBytes n
PackedBytes# ByteArray#
ba#
  where
    !(ByteArray ByteArray#
ba#) = Int -> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
withMutableByteArray Int
len ((forall s. MutableByteArray s -> ST s ()) -> ByteArray)
-> (forall s. MutableByteArray s -> ST s ()) -> ByteArray
forall a b. (a -> b) -> a -> b
$ \(MutableByteArray MutableByteArray# s
mba#) ->
           (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
st_ (Addr#
-> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr# MutableByteArray# s
mba# Int#
0# Int#
len#)
    !len :: Int
len@(I# Int#
len#) = 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# :: Proxy# n))
{-# INLINE packPinnedPtrN #-}

packPinnedPtr :: forall n a. KnownNat n => Ptr a -> IO (PackedBytes n)
packPinnedPtr :: forall (n :: Nat) a. KnownNat n => Ptr a -> IO (PackedBytes n)
packPinnedPtr Ptr a
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) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 8
forall {k} (t :: k). Proxy t
Proxy :: Proxy 8) of
        Just n :~: 8
Refl -> Ptr a -> IO (PackedBytes 8)
forall a. Ptr a -> IO (PackedBytes 8)
packPinnedPtr8 Ptr a
bs
        Maybe (n :~: 8)
Nothing -> case Proxy n -> Proxy 28 -> Maybe (n :~: 28)
forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 28
forall {k} (t :: k). Proxy t
Proxy :: Proxy 28) of
          Just n :~: 28
Refl -> Ptr a -> IO (PackedBytes 28)
forall a. Ptr a -> IO (PackedBytes 28)
packPinnedPtr28 Ptr a
bs
          Maybe (n :~: 28)
Nothing -> case Proxy n -> Proxy 32 -> Maybe (n :~: 32)
forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *)
       (proxy2 :: Nat -> *).
(KnownNat a, KnownNat b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameNat Proxy n
px (Proxy 32
forall {k} (t :: k). Proxy t
Proxy :: Proxy 32) of
            Just n :~: 32
Refl -> Ptr a -> IO (PackedBytes 32)
forall a. Ptr a -> IO (PackedBytes 32)
packPinnedPtr32 Ptr a
bs
            Maybe (n :~: 32)
Nothing   -> Ptr a -> IO (PackedBytes n)
forall (n :: Nat) a. KnownNat n => Ptr a -> IO (PackedBytes n)
packPinnedPtrN Ptr a
bs
{-# INLINE[1] packPinnedPtr #-}
{-# RULES
"packPinnedPtr8"  packPinnedPtr = packPinnedPtr8
"packPinnedPtr28" packPinnedPtr = packPinnedPtr28
"packPinnedPtr32" packPinnedPtr = packPinnedPtr32
  #-}

packPinnedBytes :: forall n . KnownNat n => ByteString -> PackedBytes n
packPinnedBytes :: forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes ByteString
bs = ByteString -> (Ptr Any -> IO (PackedBytes n)) -> PackedBytes n
forall b a. ByteString -> (Ptr b -> IO a) -> a
unsafeWithByteStringPtr ByteString
bs Ptr Any -> IO (PackedBytes n)
forall (n :: Nat) a. KnownNat n => Ptr a -> IO (PackedBytes n)
packPinnedPtr
{-# INLINE packPinnedBytes #-}


--- 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
  Word64# -> Word64
W64# (Word64# -> Word64#
byteSwap64# (ByteArray# -> Int# -> Word64#
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 (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. Ptr a -> 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 :: forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE (MutableByteArray MutableByteArray# s
mba#) (I# Int#
i#) (W64# Word64#
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# -> Word64# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word64# -> State# d -> State# d
writeWord8ArrayAsWord64# MutableByteArray# s
mba# Int#
i# Word64#
wbe#)
  where
#ifdef WORDS_BIGENDIAN
    !wbe# = w#
#else
    !wbe# :: Word64#
wbe# = Word64# -> Word64#
byteSwap64# Word64#
w#
#endif
{-# INLINE writeWord64BE #-}

#elif WORD_SIZE_IN_BITS == 32

indexWord64BE :: ByteArray -> Int -> Word64
indexWord64BE ba i =
  (fromIntegral @Word32 @Word64 (indexWord32BE ba i) `shiftL` 32) .|. fromIntegral @Word32 @Word64 (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 @Word32 @Word64 u `shiftL` 32) .|. fromIntegral @Word32 @Word64 l)
{-# INLINE peekWord64BE #-}

writeWord64BE :: MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64BE mba i w64 = do
  writeWord32BE mba i (fromIntegral @Word64 @Word32 (w64 `shiftR` 32))
  writeWord32BE mba (i + 4) (fromIntegral @Word64 @Word32 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 b. Ptr b -> 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 b. Ptr b -> 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 :: forall s. 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# -> Word32# -> State# s -> State# s
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 #-}

-- 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 =
  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 = withForeignPtr
{-# INLINE unsafeWithForeignPtr #-}
#endif