-- Necessary for servant-docs instances
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Server.Server (platformAPI, platformApp)
where

import Protolude (
  Int,
  Monoid (mempty),
  Proxy (Proxy),
  ($),
 )
import Protolude qualified as P

import Data.Aeson (Object, Value, object)
import Data.Aeson.KeyMap qualified as KeyMap
import Data.ByteString.Lazy qualified as BL
import Data.Text (Text)
import Data.Text qualified as T
import Network.Wai (Application)
import Network.Wai.Parse (
  defaultParseRequestBodyOptions,
  setMaxRequestFilesSize,
  setMaxRequestNumFiles,
 )
import Servant (Context (EmptyContext, (:.)), NoContent)
import Servant.API (
  Capture,
  Get,
  JSON,
  PlainText,
  Post,
  ReqBody,
  (:<|>) ((:<|>)),
  (:>),
 )
import Servant.Docs (
  DocCapture (DocCapture),
  ToCapture (toCapture),
  ToSample,
  singleSample,
  toSamples,
 )
import Servant.HTML.Blaze (HTML)
import Servant.Multipart (
  MultipartData (MultipartData),
  MultipartOptions (generalOptions),
  Tmp,
  ToMultipartSample (toMultipartSamples),
  defaultMultipartOptions,
 )
import Servant.Server (Server)
import Servant.Server qualified as Servant
import Text.Blaze.Internal (MarkupM)

import AirGQL.Config (Config (maxDbSize), defaultConfig)
import AirGQL.ExternalAppContext (ExternalAppContext)
import AirGQL.Lib (SQLPost)
import AirGQL.Servant.Database (
  apiDatabaseSchemaGetHandler,
  apiDatabaseVacuumPostHandler,
 )
import AirGQL.Servant.GraphQL (
  gqlQueryGetHandler,
  gqlQueryPostHandler,
  playgroundDefaultQueryHandler,
  readOnlyGqlPostHandler,
  writeOnlyGqlPostHandler,
 )
import AirGQL.Servant.SqlQuery (sqlQueryPostHandler)
import AirGQL.Types.SchemaConf (SchemaConf (pragmaConf), defaultSchemaConf)
import AirGQL.Types.SqlQueryPostResult (SqlQueryPostResult)
import AirGQL.Types.Types (GQLPost)


{- FOURMOLU_DISABLE -}
-- ATTENTION: Order of handlers matters!
type PlatformAPI =
  -- gqlQueryGetHandler
  -- Redirect to GraphiQL playground
  "graphql" :> Get '[HTML] NoContent

  -- gqlQueryPostHandler
  :<|> "graphql"
      :> ReqBody '[JSON] GQLPost
      :> Post '[JSON] Object

  -- writeOnlyGqlPostHandler
  :<|> "readonly" :> "graphql"
          :> ReqBody '[JSON] GQLPost
          :> Post '[JSON] Object

  -- writeOnlyGqlPostHandler
  :<|> "writeonly" :> "graphql"
          :> ReqBody '[JSON] GQLPost
          :> Post '[JSON] Object

  -- playgroundDefaultQueryHandler
  :<|> "playground" :> "default-query"
          :> Get '[PlainText] Text

  -- apiDatabaseSchemaGetHandler
  :<|> "schema" :> Get '[PlainText] Text

  -- apiDatabaseVacuumPostHandler
  :<|> "vacuum" :> Post '[JSON] Object

  -- sqlQueryPostHandler
  :<|> "sql"
          :> ReqBody '[JSON] SQLPost
          :> Post '[JSON] SqlQueryPostResult

{- FOURMOLU_ENABLE -}


-- | Instances for automatic documentation generation via servant-docs
instance ToSample (MultipartData Tmp) where
  toSamples :: Proxy (MultipartData Tmp) -> [(Text, MultipartData Tmp)]
toSamples Proxy (MultipartData Tmp)
_ = MultipartData Tmp -> [(Text, MultipartData Tmp)]
forall a. a -> [(Text, a)]
singleSample (MultipartData Tmp -> [(Text, MultipartData Tmp)])
-> MultipartData Tmp -> [(Text, MultipartData Tmp)]
forall a b. (a -> b) -> a -> b
$ [Input] -> [FileData Tmp] -> MultipartData Tmp
forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
forall a. Monoid a => a
mempty [FileData Tmp]
forall a. Monoid a => a
mempty


instance ToMultipartSample Tmp (MultipartData Tmp) where
  toMultipartSamples :: Proxy (MultipartData Tmp) -> [(Text, MultipartData Tmp)]
toMultipartSamples Proxy (MultipartData Tmp)
_ = []


instance ToSample Value where
  toSamples :: Proxy Value -> [(Text, Value)]
toSamples Proxy Value
_ = Value -> [(Text, Value)]
forall a. a -> [(Text, a)]
singleSample (Value -> [(Text, Value)]) -> Value -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object []


instance ToSample (KeyMap.KeyMap Value) where
  toSamples :: Proxy Object -> [(Text, Object)]
toSamples Proxy Object
_ = Object -> [(Text, Object)]
forall a. a -> [(Text, a)]
singleSample (Object -> [(Text, Object)]) -> Object -> [(Text, Object)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList []


instance ToSample (MarkupM ()) where
  toSamples :: Proxy (MarkupM ()) -> [(Text, MarkupM ())]
toSamples Proxy (MarkupM ())
_ = MarkupM () -> [(Text, MarkupM ())]
forall a. a -> [(Text, a)]
singleSample MarkupM ()
forall a. Monoid a => a
mempty


instance ToSample BL.ByteString where
  toSamples :: Proxy ByteString -> [(Text, ByteString)]
toSamples Proxy ByteString
_ = ByteString -> [(Text, ByteString)]
forall a. a -> [(Text, a)]
singleSample ByteString
forall a. Monoid a => a
mempty


instance ToSample Text where
  toSamples :: Proxy Text -> [(Text, Text)]
toSamples Proxy Text
_ = Text -> [(Text, Text)]
forall a. a -> [(Text, a)]
singleSample Text
forall a. Monoid a => a
mempty


instance ToSample P.ByteString where
  toSamples :: Proxy ByteString -> [(Text, ByteString)]
toSamples Proxy ByteString
_ = ByteString -> [(Text, ByteString)]
forall a. a -> [(Text, a)]
singleSample ByteString
forall a. Monoid a => a
mempty


instance ToCapture (Capture "readonlyId" Text) where
  toCapture :: Proxy (Capture "readonlyId" Text) -> DocCapture
toCapture Proxy (Capture "readonlyId" Text)
_ = String -> String -> DocCapture
DocCapture String
"readonlyId" String
"Read-only ID of the database"


instance ToCapture (Capture "dbId" Text) where
  toCapture :: Proxy (Capture "dbId" Text) -> DocCapture
toCapture Proxy (Capture "dbId" Text)
_ = String -> String -> DocCapture
DocCapture String
"dbId" String
"ID of the database to be served"


platformAPI :: Proxy PlatformAPI
platformAPI :: Proxy PlatformAPI
platformAPI = Proxy PlatformAPI
forall {k} (t :: k). Proxy t
Proxy


platformServer :: ExternalAppContext -> P.FilePath -> Server PlatformAPI
platformServer :: ExternalAppContext -> String -> Server PlatformAPI
platformServer ExternalAppContext
ctx String
filePath = do
  let dbPath :: Text
dbPath = String -> Text
T.pack String
filePath
  Text -> Handler NoContent
gqlQueryGetHandler Text
dbPath
    Handler NoContent
-> ((GQLPost -> Handler Object)
    :<|> ((GQLPost -> Handler Object)
          :<|> ((GQLPost -> Handler Object)
                :<|> (Handler Text
                      :<|> (Handler Text
                            :<|> (Handler Object
                                  :<|> (SQLPost -> Handler SqlQueryPostResult)))))))
-> Handler NoContent
   :<|> ((GQLPost -> Handler Object)
         :<|> ((GQLPost -> Handler Object)
               :<|> ((GQLPost -> Handler Object)
                     :<|> (Handler Text
                           :<|> (Handler Text
                                 :<|> (Handler Object
                                       :<|> (SQLPost -> Handler SqlQueryPostResult)))))))
forall a b. a -> b -> a :<|> b
:<|> SchemaConf -> Text -> GQLPost -> Handler Object
gqlQueryPostHandler SchemaConf
defaultSchemaConf Text
dbPath
    (GQLPost -> Handler Object)
-> ((GQLPost -> Handler Object)
    :<|> ((GQLPost -> Handler Object)
          :<|> (Handler Text
                :<|> (Handler Text
                      :<|> (Handler Object
                            :<|> (SQLPost -> Handler SqlQueryPostResult))))))
-> (GQLPost -> Handler Object)
   :<|> ((GQLPost -> Handler Object)
         :<|> ((GQLPost -> Handler Object)
               :<|> (Handler Text
                     :<|> (Handler Text
                           :<|> (Handler Object
                                 :<|> (SQLPost -> Handler SqlQueryPostResult))))))
forall a b. a -> b -> a :<|> b
:<|> Text -> GQLPost -> Handler Object
readOnlyGqlPostHandler Text
dbPath
    (GQLPost -> Handler Object)
-> ((GQLPost -> Handler Object)
    :<|> (Handler Text
          :<|> (Handler Text
                :<|> (Handler Object
                      :<|> (SQLPost -> Handler SqlQueryPostResult)))))
-> (GQLPost -> Handler Object)
   :<|> ((GQLPost -> Handler Object)
         :<|> (Handler Text
               :<|> (Handler Text
                     :<|> (Handler Object
                           :<|> (SQLPost -> Handler SqlQueryPostResult)))))
forall a b. a -> b -> a :<|> b
:<|> Text -> GQLPost -> Handler Object
writeOnlyGqlPostHandler Text
dbPath
    (GQLPost -> Handler Object)
-> (Handler Text
    :<|> (Handler Text
          :<|> (Handler Object
                :<|> (SQLPost -> Handler SqlQueryPostResult))))
-> (GQLPost -> Handler Object)
   :<|> (Handler Text
         :<|> (Handler Text
               :<|> (Handler Object
                     :<|> (SQLPost -> Handler SqlQueryPostResult))))
forall a b. a -> b -> a :<|> b
:<|> Text -> Handler Text
playgroundDefaultQueryHandler Text
dbPath
    Handler Text
-> (Handler Text
    :<|> (Handler Object :<|> (SQLPost -> Handler SqlQueryPostResult)))
-> Handler Text
   :<|> (Handler Text
         :<|> (Handler Object :<|> (SQLPost -> Handler SqlQueryPostResult)))
forall a b. a -> b -> a :<|> b
:<|> ExternalAppContext -> Text -> Handler Text
apiDatabaseSchemaGetHandler ExternalAppContext
ctx Text
dbPath
    Handler Text
-> (Handler Object :<|> (SQLPost -> Handler SqlQueryPostResult))
-> Handler Text
   :<|> (Handler Object :<|> (SQLPost -> Handler SqlQueryPostResult))
forall a b. a -> b -> a :<|> b
:<|> Text -> Handler Object
apiDatabaseVacuumPostHandler Text
dbPath
    Handler Object
-> (SQLPost -> Handler SqlQueryPostResult)
-> Handler Object :<|> (SQLPost -> Handler SqlQueryPostResult)
forall a b. a -> b -> a :<|> b
:<|> PragmaConf -> Text -> SQLPost -> Handler SqlQueryPostResult
sqlQueryPostHandler SchemaConf
defaultSchemaConf.pragmaConf Text
dbPath


platformApp :: ExternalAppContext -> P.FilePath -> Application
platformApp :: ExternalAppContext -> String -> Application
platformApp ExternalAppContext
ctx String
filePath = do
  let
    Int
maxFileSizeInByte :: Int = Config
defaultConfig.maxDbSize

    multipartOpts :: MultipartOptions Tmp
    multipartOpts :: MultipartOptions Tmp
multipartOpts =
      (Proxy Tmp -> MultipartOptions Tmp
forall tag.
MultipartBackend tag =>
Proxy tag -> MultipartOptions tag
defaultMultipartOptions (Proxy Tmp
forall {k} (t :: k). Proxy t
Proxy :: Proxy Tmp))
        { generalOptions =
            setMaxRequestNumFiles 1 $
              setMaxRequestFilesSize
                (P.fromIntegral maxFileSizeInByte)
                defaultParseRequestBodyOptions
        }

    context :: Context '[MultipartOptions Tmp]
    context :: Context '[MultipartOptions Tmp]
context =
      MultipartOptions Tmp
multipartOpts MultipartOptions Tmp
-> Context '[] -> Context '[MultipartOptions Tmp]
forall x (xs :: [*]). x -> Context xs -> Context (x : xs)
:. Context '[]
EmptyContext

  Proxy PlatformAPI
-> Context '[MultipartOptions Tmp]
-> Server PlatformAPI
-> Application
forall api (context :: [*]).
(HasServer api context, ServerContext context) =>
Proxy api -> Context context -> Server api -> Application
Servant.serveWithContext Proxy PlatformAPI
platformAPI Context '[MultipartOptions Tmp]
context (Server PlatformAPI -> Application)
-> Server PlatformAPI -> Application
forall a b. (a -> b) -> a -> b
$ ExternalAppContext -> String -> Server PlatformAPI
platformServer ExternalAppContext
ctx String
filePath