-- | File types
module Network.IPFS.File.Types (Serialized (..)) where

import qualified Data.ByteString.Builder as Builder
import           Data.Swagger
import qualified RIO.ByteString.Lazy     as Lazy

import Servant.API

import Network.IPFS.MIME.RawPlainText.Types
import Network.IPFS.Prelude

-- | A file serialized as a lazy bytestring
newtype Serialized = Serialized { Serialized -> ByteString
unserialize :: Lazy.ByteString }
  deriving         ( Serialized -> Serialized -> Bool
(Serialized -> Serialized -> Bool)
-> (Serialized -> Serialized -> Bool) -> Eq Serialized
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Serialized -> Serialized -> Bool
$c/= :: Serialized -> Serialized -> Bool
== :: Serialized -> Serialized -> Bool
$c== :: Serialized -> Serialized -> Bool
Eq
                   , Int -> Serialized -> ShowS
[Serialized] -> ShowS
Serialized -> String
(Int -> Serialized -> ShowS)
-> (Serialized -> String)
-> ([Serialized] -> ShowS)
-> Show Serialized
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Serialized] -> ShowS
$cshowList :: [Serialized] -> ShowS
show :: Serialized -> String
$cshow :: Serialized -> String
showsPrec :: Int -> Serialized -> ShowS
$cshowsPrec :: Int -> Serialized -> ShowS
Show
                   )
  deriving newtype ( String -> Serialized
(String -> Serialized) -> IsString Serialized
forall a. (String -> a) -> IsString a
fromString :: String -> Serialized
$cfromString :: String -> Serialized
IsString )

instance ToSchema Serialized where
  declareNamedSchema :: Proxy Serialized -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Serialized
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
|> (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example     ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"hello world"
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
|> (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
description ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A typical file's contents"
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
|> (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_       ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
      Schema -> (Schema -> NamedSchema) -> NamedSchema
forall a b. a -> (a -> b) -> b
|> Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"SerializedFile")
      NamedSchema
-> (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
forall a b. a -> (a -> b) -> b
|> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Display Serialized where
  display :: Serialized -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Serialized -> Builder) -> Serialized -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
Builder.lazyByteString (ByteString -> Builder)
-> (Serialized -> ByteString) -> Serialized -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serialized -> ByteString
unserialize

-----

instance MimeRender PlainText Serialized where
  mimeRender :: Proxy PlainText -> Serialized -> ByteString
mimeRender Proxy PlainText
_proxy = Serialized -> ByteString
unserialize

instance MimeRender RawPlainText Serialized where
  mimeRender :: Proxy RawPlainText -> Serialized -> ByteString
mimeRender Proxy RawPlainText
_proxy = Serialized -> ByteString
unserialize

instance MimeRender OctetStream Serialized where
  mimeRender :: Proxy OctetStream -> Serialized -> ByteString
mimeRender Proxy OctetStream
_proxy = Serialized -> ByteString
unserialize

-----

instance MimeUnrender PlainText Serialized where
  mimeUnrender :: Proxy PlainText -> ByteString -> Either String Serialized
mimeUnrender Proxy PlainText
_proxy = Serialized -> Either String Serialized
forall a b. b -> Either a b
Right (Serialized -> Either String Serialized)
-> (ByteString -> Serialized)
-> ByteString
-> Either String Serialized
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Serialized
Serialized

instance MimeUnrender RawPlainText Serialized where
  mimeUnrender :: Proxy RawPlainText -> ByteString -> Either String Serialized
mimeUnrender Proxy RawPlainText
_proxy = Serialized -> Either String Serialized
forall a b. b -> Either a b
Right (Serialized -> Either String Serialized)
-> (ByteString -> Serialized)
-> ByteString
-> Either String Serialized
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Serialized
Serialized

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