{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.Routes.AssetBody
  ( AssetBody,
    AssetSource (..),
  )
where

import Conduit
import Data.ByteString.Lazy qualified as LBS
import Data.OpenApi
import Data.OpenApi.Internal.Schema
import Imports
import Network.HTTP.Media ((//))
import Servant
import Servant.Conduit ()
import Servant.OpenApi.Internal.Orphans ()

data MultipartMixed

instance Accept MultipartMixed where
  contentType :: Proxy MultipartMixed -> MediaType
contentType Proxy MultipartMixed
_ = ByteString
"multipart" ByteString -> ByteString -> MediaType
// ByteString
"mixed"

instance MimeUnrender MultipartMixed ByteString where
  mimeUnrender :: Proxy MultipartMixed -> ByteString -> Either String ByteString
mimeUnrender Proxy MultipartMixed
_ = ByteString -> Either String ByteString
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict

newtype AssetSource = AssetSource
  { AssetSource -> ConduitT () ByteString (ResourceT IO) ()
getAssetSource ::
      ConduitT () ByteString (ResourceT IO) ()
  }
  deriving newtype (FromSourceIO ByteString, ToSourceIO ByteString)

instance ToSchema AssetSource where
  declareNamedSchema :: Proxy AssetSource -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy AssetSource
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> NamedSchema
named Text
"AssetSource" Schema
forall a. Monoid a => a
mempty

type AssetBody =
  StreamBody'
    '[ Description
         "A body with content type `multipart/mixed body`. The first section's \
         \content type should be `application/json`. The second section's content \
         \type should be always be `application/octet-stream`. Other content types \
         \will be ignored by the server."
     ]
    NoFraming
    MultipartMixed
    AssetSource