-- | Servant configuration for the CBOR media type
--
-- Adapted from https://hackage.haskell.org/package/servant-serialization-0.3/docs/Servant-API-ContentTypes-SerialiseCBOR.html via MIT license
module Unison.Util.Servant.CBOR
  ( CBOR,
    UnknownCBORBytes,
    CBORBytes (..),
    CBORStream (..),
    unpackCBORBytesStream,
    deserialiseOrFailCBORBytes,
    serialiseCBORBytes,
    decodeCBORBytes,
    decodeUnknownCBORBytes,
    serialiseUnknownCBORBytes,
    CBORStreamError (..),
    decodeUnframedEntities,
  )
where

import Codec.CBOR.Read (DeserialiseFailure (..))
import Codec.Serialise (Serialise, deserialiseOrFail, serialise)
import Codec.Serialise qualified as CBOR
import Codec.Serialise.Decoding qualified as CBORDecode
import Conduit
import Control.Monad.Except
import Control.Monad.ST (ST, stToIO)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Conduit.Combinators qualified as Conduit
import Data.List.NonEmpty qualified as NonEmpty
import Network.HTTP.Media.MediaType qualified as MediaType
import Servant
import Unison.Prelude

-- | Content-type for encoding and decoding objects as their CBOR representations
data CBOR

-- | Mime-type for CBOR and additional ones using the word "hackage" and the
-- name of the package "serialise".
instance Accept CBOR where
  contentTypes :: Proxy CBOR -> NonEmpty MediaType
contentTypes Proxy CBOR
Proxy =
    MediaType -> NonEmpty MediaType
forall a. a -> NonEmpty a
NonEmpty.singleton (ByteString
"application" ByteString -> ByteString -> MediaType
MediaType.// ByteString
"cbor")

-- |
--
-- >>> mimeRender (Proxy :: Proxy CBOR) ("Hello" :: String)
-- "eHello"
instance (Serialise a) => MimeRender CBOR a where
  mimeRender :: Proxy CBOR -> a -> ByteString
mimeRender Proxy CBOR
Proxy = a -> ByteString
forall a. Serialise a => a -> ByteString
serialise

-- |
--
-- >>> let bsl = mimeRender (Proxy :: Proxy CBOR) (3.14 :: Float)
-- >>> mimeUnrender (Proxy :: Proxy CBOR) bsl :: Either String Float
-- Right 3.14
--
-- >>> mimeUnrender (Proxy :: Proxy CBOR) (bsl <> "trailing garbage") :: Either String Float
-- Right 3.14
--
-- >>> mimeUnrender (Proxy :: Proxy CBOR) ("preceding garbage" <> bsl) :: Either String Float
-- Left "Codec.Serialise.deserialiseOrFail: expected float at byte-offset 0"
instance (Serialise a) => MimeUnrender CBOR a where
  mimeUnrender :: Proxy CBOR -> ByteString -> Either String a
mimeUnrender Proxy CBOR
Proxy = (DeserialiseFailure -> String)
-> Either DeserialiseFailure a -> Either String a
forall {a} {b} {b}. (a -> b) -> Either a b -> Either b b
mapLeft DeserialiseFailure -> String
prettyErr (Either DeserialiseFailure a -> Either String a)
-> (ByteString -> Either DeserialiseFailure a)
-> ByteString
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DeserialiseFailure a
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail
    where
      mapLeft :: (a -> b) -> Either a b -> Either b b
mapLeft a -> b
f = (a -> Either b b) -> (b -> Either b b) -> Either a b -> Either b b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b b
forall a b. a -> Either a b
Left (b -> Either b b) -> (a -> b) -> a -> Either b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) b -> Either b b
forall a b. b -> Either a b
Right
      prettyErr :: DeserialiseFailure -> String
prettyErr (DeserialiseFailure ByteOffset
offset String
err) =
        String
"Codec.Serialise.deserialiseOrFail: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at byte-offset " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteOffset -> String
forall a. Show a => a -> String
show ByteOffset
offset

-- | Wrapper for CBOR data that has already been serialized.
-- In our case, we use this because we may load pre-serialized CBOR directly from the database,
-- but it's also useful in allowing us to more quickly seek through a CBOR stream, since we only need to decode the CBOR when/if we actually need to use it, and can skip past it using a byte offset otherwise.
--
-- The 't' phantom type is the type of the data encoded in the bytestring.
newtype CBORBytes t = CBORBytes BL.ByteString
  deriving ([CBORBytes t] -> Encoding
CBORBytes t -> Encoding
(CBORBytes t -> Encoding)
-> (forall s. Decoder s (CBORBytes t))
-> ([CBORBytes t] -> Encoding)
-> (forall s. Decoder s [CBORBytes t])
-> Serialise (CBORBytes t)
forall s. Decoder s [CBORBytes t]
forall s. Decoder s (CBORBytes t)
forall t. [CBORBytes t] -> Encoding
forall t. CBORBytes t -> Encoding
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall t s. Decoder s [CBORBytes t]
forall t s. Decoder s (CBORBytes t)
$cencode :: forall t. CBORBytes t -> Encoding
encode :: CBORBytes t -> Encoding
$cdecode :: forall t s. Decoder s (CBORBytes t)
decode :: forall s. Decoder s (CBORBytes t)
$cencodeList :: forall t. [CBORBytes t] -> Encoding
encodeList :: [CBORBytes t] -> Encoding
$cdecodeList :: forall t s. Decoder s [CBORBytes t]
decodeList :: forall s. Decoder s [CBORBytes t]
Serialise) via (BL.ByteString)
  deriving (CBORBytes t -> CBORBytes t -> Bool
(CBORBytes t -> CBORBytes t -> Bool)
-> (CBORBytes t -> CBORBytes t -> Bool) -> Eq (CBORBytes t)
forall t. CBORBytes t -> CBORBytes t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. CBORBytes t -> CBORBytes t -> Bool
== :: CBORBytes t -> CBORBytes t -> Bool
$c/= :: forall t. CBORBytes t -> CBORBytes t -> Bool
/= :: CBORBytes t -> CBORBytes t -> Bool
Eq, Int -> CBORBytes t -> String -> String
[CBORBytes t] -> String -> String
CBORBytes t -> String
(Int -> CBORBytes t -> String -> String)
-> (CBORBytes t -> String)
-> ([CBORBytes t] -> String -> String)
-> Show (CBORBytes t)
forall t. Int -> CBORBytes t -> String -> String
forall t. [CBORBytes t] -> String -> String
forall t. CBORBytes t -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall t. Int -> CBORBytes t -> String -> String
showsPrec :: Int -> CBORBytes t -> String -> String
$cshow :: forall t. CBORBytes t -> String
show :: CBORBytes t -> String
$cshowList :: forall t. [CBORBytes t] -> String -> String
showList :: [CBORBytes t] -> String -> String
Show, Eq (CBORBytes t)
Eq (CBORBytes t) =>
(CBORBytes t -> CBORBytes t -> Ordering)
-> (CBORBytes t -> CBORBytes t -> Bool)
-> (CBORBytes t -> CBORBytes t -> Bool)
-> (CBORBytes t -> CBORBytes t -> Bool)
-> (CBORBytes t -> CBORBytes t -> Bool)
-> (CBORBytes t -> CBORBytes t -> CBORBytes t)
-> (CBORBytes t -> CBORBytes t -> CBORBytes t)
-> Ord (CBORBytes t)
CBORBytes t -> CBORBytes t -> Bool
CBORBytes t -> CBORBytes t -> Ordering
CBORBytes t -> CBORBytes t -> CBORBytes t
forall t. Eq (CBORBytes t)
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
forall t. CBORBytes t -> CBORBytes t -> Bool
forall t. CBORBytes t -> CBORBytes t -> Ordering
forall t. CBORBytes t -> CBORBytes t -> CBORBytes t
$ccompare :: forall t. CBORBytes t -> CBORBytes t -> Ordering
compare :: CBORBytes t -> CBORBytes t -> Ordering
$c< :: forall t. CBORBytes t -> CBORBytes t -> Bool
< :: CBORBytes t -> CBORBytes t -> Bool
$c<= :: forall t. CBORBytes t -> CBORBytes t -> Bool
<= :: CBORBytes t -> CBORBytes t -> Bool
$c> :: forall t. CBORBytes t -> CBORBytes t -> Bool
> :: CBORBytes t -> CBORBytes t -> Bool
$c>= :: forall t. CBORBytes t -> CBORBytes t -> Bool
>= :: CBORBytes t -> CBORBytes t -> Bool
$cmax :: forall t. CBORBytes t -> CBORBytes t -> CBORBytes t
max :: CBORBytes t -> CBORBytes t -> CBORBytes t
$cmin :: forall t. CBORBytes t -> CBORBytes t -> CBORBytes t
min :: CBORBytes t -> CBORBytes t -> CBORBytes t
Ord)

-- | Deserialize a 'CBORBytes' value into its tagged type, throwing an error if the deserialization fails.
deserialiseOrFailCBORBytes :: (Serialise t) => CBORBytes t -> Either CBOR.DeserialiseFailure t
deserialiseOrFailCBORBytes :: forall t. Serialise t => CBORBytes t -> Either DeserialiseFailure t
deserialiseOrFailCBORBytes (CBORBytes ByteString
bs) = ByteString -> Either DeserialiseFailure t
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
CBOR.deserialiseOrFail ByteString
bs

decodeCBORBytes :: (Serialise t) => CBORBytes t -> CBORDecode.Decoder s t
decodeCBORBytes :: forall t s. Serialise t => CBORBytes t -> Decoder s t
decodeCBORBytes (CBORBytes ByteString
bs) = UnknownCBORBytes -> Decoder s t
forall t s. Serialise t => UnknownCBORBytes -> Decoder s t
decodeUnknownCBORBytes (ByteString -> UnknownCBORBytes
forall t. ByteString -> CBORBytes t
CBORBytes ByteString
bs)

decodeUnknownCBORBytes :: (Serialise t) => UnknownCBORBytes -> CBORDecode.Decoder s t
decodeUnknownCBORBytes :: forall t s. Serialise t => UnknownCBORBytes -> Decoder s t
decodeUnknownCBORBytes (CBORBytes ByteString
bs) = case CBORBytes t -> Either DeserialiseFailure t
forall t. Serialise t => CBORBytes t -> Either DeserialiseFailure t
deserialiseOrFailCBORBytes (ByteString -> CBORBytes t
forall t. ByteString -> CBORBytes t
CBORBytes ByteString
bs) of
  Left DeserialiseFailure
err -> String -> Decoder s t
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
err)
  Right t
t -> t -> Decoder s t
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t

serialiseCBORBytes :: (Serialise t) => t -> CBORBytes t
serialiseCBORBytes :: forall t. Serialise t => t -> CBORBytes t
serialiseCBORBytes = ByteString -> CBORBytes t
forall t. ByteString -> CBORBytes t
CBORBytes (ByteString -> CBORBytes t)
-> (t -> ByteString) -> t -> CBORBytes t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall a. Serialise a => a -> ByteString
CBOR.serialise

serialiseUnknownCBORBytes :: (Serialise t) => t -> UnknownCBORBytes
serialiseUnknownCBORBytes :: forall t. Serialise t => t -> UnknownCBORBytes
serialiseUnknownCBORBytes = ByteString -> UnknownCBORBytes
forall t. ByteString -> CBORBytes t
CBORBytes (ByteString -> UnknownCBORBytes)
-> (t -> ByteString) -> t -> UnknownCBORBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall a. Serialise a => a -> ByteString
CBOR.serialise

data Unknown

type UnknownCBORBytes = CBORBytes Unknown

-- | Wrapper for a stream of CBOR data. Each chunk may not be a complete CBOR value, but the concatenation of all the chunks is a valid CBOR stream.
newtype CBORStream a = CBORStream BL.ByteString
  deriving ([CBORStream a] -> Encoding
CBORStream a -> Encoding
(CBORStream a -> Encoding)
-> (forall s. Decoder s (CBORStream a))
-> ([CBORStream a] -> Encoding)
-> (forall s. Decoder s [CBORStream a])
-> Serialise (CBORStream a)
forall s. Decoder s [CBORStream a]
forall s. Decoder s (CBORStream a)
forall a. [CBORStream a] -> Encoding
forall a. CBORStream a -> Encoding
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall a s. Decoder s [CBORStream a]
forall a s. Decoder s (CBORStream a)
$cencode :: forall a. CBORStream a -> Encoding
encode :: CBORStream a -> Encoding
$cdecode :: forall a s. Decoder s (CBORStream a)
decode :: forall s. Decoder s (CBORStream a)
$cencodeList :: forall a. [CBORStream a] -> Encoding
encodeList :: [CBORStream a] -> Encoding
$cdecodeList :: forall a s. Decoder s [CBORStream a]
decodeList :: forall s. Decoder s [CBORStream a]
Serialise) via (BL.ByteString)
  deriving (CBORStream a -> CBORStream a -> Bool
(CBORStream a -> CBORStream a -> Bool)
-> (CBORStream a -> CBORStream a -> Bool) -> Eq (CBORStream a)
forall a. CBORStream a -> CBORStream a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. CBORStream a -> CBORStream a -> Bool
== :: CBORStream a -> CBORStream a -> Bool
$c/= :: forall a. CBORStream a -> CBORStream a -> Bool
/= :: CBORStream a -> CBORStream a -> Bool
Eq, Int -> CBORStream a -> String -> String
[CBORStream a] -> String -> String
CBORStream a -> String
(Int -> CBORStream a -> String -> String)
-> (CBORStream a -> String)
-> ([CBORStream a] -> String -> String)
-> Show (CBORStream a)
forall a. Int -> CBORStream a -> String -> String
forall a. [CBORStream a] -> String -> String
forall a. CBORStream a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Int -> CBORStream a -> String -> String
showsPrec :: Int -> CBORStream a -> String -> String
$cshow :: forall a. CBORStream a -> String
show :: CBORStream a -> String
$cshowList :: forall a. [CBORStream a] -> String -> String
showList :: [CBORStream a] -> String -> String
Show, Eq (CBORStream a)
Eq (CBORStream a) =>
(CBORStream a -> CBORStream a -> Ordering)
-> (CBORStream a -> CBORStream a -> Bool)
-> (CBORStream a -> CBORStream a -> Bool)
-> (CBORStream a -> CBORStream a -> Bool)
-> (CBORStream a -> CBORStream a -> Bool)
-> (CBORStream a -> CBORStream a -> CBORStream a)
-> (CBORStream a -> CBORStream a -> CBORStream a)
-> Ord (CBORStream a)
CBORStream a -> CBORStream a -> Bool
CBORStream a -> CBORStream a -> Ordering
CBORStream a -> CBORStream a -> CBORStream a
forall a. Eq (CBORStream a)
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
forall a. CBORStream a -> CBORStream a -> Bool
forall a. CBORStream a -> CBORStream a -> Ordering
forall a. CBORStream a -> CBORStream a -> CBORStream a
$ccompare :: forall a. CBORStream a -> CBORStream a -> Ordering
compare :: CBORStream a -> CBORStream a -> Ordering
$c< :: forall a. CBORStream a -> CBORStream a -> Bool
< :: CBORStream a -> CBORStream a -> Bool
$c<= :: forall a. CBORStream a -> CBORStream a -> Bool
<= :: CBORStream a -> CBORStream a -> Bool
$c> :: forall a. CBORStream a -> CBORStream a -> Bool
> :: CBORStream a -> CBORStream a -> Bool
$c>= :: forall a. CBORStream a -> CBORStream a -> Bool
>= :: CBORStream a -> CBORStream a -> Bool
$cmax :: forall a. CBORStream a -> CBORStream a -> CBORStream a
max :: CBORStream a -> CBORStream a -> CBORStream a
$cmin :: forall a. CBORStream a -> CBORStream a -> CBORStream a
min :: CBORStream a -> CBORStream a -> CBORStream a
Ord)

instance MimeRender OctetStream (CBORStream a) where
  mimeRender :: Proxy OctetStream -> CBORStream a -> ByteString
mimeRender Proxy OctetStream
Proxy (CBORStream ByteString
bs) = ByteString
bs

instance MimeUnrender OctetStream (CBORStream a) where
  mimeUnrender :: Proxy OctetStream -> ByteString -> Either String (CBORStream a)
mimeUnrender Proxy OctetStream
Proxy ByteString
bs = CBORStream a -> Either String (CBORStream a)
forall a b. b -> Either a b
Right (ByteString -> CBORStream a
forall a. ByteString -> CBORStream a
CBORStream ByteString
bs)

unpackCBORBytesStream :: (CBOR.Serialise o, MonadIO m) => ConduitT (CBORStream o) o (ExceptT CBORStreamError m) ()
unpackCBORBytesStream :: forall o (m :: * -> *).
(Serialise o, MonadIO m) =>
ConduitT (CBORStream o) o (ExceptT CBORStreamError m) ()
unpackCBORBytesStream =
  (CBORStream o -> ByteString)
-> ConduitT
     (CBORStream o) ByteString (ExceptT CBORStreamError m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
Conduit.map (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (CBORStream o -> ByteString) -> CBORStream o -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @BL.ByteString) ConduitT (CBORStream o) ByteString (ExceptT CBORStreamError m) ()
-> ConduitT ByteString o (ExceptT CBORStreamError m) ()
-> ConduitT (CBORStream o) o (ExceptT CBORStreamError m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
Conduit..| ConduitT ByteString o (ExceptT CBORStreamError m) ()
forall a (m :: * -> *).
(MonadIO m, Serialise a) =>
ConduitT ByteString a (ExceptT CBORStreamError m) ()
decodeUnframedEntities

data CBORStreamError
  = CBORStreamDeserializationError CBOR.DeserialiseFailure
  | CBORStreamInitializationError Text
  | CBORStreamUnexpectedEndOfInput
  deriving (CBORStreamError -> CBORStreamError -> Bool
(CBORStreamError -> CBORStreamError -> Bool)
-> (CBORStreamError -> CBORStreamError -> Bool)
-> Eq CBORStreamError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CBORStreamError -> CBORStreamError -> Bool
== :: CBORStreamError -> CBORStreamError -> Bool
$c/= :: CBORStreamError -> CBORStreamError -> Bool
/= :: CBORStreamError -> CBORStreamError -> Bool
Eq, Int -> CBORStreamError -> String -> String
[CBORStreamError] -> String -> String
CBORStreamError -> String
(Int -> CBORStreamError -> String -> String)
-> (CBORStreamError -> String)
-> ([CBORStreamError] -> String -> String)
-> Show CBORStreamError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CBORStreamError -> String -> String
showsPrec :: Int -> CBORStreamError -> String -> String
$cshow :: CBORStreamError -> String
show :: CBORStreamError -> String
$cshowList :: [CBORStreamError] -> String -> String
showList :: [CBORStreamError] -> String -> String
Show)

-- | Unpacks a stream of tightly-packed CBOR entities without any framing/separators.
decodeUnframedEntities :: forall a m. (MonadIO m) => (CBOR.Serialise a) => ConduitT BS.ByteString a (ExceptT CBORStreamError m) ()
decodeUnframedEntities :: forall a (m :: * -> *).
(MonadIO m, Serialise a) =>
ConduitT ByteString a (ExceptT CBORStreamError m) ()
decodeUnframedEntities = (forall a.
 ExceptT CBORStreamError (ST RealWorld) a
 -> ExceptT CBORStreamError m a)
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST RealWorld)) ()
-> ConduitT ByteString a (ExceptT CBORStreamError m) ()
forall (m :: * -> *) (n :: * -> *) i o r.
Monad m =>
(forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r
Conduit.transPipe ((ST RealWorld (Either CBORStreamError a)
 -> m (Either CBORStreamError a))
-> ExceptT CBORStreamError (ST RealWorld) a
-> ExceptT CBORStreamError m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (IO (Either CBORStreamError a) -> m (Either CBORStreamError a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either CBORStreamError a) -> m (Either CBORStreamError a))
-> (ST RealWorld (Either CBORStreamError a)
    -> IO (Either CBORStreamError a))
-> ST RealWorld (Either CBORStreamError a)
-> m (Either CBORStreamError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST RealWorld (Either CBORStreamError a)
-> IO (Either CBORStreamError a)
forall a. ST RealWorld a -> IO a
stToIO)) (ConduitT ByteString a (ExceptT CBORStreamError (ST RealWorld)) ()
 -> ConduitT ByteString a (ExceptT CBORStreamError m) ())
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST RealWorld)) ()
-> ConduitT ByteString a (ExceptT CBORStreamError m) ()
forall a b. (a -> b) -> a -> b
$ do
  ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST RealWorld))
  (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
Conduit.await ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST RealWorld))
  (Maybe ByteString)
-> (Maybe ByteString
    -> ConduitT
         ByteString a (ExceptT CBORStreamError (ST RealWorld)) ())
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST RealWorld)) ()
forall a b.
ConduitT ByteString a (ExceptT CBORStreamError (ST RealWorld)) a
-> (a
    -> ConduitT
         ByteString a (ExceptT CBORStreamError (ST RealWorld)) b)
-> ConduitT ByteString a (ExceptT CBORStreamError (ST RealWorld)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ByteString
Nothing -> ()
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST RealWorld)) ()
forall a.
a
-> ConduitT ByteString a (ExceptT CBORStreamError (ST RealWorld)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ByteString
bs -> do
      d <- ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST RealWorld))
  (Maybe ByteString -> ST RealWorld (IDecode RealWorld a))
forall s.
ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST s))
  (Maybe ByteString -> ST s (IDecode s a))
newDecoder
      loop bs d
  where
    newDecoder :: ConduitT BS.ByteString a (ExceptT CBORStreamError (ST s)) (Maybe BS.ByteString -> ST s (CBOR.IDecode s a))
    newDecoder :: forall s.
ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST s))
  (Maybe ByteString -> ST s (IDecode s a))
newDecoder = do
      (ExceptT CBORStreamError (ST s) (IDecode s a)
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
forall (m :: * -> *) a. Monad m => m a -> ConduitT ByteString a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT CBORStreamError (ST s) (IDecode s a)
 -> ConduitT
      ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a))
-> (ST s (IDecode s a)
    -> ExceptT CBORStreamError (ST s) (IDecode s a))
-> ST s (IDecode s a)
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s (IDecode s a) -> ExceptT CBORStreamError (ST s) (IDecode s a)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT CBORStreamError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) ST s (IDecode s a)
forall a s. Serialise a => ST s (IDecode s a)
CBOR.deserialiseIncremental ConduitT
  ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
-> (IDecode s a
    -> ConduitT
         ByteString
         a
         (ExceptT CBORStreamError (ST s))
         (Maybe ByteString -> ST s (IDecode s a)))
-> ConduitT
     ByteString
     a
     (ExceptT CBORStreamError (ST s))
     (Maybe ByteString -> ST s (IDecode s a))
forall a b.
ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
-> (a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b)
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        CBOR.Done ByteString
_ ByteOffset
_ a
_ -> CBORStreamError
-> ConduitT
     ByteString
     a
     (ExceptT CBORStreamError (ST s))
     (Maybe ByteString -> ST s (IDecode s a))
forall a.
CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CBORStreamError
 -> ConduitT
      ByteString
      a
      (ExceptT CBORStreamError (ST s))
      (Maybe ByteString -> ST s (IDecode s a)))
-> CBORStreamError
-> ConduitT
     ByteString
     a
     (ExceptT CBORStreamError (ST s))
     (Maybe ByteString -> ST s (IDecode s a))
forall a b. (a -> b) -> a -> b
$ Text -> CBORStreamError
CBORStreamInitializationError Text
"Decoder unexpectedly finished immediately"
        CBOR.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
err -> CBORStreamError
-> ConduitT
     ByteString
     a
     (ExceptT CBORStreamError (ST s))
     (Maybe ByteString -> ST s (IDecode s a))
forall a.
CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CBORStreamError
 -> ConduitT
      ByteString
      a
      (ExceptT CBORStreamError (ST s))
      (Maybe ByteString -> ST s (IDecode s a)))
-> CBORStreamError
-> ConduitT
     ByteString
     a
     (ExceptT CBORStreamError (ST s))
     (Maybe ByteString -> ST s (IDecode s a))
forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> CBORStreamError
CBORStreamDeserializationError DeserialiseFailure
err
        CBOR.Partial Maybe ByteString -> ST s (IDecode s a)
k -> (Maybe ByteString -> ST s (IDecode s a))
-> ConduitT
     ByteString
     a
     (ExceptT CBORStreamError (ST s))
     (Maybe ByteString -> ST s (IDecode s a))
forall a.
a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString -> ST s (IDecode s a)
k
    loop :: BS.ByteString -> (Maybe BS.ByteString -> ST s (CBOR.IDecode s a)) -> ConduitT BS.ByteString a (ExceptT CBORStreamError (ST s)) ()
    loop :: forall s.
ByteString
-> (Maybe ByteString -> ST s (IDecode s a))
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
loop ByteString
bs Maybe ByteString -> ST s (IDecode s a)
k = do
      (ExceptT CBORStreamError (ST s) (IDecode s a)
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
forall (m :: * -> *) a. Monad m => m a -> ConduitT ByteString a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT CBORStreamError (ST s) (IDecode s a)
 -> ConduitT
      ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a))
-> (ST s (IDecode s a)
    -> ExceptT CBORStreamError (ST s) (IDecode s a))
-> ST s (IDecode s a)
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s (IDecode s a) -> ExceptT CBORStreamError (ST s) (IDecode s a)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT CBORStreamError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (Maybe ByteString -> ST s (IDecode s a)
k (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)) ConduitT
  ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
-> (IDecode s a
    -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ())
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a b.
ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
-> (a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b)
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        CBOR.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
err -> CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a.
CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CBORStreamError
 -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ())
-> CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> CBORStreamError
CBORStreamDeserializationError DeserialiseFailure
err
        CBOR.Partial Maybe ByteString -> ST s (IDecode s a)
k' -> do
          -- We need more input, try to get some
          nextBS <- ConduitT
  ByteString a (ExceptT CBORStreamError (ST s)) (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
Conduit.await
          case nextBS of
            Maybe ByteString
Nothing -> do
              -- No more input, try to finish up the decoder.
              (ExceptT CBORStreamError (ST s) (IDecode s a)
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
forall (m :: * -> *) a. Monad m => m a -> ConduitT ByteString a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT CBORStreamError (ST s) (IDecode s a)
 -> ConduitT
      ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a))
-> (ST s (IDecode s a)
    -> ExceptT CBORStreamError (ST s) (IDecode s a))
-> ST s (IDecode s a)
-> ConduitT
     ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s (IDecode s a) -> ExceptT CBORStreamError (ST s) (IDecode s a)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT CBORStreamError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (Maybe ByteString -> ST s (IDecode s a)
k' Maybe ByteString
forall a. Maybe a
Nothing) ConduitT
  ByteString a (ExceptT CBORStreamError (ST s)) (IDecode s a)
-> (IDecode s a
    -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ())
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a b.
ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
-> (a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b)
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                CBOR.Done ByteString
_ ByteOffset
_ a
a -> a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield a
a
                CBOR.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
err -> CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a.
CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CBORStreamError
 -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ())
-> CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> CBORStreamError
CBORStreamDeserializationError DeserialiseFailure
err
                CBOR.Partial Maybe ByteString -> ST s (IDecode s a)
_ -> CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a.
CBORStreamError
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CBORStreamError
CBORStreamUnexpectedEndOfInput
            Just ByteString
bs' ->
              -- Have some input, keep going.
              ByteString
-> (Maybe ByteString -> ST s (IDecode s a))
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall s.
ByteString
-> (Maybe ByteString -> ST s (IDecode s a))
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
loop ByteString
bs' Maybe ByteString -> ST s (IDecode s a)
k'
        CBOR.Done ByteString
rem ByteOffset
_ a
a -> do
          a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield a
a
          if ByteString -> Bool
BS.null ByteString
rem
            then do
              -- If we had no leftovers, we can check if there's any input left.
              ConduitT
  ByteString a (ExceptT CBORStreamError (ST s)) (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
Conduit.await ConduitT
  ByteString a (ExceptT CBORStreamError (ST s)) (Maybe ByteString)
-> (Maybe ByteString
    -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ())
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a b.
ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
-> (a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b)
-> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe ByteString
Nothing -> () -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) ()
forall a.
a -> ConduitT ByteString a (ExceptT CBORStreamError (ST s)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Just ByteString
bs'' -> do
                  -- If we have input left, start up a new decoder.
                  k <- ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST s))
  (Maybe ByteString -> ST s (IDecode s a))
forall s.
ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST s))
  (Maybe ByteString -> ST s (IDecode s a))
newDecoder
                  loop bs'' k
            else do
              -- We have leftovers, start a new decoder and use those.
              k <- ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST s))
  (Maybe ByteString -> ST s (IDecode s a))
forall s.
ConduitT
  ByteString
  a
  (ExceptT CBORStreamError (ST s))
  (Maybe ByteString -> ST s (IDecode s a))
newDecoder
              loop rem k