module Codec.Borsh.Decoding (
decodeU8
, decodeU16
, decodeU32
, decodeU64
, decodeU128
, decodeI8
, decodeI16
, decodeI32
, decodeI64
, decodeI128
, decodeF32
, decodeF64
, decodeString
, decodeArray
, decodeVec
, decodeOption
, decodeHashSet
, decodeHashMap
, decodeStruct
, decodeEnum
, decodeLazyByteString
, decodeStrictByteString
, decodeChar
, decodeBool
) where
import Data.Char (chr)
import Data.Int
import Data.Map (Map)
import Data.Maybe
import Data.Proxy
import Data.Set (Set)
import Data.STRef
import Data.Text (Text)
import Data.WideWord.Word128
import Data.WideWord.Int128
import Data.Word
import Generics.SOP
import GHC.TypeLits
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text.Encoding as Text
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import Codec.Borsh.Incremental
import Codec.Borsh.Incremental.Decoder (decodeLittleEndian)
import Codec.Borsh.Internal.Util.BitwiseCast
import Codec.Borsh.Internal.Util.SOP
import Data.FixedSizeArray (FixedSizeArray, MFixedSizeArray)
import qualified Data.FixedSizeArray as FSA
decodeU8 :: Decoder s Word8
decodeU16 :: Decoder s Word16
decodeU32 :: Decoder s Word32
decodeU64 :: Decoder s Word64
decodeU128 :: Decoder s Word128
decodeU8 :: forall s. Decoder s Word8
decodeU8 = forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeU16 :: forall s. Decoder s Word16
decodeU16 = forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeU32 :: forall s. Decoder s Word32
decodeU32 = forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeU64 :: forall s. Decoder s Word64
decodeU64 = forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeU128 :: forall s. Decoder s Word128
decodeU128 = forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeI8 :: Decoder s Int8
decodeI16 :: Decoder s Int16
decodeI32 :: Decoder s Int32
decodeI64 :: Decoder s Int64
decodeI128 :: Decoder s Int128
decodeI8 :: forall s. Decoder s Int8
decodeI8 = (forall a b. BitwiseCast a b => a -> b
castBits @Word8 ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeI16 :: forall s. Decoder s Int16
decodeI16 = (forall a b. BitwiseCast a b => a -> b
castBits @Word16 ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeI32 :: forall s. Decoder s Int32
decodeI32 = (forall a b. BitwiseCast a b => a -> b
castBits @Word32 ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeI64 :: forall s. Decoder s Int64
decodeI64 = (forall a b. BitwiseCast a b => a -> b
castBits @Word64 ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeI128 :: forall s. Decoder s Int128
decodeI128 = (forall a b. BitwiseCast a b => a -> b
castBits @Word128) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeF32 :: Decoder s Float
decodeF64 :: Decoder s Double
decodeF32 :: forall s. Decoder s Float
decodeF32 = (forall a b. BitwiseCast a b => a -> b
castBits @Word32) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeF64 :: forall s. Decoder s Double
decodeF64 = (forall a b. BitwiseCast a b => a -> b
castBits @Word64) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ByteSwap a => Decoder s a
decodeLittleEndian
decodeString :: Decoder s Text
decodeString :: forall s. Decoder s Text
decodeString = do
Word32
len <- forall s. Decoder s Word32
decodeU32
ByteString
lbs <- forall s. Word32 -> Decoder s ByteString
decodeLargeToken Word32
len
case ByteString -> Either UnicodeException Text
Text.decodeUtf8' forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.toStrict ByteString
lbs of
Right Text
txt -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt
Left UnicodeException
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show UnicodeException
err)
decodeArray :: forall n s a.
KnownNat n
=> Decoder s a -> Decoder s (FixedSizeArray n a)
decodeArray :: forall (n :: Nat) s a.
KnownNat n =>
Decoder s a -> Decoder s (FixedSizeArray n a)
decodeArray Decoder s a
d = do
MFixedSizeArray n s a
mArr :: MFixedSizeArray n s a <- forall s a. ST s a -> Decoder s a
liftDecoder forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: Nat) a.
(PrimMonad m, KnownNat n) =>
m (MFixedSizeArray n (PrimState m) a)
FSA.new
STRef s Int
next :: STRef s Int <- forall s a. ST s a -> Decoder s a
liftDecoder forall a b. (a -> b) -> a -> b
$ forall a s. a -> ST s (STRef s a)
newSTRef Int
0
let d' :: Decoder s ()
d' :: Decoder s ()
d' = Decoder s a
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
b -> forall s a. ST s a -> Decoder s a
liftDecoder forall a b. (a -> b) -> a -> b
$ do
Int
i <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
next
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
next (forall a. Num a => a -> a -> a
+ Int
1)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
GM.write MFixedSizeArray n s a
mArr Int
i a
b
forall s. Word32 -> Decoder s () -> Decoder s ()
decodeIncremental_ Word32
count Decoder s ()
d'
forall s a. ST s a -> Decoder s a
liftDecoder forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
G.freeze MFixedSizeArray n s a
mArr
where
count :: Word32
count :: Word32
count = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n)
decodeVec :: Decoder s a -> Decoder s [a]
decodeVec :: forall s a. Decoder s a -> Decoder s [a]
decodeVec Decoder s a
d = forall s. Decoder s Word32
decodeU32 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word32
count -> forall s a. Word32 -> Decoder s a -> Decoder s [a]
decodeIncremental Word32
count Decoder s a
d
decodeOption :: Decoder s a -> Decoder s (Maybe a)
decodeOption :: forall s a. Decoder s a -> Decoder s (Maybe a)
decodeOption Decoder s a
d = do
Word8
present <- forall s. Decoder s Word8
decodeU8
case Word8
present of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Word8
1 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
d
Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected 0 or 1 for option prefix"
decodeHashSet :: Ord a => Decoder s a -> Decoder s (Set a)
decodeHashSet :: forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeHashSet Decoder s a
d = do
Word32
count <- forall s. Decoder s Word32
decodeU32
forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Word32 -> Decoder s a -> Decoder s [a]
decodeIncremental Word32
count Decoder s a
d
decodeHashMap :: Ord k => Decoder s k -> Decoder s a -> Decoder s (Map k a)
decodeHashMap :: forall k s a.
Ord k =>
Decoder s k -> Decoder s a -> Decoder s (Map k a)
decodeHashMap Decoder s k
dk Decoder s a
dv = do
Word32
count <- forall s. Decoder s Word32
decodeU32
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Word32 -> Decoder s a -> Decoder s [a]
decodeIncremental Word32
count Decoder s (k, a)
dPair
where
dPair :: Decoder s (k, a)
dPair = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s k
dk forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s a
dv
decodeStruct :: All Top xs => NP (Decoder s) xs -> Decoder s (NP I xs)
decodeStruct :: forall (xs :: [*]) s.
All Top xs =>
NP (Decoder s) xs -> Decoder s (NP I xs)
decodeStruct = forall {l} (h :: (* -> *) -> l -> *) (xs :: l) (f :: * -> *).
(SListIN h xs, SListIN (Prod h) xs, HSequence h, Applicative f) =>
h f xs -> f (h I xs)
hsequence
decodeEnum :: forall s xss.
All SListI xss
=> POP (Decoder s) xss -> Decoder s (SOP I xss)
decodeEnum :: forall s (xss :: [[*]]).
All SListI xss =>
POP (Decoder s) xss -> Decoder s (SOP I xss)
decodeEnum =
[(Word8, Decoder s (SOP I xss))] -> Decoder s (SOP I xss)
selectDecoder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *) (f'' :: k -> *) (f''' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a -> f''' a)
-> Prod h f xs
-> Prod h f' xs
-> h f'' xs
-> h f''' xs
hczipWith3
(forall {k} (t :: k). Proxy t
Proxy @SListI)
(\(K Word8
ix) (Fn NP I a -> K (NS (NP I) xss) a
inj) NP (Decoder s) a
ds -> forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$ (Word8
ix, forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). K a b -> a
unK forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP I a -> K (NS (NP I) xss) a
inj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} (h :: (* -> *) -> l -> *) (xs :: l) (f :: * -> *).
(SListIN h xs, SListIN (Prod h) xs, HSequence h, Applicative f) =>
h f xs -> f (h I xs)
hsequence NP (Decoder s) a
ds))
forall k (xs :: [k]). SListI xs => NP (K Word8) xs
indices
(forall {k} (xs :: [k]) (f :: k -> *).
SListI xs =>
NP (Injection f xs) xs
injections :: NP (Injection (NP I) xss) xss)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (xss :: [[k]]). POP f xss -> NP (NP f) xss
unPOP
where
selectDecoder :: [(Word8, Decoder s (SOP I xss))] -> Decoder s (SOP I xss)
selectDecoder :: [(Word8, Decoder s (SOP I xss))] -> Decoder s (SOP I xss)
selectDecoder [(Word8, Decoder s (SOP I xss))]
decs = do
Word8
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word8
decodeU8
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
n [(Word8, Decoder s (SOP I xss))]
decs
where
err :: String
err :: String
err = String
"Expected index < " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Word8, Decoder s (SOP I xss))]
decs)
decodeLazyByteString :: Decoder s L.ByteString
decodeLazyByteString :: forall s. Decoder s ByteString
decodeLazyByteString = do
Word32
len <- forall s. Decoder s Word32
decodeU32
forall s. Word32 -> Decoder s ByteString
decodeLargeToken Word32
len
decodeStrictByteString :: Decoder s S.ByteString
decodeStrictByteString :: forall s. Decoder s ByteString
decodeStrictByteString = do
Word32
len <- forall s. Decoder s Word32
decodeU32
ByteString -> ByteString
L.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Word32 -> Decoder s ByteString
decodeLargeToken Word32
len
decodeChar :: Decoder s Char
decodeChar :: forall s. Decoder s Char
decodeChar = Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word32
decodeU32
decodeBool :: Decoder s Bool
decodeBool :: forall s. Decoder s Bool
decodeBool = forall s. Decoder s Word8
decodeU8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected 0 or 1 while decoding Bool"