{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Hercules.API.State where

import Data.ByteString (ByteString)
import Data.Swagger (NamedSchema (NamedSchema), binarySchema)
import Data.Swagger.Schema (ToSchema (..))
import Hercules.API.Prelude
import Hercules.API.Projects.Project (Project)
import Hercules.API.State.ProjectState (ProjectState)
import Servant.API
import Servant.API.Generic

-- | A newtype wrapper for servant-swagger
newtype RawBytes = RawBytes {RawBytes -> ByteString
fromRawBytes :: ByteString}
  deriving newtype (MimeUnrender OctetStream, MimeRender OctetStream)

instance ToSchema RawBytes where
  declareNamedSchema :: Proxy RawBytes -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy RawBytes
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
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
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"RawBytes") Schema
binarySchema

type ContentLength = Header "Content-Length" Integer

type ContentDisposition = Header "Content-Disposition" Text

data StateAPI auth f = StateAPI
  { StateAPI auth f
-> f
   :- (Summary "Upload a state file"
       :> ("projects"
           :> (Capture' '[Required, Strict] "projectId" (Id Project)
               :> ("state"
                   :> (Capture' '[Required, Strict] "stateName" Text
                       :> ("data"
                           :> (StreamBody NoFraming OctetStream (SourceIO RawBytes)
                               :> (auth :> Put '[JSON] NoContent))))))))
putProjectStateData ::
      f
        :- Summary "Upload a state file"
        :> "projects"
        :> Capture' '[Required, Strict] "projectId" (Id Project)
        :> "state"
        :> Capture' '[Required, Strict] "stateName" Text
        :> "data"
        :> StreamBody NoFraming OctetStream (SourceIO RawBytes)
        :> auth
        :> Put '[JSON] NoContent,
    StateAPI auth f
-> f
   :- (Summary "List all state files"
       :> ("projects"
           :> (Capture' '[Required, Strict] "projectId" (Id Project)
               :> ("states" :> (auth :> Get '[JSON] ProjectState)))))
getProjectStates ::
      f
        :- Summary "List all state files"
        :> "projects"
        :> Capture' '[Required, Strict] "projectId" (Id Project)
        :> "states"
        :> auth
        :> Get '[JSON] ProjectState,
    StateAPI auth f
-> f
   :- (Summary "Download a state file"
       :> ("projects"
           :> (Capture' '[Required, Strict] "projectId" (Id Project)
               :> ("state"
                   :> (Capture' '[Required, Strict] "stateName" Text
                       :> ("data"
                           :> (auth
                               :> StreamGet
                                    NoFraming
                                    OctetStream
                                    (Headers
                                       '[ContentLength, ContentDisposition]
                                       (SourceIO RawBytes)))))))))
getProjectStateData ::
      f
        :- Summary "Download a state file"
        :> "projects"
        :> Capture' '[Required, Strict] "projectId" (Id Project)
        :> "state"
        :> Capture' '[Required, Strict] "stateName" Text
        :> "data"
        :> auth
        :> StreamGet NoFraming OctetStream (Headers '[ContentLength, ContentDisposition] (SourceIO RawBytes))
  }
  deriving ((forall x. StateAPI auth f -> Rep (StateAPI auth f) x)
-> (forall x. Rep (StateAPI auth f) x -> StateAPI auth f)
-> Generic (StateAPI auth f)
forall x. Rep (StateAPI auth f) x -> StateAPI auth f
forall x. StateAPI auth f -> Rep (StateAPI auth f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x. Rep (StateAPI auth f) x -> StateAPI auth f
forall auth f x. StateAPI auth f -> Rep (StateAPI auth f) x
$cto :: forall auth f x. Rep (StateAPI auth f) x -> StateAPI auth f
$cfrom :: forall auth f x. StateAPI auth f -> Rep (StateAPI auth f) x
Generic)