{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}

module Data.StaticBytes
  ( Bytes8
  , Bytes16
  , Bytes32
  , Bytes64
  , Bytes128
  , DynamicBytes
  , StaticBytes
  , StaticBytesException (..)
  , toStaticExact
  , toStaticPad
  , toStaticTruncate
  , toStaticPadTruncate
  , fromStatic
  ) where

import           Data.Bits ( Bits (..) )
import           Data.ByteArray ( ByteArrayAccess (..) )
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.Primitive.ByteArray as BA
#if MIN_VERSION_GLASGOW_HASKELL(9,4,1,0)
import           Data.Type.Equality ( type (~) )
#endif
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Base as VU
import           Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
import           Foreign.Ptr ( Ptr, castPtr )
import           Foreign.Storable ( Storable (..) )
import           GHC.ByteOrder ( ByteOrder (..), targetByteOrder )
import           RIO hiding ( words )
import           System.IO.Unsafe ( unsafePerformIO )

-- | A type representing 8 bytes of data.

newtype Bytes8 = Bytes8 Word64
  deriving (Bytes8 -> Bytes8 -> Bool
(Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool) -> Eq Bytes8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bytes8 -> Bytes8 -> Bool
== :: Bytes8 -> Bytes8 -> Bool
$c/= :: Bytes8 -> Bytes8 -> Bool
/= :: Bytes8 -> Bytes8 -> Bool
Eq, Eq Bytes8
Eq Bytes8 =>
(Bytes8 -> Bytes8 -> Ordering)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bytes8)
-> (Bytes8 -> Bytes8 -> Bytes8)
-> Ord Bytes8
Bytes8 -> Bytes8 -> Bool
Bytes8 -> Bytes8 -> Ordering
Bytes8 -> Bytes8 -> Bytes8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bytes8 -> Bytes8 -> Ordering
compare :: Bytes8 -> Bytes8 -> Ordering
$c< :: Bytes8 -> Bytes8 -> Bool
< :: Bytes8 -> Bytes8 -> Bool
$c<= :: Bytes8 -> Bytes8 -> Bool
<= :: Bytes8 -> Bytes8 -> Bool
$c> :: Bytes8 -> Bytes8 -> Bool
> :: Bytes8 -> Bytes8 -> Bool
$c>= :: Bytes8 -> Bytes8 -> Bool
>= :: Bytes8 -> Bytes8 -> Bool
$cmax :: Bytes8 -> Bytes8 -> Bytes8
max :: Bytes8 -> Bytes8 -> Bytes8
$cmin :: Bytes8 -> Bytes8 -> Bytes8
min :: Bytes8 -> Bytes8 -> Bytes8
Ord, (forall x. Bytes8 -> Rep Bytes8 x)
-> (forall x. Rep Bytes8 x -> Bytes8) -> Generic Bytes8
forall x. Rep Bytes8 x -> Bytes8
forall x. Bytes8 -> Rep Bytes8 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes8 -> Rep Bytes8 x
from :: forall x. Bytes8 -> Rep Bytes8 x
$cto :: forall x. Rep Bytes8 x -> Bytes8
to :: forall x. Rep Bytes8 x -> Bytes8
Generic, Bytes8 -> ()
(Bytes8 -> ()) -> NFData Bytes8
forall a. (a -> ()) -> NFData a
$crnf :: Bytes8 -> ()
rnf :: Bytes8 -> ()
NFData, Eq Bytes8
Eq Bytes8 =>
(Int -> Bytes8 -> Int) -> (Bytes8 -> Int) -> Hashable Bytes8
Int -> Bytes8 -> Int
Bytes8 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Bytes8 -> Int
hashWithSalt :: Int -> Bytes8 -> Int
$chash :: Bytes8 -> Int
hash :: Bytes8 -> Int
Hashable, Typeable Bytes8
Typeable Bytes8 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Bytes8 -> c Bytes8)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes8)
-> (Bytes8 -> Constr)
-> (Bytes8 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes8))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8))
-> ((forall b. Data b => b -> b) -> Bytes8 -> Bytes8)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes8 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes8 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8)
-> Data Bytes8
Bytes8 -> DataType
Bytes8 -> Constr
(forall b. Data b => b -> b) -> Bytes8 -> Bytes8
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes8 -> u
forall u. (forall d. Data d => d -> u) -> Bytes8 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes8
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes8 -> c Bytes8
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes8)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes8 -> c Bytes8
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes8 -> c Bytes8
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes8
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes8
$ctoConstr :: Bytes8 -> Constr
toConstr :: Bytes8 -> Constr
$cdataTypeOf :: Bytes8 -> DataType
dataTypeOf :: Bytes8 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes8)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes8)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8)
$cgmapT :: (forall b. Data b => b -> b) -> Bytes8 -> Bytes8
gmapT :: (forall b. Data b => b -> b) -> Bytes8 -> Bytes8
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes8 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes8 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes8 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes8 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
Data)

instance Show Bytes8 where
  show :: Bytes8 -> String
show (Bytes8 Word64
w) = ByteString -> String
forall a. Show a => a -> String
show (Int -> [Word64] -> ByteString
forall dbytes. DynamicBytes dbytes => Int -> [Word64] -> dbytes
fromWordsD Int
8 [Word64
w] :: B.ByteString)

-- | A type representing 16 bytes of data.

data Bytes16 = Bytes16 !Bytes8 !Bytes8
  deriving (Int -> Bytes16 -> ShowS
[Bytes16] -> ShowS
Bytes16 -> String
(Int -> Bytes16 -> ShowS)
-> (Bytes16 -> String) -> ([Bytes16] -> ShowS) -> Show Bytes16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bytes16 -> ShowS
showsPrec :: Int -> Bytes16 -> ShowS
$cshow :: Bytes16 -> String
show :: Bytes16 -> String
$cshowList :: [Bytes16] -> ShowS
showList :: [Bytes16] -> ShowS
Show, Bytes16 -> Bytes16 -> Bool
(Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool) -> Eq Bytes16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bytes16 -> Bytes16 -> Bool
== :: Bytes16 -> Bytes16 -> Bool
$c/= :: Bytes16 -> Bytes16 -> Bool
/= :: Bytes16 -> Bytes16 -> Bool
Eq, Eq Bytes16
Eq Bytes16 =>
(Bytes16 -> Bytes16 -> Ordering)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bytes16)
-> (Bytes16 -> Bytes16 -> Bytes16)
-> Ord Bytes16
Bytes16 -> Bytes16 -> Bool
Bytes16 -> Bytes16 -> Ordering
Bytes16 -> Bytes16 -> Bytes16
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bytes16 -> Bytes16 -> Ordering
compare :: Bytes16 -> Bytes16 -> Ordering
$c< :: Bytes16 -> Bytes16 -> Bool
< :: Bytes16 -> Bytes16 -> Bool
$c<= :: Bytes16 -> Bytes16 -> Bool
<= :: Bytes16 -> Bytes16 -> Bool
$c> :: Bytes16 -> Bytes16 -> Bool
> :: Bytes16 -> Bytes16 -> Bool
$c>= :: Bytes16 -> Bytes16 -> Bool
>= :: Bytes16 -> Bytes16 -> Bool
$cmax :: Bytes16 -> Bytes16 -> Bytes16
max :: Bytes16 -> Bytes16 -> Bytes16
$cmin :: Bytes16 -> Bytes16 -> Bytes16
min :: Bytes16 -> Bytes16 -> Bytes16
Ord, (forall x. Bytes16 -> Rep Bytes16 x)
-> (forall x. Rep Bytes16 x -> Bytes16) -> Generic Bytes16
forall x. Rep Bytes16 x -> Bytes16
forall x. Bytes16 -> Rep Bytes16 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes16 -> Rep Bytes16 x
from :: forall x. Bytes16 -> Rep Bytes16 x
$cto :: forall x. Rep Bytes16 x -> Bytes16
to :: forall x. Rep Bytes16 x -> Bytes16
Generic, Bytes16 -> ()
(Bytes16 -> ()) -> NFData Bytes16
forall a. (a -> ()) -> NFData a
$crnf :: Bytes16 -> ()
rnf :: Bytes16 -> ()
NFData, Eq Bytes16
Eq Bytes16 =>
(Int -> Bytes16 -> Int) -> (Bytes16 -> Int) -> Hashable Bytes16
Int -> Bytes16 -> Int
Bytes16 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Bytes16 -> Int
hashWithSalt :: Int -> Bytes16 -> Int
$chash :: Bytes16 -> Int
hash :: Bytes16 -> Int
Hashable, Typeable Bytes16
Typeable Bytes16 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Bytes16 -> c Bytes16)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes16)
-> (Bytes16 -> Constr)
-> (Bytes16 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes16))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16))
-> ((forall b. Data b => b -> b) -> Bytes16 -> Bytes16)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes16 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes16 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes16 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes16 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16)
-> Data Bytes16
Bytes16 -> DataType
Bytes16 -> Constr
(forall b. Data b => b -> b) -> Bytes16 -> Bytes16
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes16 -> u
forall u. (forall d. Data d => d -> u) -> Bytes16 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes16
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes16 -> c Bytes16
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes16)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes16 -> c Bytes16
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes16 -> c Bytes16
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes16
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes16
$ctoConstr :: Bytes16 -> Constr
toConstr :: Bytes16 -> Constr
$cdataTypeOf :: Bytes16 -> DataType
dataTypeOf :: Bytes16 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes16)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes16)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16)
$cgmapT :: (forall b. Data b => b -> b) -> Bytes16 -> Bytes16
gmapT :: (forall b. Data b => b -> b) -> Bytes16 -> Bytes16
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes16 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes16 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes16 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes16 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
Data)

-- | A type representing 32 bytes of data.

data Bytes32 = Bytes32 !Bytes16 !Bytes16
  deriving (Int -> Bytes32 -> ShowS
[Bytes32] -> ShowS
Bytes32 -> String
(Int -> Bytes32 -> ShowS)
-> (Bytes32 -> String) -> ([Bytes32] -> ShowS) -> Show Bytes32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bytes32 -> ShowS
showsPrec :: Int -> Bytes32 -> ShowS
$cshow :: Bytes32 -> String
show :: Bytes32 -> String
$cshowList :: [Bytes32] -> ShowS
showList :: [Bytes32] -> ShowS
Show, Bytes32 -> Bytes32 -> Bool
(Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool) -> Eq Bytes32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bytes32 -> Bytes32 -> Bool
== :: Bytes32 -> Bytes32 -> Bool
$c/= :: Bytes32 -> Bytes32 -> Bool
/= :: Bytes32 -> Bytes32 -> Bool
Eq, Eq Bytes32
Eq Bytes32 =>
(Bytes32 -> Bytes32 -> Ordering)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bytes32)
-> (Bytes32 -> Bytes32 -> Bytes32)
-> Ord Bytes32
Bytes32 -> Bytes32 -> Bool
Bytes32 -> Bytes32 -> Ordering
Bytes32 -> Bytes32 -> Bytes32
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bytes32 -> Bytes32 -> Ordering
compare :: Bytes32 -> Bytes32 -> Ordering
$c< :: Bytes32 -> Bytes32 -> Bool
< :: Bytes32 -> Bytes32 -> Bool
$c<= :: Bytes32 -> Bytes32 -> Bool
<= :: Bytes32 -> Bytes32 -> Bool
$c> :: Bytes32 -> Bytes32 -> Bool
> :: Bytes32 -> Bytes32 -> Bool
$c>= :: Bytes32 -> Bytes32 -> Bool
>= :: Bytes32 -> Bytes32 -> Bool
$cmax :: Bytes32 -> Bytes32 -> Bytes32
max :: Bytes32 -> Bytes32 -> Bytes32
$cmin :: Bytes32 -> Bytes32 -> Bytes32
min :: Bytes32 -> Bytes32 -> Bytes32
Ord, (forall x. Bytes32 -> Rep Bytes32 x)
-> (forall x. Rep Bytes32 x -> Bytes32) -> Generic Bytes32
forall x. Rep Bytes32 x -> Bytes32
forall x. Bytes32 -> Rep Bytes32 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes32 -> Rep Bytes32 x
from :: forall x. Bytes32 -> Rep Bytes32 x
$cto :: forall x. Rep Bytes32 x -> Bytes32
to :: forall x. Rep Bytes32 x -> Bytes32
Generic, Bytes32 -> ()
(Bytes32 -> ()) -> NFData Bytes32
forall a. (a -> ()) -> NFData a
$crnf :: Bytes32 -> ()
rnf :: Bytes32 -> ()
NFData, Eq Bytes32
Eq Bytes32 =>
(Int -> Bytes32 -> Int) -> (Bytes32 -> Int) -> Hashable Bytes32
Int -> Bytes32 -> Int
Bytes32 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Bytes32 -> Int
hashWithSalt :: Int -> Bytes32 -> Int
$chash :: Bytes32 -> Int
hash :: Bytes32 -> Int
Hashable, Typeable Bytes32
Typeable Bytes32 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Bytes32 -> c Bytes32)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes32)
-> (Bytes32 -> Constr)
-> (Bytes32 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes32))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32))
-> ((forall b. Data b => b -> b) -> Bytes32 -> Bytes32)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes32 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes32 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes32 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes32 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32)
-> Data Bytes32
Bytes32 -> DataType
Bytes32 -> Constr
(forall b. Data b => b -> b) -> Bytes32 -> Bytes32
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes32 -> u
forall u. (forall d. Data d => d -> u) -> Bytes32 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes32
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes32 -> c Bytes32
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes32)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes32 -> c Bytes32
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes32 -> c Bytes32
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes32
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes32
$ctoConstr :: Bytes32 -> Constr
toConstr :: Bytes32 -> Constr
$cdataTypeOf :: Bytes32 -> DataType
dataTypeOf :: Bytes32 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes32)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes32)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32)
$cgmapT :: (forall b. Data b => b -> b) -> Bytes32 -> Bytes32
gmapT :: (forall b. Data b => b -> b) -> Bytes32 -> Bytes32
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes32 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes32 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes32 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes32 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
Data)

-- | A type representing 64 bytes of data.

data Bytes64 = Bytes64 !Bytes32 !Bytes32
  deriving (Int -> Bytes64 -> ShowS
[Bytes64] -> ShowS
Bytes64 -> String
(Int -> Bytes64 -> ShowS)
-> (Bytes64 -> String) -> ([Bytes64] -> ShowS) -> Show Bytes64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bytes64 -> ShowS
showsPrec :: Int -> Bytes64 -> ShowS
$cshow :: Bytes64 -> String
show :: Bytes64 -> String
$cshowList :: [Bytes64] -> ShowS
showList :: [Bytes64] -> ShowS
Show, Bytes64 -> Bytes64 -> Bool
(Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool) -> Eq Bytes64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bytes64 -> Bytes64 -> Bool
== :: Bytes64 -> Bytes64 -> Bool
$c/= :: Bytes64 -> Bytes64 -> Bool
/= :: Bytes64 -> Bytes64 -> Bool
Eq, Eq Bytes64
Eq Bytes64 =>
(Bytes64 -> Bytes64 -> Ordering)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bytes64)
-> (Bytes64 -> Bytes64 -> Bytes64)
-> Ord Bytes64
Bytes64 -> Bytes64 -> Bool
Bytes64 -> Bytes64 -> Ordering
Bytes64 -> Bytes64 -> Bytes64
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bytes64 -> Bytes64 -> Ordering
compare :: Bytes64 -> Bytes64 -> Ordering
$c< :: Bytes64 -> Bytes64 -> Bool
< :: Bytes64 -> Bytes64 -> Bool
$c<= :: Bytes64 -> Bytes64 -> Bool
<= :: Bytes64 -> Bytes64 -> Bool
$c> :: Bytes64 -> Bytes64 -> Bool
> :: Bytes64 -> Bytes64 -> Bool
$c>= :: Bytes64 -> Bytes64 -> Bool
>= :: Bytes64 -> Bytes64 -> Bool
$cmax :: Bytes64 -> Bytes64 -> Bytes64
max :: Bytes64 -> Bytes64 -> Bytes64
$cmin :: Bytes64 -> Bytes64 -> Bytes64
min :: Bytes64 -> Bytes64 -> Bytes64
Ord, (forall x. Bytes64 -> Rep Bytes64 x)
-> (forall x. Rep Bytes64 x -> Bytes64) -> Generic Bytes64
forall x. Rep Bytes64 x -> Bytes64
forall x. Bytes64 -> Rep Bytes64 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes64 -> Rep Bytes64 x
from :: forall x. Bytes64 -> Rep Bytes64 x
$cto :: forall x. Rep Bytes64 x -> Bytes64
to :: forall x. Rep Bytes64 x -> Bytes64
Generic, Bytes64 -> ()
(Bytes64 -> ()) -> NFData Bytes64
forall a. (a -> ()) -> NFData a
$crnf :: Bytes64 -> ()
rnf :: Bytes64 -> ()
NFData, Eq Bytes64
Eq Bytes64 =>
(Int -> Bytes64 -> Int) -> (Bytes64 -> Int) -> Hashable Bytes64
Int -> Bytes64 -> Int
Bytes64 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Bytes64 -> Int
hashWithSalt :: Int -> Bytes64 -> Int
$chash :: Bytes64 -> Int
hash :: Bytes64 -> Int
Hashable, Typeable Bytes64
Typeable Bytes64 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Bytes64 -> c Bytes64)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes64)
-> (Bytes64 -> Constr)
-> (Bytes64 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes64))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64))
-> ((forall b. Data b => b -> b) -> Bytes64 -> Bytes64)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes64 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes64 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes64 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes64 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64)
-> Data Bytes64
Bytes64 -> DataType
Bytes64 -> Constr
(forall b. Data b => b -> b) -> Bytes64 -> Bytes64
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes64 -> u
forall u. (forall d. Data d => d -> u) -> Bytes64 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes64
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes64 -> c Bytes64
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes64)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes64 -> c Bytes64
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes64 -> c Bytes64
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes64
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes64
$ctoConstr :: Bytes64 -> Constr
toConstr :: Bytes64 -> Constr
$cdataTypeOf :: Bytes64 -> DataType
dataTypeOf :: Bytes64 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes64)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes64)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64)
$cgmapT :: (forall b. Data b => b -> b) -> Bytes64 -> Bytes64
gmapT :: (forall b. Data b => b -> b) -> Bytes64 -> Bytes64
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes64 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes64 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes64 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes64 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
Data)

-- | A type representing 128 bytes of data.

data Bytes128 = Bytes128 !Bytes64 !Bytes64
  deriving (Int -> Bytes128 -> ShowS
[Bytes128] -> ShowS
Bytes128 -> String
(Int -> Bytes128 -> ShowS)
-> (Bytes128 -> String) -> ([Bytes128] -> ShowS) -> Show Bytes128
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bytes128 -> ShowS
showsPrec :: Int -> Bytes128 -> ShowS
$cshow :: Bytes128 -> String
show :: Bytes128 -> String
$cshowList :: [Bytes128] -> ShowS
showList :: [Bytes128] -> ShowS
Show, Bytes128 -> Bytes128 -> Bool
(Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool) -> Eq Bytes128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bytes128 -> Bytes128 -> Bool
== :: Bytes128 -> Bytes128 -> Bool
$c/= :: Bytes128 -> Bytes128 -> Bool
/= :: Bytes128 -> Bytes128 -> Bool
Eq, Eq Bytes128
Eq Bytes128 =>
(Bytes128 -> Bytes128 -> Ordering)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bytes128)
-> (Bytes128 -> Bytes128 -> Bytes128)
-> Ord Bytes128
Bytes128 -> Bytes128 -> Bool
Bytes128 -> Bytes128 -> Ordering
Bytes128 -> Bytes128 -> Bytes128
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bytes128 -> Bytes128 -> Ordering
compare :: Bytes128 -> Bytes128 -> Ordering
$c< :: Bytes128 -> Bytes128 -> Bool
< :: Bytes128 -> Bytes128 -> Bool
$c<= :: Bytes128 -> Bytes128 -> Bool
<= :: Bytes128 -> Bytes128 -> Bool
$c> :: Bytes128 -> Bytes128 -> Bool
> :: Bytes128 -> Bytes128 -> Bool
$c>= :: Bytes128 -> Bytes128 -> Bool
>= :: Bytes128 -> Bytes128 -> Bool
$cmax :: Bytes128 -> Bytes128 -> Bytes128
max :: Bytes128 -> Bytes128 -> Bytes128
$cmin :: Bytes128 -> Bytes128 -> Bytes128
min :: Bytes128 -> Bytes128 -> Bytes128
Ord, (forall x. Bytes128 -> Rep Bytes128 x)
-> (forall x. Rep Bytes128 x -> Bytes128) -> Generic Bytes128
forall x. Rep Bytes128 x -> Bytes128
forall x. Bytes128 -> Rep Bytes128 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes128 -> Rep Bytes128 x
from :: forall x. Bytes128 -> Rep Bytes128 x
$cto :: forall x. Rep Bytes128 x -> Bytes128
to :: forall x. Rep Bytes128 x -> Bytes128
Generic, Bytes128 -> ()
(Bytes128 -> ()) -> NFData Bytes128
forall a. (a -> ()) -> NFData a
$crnf :: Bytes128 -> ()
rnf :: Bytes128 -> ()
NFData, Eq Bytes128
Eq Bytes128 =>
(Int -> Bytes128 -> Int) -> (Bytes128 -> Int) -> Hashable Bytes128
Int -> Bytes128 -> Int
Bytes128 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Bytes128 -> Int
hashWithSalt :: Int -> Bytes128 -> Int
$chash :: Bytes128 -> Int
hash :: Bytes128 -> Int
Hashable, Typeable Bytes128
Typeable Bytes128 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Bytes128 -> c Bytes128)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes128)
-> (Bytes128 -> Constr)
-> (Bytes128 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes128))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128))
-> ((forall b. Data b => b -> b) -> Bytes128 -> Bytes128)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes128 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes128 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes128 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes128 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128)
-> Data Bytes128
Bytes128 -> DataType
Bytes128 -> Constr
(forall b. Data b => b -> b) -> Bytes128 -> Bytes128
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes128 -> u
forall u. (forall d. Data d => d -> u) -> Bytes128 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes128
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes128 -> c Bytes128
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes128)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes128 -> c Bytes128
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes128 -> c Bytes128
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes128
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes128
$ctoConstr :: Bytes128 -> Constr
toConstr :: Bytes128 -> Constr
$cdataTypeOf :: Bytes128 -> DataType
dataTypeOf :: Bytes128 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes128)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes128)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128)
$cgmapT :: (forall b. Data b => b -> b) -> Bytes128 -> Bytes128
gmapT :: (forall b. Data b => b -> b) -> Bytes128 -> Bytes128
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes128 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes128 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes128 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes128 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
Data)

-- | A type representing exceptions thrown by functions expecting data of a

-- fixed number of bytes.

data StaticBytesException
  = NotEnoughBytes
  | TooManyBytes
  deriving (StaticBytesException -> StaticBytesException -> Bool
(StaticBytesException -> StaticBytesException -> Bool)
-> (StaticBytesException -> StaticBytesException -> Bool)
-> Eq StaticBytesException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticBytesException -> StaticBytesException -> Bool
== :: StaticBytesException -> StaticBytesException -> Bool
$c/= :: StaticBytesException -> StaticBytesException -> Bool
/= :: StaticBytesException -> StaticBytesException -> Bool
Eq, Int -> StaticBytesException -> ShowS
[StaticBytesException] -> ShowS
StaticBytesException -> String
(Int -> StaticBytesException -> ShowS)
-> (StaticBytesException -> String)
-> ([StaticBytesException] -> ShowS)
-> Show StaticBytesException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticBytesException -> ShowS
showsPrec :: Int -> StaticBytesException -> ShowS
$cshow :: StaticBytesException -> String
show :: StaticBytesException -> String
$cshowList :: [StaticBytesException] -> ShowS
showList :: [StaticBytesException] -> ShowS
Show, Typeable)

instance Exception StaticBytesException

-- All lengths below are given in bytes


class DynamicBytes dbytes where
  lengthD :: dbytes -> Int
  -- Yeah, it looks terrible to use a list here, but fusion should kick in

  withPeekD :: dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
  -- ^ This assumes that the Word64 values are all little-endian.

  -- | May throw a runtime exception if invariants are violated!

  fromWordsD :: Int -> [Word64] -> dbytes
  -- ^ This assumes that the Word64 values are all little-endian.


fromWordsForeign ::
     (ForeignPtr a -> Int -> b)
  -> Int
  -> [Word64]
     -- ^ The Word64 values are assumed to be little-endian.

  -> b
fromWordsForeign :: forall a b. (ForeignPtr a -> Int -> b) -> Int -> [Word64] -> b
fromWordsForeign ForeignPtr a -> Int -> b
wrapper Int
len [Word64]
words0 = IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr a
fptr <- Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
len
  ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
    let loop :: Int -> [Word64] -> IO ()
loop Int
_ [] = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        loop Int
off (Word64
w:[Word64]
ws) = do
          Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr a -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
off (Word64 -> Word64
fromLE64 Word64
w)
          Int -> [Word64] -> IO ()
loop (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word64]
ws
    Int -> [Word64] -> IO ()
loop Int
0 [Word64]
words0
  b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Int -> b
wrapper ForeignPtr a
fptr Int
len

withPeekForeign ::
     (ForeignPtr a, Int, Int)
  -> ((Int -> IO Word64) -> IO b)
     -- ^ The Word64 values are assumed to be little-endian.

  -> IO b
withPeekForeign :: forall a b.
(ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -> IO b
withPeekForeign (ForeignPtr a
fptr, Int
off, Int
len) (Int -> IO Word64) -> IO b
inner =
  ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
    let f :: Int -> IO Word64
f Int
off'
          | Int
off' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
          | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len = do
              let loop :: Word64 -> Int -> IO Word64
loop Word64
w64 Int
i
                    | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
w64
                    | Bool
otherwise = do
                        Word8
w8 :: Word8 <- Ptr a -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
                        let w64' :: Word64
w64' = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w64
                        Word64 -> Int -> IO Word64
loop Word64
w64' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Word64 -> Int -> IO Word64
loop Word64
0 Int
0
          | Bool
otherwise = Word64 -> Word64
toLE64 (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off')
    (Int -> IO Word64) -> IO b
inner Int -> IO Word64
f

instance DynamicBytes B.ByteString where
  lengthD :: ByteString -> Int
lengthD = ByteString -> Int
B.length
  fromWordsD :: Int -> [Word64] -> ByteString
fromWordsD = (ForeignPtr Word8 -> Int -> ByteString)
-> Int -> [Word64] -> ByteString
forall a b. (ForeignPtr a -> Int -> b) -> Int -> [Word64] -> b
fromWordsForeign (ForeignPtr Word8 -> Int -> Int -> ByteString
`B.fromForeignPtr` Int
0)
  withPeekD :: forall a. ByteString -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD = (ForeignPtr Word8, Int, Int)
-> ((Int -> IO Word64) -> IO a) -> IO a
forall a b.
(ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -> IO b
withPeekForeign ((ForeignPtr Word8, Int, Int)
 -> ((Int -> IO Word64) -> IO a) -> IO a)
-> (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString
-> ((Int -> IO Word64) -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr

instance word8 ~ Word8 => DynamicBytes (VS.Vector word8) where
  lengthD :: Vector word8 -> Int
lengthD = Vector word8 -> Int
forall a. Storable a => Vector a -> Int
VS.length
  fromWordsD :: Int -> [Word64] -> Vector word8
fromWordsD = (ForeignPtr word8 -> Int -> Vector word8)
-> Int -> [Word64] -> Vector word8
forall a b. (ForeignPtr a -> Int -> b) -> Int -> [Word64] -> b
fromWordsForeign ForeignPtr word8 -> Int -> Vector word8
forall a. ForeignPtr a -> Int -> Vector a
VS.unsafeFromForeignPtr0
  withPeekD :: forall a. Vector word8 -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD = (ForeignPtr word8, Int, Int)
-> ((Int -> IO Word64) -> IO a) -> IO a
forall a b.
(ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -> IO b
withPeekForeign ((ForeignPtr word8, Int, Int)
 -> ((Int -> IO Word64) -> IO a) -> IO a)
-> (Vector word8 -> (ForeignPtr word8, Int, Int))
-> Vector word8
-> ((Int -> IO Word64) -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector word8 -> (ForeignPtr word8, Int, Int)
forall a. Vector a -> (ForeignPtr a, Int, Int)
VS.unsafeToForeignPtr

instance word8 ~ Word8 => DynamicBytes (VP.Vector word8) where
  lengthD :: Vector word8 -> Int
lengthD = Vector word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length
  fromWordsD :: Int -> [Word64] -> Vector word8
fromWordsD Int
len [Word64]
words0 = IO (Vector word8) -> Vector word8
forall a. IO a -> a
unsafePerformIO (IO (Vector word8) -> Vector word8)
-> IO (Vector word8) -> Vector word8
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray RealWorld
ba <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newByteArray Int
len
    let loop :: Int -> [Word64] -> IO (Vector word8)
loop Int
_ [] =
          Int -> Int -> ByteArray -> Vector word8
forall a. Int -> Int -> ByteArray -> Vector a
VP.Vector Int
0 Int
len (ByteArray -> Vector word8) -> IO ByteArray -> IO (Vector word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
BA.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ba
        loop Int
i (Word64
w:[Word64]
ws) = do
          MutableByteArray (PrimState IO) -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ba Int
i (Word64 -> Word64
fromLE64 Word64
w)
          Int -> [Word64] -> IO (Vector word8)
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word64]
ws
    Int -> [Word64] -> IO (Vector word8)
loop Int
0 [Word64]
words0
  withPeekD :: forall a. Vector word8 -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD (VP.Vector Int
off Int
len ByteArray
ba) (Int -> IO Word64) -> IO a
inner = do
    let f :: Int -> IO Word64
f Int
off'
          | Int
off' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
          | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len = do
              let loop :: Word64 -> Int -> IO Word64
loop Word64
w64 Int
i
                    | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
w64
                    | Bool
otherwise = do
                        let Word8
w8 :: Word8 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
                        let w64' :: Word64
w64' = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w64
                        Word64 -> Int -> IO Word64
loop Word64
w64' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Word64 -> Int -> IO Word64
loop Word64
0 Int
0
          | Bool
otherwise = Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$
              Word64 -> Word64
toLE64 (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
off' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8))
    (Int -> IO Word64) -> IO a
inner Int -> IO Word64
f

instance word8 ~ Word8 => DynamicBytes (VU.Vector word8) where
  lengthD :: Vector word8 -> Int
lengthD = Vector word8 -> Int
forall a. Unbox a => Vector a -> Int
VU.length
  fromWordsD :: Int -> [Word64] -> Vector word8
fromWordsD Int
len [Word64]
words = Vector Word8 -> Vector Word8
VU.V_Word8 (Int -> [Word64] -> Vector Word8
forall dbytes. DynamicBytes dbytes => Int -> [Word64] -> dbytes
fromWordsD Int
len [Word64]
words)
  withPeekD :: forall a. Vector word8 -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD (VU.V_Word8 Vector Word8
v) = Vector Word8 -> ((Int -> IO Word64) -> IO a) -> IO a
forall a. Vector Word8 -> ((Int -> IO Word64) -> IO a) -> IO a
forall dbytes a.
DynamicBytes dbytes =>
dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD Vector Word8
v

class StaticBytes sbytes where
  lengthS :: proxy sbytes -> Int -- use type level literals instead?

  -- difference list

  toWordsS :: sbytes -> [Word64] -> [Word64]
  usePeekS :: Int -> (Int -> IO Word64) -> IO sbytes

instance StaticBytes Bytes8 where
  lengthS :: forall (proxy :: * -> *). proxy Bytes8 -> Int
lengthS proxy Bytes8
_ = Int
8
  toWordsS :: Bytes8 -> [Word64] -> [Word64]
toWordsS (Bytes8 Word64
w) = (Word64
wWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:)
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes8
usePeekS Int
off Int -> IO Word64
f = Word64 -> Bytes8
Bytes8 (Word64 -> Bytes8) -> IO Word64 -> IO Bytes8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Word64
f Int
off

instance StaticBytes Bytes16 where
  lengthS :: forall (proxy :: * -> *). proxy Bytes16 -> Int
lengthS proxy Bytes16
_ = Int
16
  toWordsS :: Bytes16 -> [Word64] -> [Word64]
toWordsS (Bytes16 Bytes8
b1 Bytes8
b2) = Bytes8 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes8
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes8 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes8
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes16
usePeekS Int
off Int -> IO Word64
f = Bytes8 -> Bytes8 -> Bytes16
Bytes16 (Bytes8 -> Bytes8 -> Bytes16)
-> IO Bytes8 -> IO (Bytes8 -> Bytes16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes8
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes8 -> Bytes16) -> IO Bytes8 -> IO Bytes16
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes8
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Int -> IO Word64
f

instance StaticBytes Bytes32 where
  lengthS :: forall (proxy :: * -> *). proxy Bytes32 -> Int
lengthS proxy Bytes32
_ = Int
32
  toWordsS :: Bytes32 -> [Word64] -> [Word64]
toWordsS (Bytes32 Bytes16
b1 Bytes16
b2) = Bytes16 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes16
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes16 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes16
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes32
usePeekS Int
off Int -> IO Word64
f = Bytes16 -> Bytes16 -> Bytes32
Bytes32 (Bytes16 -> Bytes16 -> Bytes32)
-> IO Bytes16 -> IO (Bytes16 -> Bytes32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes16
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes16 -> Bytes32) -> IO Bytes16 -> IO Bytes32
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes16
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) Int -> IO Word64
f

instance StaticBytes Bytes64 where
  lengthS :: forall (proxy :: * -> *). proxy Bytes64 -> Int
lengthS proxy Bytes64
_ = Int
64
  toWordsS :: Bytes64 -> [Word64] -> [Word64]
toWordsS (Bytes64 Bytes32
b1 Bytes32
b2) = Bytes32 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes32
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes32 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes32
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes64
usePeekS Int
off Int -> IO Word64
f = Bytes32 -> Bytes32 -> Bytes64
Bytes64 (Bytes32 -> Bytes32 -> Bytes64)
-> IO Bytes32 -> IO (Bytes32 -> Bytes64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes32
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes32 -> Bytes64) -> IO Bytes32 -> IO Bytes64
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes32
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32) Int -> IO Word64
f

instance StaticBytes Bytes128 where
  lengthS :: forall (proxy :: * -> *). proxy Bytes128 -> Int
lengthS proxy Bytes128
_ = Int
128
  toWordsS :: Bytes128 -> [Word64] -> [Word64]
toWordsS (Bytes128 Bytes64
b1 Bytes64
b2) = Bytes64 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes64
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes64 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes64
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes128
usePeekS Int
off Int -> IO Word64
f = Bytes64 -> Bytes64 -> Bytes128
Bytes128 (Bytes64 -> Bytes64 -> Bytes128)
-> IO Bytes64 -> IO (Bytes64 -> Bytes128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes64
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes64 -> Bytes128) -> IO Bytes64 -> IO Bytes128
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes64
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) Int -> IO Word64
f

instance ByteArrayAccess Bytes8 where
  length :: Bytes8 -> Int
length Bytes8
_ = Int
8
  withByteArray :: forall p a. Bytes8 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes8 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS

instance ByteArrayAccess Bytes16 where
  length :: Bytes16 -> Int
length Bytes16
_ = Int
16
  withByteArray :: forall p a. Bytes16 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes16 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS

instance ByteArrayAccess Bytes32 where
  length :: Bytes32 -> Int
length Bytes32
_ = Int
32
  withByteArray :: forall p a. Bytes32 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes32 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS

instance ByteArrayAccess Bytes64 where
  length :: Bytes64 -> Int
length Bytes64
_ = Int
64
  withByteArray :: forall p a. Bytes64 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes64 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS

instance ByteArrayAccess Bytes128 where
  length :: Bytes128 -> Int
length Bytes128
_ = Int
128
  withByteArray :: forall p a. Bytes128 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes128 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS

withByteArrayS :: StaticBytes sbytes => sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS :: forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS sbytes
sbytes = ByteString -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray (sbytes -> ByteString
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
sbytes -> dbytes
fromStatic sbytes
sbytes :: ByteString)

toStaticExact ::
     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> Either StaticBytesException sbytes
toStaticExact :: forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> Either StaticBytesException sbytes
toStaticExact dbytes
dbytes =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (dbytes -> Int
forall dbytes. DynamicBytes dbytes => dbytes -> Int
lengthD dbytes
dbytes) (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
forall (proxy :: * -> *). proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) of
    Ordering
LT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
NotEnoughBytes
    Ordering
GT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
TooManyBytes
    Ordering
EQ -> sbytes -> Either StaticBytesException sbytes
forall a b. b -> Either a b
Right (dbytes -> sbytes
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes)

toStaticPad ::
     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> Either StaticBytesException sbytes
toStaticPad :: forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> Either StaticBytesException sbytes
toStaticPad dbytes
dbytes =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (dbytes -> Int
forall dbytes. DynamicBytes dbytes => dbytes -> Int
lengthD dbytes
dbytes) (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
forall (proxy :: * -> *). proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) of
    Ordering
GT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
TooManyBytes
    Ordering
_  -> sbytes -> Either StaticBytesException sbytes
forall a b. b -> Either a b
Right (dbytes -> sbytes
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes)

toStaticTruncate ::
     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> Either StaticBytesException sbytes
toStaticTruncate :: forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> Either StaticBytesException sbytes
toStaticTruncate dbytes
dbytes =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (dbytes -> Int
forall dbytes. DynamicBytes dbytes => dbytes -> Int
lengthD dbytes
dbytes) (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
forall (proxy :: * -> *). proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) of
    Ordering
LT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
NotEnoughBytes
    Ordering
_  -> sbytes -> Either StaticBytesException sbytes
forall a b. b -> Either a b
Right (dbytes -> sbytes
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes)

toStaticPadTruncate ::
     (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> sbytes
toStaticPadTruncate :: forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes = IO sbytes -> sbytes
forall a. IO a -> a
unsafePerformIO (dbytes -> ((Int -> IO Word64) -> IO sbytes) -> IO sbytes
forall a. dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
forall dbytes a.
DynamicBytes dbytes =>
dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD dbytes
dbytes (Int -> (Int -> IO Word64) -> IO sbytes
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
0))

fromStatic ::
     forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes)
  => sbytes
  -> dbytes
fromStatic :: forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
sbytes -> dbytes
fromStatic = Int -> [Word64] -> dbytes
forall dbytes. DynamicBytes dbytes => Int -> [Word64] -> dbytes
fromWordsD (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
forall (proxy :: * -> *). proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) ([Word64] -> dbytes) -> (sbytes -> [Word64]) -> sbytes -> dbytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ []) (([Word64] -> [Word64]) -> [Word64])
-> (sbytes -> [Word64] -> [Word64]) -> sbytes -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sbytes -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS

-- | Convert a 64 bit value in CPU endianess to little endian.

toLE64 :: Word64 -> Word64
toLE64 :: Word64 -> Word64
toLE64 = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian -> Word64 -> Word64
byteSwap64
  ByteOrder
LittleEndian -> Word64 -> Word64
forall a. a -> a
id

-- | Convert a little endian 64 bit value to CPU endianess.

fromLE64 :: Word64 -> Word64
fromLE64 :: Word64 -> Word64
fromLE64 = Word64 -> Word64
toLE64