{-# OPTIONS_GHC -fno-warn-orphans #-}

module Network.IPFS.Internal.Orphanage.ByteString.Lazy () where

import qualified RIO.ByteString.Lazy  as Lazy
import           Servant.API

import           Network.IPFS.Prelude

instance MimeRender PlainText Lazy.ByteString where
  mimeRender :: Proxy PlainText -> ByteString -> ByteString
mimeRender Proxy PlainText
_proxy = forall a. a -> a
identity

instance FromJSON Lazy.ByteString where
  parseJSON :: Value -> Parser ByteString
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ByteString" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)