{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}

module Codec.Candid.Decode where

import Numeric.Natural
import qualified Data.Vector as V
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as M
import Data.List
import Data.Void
import Data.Serialize.LEB128.Lenient
import qualified Data.Serialize.Get as G
import qualified Data.Serialize.IEEE754 as G
import Control.Monad

import Codec.Candid.Data
import Codec.Candid.TypTable
import Codec.Candid.Types
import Codec.Candid.FieldName

-- | Decode binay value into the type description and the untyped value
-- representation.
decodeVals :: BS.ByteString -> Either String (SeqDesc, [Value])
decodeVals :: ByteString -> Either String (SeqDesc, [Value])
decodeVals ByteString
bytes = forall a. Get a -> ByteString -> Either String a
G.runGet Get (SeqDesc, [Value])
go (ByteString -> ByteString
BS.toStrict ByteString
bytes)
  where
    go :: Get (SeqDesc, [Value])
go = do
        Get ()
decodeMagic
        SeqDesc
arg_tys <- Get SeqDesc
decodeTypTable
        [Value]
vs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type Void -> Get Value
decodeVal (SeqDesc -> [Type Void]
tieKnot (SeqDesc -> SeqDesc
voidEmptyTypes SeqDesc
arg_tys))
        Get Int
G.remaining forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return (SeqDesc
arg_tys, [Value]
vs)
            Int
n -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" left-over bytes"

decodeVal :: Type Void -> G.Get Value
decodeVal :: Type Void -> Get Value
decodeVal Type Void
BoolT = Get Word8
G.getWord8 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 forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolV Bool
False
    Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolV Bool
True
    Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid boolean value"
decodeVal Type Void
NatT = Natural -> Value
NatV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. LEB128 a => Get a
getLEB128
decodeVal Type Void
Nat8T = Word8 -> Value
Nat8V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
G.getWord8
decodeVal Type Void
Nat16T = Word16 -> Value
Nat16V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
decodeVal Type Void
Nat32T = Word32 -> Value
Nat32V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
G.getWord32le
decodeVal Type Void
Nat64T = Word64 -> Value
Nat64V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
G.getWord64le
decodeVal Type Void
IntT = Integer -> Value
IntV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SLEB128 a => Get a
getSLEB128
decodeVal Type Void
Int8T = Int8 -> Value
Int8V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
G.getInt8
decodeVal Type Void
Int16T = Int16 -> Value
Int16V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
G.getInt16le
decodeVal Type Void
Int32T = Int32 -> Value
Int32V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
G.getInt32le
decodeVal Type Void
Int64T = Int64 -> Value
Int64V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
G.getInt64le
decodeVal Type Void
Float32T = Float -> Value
Float32V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
G.getFloat32le
decodeVal Type Void
Float64T = Double -> Value
Float64V forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
G.getFloat64le
decodeVal Type Void
TextT = Text -> Value
TextV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
decodeText
decodeVal Type Void
NullT = forall (m :: * -> *) a. Monad m => a -> m a
return Value
NullV
decodeVal Type Void
ReservedT = forall (m :: * -> *) a. Monad m => a -> m a
return Value
ReservedV
decodeVal (OptT Type Void
t) = Get Word8
G.getWord8 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 forall a b. (a -> b) -> a -> b
$ Maybe Value -> Value
OptV forall a. Maybe a
Nothing
    Word8
1 -> Maybe Value -> Value
OptV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type Void -> Get Value
decodeVal Type Void
t
    Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid optional value"
decodeVal Type Void
BlobT = ByteString -> Value
BlobV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
decodeBytes
decodeVal (VecT Type Void
t) = do
    Int
n <- forall a. Integral a => Get a
getLEB128Int
    Vector Value -> Value
VecV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Type Void -> Get Value
decodeVal Type Void
t)
decodeVal (RecT Fields Void
fs)
    | Bool
isTuple   = [Value] -> Value
TupV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(FieldName
_,Type Void
t) -> Type Void -> Get Value
decodeVal Type Void
t) Fields Void
fs'
    | Bool
otherwise = [(FieldName, Value)] -> Value
RecV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(FieldName
fn, Type Void
t) -> (FieldName
fn,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type Void -> Get Value
decodeVal Type Void
t) Fields Void
fs'
  where
    fs' :: Fields Void
fs' = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst Fields Void
fs
    isTuple :: Bool
isTuple = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Eq a => a -> a -> Bool
(==) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst Fields Void
fs') (forall a b. (a -> b) -> [a] -> [b]
map Word32 -> FieldName
hashedField [Word32
0..])
decodeVal (VariantT Fields Void
fs) = do
    Int
i <- forall a. Integral a => Get a
getLEB128Int
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length Fields Void
fs) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"variant index out of bound"
    let (FieldName
fn, Type Void
t) = Fields Void
fs' forall a. [a] -> Int -> a
!! Int
i
    FieldName -> Value -> Value
VariantV FieldName
fn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type Void -> Get Value
decodeVal Type Void
t
  where
    fs' :: Fields Void
fs' = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst Fields Void
fs
decodeVal (FuncT MethodType Void
_) = do
    Get ()
referenceByte
    Get ()
referenceByte
    Principal -> Text -> Value
FuncV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Principal
decodePrincipal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Text
decodeText
decodeVal (ServiceT [(Text, MethodType Void)]
_) = do
    Get ()
referenceByte
    Principal -> Value
ServiceV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Principal
decodePrincipal
decodeVal Type Void
PrincipalT = do
    Get ()
referenceByte
    Principal -> Value
PrincipalV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Principal
decodePrincipal

decodeVal Type Void
EmptyT = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty value"
decodeVal Type Void
FutureT = do
    Int64
m <- forall a. Integral a => Get a
getLEB128Int
    Natural
_n <- forall a. Integral a => Get a
getLEB128Int @Natural
    ByteString
_ <- Int64 -> Get ByteString
G.getLazyByteString Int64
m
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
FutureV

decodeVal (RefT Void
v) = forall a. Void -> a
absurd Void
v

referenceByte :: G.Get ()
referenceByte :: Get ()
referenceByte = Get Word8
G.getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"reference encountered"
    Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid reference tag"

decodeBytes :: G.Get BS.ByteString
decodeBytes :: Get ByteString
decodeBytes = forall a. Integral a => Get a
getLEB128Int forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64 -> Get ByteString
G.getLazyByteString

decodeText :: G.Get T.Text
decodeText :: Get Text
decodeText = do
    ByteString
bs <- Get ByteString
decodeBytes
    case ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> ByteString
BS.toStrict ByteString
bs) of
        Left UnicodeException
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid utf8: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show UnicodeException
err
        Right Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
t

decodePrincipal :: G.Get Principal
decodePrincipal :: Get Principal
decodePrincipal = ByteString -> Principal
Principal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
decodeBytes

decodeMagic :: G.Get ()
decodeMagic :: Get ()
decodeMagic = do
    ByteString
magic <- Int -> Get ByteString
G.getBytes Int
4
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
magic forall a. Eq a => a -> a -> Bool
== Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack String
"DIDL")) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected magic bytes \"DIDL\", got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
magic

getLEB128Int :: Integral a => G.Get a
getLEB128Int :: forall a. Integral a => Get a
getLEB128Int = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. LEB128 a => Get a
getLEB128 @Natural

-- eagerly detect overshoot
checkOvershoot :: Natural -> G.Get ()
checkOvershoot :: Natural -> Get ()
checkOvershoot Natural
n = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a. Get a -> Get a
G.lookAhead forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
G.ensure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)

decodeSeq :: G.Get a -> G.Get [a]
decodeSeq :: forall a. Get a -> Get [a]
decodeSeq Get a
act = do
    Int
len <- forall a. Integral a => Get a
getLEB128Int
    Natural -> Get ()
checkOvershoot (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get a
act

decodeFoldSeq :: (a -> G.Get a) -> (a -> G.Get a)
decodeFoldSeq :: forall a. (a -> Get a) -> a -> Get a
decodeFoldSeq a -> Get a
act a
x = do
    Integer
len <- forall a. Integral a => Get a
getLEB128Int @Integer
    Natural -> Get ()
checkOvershoot (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len)
    forall {t}. (Eq t, Num t) => t -> a -> Get a
go Integer
len a
x
  where
    go :: t -> a -> Get a
go t
0 a
x = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    go t
n a
x = a -> Get a
act a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> a -> Get a
go (t
nforall a. Num a => a -> a -> a
-t
1)

decodeTypTable :: G.Get SeqDesc
decodeTypTable :: Get SeqDesc
decodeTypTable = do
    Natural
len <- forall a. LEB128 a => Get a
getLEB128
    Natural -> Get ()
checkOvershoot Natural
len
    [Either (Type Int) PreService]
table <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
len) (Natural -> Get (Either (Type Int) PreService)
decodeTypTableEntry Natural
len)
    [Type Int]
table <- [Either (Type Int) PreService] -> Get [Type Int]
resolveServiceT [Either (Type Int) PreService]
table
    let m :: Map Int (Type Int)
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Type Int]
table)
    [Type Int]
ts <- forall a. Get a -> Get [a]
decodeSeq (Natural -> Get (Type Int)
decodeTypRef Natural
len)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k.
(Pretty k, Ord k) =>
Map k (Type k) -> [Type k] -> SeqDesc
SeqDesc Map Int (Type Int)
m [Type Int]
ts

type PreService = [(T.Text, Int)]

decodeTypTableEntry :: Natural -> G.Get (Either (Type Int) PreService)
decodeTypTableEntry :: Natural -> Get (Either (Type Int) PreService)
decodeTypTableEntry Natural
max = forall a. SLEB128 a => Get a
getSLEB128 @Integer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -18 -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Type a -> Type a
OptT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Get (Type Int)
decodeTypRef Natural
max
    -19 -> do
        Type Int
t <- Natural -> Get (Type Int)
decodeTypRef Natural
max
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Type Int
t forall a. Eq a => a -> a -> Bool
== forall a. Type a
Nat8T then forall a b. a -> Either a b
Left forall a. Type a
BlobT
                             else forall a b. a -> Either a b
Left (forall a. Type a -> Type a
VecT Type Int
t)
    -20 -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fields a -> Type a
RecT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Get (Fields Int)
decodeTypFields Natural
max
    -21 -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fields a -> Type a
VariantT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Get (Fields Int)
decodeTypFields Natural
max
    -22 -> do
        [Type Int]
a <- forall a. Get a -> Get [a]
decodeSeq (Natural -> Get (Type Int)
decodeTypRef Natural
max)
        [Type Int]
r <- forall a. Get a -> Get [a]
decodeSeq (Natural -> Get (Type Int)
decodeTypRef Natural
max)
        MethodType Int
m <- forall a. (a -> Get a) -> a -> Get a
decodeFoldSeq forall t. MethodType t -> Get (MethodType t)
decodeFuncAnn (forall a. [Type a] -> [Type a] -> Bool -> Bool -> MethodType a
MethodType [Type Int]
a [Type Int]
r Bool
False Bool
False)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. MethodType a -> Type a
FuncT MethodType Int
m)
    -23 -> do
        PreService
m <- forall a. Get a -> Get [a]
decodeSeq ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
decodeText forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Get Int
decodeFuncTypRef Natural
max)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Ord a => [a] -> Bool
isOrdered (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst PreService
m)) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Service methods not in strict order"
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right PreService
m)
    Integer
_ -> do
        ByteString
_ <- forall a. Integral a => Get a
getLEB128Int forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64 -> Get ByteString
G.getLazyByteString
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a. Type a
FutureT)

decodeTypRef :: Natural -> G.Get (Type Int)
decodeTypRef :: Natural -> Get (Type Int)
decodeTypRef Natural
max = do
    Integer
i <- forall a. SLEB128 a => Get a
getSLEB128
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
max) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Type reference out of range"
    if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0
    then case forall a. Integer -> Maybe (Type a)
primTyp Integer
i of
        Just Type Int
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Type Int
t
        Maybe (Type Int)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail  forall a b. (a -> b) -> a -> b
$ String
"Unknown prim typ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Type a
RefT (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)

decodeFuncTypRef :: Natural -> G.Get Int
decodeFuncTypRef :: Natural -> Get Int
decodeFuncTypRef Natural
max = do
    Integer
i <- forall a. SLEB128 a => Get a
getSLEB128
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
max) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Type reference out of range"
    if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0
    then case forall a. Integer -> Maybe (Type a)
primTyp Integer
i of
        Just Type Any
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Primitive type as method type in service type"
        Maybe (Type Any)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail  forall a b. (a -> b) -> a -> b
$ String
"Unknown prim typ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i

-- This resolves PreServiceT to ServiceT
resolveServiceT :: [Either (Type Int) PreService] -> G.Get [Type Int]
resolveServiceT :: [Either (Type Int) PreService] -> Get [Type Int]
resolveServiceT [Either (Type Int) PreService]
table = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *}.
MonadFail f =>
Either (Type Int) PreService -> f (Type Int)
go [Either (Type Int) PreService]
table
  where
    m :: Map Int (Either (Type Int) PreService)
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Either (Type Int) PreService]
table)

    go :: Either (Type Int) PreService -> f (Type Int)
go (Left Type Int
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type Int
t
    go (Right PreService
is) = forall a. [(Text, MethodType a)] -> Type a
ServiceT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *} {a}.
MonadFail m =>
(a, Int) -> m (a, MethodType Int)
goMethod PreService
is

    goMethod :: (a, Int) -> m (a, MethodType Int)
goMethod (a
n, Int
i) = case Map Int (Either (Type Int) PreService)
m forall k a. Ord k => Map k a -> k -> a
M.! Int
i of
        Left (FuncT MethodType Int
t) -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
n,MethodType Int
t)
        Either (Type Int) PreService
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Method type not a function type"


decodeFuncAnn :: MethodType t -> G.Get (MethodType t)
decodeFuncAnn :: forall t. MethodType t -> Get (MethodType t)
decodeFuncAnn MethodType t
m = Get Word8
G.getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. MethodType a -> Bool
methQuery MethodType t
m) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"query annotation duplicated"
        forall (m :: * -> *) a. Monad m => a -> m a
return (MethodType t
m { methQuery :: Bool
methQuery = Bool
True })
    Word8
2 -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. MethodType a -> Bool
methOneway MethodType t
m) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"oneway annotation duplicated"
        forall (m :: * -> *) a. Monad m => a -> m a
return (MethodType t
m { methOneway :: Bool
methOneway = Bool
True })
    Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid function annotation"


isOrdered :: Ord a => [a] -> Bool
isOrdered :: forall a. Ord a => [a] -> Bool
isOrdered [] = Bool
True
isOrdered [a
_] = Bool
True
isOrdered (a
x:a
y:[a]
xs) = a
x forall a. Ord a => a -> a -> Bool
< a
y Bool -> Bool -> Bool
&& forall a. Ord a => [a] -> Bool
isOrdered (a
yforall a. a -> [a] -> [a]
:[a]
xs)

decodeTypFields :: Natural -> G.Get (Fields Int)
decodeTypFields :: Natural -> Get (Fields Int)
decodeTypFields Natural
max = do
    Fields Int
fs <- forall a. Get a -> Get [a]
decodeSeq (Natural -> Get (FieldName, Type Int)
decodeTypField Natural
max)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Ord a => [a] -> Bool
isOrdered (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst Fields Int
fs)) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Fields not in strict order"
    forall (m :: * -> *) a. Monad m => a -> m a
return Fields Int
fs

decodeTypField :: Natural -> G.Get (FieldName, Type Int)
decodeTypField :: Natural -> Get (FieldName, Type Int)
decodeTypField Natural
max = do
    Word32
h <- forall a. LEB128 a => Get a
getLEB128
    Type Int
t <- Natural -> Get (Type Int)
decodeTypRef Natural
max
    forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> FieldName
hashedField Word32
h, Type Int
t)