-- | CBOR Servant support and wrapper type

module Blockfrost.Types.Shared.CBOR
  where

import Data.Aeson (FromJSON (..), ToJSON (..), withText)
import Data.ByteString.Lazy (ByteString)
import Servant.API (Accept (..), MimeRender (..), MimeUnrender (..))
import Servant.Docs (ToSample (..), singleSample)

import qualified Data.ByteString.Char8
import qualified Data.ByteString.Lazy
import qualified Data.Text

data CBOR

-- | Wrapper for CBOR encoded `ByteString`s
-- used for submitting a transaction
newtype CBORString = CBORString ByteString
  deriving stock (CBORString -> CBORString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CBORString -> CBORString -> Bool
$c/= :: CBORString -> CBORString -> Bool
== :: CBORString -> CBORString -> Bool
$c== :: CBORString -> CBORString -> Bool
Eq, Int -> CBORString -> ShowS
[CBORString] -> ShowS
CBORString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CBORString] -> ShowS
$cshowList :: [CBORString] -> ShowS
show :: CBORString -> String
$cshow :: CBORString -> String
showsPrec :: Int -> CBORString -> ShowS
$cshowsPrec :: Int -> CBORString -> ShowS
Show)

instance ToJSON CBORString where
  toJSON :: CBORString -> Value
toJSON (CBORString ByteString
bs) =
    forall a. ToJSON a => a -> Value
toJSON
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Data.Text.pack
      forall a b. (a -> b) -> a -> b
$ ByteString -> String
Data.ByteString.Char8.unpack
      forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Data.ByteString.Lazy.toStrict ByteString
bs

instance FromJSON CBORString where
  parseJSON :: Value -> Parser CBORString
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"CBORString" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      forall a b. (a -> b) -> a -> b
$ ByteString -> CBORString
CBORString
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString
Data.ByteString.Lazy.fromStrict
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Data.ByteString.Char8.pack
        forall a b. (a -> b) -> a -> b
$ Text -> String
Data.Text.unpack Text
t

instance Accept CBOR where
  contentType :: Proxy CBOR -> MediaType
contentType = forall (f :: * -> *) a. Applicative f => a -> f a
pure MediaType
"application/cbor"

instance MimeRender CBOR CBORString where
  mimeRender :: Proxy CBOR -> CBORString -> ByteString
mimeRender Proxy CBOR
_ (CBORString ByteString
cs) = ByteString
cs

instance MimeUnrender CBOR CBORString where
  mimeUnrender :: Proxy CBOR -> ByteString -> Either String CBORString
mimeUnrender Proxy CBOR
_ ByteString
lbs = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> CBORString
CBORString ByteString
lbs

instance ToSample CBORString where
  toSamples :: Proxy CBORString -> [(Text, CBORString)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample forall a b. (a -> b) -> a -> b
$ ByteString -> CBORString
CBORString ByteString
"adef"