{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

-- 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.Asset
  ( -- * Asset
    Asset,
    Asset',
    mkAsset,
    assetKey,
    assetExpires,
    assetToken,

    -- * AssetKey
    AssetKey (..),
    assetKeyToText,

    -- * AssetToken
    AssetToken (..),
    NewAssetToken (..),

    -- * Body Construction
    buildMultipartBody,
    beginMultipartBody,
    endMultipartBody,

    -- * AssetHeaders
    AssetHeaders (..),
    mkHeaders,

    -- * AssetSettings
    AssetSettings,
    defAssetSettings,
    setAssetPublic,
    setAssetRetention,
    AssetRetention (..),
    assetRetentionSeconds,
    assetExpiringSeconds,
    assetVolatileSeconds,
    retentionToTextRep,

    -- * Streaming
    AssetLocation (..),
    LocalOrRemoteAsset (..),
  )
where

import Cassandra qualified as C
import Codec.MIME.Type qualified as MIME
import Control.Lens (makeLenses, (?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as Aeson
import Data.Attoparsec.ByteString.Char8 hiding (I)
import Data.Bifunctor
import Data.ByteString.Builder
import Data.ByteString.Conversion
import Data.ByteString.Lazy qualified as LBS
import Data.Id
import Data.Json.Util (UTCTimeMillis (fromUTCTimeMillis), toUTCTimeMillis)
import Data.OpenApi qualified as S
import Data.Proxy
import Data.Qualified
import Data.SOP
import Data.Schema
import Data.Text qualified as T
import Data.Text.Ascii (AsciiBase64Url)
import Data.Text.Encoding qualified as T
import Data.Text.Encoding.Error qualified as T
import Data.Time.Clock
import Data.UUID qualified as UUID
import Imports
import Servant
import URI.ByteString
import Wire.API.Error
import Wire.API.Routes.MultiVerb
import Wire.Arbitrary (Arbitrary (..), GenericUniform (..))

--------------------------------------------------------------------------------
-- Asset

type Asset = Asset' (Qualified AssetKey)

-- | A newly uploaded asset.
data Asset' key = Asset
  { forall key. Asset' key -> key
_assetKey :: key,
    forall key. Asset' key -> Maybe UTCTime
_assetExpires :: Maybe UTCTime,
    forall key. Asset' key -> Maybe AssetToken
_assetToken :: Maybe AssetToken
  }
  deriving stock (Asset' key -> Asset' key -> Bool
(Asset' key -> Asset' key -> Bool)
-> (Asset' key -> Asset' key -> Bool) -> Eq (Asset' key)
forall key. Eq key => Asset' key -> Asset' key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall key. Eq key => Asset' key -> Asset' key -> Bool
== :: Asset' key -> Asset' key -> Bool
$c/= :: forall key. Eq key => Asset' key -> Asset' key -> Bool
/= :: Asset' key -> Asset' key -> Bool
Eq, Int -> Asset' key -> ShowS
[Asset' key] -> ShowS
Asset' key -> String
(Int -> Asset' key -> ShowS)
-> (Asset' key -> String)
-> ([Asset' key] -> ShowS)
-> Show (Asset' key)
forall key. Show key => Int -> Asset' key -> ShowS
forall key. Show key => [Asset' key] -> ShowS
forall key. Show key => Asset' key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall key. Show key => Int -> Asset' key -> ShowS
showsPrec :: Int -> Asset' key -> ShowS
$cshow :: forall key. Show key => Asset' key -> String
show :: Asset' key -> String
$cshowList :: forall key. Show key => [Asset' key] -> ShowS
showList :: [Asset' key] -> ShowS
Show, (forall x. Asset' key -> Rep (Asset' key) x)
-> (forall x. Rep (Asset' key) x -> Asset' key)
-> Generic (Asset' key)
forall x. Rep (Asset' key) x -> Asset' key
forall x. Asset' key -> Rep (Asset' key) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall key x. Rep (Asset' key) x -> Asset' key
forall key x. Asset' key -> Rep (Asset' key) x
$cfrom :: forall key x. Asset' key -> Rep (Asset' key) x
from :: forall x. Asset' key -> Rep (Asset' key) x
$cto :: forall key x. Rep (Asset' key) x -> Asset' key
to :: forall x. Rep (Asset' key) x -> Asset' key
Generic, (forall a b. (a -> b) -> Asset' a -> Asset' b)
-> (forall a b. a -> Asset' b -> Asset' a) -> Functor Asset'
forall a b. a -> Asset' b -> Asset' a
forall a b. (a -> b) -> Asset' a -> Asset' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Asset' a -> Asset' b
fmap :: forall a b. (a -> b) -> Asset' a -> Asset' b
$c<$ :: forall a b. a -> Asset' b -> Asset' a
<$ :: forall a b. a -> Asset' b -> Asset' a
Functor)

deriving via Schema (Asset' key) instance (ToSchema (Asset' key)) => (ToJSON (Asset' key))

deriving via Schema (Asset' key) instance (ToSchema (Asset' key)) => (FromJSON (Asset' key))

deriving via Schema (Asset' key) instance (Typeable key, ToSchema (Asset' key)) => (S.ToSchema (Asset' key))

-- Generate expiry time with millisecond precision
instance (Arbitrary key) => Arbitrary (Asset' key) where
  arbitrary :: Gen (Asset' key)
arbitrary = key -> Maybe UTCTime -> Maybe AssetToken -> Asset' key
forall key. key -> Maybe UTCTime -> Maybe AssetToken -> Asset' key
Asset (key -> Maybe UTCTime -> Maybe AssetToken -> Asset' key)
-> Gen key -> Gen (Maybe UTCTime -> Maybe AssetToken -> Asset' key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen key
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe UTCTime -> Maybe AssetToken -> Asset' key)
-> Gen (Maybe UTCTime) -> Gen (Maybe AssetToken -> Asset' key)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((UTCTime -> UTCTime) -> Maybe UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> UTCTime
milli (Maybe UTCTime -> Maybe UTCTime)
-> Gen (Maybe UTCTime) -> Gen (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe UTCTime)
forall a. Arbitrary a => Gen a
arbitrary) Gen (Maybe AssetToken -> Asset' key)
-> Gen (Maybe AssetToken) -> Gen (Asset' key)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe AssetToken)
forall a. Arbitrary a => Gen a
arbitrary
    where
      milli :: UTCTime -> UTCTime
milli = UTCTimeMillis -> UTCTime
fromUTCTimeMillis (UTCTimeMillis -> UTCTime)
-> (UTCTime -> UTCTimeMillis) -> UTCTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTimeMillis
toUTCTimeMillis

mkAsset :: key -> Asset' key
mkAsset :: forall key. key -> Asset' key
mkAsset key
k = key -> Maybe UTCTime -> Maybe AssetToken -> Asset' key
forall key. key -> Maybe UTCTime -> Maybe AssetToken -> Asset' key
Asset key
k Maybe UTCTime
forall a. Maybe a
Nothing Maybe AssetToken
forall a. Maybe a
Nothing

instance ToSchema Asset where
  schema :: ValueSchema NamedSwaggerDoc Asset
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Asset Asset
-> ValueSchema NamedSwaggerDoc Asset
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Asset" (SchemaP SwaggerDoc Object [Pair] Asset Asset
 -> ValueSchema NamedSwaggerDoc Asset)
-> SchemaP SwaggerDoc Object [Pair] Asset Asset
-> ValueSchema NamedSwaggerDoc Asset
forall a b. (a -> b) -> a -> b
$
      Qualified AssetKey -> Maybe UTCTime -> Maybe AssetToken -> Asset
forall key. key -> Maybe UTCTime -> Maybe AssetToken -> Asset' key
Asset
        (Qualified AssetKey -> Maybe UTCTime -> Maybe AssetToken -> Asset)
-> SchemaP SwaggerDoc Object [Pair] Asset (Qualified AssetKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Asset
     (Maybe UTCTime -> Maybe AssetToken -> Asset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Asset -> Qualified AssetKey
forall key. Asset' key -> key
_assetKey
          (Asset -> Qualified AssetKey)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified AssetKey) (Qualified AssetKey)
-> SchemaP SwaggerDoc Object [Pair] Asset (Qualified AssetKey)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ( AssetKey -> Domain -> Qualified AssetKey
forall a. a -> Domain -> Qualified a
Qualified
                 (AssetKey -> Domain -> Qualified AssetKey)
-> SchemaP SwaggerDoc Object [Pair] (Qualified AssetKey) AssetKey
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Qualified AssetKey)
     (Domain -> Qualified AssetKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified AssetKey -> AssetKey
forall a. Qualified a -> a
qUnqualified (Qualified AssetKey -> AssetKey)
-> SchemaP SwaggerDoc Object [Pair] AssetKey AssetKey
-> SchemaP SwaggerDoc Object [Pair] (Qualified AssetKey) AssetKey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
-> SchemaP SwaggerDoc Object [Pair] AssetKey AssetKey
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"key" SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
                 SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Qualified AssetKey)
  (Domain -> Qualified AssetKey)
-> SchemaP SwaggerDoc Object [Pair] (Qualified AssetKey) Domain
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified AssetKey) (Qualified AssetKey)
forall a b.
SchemaP SwaggerDoc Object [Pair] (Qualified AssetKey) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Qualified AssetKey) a
-> SchemaP SwaggerDoc Object [Pair] (Qualified AssetKey) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Qualified AssetKey -> Domain
forall a. Qualified a -> Domain
qDomain (Qualified AssetKey -> Domain)
-> SchemaP SwaggerDoc Object [Pair] Domain Domain
-> SchemaP SwaggerDoc Object [Pair] (Qualified AssetKey) Domain
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Domain Domain
-> SchemaP SwaggerDoc Object [Pair] Domain Domain
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"domain" SchemaP NamedSwaggerDoc Value Value Domain Domain
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
             )
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Asset
  (Maybe UTCTime -> Maybe AssetToken -> Asset)
-> SchemaP SwaggerDoc Object [Pair] Asset (Maybe UTCTime)
-> SchemaP
     SwaggerDoc Object [Pair] Asset (Maybe AssetToken -> Asset)
forall a b.
SchemaP SwaggerDoc Object [Pair] Asset (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Asset a
-> SchemaP SwaggerDoc Object [Pair] Asset b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((UTCTime -> UTCTimeMillis) -> Maybe UTCTime -> Maybe UTCTimeMillis
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> UTCTimeMillis
toUTCTimeMillis (Maybe UTCTime -> Maybe UTCTimeMillis)
-> (Asset -> Maybe UTCTime) -> Asset -> Maybe UTCTimeMillis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Asset -> Maybe UTCTime
forall key. Asset' key -> Maybe UTCTime
_assetExpires)
          (Asset -> Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe UTCTimeMillis) (Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] Asset (Maybe UTCTime)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTime)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe UTCTimeMillis) (Maybe UTCTime)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_
            (Text
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTime)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"expires" (UTCTimeMillis -> UTCTime
fromUTCTimeMillis (UTCTimeMillis -> UTCTime)
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP SwaggerDoc Object [Pair] Asset (Maybe AssetToken -> Asset)
-> SchemaP SwaggerDoc Object [Pair] Asset (Maybe AssetToken)
-> SchemaP SwaggerDoc Object [Pair] Asset Asset
forall a b.
SchemaP SwaggerDoc Object [Pair] Asset (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Asset a
-> SchemaP SwaggerDoc Object [Pair] Asset b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Asset -> Maybe AssetToken
forall key. Asset' key -> Maybe AssetToken
_assetToken (Asset -> Maybe AssetToken)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe AssetToken) (Maybe AssetToken)
-> SchemaP SwaggerDoc Object [Pair] Asset (Maybe AssetToken)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] AssetToken (Maybe AssetToken)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe AssetToken) (Maybe AssetToken)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
-> SchemaP SwaggerDoc Object [Pair] AssetToken (Maybe AssetToken)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"token" SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- AssetKey

-- | A unique, versioned asset identifier.
-- Note: Can be turned into a sum type with additional constructors
-- for future versions.
data AssetKey = AssetKeyV3 AssetId AssetRetention
  deriving stock (AssetKey -> AssetKey -> Bool
(AssetKey -> AssetKey -> Bool)
-> (AssetKey -> AssetKey -> Bool) -> Eq AssetKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetKey -> AssetKey -> Bool
== :: AssetKey -> AssetKey -> Bool
$c/= :: AssetKey -> AssetKey -> Bool
/= :: AssetKey -> AssetKey -> Bool
Eq, Eq AssetKey
Eq AssetKey =>
(AssetKey -> AssetKey -> Ordering)
-> (AssetKey -> AssetKey -> Bool)
-> (AssetKey -> AssetKey -> Bool)
-> (AssetKey -> AssetKey -> Bool)
-> (AssetKey -> AssetKey -> Bool)
-> (AssetKey -> AssetKey -> AssetKey)
-> (AssetKey -> AssetKey -> AssetKey)
-> Ord AssetKey
AssetKey -> AssetKey -> Bool
AssetKey -> AssetKey -> Ordering
AssetKey -> AssetKey -> AssetKey
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
$ccompare :: AssetKey -> AssetKey -> Ordering
compare :: AssetKey -> AssetKey -> Ordering
$c< :: AssetKey -> AssetKey -> Bool
< :: AssetKey -> AssetKey -> Bool
$c<= :: AssetKey -> AssetKey -> Bool
<= :: AssetKey -> AssetKey -> Bool
$c> :: AssetKey -> AssetKey -> Bool
> :: AssetKey -> AssetKey -> Bool
$c>= :: AssetKey -> AssetKey -> Bool
>= :: AssetKey -> AssetKey -> Bool
$cmax :: AssetKey -> AssetKey -> AssetKey
max :: AssetKey -> AssetKey -> AssetKey
$cmin :: AssetKey -> AssetKey -> AssetKey
min :: AssetKey -> AssetKey -> AssetKey
Ord, Int -> AssetKey -> ShowS
[AssetKey] -> ShowS
AssetKey -> String
(Int -> AssetKey -> ShowS)
-> (AssetKey -> String) -> ([AssetKey] -> ShowS) -> Show AssetKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetKey -> ShowS
showsPrec :: Int -> AssetKey -> ShowS
$cshow :: AssetKey -> String
show :: AssetKey -> String
$cshowList :: [AssetKey] -> ShowS
showList :: [AssetKey] -> ShowS
Show, (forall x. AssetKey -> Rep AssetKey x)
-> (forall x. Rep AssetKey x -> AssetKey) -> Generic AssetKey
forall x. Rep AssetKey x -> AssetKey
forall x. AssetKey -> Rep AssetKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssetKey -> Rep AssetKey x
from :: forall x. AssetKey -> Rep AssetKey x
$cto :: forall x. Rep AssetKey x -> AssetKey
to :: forall x. Rep AssetKey x -> AssetKey
Generic)
  deriving (Gen AssetKey
Gen AssetKey -> (AssetKey -> [AssetKey]) -> Arbitrary AssetKey
AssetKey -> [AssetKey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AssetKey
arbitrary :: Gen AssetKey
$cshrink :: AssetKey -> [AssetKey]
shrink :: AssetKey -> [AssetKey]
Arbitrary) via (GenericUniform AssetKey)
  deriving (Value -> Parser [AssetKey]
Value -> Parser AssetKey
(Value -> Parser AssetKey)
-> (Value -> Parser [AssetKey]) -> FromJSON AssetKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AssetKey
parseJSON :: Value -> Parser AssetKey
$cparseJSONList :: Value -> Parser [AssetKey]
parseJSONList :: Value -> Parser [AssetKey]
FromJSON, [AssetKey] -> Value
[AssetKey] -> Encoding
AssetKey -> Value
AssetKey -> Encoding
(AssetKey -> Value)
-> (AssetKey -> Encoding)
-> ([AssetKey] -> Value)
-> ([AssetKey] -> Encoding)
-> ToJSON AssetKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AssetKey -> Value
toJSON :: AssetKey -> Value
$ctoEncoding :: AssetKey -> Encoding
toEncoding :: AssetKey -> Encoding
$ctoJSONList :: [AssetKey] -> Value
toJSONList :: [AssetKey] -> Value
$ctoEncodingList :: [AssetKey] -> Encoding
toEncodingList :: [AssetKey] -> Encoding
ToJSON, Typeable AssetKey
Typeable AssetKey =>
(Proxy AssetKey -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AssetKey
Proxy AssetKey -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AssetKey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AssetKey -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema AssetKey)

instance FromByteString AssetKey where
  parser :: Parser AssetKey
parser = do
    Word
v <- Parser Word
forall a. Integral a => Parser a
decimal
    Char
_ <- Char -> Parser Char
char Char
'-'
    case (Word
v :: Word) of
      Word
3 -> Parser AssetKey
parseV3
      Word
_ -> String -> Parser AssetKey
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AssetKey) -> String -> Parser AssetKey
forall a b. (a -> b) -> a -> b
$ String
"Invalid asset version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
v
    where
      -- AssetKeyV3 ::= Retention "-" uuid
      -- Retention  ::= decimal
      parseV3 :: Parser AssetKey
parseV3 = do
        AssetRetention
r <- Parser AssetRetention
forall a. FromByteString a => Parser a
parser
        Char
_ <- Char -> Parser Char
char Char
'-'
        ByteString
b <- Parser ByteString
takeByteString
        case ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
b of
          Just UUID
i -> AssetKey -> Parser AssetKey
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssetKey -> Parser AssetKey) -> AssetKey -> Parser AssetKey
forall a b. (a -> b) -> a -> b
$! AssetId -> AssetRetention -> AssetKey
AssetKeyV3 (UUID -> AssetId
forall {k} (a :: k). UUID -> Id a
Id UUID
i) AssetRetention
r
          Maybe UUID
Nothing -> String -> Parser AssetKey
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid asset ID"

instance ToByteString AssetKey where
  builder :: AssetKey -> Builder
builder (AssetKeyV3 AssetId
i AssetRetention
r) =
    Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'3'
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'-'
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> AssetRetention -> Builder
forall a. ToByteString a => a -> Builder
builder AssetRetention
r
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'-'
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. ToByteString a => a -> Builder
builder (UUID -> ByteString
UUID.toASCIIBytes (AssetId -> UUID
forall {k} (a :: k). Id a -> UUID
toUUID AssetId
i))

assetKeyToText :: AssetKey -> Text
assetKeyToText :: AssetKey -> Text
assetKeyToText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (AssetKey -> ByteString) -> AssetKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetKey -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance ToSchema AssetKey where
  schema :: SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
schema =
    AssetKey -> Text
assetKeyToText
      (AssetKey -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text AssetKey
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String AssetKey)
-> SchemaP NamedSwaggerDoc Value Value Text AssetKey
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"AssetKey" (Parser AssetKey -> ByteString -> Either String AssetKey
forall a. Parser a -> ByteString -> Either String a
runParser Parser AssetKey
forall a. FromByteString a => Parser a
parser (ByteString -> Either String AssetKey)
-> (Text -> ByteString) -> Text -> Either String AssetKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8)
      SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
-> (SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
    -> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey)
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
forall a b. a -> (a -> b) -> b
& (NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
-> Identity (SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey)
forall doc v w a b (f :: * -> *).
Functor f =>
(doc -> f doc) -> SchemaP doc v w a b -> f (SchemaP doc v w a b)
doc' ((NamedSwaggerDoc -> Identity NamedSwaggerDoc)
 -> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey))
-> ((Maybe Value -> Identity (Maybe Value))
    -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> (Maybe Value -> Identity (Maybe Value))
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
-> Identity (SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Value -> Identity (Maybe Value))
    -> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
 -> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey))
-> Value
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"3-1-47de4580-ae51-4650-acbb-d10c028cb0ac" :: Text)

instance S.ToParamSchema AssetKey where
  toParamSchema :: Proxy AssetKey -> Schema
toParamSchema Proxy AssetKey
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
S.toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance FromHttpApiData AssetKey where
  parseUrlPiece :: Text -> Either Text AssetKey
parseUrlPiece = (String -> Text) -> Either String AssetKey -> Either Text AssetKey
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String AssetKey -> Either Text AssetKey)
-> (Text -> Either String AssetKey) -> Text -> Either Text AssetKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser AssetKey -> ByteString -> Either String AssetKey
forall a. Parser a -> ByteString -> Either String a
runParser Parser AssetKey
forall a. FromByteString a => Parser a
parser (ByteString -> Either String AssetKey)
-> (Text -> ByteString) -> Text -> Either String AssetKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance C.Cql AssetKey where
  ctype :: Tagged AssetKey ColumnType
ctype = ColumnType -> Tagged AssetKey ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.TextColumn
  toCql :: AssetKey -> Value
toCql = Text -> Value
C.CqlText (Text -> Value) -> (AssetKey -> Text) -> AssetKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetKey -> Text
assetKeyToText
  fromCql :: Value -> Either String AssetKey
fromCql (C.CqlText Text
txt) = Parser AssetKey -> ByteString -> Either String AssetKey
forall a. Parser a -> ByteString -> Either String a
runParser Parser AssetKey
forall a. FromByteString a => Parser a
parser (ByteString -> Either String AssetKey)
-> (Text -> ByteString) -> Text -> Either String AssetKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> Either String AssetKey) -> Text -> Either String AssetKey
forall a b. (a -> b) -> a -> b
$ Text
txt
  fromCql Value
_ = String -> Either String AssetKey
forall a b. a -> Either a b
Left String
"AssetKey: Text expected"

--------------------------------------------------------------------------------
-- AssetToken

-- | Asset tokens are bearer tokens that grant access to a single asset.
newtype AssetToken = AssetToken {AssetToken -> AsciiBase64Url
assetTokenAscii :: AsciiBase64Url}
  deriving stock (AssetToken -> AssetToken -> Bool
(AssetToken -> AssetToken -> Bool)
-> (AssetToken -> AssetToken -> Bool) -> Eq AssetToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetToken -> AssetToken -> Bool
== :: AssetToken -> AssetToken -> Bool
$c/= :: AssetToken -> AssetToken -> Bool
/= :: AssetToken -> AssetToken -> Bool
Eq, Int -> AssetToken -> ShowS
[AssetToken] -> ShowS
AssetToken -> String
(Int -> AssetToken -> ShowS)
-> (AssetToken -> String)
-> ([AssetToken] -> ShowS)
-> Show AssetToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetToken -> ShowS
showsPrec :: Int -> AssetToken -> ShowS
$cshow :: AssetToken -> String
show :: AssetToken -> String
$cshowList :: [AssetToken] -> ShowS
showList :: [AssetToken] -> ShowS
Show)
  deriving newtype (Parser AssetToken
Parser AssetToken -> FromByteString AssetToken
forall a. Parser a -> FromByteString a
$cparser :: Parser AssetToken
parser :: Parser AssetToken
FromByteString, AssetToken -> Builder
(AssetToken -> Builder) -> ToByteString AssetToken
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: AssetToken -> Builder
builder :: AssetToken -> Builder
ToByteString, Gen AssetToken
Gen AssetToken
-> (AssetToken -> [AssetToken]) -> Arbitrary AssetToken
AssetToken -> [AssetToken]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AssetToken
arbitrary :: Gen AssetToken
$cshrink :: AssetToken -> [AssetToken]
shrink :: AssetToken -> [AssetToken]
Arbitrary)
  deriving (Value -> Parser [AssetToken]
Value -> Parser AssetToken
(Value -> Parser AssetToken)
-> (Value -> Parser [AssetToken]) -> FromJSON AssetToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AssetToken
parseJSON :: Value -> Parser AssetToken
$cparseJSONList :: Value -> Parser [AssetToken]
parseJSONList :: Value -> Parser [AssetToken]
FromJSON, [AssetToken] -> Value
[AssetToken] -> Encoding
AssetToken -> Value
AssetToken -> Encoding
(AssetToken -> Value)
-> (AssetToken -> Encoding)
-> ([AssetToken] -> Value)
-> ([AssetToken] -> Encoding)
-> ToJSON AssetToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AssetToken -> Value
toJSON :: AssetToken -> Value
$ctoEncoding :: AssetToken -> Encoding
toEncoding :: AssetToken -> Encoding
$ctoJSONList :: [AssetToken] -> Value
toJSONList :: [AssetToken] -> Value
$ctoEncodingList :: [AssetToken] -> Encoding
toEncodingList :: [AssetToken] -> Encoding
ToJSON, Typeable AssetToken
Typeable AssetToken =>
(Proxy AssetToken -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AssetToken
Proxy AssetToken -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AssetToken -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AssetToken -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema AssetToken)

instance ToSchema AssetToken where
  schema :: SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
schema =
    AsciiBase64Url -> AssetToken
AssetToken
      (AsciiBase64Url -> AssetToken)
-> SchemaP NamedSwaggerDoc Value Value AssetToken AsciiBase64Url
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AssetToken -> AsciiBase64Url
assetTokenAscii
        (AssetToken -> AsciiBase64Url)
-> SchemaP
     NamedSwaggerDoc Value Value AsciiBase64Url AsciiBase64Url
-> SchemaP NamedSwaggerDoc Value Value AssetToken AsciiBase64Url
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value AsciiBase64Url AsciiBase64Url
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
      SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
-> (SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
    -> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken)
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
forall a b. a -> (a -> b) -> b
& (NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
-> Identity
     (SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken)
forall doc v w a b (f :: * -> *).
Functor f =>
(doc -> f doc) -> SchemaP doc v w a b -> f (SchemaP doc v w a b)
doc' ((NamedSwaggerDoc -> Identity NamedSwaggerDoc)
 -> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken))
-> ((Maybe Value -> Identity (Maybe Value))
    -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> (Maybe Value -> Identity (Maybe Value))
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
-> Identity
     (SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Value -> Identity (Maybe Value))
    -> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
 -> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken))
-> Value
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"aGVsbG8" :: Text)

instance S.ToParamSchema AssetToken where
  toParamSchema :: Proxy AssetToken -> Schema
toParamSchema Proxy AssetToken
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
S.toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance FromHttpApiData AssetToken where
  parseUrlPiece :: Text -> Either Text AssetToken
parseUrlPiece = (String -> Text)
-> Either String AssetToken -> Either Text AssetToken
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String AssetToken -> Either Text AssetToken)
-> (Text -> Either String AssetToken)
-> Text
-> Either Text AssetToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser AssetToken -> ByteString -> Either String AssetToken
forall a. Parser a -> ByteString -> Either String a
runParser Parser AssetToken
forall a. FromByteString a => Parser a
parser (ByteString -> Either String AssetToken)
-> (Text -> ByteString) -> Text -> Either String AssetToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

-- | A newly (re)generated token for an existing asset.
newtype NewAssetToken = NewAssetToken
  {NewAssetToken -> AssetToken
newAssetToken :: AssetToken}
  deriving stock (NewAssetToken -> NewAssetToken -> Bool
(NewAssetToken -> NewAssetToken -> Bool)
-> (NewAssetToken -> NewAssetToken -> Bool) -> Eq NewAssetToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewAssetToken -> NewAssetToken -> Bool
== :: NewAssetToken -> NewAssetToken -> Bool
$c/= :: NewAssetToken -> NewAssetToken -> Bool
/= :: NewAssetToken -> NewAssetToken -> Bool
Eq, Int -> NewAssetToken -> ShowS
[NewAssetToken] -> ShowS
NewAssetToken -> String
(Int -> NewAssetToken -> ShowS)
-> (NewAssetToken -> String)
-> ([NewAssetToken] -> ShowS)
-> Show NewAssetToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewAssetToken -> ShowS
showsPrec :: Int -> NewAssetToken -> ShowS
$cshow :: NewAssetToken -> String
show :: NewAssetToken -> String
$cshowList :: [NewAssetToken] -> ShowS
showList :: [NewAssetToken] -> ShowS
Show)
  deriving newtype (Gen NewAssetToken
Gen NewAssetToken
-> (NewAssetToken -> [NewAssetToken]) -> Arbitrary NewAssetToken
NewAssetToken -> [NewAssetToken]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewAssetToken
arbitrary :: Gen NewAssetToken
$cshrink :: NewAssetToken -> [NewAssetToken]
shrink :: NewAssetToken -> [NewAssetToken]
Arbitrary)
  deriving (Value -> Parser [NewAssetToken]
Value -> Parser NewAssetToken
(Value -> Parser NewAssetToken)
-> (Value -> Parser [NewAssetToken]) -> FromJSON NewAssetToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewAssetToken
parseJSON :: Value -> Parser NewAssetToken
$cparseJSONList :: Value -> Parser [NewAssetToken]
parseJSONList :: Value -> Parser [NewAssetToken]
FromJSON, [NewAssetToken] -> Value
[NewAssetToken] -> Encoding
NewAssetToken -> Value
NewAssetToken -> Encoding
(NewAssetToken -> Value)
-> (NewAssetToken -> Encoding)
-> ([NewAssetToken] -> Value)
-> ([NewAssetToken] -> Encoding)
-> ToJSON NewAssetToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewAssetToken -> Value
toJSON :: NewAssetToken -> Value
$ctoEncoding :: NewAssetToken -> Encoding
toEncoding :: NewAssetToken -> Encoding
$ctoJSONList :: [NewAssetToken] -> Value
toJSONList :: [NewAssetToken] -> Value
$ctoEncodingList :: [NewAssetToken] -> Encoding
toEncodingList :: [NewAssetToken] -> Encoding
ToJSON, Typeable NewAssetToken
Typeable NewAssetToken =>
(Proxy NewAssetToken -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewAssetToken
Proxy NewAssetToken -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewAssetToken -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewAssetToken -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NewAssetToken)

instance ToSchema NewAssetToken where
  schema :: ValueSchema NamedSwaggerDoc NewAssetToken
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] NewAssetToken NewAssetToken
-> ValueSchema NamedSwaggerDoc NewAssetToken
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NewAssetToken" (SchemaP SwaggerDoc Object [Pair] NewAssetToken NewAssetToken
 -> ValueSchema NamedSwaggerDoc NewAssetToken)
-> SchemaP SwaggerDoc Object [Pair] NewAssetToken NewAssetToken
-> ValueSchema NamedSwaggerDoc NewAssetToken
forall a b. (a -> b) -> a -> b
$
      AssetToken -> NewAssetToken
NewAssetToken (AssetToken -> NewAssetToken)
-> SchemaP SwaggerDoc Object [Pair] NewAssetToken AssetToken
-> SchemaP SwaggerDoc Object [Pair] NewAssetToken NewAssetToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewAssetToken -> AssetToken
newAssetToken (NewAssetToken -> AssetToken)
-> SchemaP SwaggerDoc Object [Pair] AssetToken AssetToken
-> SchemaP SwaggerDoc Object [Pair] NewAssetToken AssetToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
-> SchemaP SwaggerDoc Object [Pair] AssetToken AssetToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"token" SchemaP NamedSwaggerDoc Value Value AssetToken AssetToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- Body Construction

-- | Build a complete @multipart/mixed@ request body for a one-shot,
-- non-resumable asset upload.
buildMultipartBody :: AssetSettings -> MIME.Type -> LByteString -> Builder
buildMultipartBody :: AssetSettings -> Type -> LByteString -> Builder
buildMultipartBody AssetSettings
sets Type
typ LByteString
bs =
  let hdrs :: AssetHeaders
hdrs = Type -> LByteString -> AssetHeaders
mkHeaders Type
typ LByteString
bs
   in AssetSettings -> AssetHeaders -> Builder
beginMultipartBody AssetSettings
sets AssetHeaders
hdrs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LByteString -> Builder
lazyByteString LByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
endMultipartBody

-- | Begin building a @multipart/mixed@ request body for a non-resumable upload.
-- The returned 'Builder' can be immediately followed by the actual asset bytes.
beginMultipartBody :: AssetSettings -> AssetHeaders -> Builder
beginMultipartBody :: AssetSettings -> AssetHeaders -> Builder
beginMultipartBody AssetSettings
sets (AssetHeaders Type
t Word
l) =
  ByteString -> Builder
byteString
    ByteString
"--frontier\r\n\
    \Content-Type: application/json\r\n\
    \Content-Length: "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Dec (LByteString -> Int64
LBS.length LByteString
settingsJson)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString
      ByteString
"\r\n\
      \\r\n"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LByteString -> Builder
lazyByteString LByteString
settingsJson
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString
      ByteString
"\r\n\
      \--frontier\r\n\
      \Content-Type: "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (Text -> ByteString
T.encodeUtf8 (Type -> Text
MIME.showType Type
t))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString
      ByteString
"\r\n\
      \Content-Length: "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
wordDec Word
l
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n\
       \\r\n"
  where
    settingsJson :: LByteString
settingsJson = Value -> LByteString
forall a. ToJSON a => a -> LByteString
Aeson.encode (AssetSettings -> Value
forall a. ToSchema a => a -> Value
schemaToJSON AssetSettings
sets)

-- | The trailer of a non-resumable @multipart/mixed@ request body initiated
-- via 'beginMultipartBody'.
endMultipartBody :: Builder
endMultipartBody :: Builder
endMultipartBody = ByteString -> Builder
byteString ByteString
"\r\n--frontier--\r\n"

--------------------------------------------------------------------------------
-- AssetHeaders

-- | Headers provided during upload.
data AssetHeaders = AssetHeaders
  { AssetHeaders -> Type
hdrType :: MIME.Type,
    AssetHeaders -> Word
hdrLength :: Word
  }

mkHeaders :: MIME.Type -> LByteString -> AssetHeaders
mkHeaders :: Type -> LByteString -> AssetHeaders
mkHeaders Type
t LByteString
b = Type -> Word -> AssetHeaders
AssetHeaders Type
t (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LByteString -> Int64
LBS.length LByteString
b))

--------------------------------------------------------------------------------
-- AssetSettings

-- | Settings provided during upload.
data AssetSettings = AssetSettings
  { AssetSettings -> Bool
_setAssetPublic :: Bool,
    AssetSettings -> Maybe AssetRetention
_setAssetRetention :: Maybe AssetRetention
  }
  deriving stock (AssetSettings -> AssetSettings -> Bool
(AssetSettings -> AssetSettings -> Bool)
-> (AssetSettings -> AssetSettings -> Bool) -> Eq AssetSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetSettings -> AssetSettings -> Bool
== :: AssetSettings -> AssetSettings -> Bool
$c/= :: AssetSettings -> AssetSettings -> Bool
/= :: AssetSettings -> AssetSettings -> Bool
Eq, Int -> AssetSettings -> ShowS
[AssetSettings] -> ShowS
AssetSettings -> String
(Int -> AssetSettings -> ShowS)
-> (AssetSettings -> String)
-> ([AssetSettings] -> ShowS)
-> Show AssetSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetSettings -> ShowS
showsPrec :: Int -> AssetSettings -> ShowS
$cshow :: AssetSettings -> String
show :: AssetSettings -> String
$cshowList :: [AssetSettings] -> ShowS
showList :: [AssetSettings] -> ShowS
Show, (forall x. AssetSettings -> Rep AssetSettings x)
-> (forall x. Rep AssetSettings x -> AssetSettings)
-> Generic AssetSettings
forall x. Rep AssetSettings x -> AssetSettings
forall x. AssetSettings -> Rep AssetSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssetSettings -> Rep AssetSettings x
from :: forall x. AssetSettings -> Rep AssetSettings x
$cto :: forall x. Rep AssetSettings x -> AssetSettings
to :: forall x. Rep AssetSettings x -> AssetSettings
Generic)
  deriving (Gen AssetSettings
Gen AssetSettings
-> (AssetSettings -> [AssetSettings]) -> Arbitrary AssetSettings
AssetSettings -> [AssetSettings]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AssetSettings
arbitrary :: Gen AssetSettings
$cshrink :: AssetSettings -> [AssetSettings]
shrink :: AssetSettings -> [AssetSettings]
Arbitrary) via (GenericUniform AssetSettings)
  deriving (Value -> Parser [AssetSettings]
Value -> Parser AssetSettings
(Value -> Parser AssetSettings)
-> (Value -> Parser [AssetSettings]) -> FromJSON AssetSettings
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AssetSettings
parseJSON :: Value -> Parser AssetSettings
$cparseJSONList :: Value -> Parser [AssetSettings]
parseJSONList :: Value -> Parser [AssetSettings]
FromJSON, [AssetSettings] -> Value
[AssetSettings] -> Encoding
AssetSettings -> Value
AssetSettings -> Encoding
(AssetSettings -> Value)
-> (AssetSettings -> Encoding)
-> ([AssetSettings] -> Value)
-> ([AssetSettings] -> Encoding)
-> ToJSON AssetSettings
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AssetSettings -> Value
toJSON :: AssetSettings -> Value
$ctoEncoding :: AssetSettings -> Encoding
toEncoding :: AssetSettings -> Encoding
$ctoJSONList :: [AssetSettings] -> Value
toJSONList :: [AssetSettings] -> Value
$ctoEncodingList :: [AssetSettings] -> Encoding
toEncodingList :: [AssetSettings] -> Encoding
ToJSON, Typeable AssetSettings
Typeable AssetSettings =>
(Proxy AssetSettings -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AssetSettings
Proxy AssetSettings -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AssetSettings -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AssetSettings -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema AssetSettings)

defAssetSettings :: AssetSettings
defAssetSettings :: AssetSettings
defAssetSettings = Bool -> Maybe AssetRetention -> AssetSettings
AssetSettings Bool
False Maybe AssetRetention
forall a. Maybe a
Nothing

instance ToSchema AssetSettings where
  schema :: ValueSchema NamedSwaggerDoc AssetSettings
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] AssetSettings AssetSettings
-> ValueSchema NamedSwaggerDoc AssetSettings
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AssetSettings" (SchemaP SwaggerDoc Object [Pair] AssetSettings AssetSettings
 -> ValueSchema NamedSwaggerDoc AssetSettings)
-> SchemaP SwaggerDoc Object [Pair] AssetSettings AssetSettings
-> ValueSchema NamedSwaggerDoc AssetSettings
forall a b. (a -> b) -> a -> b
$
      Bool -> Maybe AssetRetention -> AssetSettings
AssetSettings
        (Bool -> Maybe AssetRetention -> AssetSettings)
-> SchemaP SwaggerDoc Object [Pair] AssetSettings Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AssetSettings
     (Maybe AssetRetention -> AssetSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AssetSettings -> Bool
_setAssetPublic (AssetSettings -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] AssetSettings Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"public" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AssetSettings
  (Maybe AssetRetention -> AssetSettings)
-> SchemaP
     SwaggerDoc Object [Pair] AssetSettings (Maybe AssetRetention)
-> SchemaP SwaggerDoc Object [Pair] AssetSettings AssetSettings
forall a b.
SchemaP SwaggerDoc Object [Pair] AssetSettings (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AssetSettings a
-> SchemaP SwaggerDoc Object [Pair] AssetSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AssetSettings -> Maybe AssetRetention
_setAssetRetention (AssetSettings -> Maybe AssetRetention)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AssetRetention)
     (Maybe AssetRetention)
-> SchemaP
     SwaggerDoc Object [Pair] AssetSettings (Maybe AssetRetention)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] AssetRetention (Maybe AssetRetention)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AssetRetention)
     (Maybe AssetRetention)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value AssetRetention AssetRetention
-> SchemaP
     SwaggerDoc Object [Pair] AssetRetention (Maybe AssetRetention)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"retention" SchemaP NamedSwaggerDoc Value Value AssetRetention AssetRetention
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- AssetRetention

-- | The desired asset retention.
data AssetRetention
  = -- | The asset is retained indefinitely. Typically used
    -- for profile pictures / assets frequently accessed.
    AssetEternal
  | -- | DEPRECATED: should not be used by clients for new assets
    -- The asset is retained indefinitely.
    AssetPersistent
  | -- | The asset is retained for a short period of time.
    AssetVolatile
  | -- | The asset is retained indefinitely, storage is optimised
    -- for infrequent access
    AssetEternalInfrequentAccess
  | -- | The asset is retained for an extended period of time,
    -- but not indefinitely.
    AssetExpiring
  deriving stock (AssetRetention -> AssetRetention -> Bool
(AssetRetention -> AssetRetention -> Bool)
-> (AssetRetention -> AssetRetention -> Bool) -> Eq AssetRetention
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetRetention -> AssetRetention -> Bool
== :: AssetRetention -> AssetRetention -> Bool
$c/= :: AssetRetention -> AssetRetention -> Bool
/= :: AssetRetention -> AssetRetention -> Bool
Eq, Eq AssetRetention
Eq AssetRetention =>
(AssetRetention -> AssetRetention -> Ordering)
-> (AssetRetention -> AssetRetention -> Bool)
-> (AssetRetention -> AssetRetention -> Bool)
-> (AssetRetention -> AssetRetention -> Bool)
-> (AssetRetention -> AssetRetention -> Bool)
-> (AssetRetention -> AssetRetention -> AssetRetention)
-> (AssetRetention -> AssetRetention -> AssetRetention)
-> Ord AssetRetention
AssetRetention -> AssetRetention -> Bool
AssetRetention -> AssetRetention -> Ordering
AssetRetention -> AssetRetention -> AssetRetention
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
$ccompare :: AssetRetention -> AssetRetention -> Ordering
compare :: AssetRetention -> AssetRetention -> Ordering
$c< :: AssetRetention -> AssetRetention -> Bool
< :: AssetRetention -> AssetRetention -> Bool
$c<= :: AssetRetention -> AssetRetention -> Bool
<= :: AssetRetention -> AssetRetention -> Bool
$c> :: AssetRetention -> AssetRetention -> Bool
> :: AssetRetention -> AssetRetention -> Bool
$c>= :: AssetRetention -> AssetRetention -> Bool
>= :: AssetRetention -> AssetRetention -> Bool
$cmax :: AssetRetention -> AssetRetention -> AssetRetention
max :: AssetRetention -> AssetRetention -> AssetRetention
$cmin :: AssetRetention -> AssetRetention -> AssetRetention
min :: AssetRetention -> AssetRetention -> AssetRetention
Ord, Int -> AssetRetention -> ShowS
[AssetRetention] -> ShowS
AssetRetention -> String
(Int -> AssetRetention -> ShowS)
-> (AssetRetention -> String)
-> ([AssetRetention] -> ShowS)
-> Show AssetRetention
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetRetention -> ShowS
showsPrec :: Int -> AssetRetention -> ShowS
$cshow :: AssetRetention -> String
show :: AssetRetention -> String
$cshowList :: [AssetRetention] -> ShowS
showList :: [AssetRetention] -> ShowS
Show, Int -> AssetRetention
AssetRetention -> Int
AssetRetention -> [AssetRetention]
AssetRetention -> AssetRetention
AssetRetention -> AssetRetention -> [AssetRetention]
AssetRetention
-> AssetRetention -> AssetRetention -> [AssetRetention]
(AssetRetention -> AssetRetention)
-> (AssetRetention -> AssetRetention)
-> (Int -> AssetRetention)
-> (AssetRetention -> Int)
-> (AssetRetention -> [AssetRetention])
-> (AssetRetention -> AssetRetention -> [AssetRetention])
-> (AssetRetention -> AssetRetention -> [AssetRetention])
-> (AssetRetention
    -> AssetRetention -> AssetRetention -> [AssetRetention])
-> Enum AssetRetention
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AssetRetention -> AssetRetention
succ :: AssetRetention -> AssetRetention
$cpred :: AssetRetention -> AssetRetention
pred :: AssetRetention -> AssetRetention
$ctoEnum :: Int -> AssetRetention
toEnum :: Int -> AssetRetention
$cfromEnum :: AssetRetention -> Int
fromEnum :: AssetRetention -> Int
$cenumFrom :: AssetRetention -> [AssetRetention]
enumFrom :: AssetRetention -> [AssetRetention]
$cenumFromThen :: AssetRetention -> AssetRetention -> [AssetRetention]
enumFromThen :: AssetRetention -> AssetRetention -> [AssetRetention]
$cenumFromTo :: AssetRetention -> AssetRetention -> [AssetRetention]
enumFromTo :: AssetRetention -> AssetRetention -> [AssetRetention]
$cenumFromThenTo :: AssetRetention
-> AssetRetention -> AssetRetention -> [AssetRetention]
enumFromThenTo :: AssetRetention
-> AssetRetention -> AssetRetention -> [AssetRetention]
Enum, AssetRetention
AssetRetention -> AssetRetention -> Bounded AssetRetention
forall a. a -> a -> Bounded a
$cminBound :: AssetRetention
minBound :: AssetRetention
$cmaxBound :: AssetRetention
maxBound :: AssetRetention
Bounded, (forall x. AssetRetention -> Rep AssetRetention x)
-> (forall x. Rep AssetRetention x -> AssetRetention)
-> Generic AssetRetention
forall x. Rep AssetRetention x -> AssetRetention
forall x. AssetRetention -> Rep AssetRetention x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssetRetention -> Rep AssetRetention x
from :: forall x. AssetRetention -> Rep AssetRetention x
$cto :: forall x. Rep AssetRetention x -> AssetRetention
to :: forall x. Rep AssetRetention x -> AssetRetention
Generic)
  deriving (Gen AssetRetention
Gen AssetRetention
-> (AssetRetention -> [AssetRetention]) -> Arbitrary AssetRetention
AssetRetention -> [AssetRetention]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AssetRetention
arbitrary :: Gen AssetRetention
$cshrink :: AssetRetention -> [AssetRetention]
shrink :: AssetRetention -> [AssetRetention]
Arbitrary) via (GenericUniform AssetRetention)
  deriving (Value -> Parser [AssetRetention]
Value -> Parser AssetRetention
(Value -> Parser AssetRetention)
-> (Value -> Parser [AssetRetention]) -> FromJSON AssetRetention
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AssetRetention
parseJSON :: Value -> Parser AssetRetention
$cparseJSONList :: Value -> Parser [AssetRetention]
parseJSONList :: Value -> Parser [AssetRetention]
FromJSON, [AssetRetention] -> Value
[AssetRetention] -> Encoding
AssetRetention -> Value
AssetRetention -> Encoding
(AssetRetention -> Value)
-> (AssetRetention -> Encoding)
-> ([AssetRetention] -> Value)
-> ([AssetRetention] -> Encoding)
-> ToJSON AssetRetention
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AssetRetention -> Value
toJSON :: AssetRetention -> Value
$ctoEncoding :: AssetRetention -> Encoding
toEncoding :: AssetRetention -> Encoding
$ctoJSONList :: [AssetRetention] -> Value
toJSONList :: [AssetRetention] -> Value
$ctoEncodingList :: [AssetRetention] -> Encoding
toEncodingList :: [AssetRetention] -> Encoding
ToJSON, Typeable AssetRetention
Typeable AssetRetention =>
(Proxy AssetRetention -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AssetRetention
Proxy AssetRetention -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AssetRetention -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AssetRetention -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema AssetRetention)

-- | The minimum TTL in seconds corresponding to a chosen retention.
assetRetentionSeconds :: AssetRetention -> Maybe NominalDiffTime
assetRetentionSeconds :: AssetRetention -> Maybe NominalDiffTime
assetRetentionSeconds AssetRetention
AssetEternal = Maybe NominalDiffTime
forall a. Maybe a
Nothing
assetRetentionSeconds AssetRetention
AssetPersistent = Maybe NominalDiffTime
forall a. Maybe a
Nothing
assetRetentionSeconds AssetRetention
AssetVolatile = NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just NominalDiffTime
assetVolatileSeconds
assetRetentionSeconds AssetRetention
AssetEternalInfrequentAccess = Maybe NominalDiffTime
forall a. Maybe a
Nothing
assetRetentionSeconds AssetRetention
AssetExpiring = NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just NominalDiffTime
assetExpiringSeconds

assetVolatileSeconds :: NominalDiffTime
assetVolatileSeconds :: NominalDiffTime
assetVolatileSeconds = NominalDiffTime
28 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
3600 -- 28 days

assetExpiringSeconds :: NominalDiffTime
assetExpiringSeconds :: NominalDiffTime
assetExpiringSeconds = NominalDiffTime
365 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
3600 -- 365 days

instance ToByteString AssetRetention where
  builder :: AssetRetention -> Builder
builder AssetRetention
AssetEternal = Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'1'
  builder AssetRetention
AssetPersistent = Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'2'
  builder AssetRetention
AssetVolatile = Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'3'
  builder AssetRetention
AssetEternalInfrequentAccess = Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'4'
  builder AssetRetention
AssetExpiring = Char -> Builder
forall a. ToByteString a => a -> Builder
builder Char
'5'

-- | ByteString representation is used in AssetKey
instance FromByteString AssetRetention where
  parser :: Parser AssetRetention
parser =
    Parser Word
forall a. Integral a => Parser a
decimal Parser Word
-> (Word -> Parser AssetRetention) -> Parser AssetRetention
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word
d -> case (Word
d :: Word) of
      Word
1 -> AssetRetention -> Parser AssetRetention
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetRetention
AssetEternal
      Word
2 -> AssetRetention -> Parser AssetRetention
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetRetention
AssetPersistent
      Word
3 -> AssetRetention -> Parser AssetRetention
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetRetention
AssetVolatile
      Word
4 -> AssetRetention -> Parser AssetRetention
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetRetention
AssetEternalInfrequentAccess
      Word
5 -> AssetRetention -> Parser AssetRetention
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetRetention
AssetExpiring
      Word
_ -> String -> Parser AssetRetention
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AssetRetention)
-> String -> Parser AssetRetention
forall a b. (a -> b) -> a -> b
$ String
"Invalid asset retention: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
d

retentionToTextRep :: AssetRetention -> Text
retentionToTextRep :: AssetRetention -> Text
retentionToTextRep AssetRetention
AssetEternal = Text
"eternal"
retentionToTextRep AssetRetention
AssetPersistent = Text
"persistent"
retentionToTextRep AssetRetention
AssetVolatile = Text
"volatile"
retentionToTextRep AssetRetention
AssetEternalInfrequentAccess = Text
"eternal-infrequent_access"
retentionToTextRep AssetRetention
AssetExpiring = Text
"expiring"

instance ToSchema AssetRetention where
  schema :: SchemaP NamedSwaggerDoc Value Value AssetRetention AssetRetention
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"AssetRetention" (SchemaP
   [Value] Text (Alt Maybe Text) AssetRetention AssetRetention
 -> SchemaP
      NamedSwaggerDoc Value Value AssetRetention AssetRetention)
-> SchemaP
     [Value] Text (Alt Maybe Text) AssetRetention AssetRetention
-> SchemaP
     NamedSwaggerDoc Value Value AssetRetention AssetRetention
forall a b. (a -> b) -> a -> b
$
      (AssetRetention
 -> SchemaP
      [Value] Text (Alt Maybe Text) AssetRetention AssetRetention)
-> [AssetRetention]
-> SchemaP
     [Value] Text (Alt Maybe Text) AssetRetention AssetRetention
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (\AssetRetention
value -> Text
-> AssetRetention
-> SchemaP
     [Value] Text (Alt Maybe Text) AssetRetention AssetRetention
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element (AssetRetention -> Text
retentionToTextRep AssetRetention
value) AssetRetention
value)
        [AssetRetention
forall a. Bounded a => a
minBound .. AssetRetention
forall a. Bounded a => a
maxBound]

-- FUTUREWORK: switch to a better URI library (e.g. modern-uri)
--
-- This URI type is error-prone, since its internal representation is based on
-- ByteString, whereas URLs are defined in terms of characters, not octets (RFC
-- 3986).
newtype AssetLocation r = AssetLocation {forall r. AssetLocation r -> URIRef r
getAssetLocation :: URIRef r}

instance ToHttpApiData (AssetLocation r) where
  toUrlPiece :: AssetLocation r -> Text
toUrlPiece = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode (ByteString -> Text)
-> (AssetLocation r -> ByteString) -> AssetLocation r -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetLocation r -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader
  toHeader :: AssetLocation r -> ByteString
toHeader = URIRef r -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URIRef r -> ByteString)
-> (AssetLocation r -> URIRef r) -> AssetLocation r -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetLocation r -> URIRef r
forall r. AssetLocation r -> URIRef r
getAssetLocation

instance FromHttpApiData (AssetLocation Relative) where
  parseUrlPiece :: Text -> Either Text (AssetLocation Relative)
parseUrlPiece = ByteString -> Either Text (AssetLocation Relative)
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text (AssetLocation Relative))
-> (Text -> ByteString)
-> Text
-> Either Text (AssetLocation Relative)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
  parseHeader :: ByteString -> Either Text (AssetLocation Relative)
parseHeader =
    (URIParseError -> Text)
-> (URIRef Relative -> AssetLocation Relative)
-> Either URIParseError (URIRef Relative)
-> Either Text (AssetLocation Relative)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Text
T.pack (String -> Text)
-> (URIParseError -> String) -> URIParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParseError -> String
forall a. Show a => a -> String
show) URIRef Relative -> AssetLocation Relative
forall r. URIRef r -> AssetLocation r
AssetLocation
      (Either URIParseError (URIRef Relative)
 -> Either Text (AssetLocation Relative))
-> (ByteString -> Either URIParseError (URIRef Relative))
-> ByteString
-> Either Text (AssetLocation Relative)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef URIParserOptions
strictURIParserOptions

instance FromHttpApiData (AssetLocation Absolute) where
  parseUrlPiece :: Text -> Either Text (AssetLocation Absolute)
parseUrlPiece = ByteString -> Either Text (AssetLocation Absolute)
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text (AssetLocation Absolute))
-> (Text -> ByteString)
-> Text
-> Either Text (AssetLocation Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
  parseHeader :: ByteString -> Either Text (AssetLocation Absolute)
parseHeader =
    (URIParseError -> Text)
-> (URIRef Absolute -> AssetLocation Absolute)
-> Either URIParseError (URIRef Absolute)
-> Either Text (AssetLocation Absolute)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Text
T.pack (String -> Text)
-> (URIParseError -> String) -> URIParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParseError -> String
forall a. Show a => a -> String
show) URIRef Absolute -> AssetLocation Absolute
forall r. URIRef r -> AssetLocation r
AssetLocation
      (Either URIParseError (URIRef Absolute)
 -> Either Text (AssetLocation Absolute))
-> (ByteString -> Either URIParseError (URIRef Absolute))
-> ByteString
-> Either Text (AssetLocation Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions

instance S.ToParamSchema (AssetLocation r) where
  toParamSchema :: Proxy (AssetLocation r) -> Schema
toParamSchema Proxy (AssetLocation r)
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
Lens' Schema (Maybe Text)
S.format ((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
"url"

-- | An asset as returned by the download API: if the asset is local, only a
-- URL is returned, and if it is remote the content of the asset is streamed.
data LocalOrRemoteAsset
  = LocalAsset (AssetLocation Absolute)
  | RemoteAsset (SourceIO ByteString)

instance
  ( ResponseType r1 ~ AssetLocation Absolute,
    ResponseType r2 ~ SourceIO ByteString,
    KnownError (MapError e)
  ) =>
  AsUnion '[ErrorResponse e, r1, r2] (Maybe LocalOrRemoteAsset)
  where
  toUnion :: Maybe LocalOrRemoteAsset
-> Union (ResponseTypes '[ErrorResponse e, r1, r2])
toUnion Maybe LocalOrRemoteAsset
Nothing = I DynError
-> NS I '[DynError, AssetLocation Absolute, SourceIO ByteString]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (DynError -> I DynError
forall a. a -> I a
I (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e)))
  toUnion (Just (LocalAsset AssetLocation Absolute
loc)) = NS I '[AssetLocation Absolute, SourceIO ByteString]
-> NS I '[DynError, AssetLocation Absolute, SourceIO ByteString]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I (AssetLocation Absolute)
-> NS I '[AssetLocation Absolute, SourceIO ByteString]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (AssetLocation Absolute -> I (AssetLocation Absolute)
forall a. a -> I a
I AssetLocation Absolute
loc))
  toUnion (Just (RemoteAsset SourceIO ByteString
asset)) = NS I '[AssetLocation Absolute, SourceIO ByteString]
-> NS I '[DynError, AssetLocation Absolute, SourceIO ByteString]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[SourceIO ByteString]
-> NS I '[AssetLocation Absolute, SourceIO ByteString]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I (SourceIO ByteString) -> NS I '[SourceIO ByteString]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (SourceIO ByteString -> I (SourceIO ByteString)
forall a. a -> I a
I SourceIO ByteString
asset)))

  fromUnion :: Union (ResponseTypes '[ErrorResponse e, r1, r2])
-> Maybe LocalOrRemoteAsset
fromUnion (Z (I x
_)) = Maybe LocalOrRemoteAsset
forall a. Maybe a
Nothing
  fromUnion (S (Z (I x
loc))) = LocalOrRemoteAsset -> Maybe LocalOrRemoteAsset
forall a. a -> Maybe a
Just (AssetLocation Absolute -> LocalOrRemoteAsset
LocalAsset x
AssetLocation Absolute
loc)
  fromUnion (S (S (Z (I x
asset)))) = LocalOrRemoteAsset -> Maybe LocalOrRemoteAsset
forall a. a -> Maybe a
Just (SourceIO ByteString -> LocalOrRemoteAsset
RemoteAsset x
SourceIO ByteString
asset)
  fromUnion (S (S (S NS I xs
x))) = case NS I xs
x of {}

makeLenses ''Asset'
makeLenses ''AssetSettings