{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE ViewPatterns               #-}
{-# OPTIONS_GHC
-fno-warn-unused-binds -fno-warn-unused-imports -freduction-depth=328 #-}

module Httpstan.API
  ( -- * Client and Server
    Config(..)
  , HttpstanBackend(..)
  , createHttpstanClient
  , runHttpstanServer
  , runHttpstanMiddlewareServer
  , runHttpstanClient
  , runHttpstanClientWithManager
  , callHttpstan
  , HttpstanClient
  , HttpstanClientError(..)
  -- ** Servant
  , HttpstanAPI
  -- ** Plain WAI Application
  , serverWaiApplicationHttpstan
  ) where

import           Httpstan.Types

import           Control.Monad.Catch                (Exception, MonadThrow, throwM)
import           Control.Monad.Except               (ExceptT, runExceptT)
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Reader         (ReaderT (..))
import           Data.Aeson                         (Value)
import           Data.Coerce                        (coerce)
import           Data.Data                          (Data)
import           Data.Function                      ((&))
import qualified Data.Map                           as Map
import           Data.Monoid                        ((<>))
import           Data.Proxy                         (Proxy (..))
import           Data.Set                           (Set)
import           Data.Text                          (Text)
import qualified Data.Text                          as T
import           Data.Time
import           Data.UUID                          (UUID)
import           GHC.Exts                           (IsString (..))
import           GHC.Generics                       (Generic)
import           Network.HTTP.Client                (Manager, newManager)
import           Network.HTTP.Client.TLS            (tlsManagerSettings)
import           Network.HTTP.Types.Method          (methodOptions)
import           Network.Wai                        (Middleware)
import qualified Network.Wai.Handler.Warp           as Warp
import           Servant                            (ServerError, serveWithContextT)
import           Servant.API                        hiding (addHeader)
import           Servant.API.Verbs                  (StdMethod (..), Verb)
import           Servant.Client                     (ClientEnv, Scheme (Http), ClientError, client,
                                                     mkClientEnv, parseBaseUrl)
import           Servant.Client.Core                (baseUrlPort, baseUrlHost)
import           Servant.Client.Internal.HttpClient (ClientM (..))
import           Servant.Server                     (Handler (..), Application, Context (EmptyContext))
import           Servant.Server.StaticFiles         (serveDirectoryFileServer)
import           Web.FormUrlEncoded
import           Web.HttpApiData




-- | List of elements parsed from a query.
newtype QueryList (p :: CollectionFormat) a = QueryList
  { forall (p :: CollectionFormat) a. QueryList p a -> [a]
fromQueryList :: [a]
  } deriving (forall a b. a -> QueryList p b -> QueryList p a
forall a b. (a -> b) -> QueryList p a -> QueryList p b
forall (p :: CollectionFormat) a b.
a -> QueryList p b -> QueryList p a
forall (p :: CollectionFormat) a b.
(a -> b) -> QueryList p a -> QueryList p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> QueryList p b -> QueryList p a
$c<$ :: forall (p :: CollectionFormat) a b.
a -> QueryList p b -> QueryList p a
fmap :: forall a b. (a -> b) -> QueryList p a -> QueryList p b
$cfmap :: forall (p :: CollectionFormat) a b.
(a -> b) -> QueryList p a -> QueryList p b
Functor, forall a. a -> QueryList p a
forall a b. QueryList p a -> QueryList p b -> QueryList p a
forall a b. QueryList p a -> QueryList p b -> QueryList p b
forall a b. QueryList p (a -> b) -> QueryList p a -> QueryList p b
forall a b c.
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
forall (p :: CollectionFormat). Functor (QueryList p)
forall (p :: CollectionFormat) a. a -> QueryList p a
forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p a
forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
forall (p :: CollectionFormat) a b.
QueryList p (a -> b) -> QueryList p a -> QueryList p b
forall (p :: CollectionFormat) a b c.
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. QueryList p a -> QueryList p b -> QueryList p a
$c<* :: forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p a
*> :: forall a b. QueryList p a -> QueryList p b -> QueryList p b
$c*> :: forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
liftA2 :: forall a b c.
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
$cliftA2 :: forall (p :: CollectionFormat) a b c.
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
<*> :: forall a b. QueryList p (a -> b) -> QueryList p a -> QueryList p b
$c<*> :: forall (p :: CollectionFormat) a b.
QueryList p (a -> b) -> QueryList p a -> QueryList p b
pure :: forall a. a -> QueryList p a
$cpure :: forall (p :: CollectionFormat) a. a -> QueryList p a
Applicative, forall a. a -> QueryList p a
forall a b. QueryList p a -> QueryList p b -> QueryList p b
forall a b. QueryList p a -> (a -> QueryList p b) -> QueryList p b
forall (p :: CollectionFormat). Applicative (QueryList p)
forall (p :: CollectionFormat) a. a -> QueryList p a
forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
forall (p :: CollectionFormat) a b.
QueryList p a -> (a -> QueryList p b) -> QueryList p b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> QueryList p a
$creturn :: forall (p :: CollectionFormat) a. a -> QueryList p a
>> :: forall a b. QueryList p a -> QueryList p b -> QueryList p b
$c>> :: forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
>>= :: forall a b. QueryList p a -> (a -> QueryList p b) -> QueryList p b
$c>>= :: forall (p :: CollectionFormat) a b.
QueryList p a -> (a -> QueryList p b) -> QueryList p b
Monad, forall a. Eq a => a -> QueryList p a -> Bool
forall a. Num a => QueryList p a -> a
forall a. Ord a => QueryList p a -> a
forall m. Monoid m => QueryList p m -> m
forall a. QueryList p a -> Bool
forall a. QueryList p a -> Int
forall a. QueryList p a -> [a]
forall a. (a -> a -> a) -> QueryList p a -> a
forall m a. Monoid m => (a -> m) -> QueryList p a -> m
forall b a. (b -> a -> b) -> b -> QueryList p a -> b
forall a b. (a -> b -> b) -> b -> QueryList p a -> b
forall (p :: CollectionFormat) a.
Eq a =>
a -> QueryList p a -> Bool
forall (p :: CollectionFormat) a. Num a => QueryList p a -> a
forall (p :: CollectionFormat) a. Ord a => QueryList p a -> a
forall (p :: CollectionFormat) m. Monoid m => QueryList p m -> m
forall (p :: CollectionFormat) a. QueryList p a -> Bool
forall (p :: CollectionFormat) a. QueryList p a -> Int
forall (p :: CollectionFormat) a. QueryList p a -> [a]
forall (p :: CollectionFormat) a.
(a -> a -> a) -> QueryList p a -> a
forall (p :: CollectionFormat) m a.
Monoid m =>
(a -> m) -> QueryList p a -> m
forall (p :: CollectionFormat) b a.
(b -> a -> b) -> b -> QueryList p a -> b
forall (p :: CollectionFormat) a b.
(a -> b -> b) -> b -> QueryList p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => QueryList p a -> a
$cproduct :: forall (p :: CollectionFormat) a. Num a => QueryList p a -> a
sum :: forall a. Num a => QueryList p a -> a
$csum :: forall (p :: CollectionFormat) a. Num a => QueryList p a -> a
minimum :: forall a. Ord a => QueryList p a -> a
$cminimum :: forall (p :: CollectionFormat) a. Ord a => QueryList p a -> a
maximum :: forall a. Ord a => QueryList p a -> a
$cmaximum :: forall (p :: CollectionFormat) a. Ord a => QueryList p a -> a
elem :: forall a. Eq a => a -> QueryList p a -> Bool
$celem :: forall (p :: CollectionFormat) a.
Eq a =>
a -> QueryList p a -> Bool
length :: forall a. QueryList p a -> Int
$clength :: forall (p :: CollectionFormat) a. QueryList p a -> Int
null :: forall a. QueryList p a -> Bool
$cnull :: forall (p :: CollectionFormat) a. QueryList p a -> Bool
toList :: forall a. QueryList p a -> [a]
$ctoList :: forall (p :: CollectionFormat) a. QueryList p a -> [a]
foldl1 :: forall a. (a -> a -> a) -> QueryList p a -> a
$cfoldl1 :: forall (p :: CollectionFormat) a.
(a -> a -> a) -> QueryList p a -> a
foldr1 :: forall a. (a -> a -> a) -> QueryList p a -> a
$cfoldr1 :: forall (p :: CollectionFormat) a.
(a -> a -> a) -> QueryList p a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> QueryList p a -> b
$cfoldl' :: forall (p :: CollectionFormat) b a.
(b -> a -> b) -> b -> QueryList p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> QueryList p a -> b
$cfoldl :: forall (p :: CollectionFormat) b a.
(b -> a -> b) -> b -> QueryList p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> QueryList p a -> b
$cfoldr' :: forall (p :: CollectionFormat) a b.
(a -> b -> b) -> b -> QueryList p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> QueryList p a -> b
$cfoldr :: forall (p :: CollectionFormat) a b.
(a -> b -> b) -> b -> QueryList p a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> QueryList p a -> m
$cfoldMap' :: forall (p :: CollectionFormat) m a.
Monoid m =>
(a -> m) -> QueryList p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> QueryList p a -> m
$cfoldMap :: forall (p :: CollectionFormat) m a.
Monoid m =>
(a -> m) -> QueryList p a -> m
fold :: forall m. Monoid m => QueryList p m -> m
$cfold :: forall (p :: CollectionFormat) m. Monoid m => QueryList p m -> m
Foldable, forall (p :: CollectionFormat). Functor (QueryList p)
forall (p :: CollectionFormat). Foldable (QueryList p)
forall (p :: CollectionFormat) (m :: * -> *) a.
Monad m =>
QueryList p (m a) -> m (QueryList p a)
forall (p :: CollectionFormat) (f :: * -> *) a.
Applicative f =>
QueryList p (f a) -> f (QueryList p a)
forall (p :: CollectionFormat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryList p a -> m (QueryList p b)
forall (p :: CollectionFormat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryList p a -> f (QueryList p b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryList p a -> f (QueryList p b)
sequence :: forall (m :: * -> *) a.
Monad m =>
QueryList p (m a) -> m (QueryList p a)
$csequence :: forall (p :: CollectionFormat) (m :: * -> *) a.
Monad m =>
QueryList p (m a) -> m (QueryList p a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryList p a -> m (QueryList p b)
$cmapM :: forall (p :: CollectionFormat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryList p a -> m (QueryList p b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
QueryList p (f a) -> f (QueryList p a)
$csequenceA :: forall (p :: CollectionFormat) (f :: * -> *) a.
Applicative f =>
QueryList p (f a) -> f (QueryList p a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryList p a -> f (QueryList p b)
$ctraverse :: forall (p :: CollectionFormat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryList p a -> f (QueryList p b)
Traversable)

-- | Formats in which a list can be encoded into a HTTP path.
data CollectionFormat
  = CommaSeparated -- ^ CSV format for multiple parameters.
  | SpaceSeparated -- ^ Also called "SSV"
  | TabSeparated -- ^ Also called "TSV"
  | PipeSeparated -- ^ `value1|value2|value2`
  | MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params.

instance FromHttpApiData a => FromHttpApiData (QueryList 'CommaSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'CommaSeparated a)
parseQueryParam = forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
','

instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'TabSeparated a)
parseQueryParam = forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
'\t'

instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'SpaceSeparated a)
parseQueryParam = forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
' '

instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'PipeSeparated a)
parseQueryParam = forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
'|'

instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where
  parseQueryParam :: Text -> Either Text (QueryList 'MultiParamArray a)
parseQueryParam = forall a. HasCallStack => [Char] -> a
error [Char]
"unimplemented FromHttpApiData for MultiParamArray collection format"

parseSeparatedQueryList :: FromHttpApiData a => Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList :: forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
char = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: CollectionFormat) a. [a] -> QueryList p a
QueryList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
char)

instance ToHttpApiData a => ToHttpApiData (QueryList 'CommaSeparated a) where
  toQueryParam :: QueryList 'CommaSeparated a -> Text
toQueryParam = forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
','

instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where
  toQueryParam :: QueryList 'TabSeparated a -> Text
toQueryParam = forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
'\t'

instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where
  toQueryParam :: QueryList 'SpaceSeparated a -> Text
toQueryParam = forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
' '

instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where
  toQueryParam :: QueryList 'PipeSeparated a -> Text
toQueryParam = forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
'|'

instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
  toQueryParam :: QueryList 'MultiParamArray a -> Text
toQueryParam = forall a. HasCallStack => [Char] -> a
error [Char]
"unimplemented ToHttpApiData for MultiParamArray collection format"

formatSeparatedQueryList :: ToHttpApiData a => Char ->  QueryList p a -> Text
formatSeparatedQueryList :: forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
char = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
char) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToHttpApiData a => a -> Text
toQueryParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: CollectionFormat) a. QueryList p a -> [a]
fromQueryList


-- | Servant type-level API, generated from the OpenAPI spec for Httpstan.
type HttpstanAPI
    =    "v1" :> "health" :> Verb 'GET 200 '[JSON] NoContent -- 'v1HealthGet' route
    :<|> "v1" :> "models" :> Verb 'GET 200 '[JSON] V1ModelsGet200Response -- 'v1ModelsGet' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> Verb 'DELETE 200 '[JSON] NoContent -- 'v1ModelsModelIdDelete' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "fits" :> Capture "fit_id" Text :> Verb 'DELETE 200 '[JSON] NoContent -- 'v1ModelsModelIdFitsFitIdDelete' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "fits" :> Capture "fit_id" Text :> Verb 'GET 200 '[JSON] NoContent -- 'v1ModelsModelIdFitsFitIdGet' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "fits" :> ReqBody '[JSON] CreateFitRequest :> Verb 'POST 201 '[JSON] Fit -- 'v1ModelsModelIdFitsPost' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "log_prob_grad" :> ReqBody '[JSON] Bool :> Verb 'POST 200 '[JSON] V1ModelsModelIdLogProbGradPost200Response -- 'v1ModelsModelIdLogProbGradPost' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "log_prob" :> ReqBody '[JSON] Bool :> Verb 'POST 200 '[JSON] V1ModelsModelIdLogProbPost200Response -- 'v1ModelsModelIdLogProbPost' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "params" :> ReqBody '[JSON] Value :> Verb 'POST 200 '[JSON] V1ModelsModelIdParamsPost200Response -- 'v1ModelsModelIdParamsPost' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "transform_inits" :> ReqBody '[JSON] Value :> Verb 'POST 200 '[JSON] V1ModelsModelIdTransformInitsPost200Response -- 'v1ModelsModelIdTransformInitsPost' route
    :<|> "v1" :> "models" :> Capture "model_id" Text :> "write_array" :> ReqBody '[JSON] Bool :> Verb 'POST 200 '[JSON] V1ModelsModelIdWriteArrayPost200Response -- 'v1ModelsModelIdWriteArrayPost' route
    :<|> "v1" :> "models" :> ReqBody '[JSON] CreateModelRequest :> Verb 'POST 201 '[JSON] Model -- 'v1ModelsPost' route
    :<|> "v1" :> "operations" :> Capture "operation_id" Text :> Verb 'GET 200 '[JSON] Operation -- 'v1OperationsOperationIdGet' route
    :<|> Raw


-- | Server or client configuration, specifying the host and port to query or serve on.
data Config = Config
  { Config -> [Char]
configUrl :: String  -- ^ scheme://hostname:port/path, e.g. "http://localhost:8080/"
  } deriving (Config -> Config -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Eq Config
Config -> Config -> Bool
Config -> Config -> Ordering
Config -> Config -> Config
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
min :: Config -> Config -> Config
$cmin :: Config -> Config -> Config
max :: Config -> Config -> Config
$cmax :: Config -> Config -> Config
>= :: Config -> Config -> Bool
$c>= :: Config -> Config -> Bool
> :: Config -> Config -> Bool
$c> :: Config -> Config -> Bool
<= :: Config -> Config -> Bool
$c<= :: Config -> Config -> Bool
< :: Config -> Config -> Bool
$c< :: Config -> Config -> Bool
compare :: Config -> Config -> Ordering
$ccompare :: Config -> Config -> Ordering
Ord, Int -> Config -> ShowS
[Config] -> ShowS
Config -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> [Char]
$cshow :: Config -> [Char]
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Config]
$creadListPrec :: ReadPrec [Config]
readPrec :: ReadPrec Config
$creadPrec :: ReadPrec Config
readList :: ReadS [Config]
$creadList :: ReadS [Config]
readsPrec :: Int -> ReadS Config
$creadsPrec :: Int -> ReadS Config
Read)


-- | Custom exception type for our errors.
newtype HttpstanClientError = HttpstanClientError ClientError
  deriving (Int -> HttpstanClientError -> ShowS
[HttpstanClientError] -> ShowS
HttpstanClientError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HttpstanClientError] -> ShowS
$cshowList :: [HttpstanClientError] -> ShowS
show :: HttpstanClientError -> [Char]
$cshow :: HttpstanClientError -> [Char]
showsPrec :: Int -> HttpstanClientError -> ShowS
$cshowsPrec :: Int -> HttpstanClientError -> ShowS
Show, Show HttpstanClientError
Typeable HttpstanClientError
SomeException -> Maybe HttpstanClientError
HttpstanClientError -> [Char]
HttpstanClientError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> [Char])
-> Exception e
displayException :: HttpstanClientError -> [Char]
$cdisplayException :: HttpstanClientError -> [Char]
fromException :: SomeException -> Maybe HttpstanClientError
$cfromException :: SomeException -> Maybe HttpstanClientError
toException :: HttpstanClientError -> SomeException
$ctoException :: HttpstanClientError -> SomeException
Exception)
-- | Configuration, specifying the full url of the service.


-- | Backend for Httpstan.
-- The backend can be used both for the client and the server. The client generated from the Httpstan OpenAPI spec
-- is a backend that executes actions by sending HTTP requests (see @createHttpstanClient@). Alternatively, provided
-- a backend, the API can be served using @runHttpstanMiddlewareServer@.
data HttpstanBackend m = HttpstanBackend
  { forall (m :: * -> *). HttpstanBackend m -> m NoContent
v1HealthGet :: m NoContent{- ^ Check if service is running. -}
  , forall (m :: * -> *). HttpstanBackend m -> m V1ModelsGet200Response
v1ModelsGet :: m V1ModelsGet200Response{- ^ List cached models. -}
  , forall (m :: * -> *). HttpstanBackend m -> Text -> m NoContent
v1ModelsModelIdDelete :: Text -> m NoContent{- ^ Delete a model which has been saved in the cache. -}
  , forall (m :: * -> *).
HttpstanBackend m -> Text -> Text -> m NoContent
v1ModelsModelIdFitsFitIdDelete :: Text -> Text -> m NoContent{- ^ Delete a fit which has been saved in the cache. -}
  , forall (m :: * -> *).
HttpstanBackend m -> Text -> Text -> m NoContent
v1ModelsModelIdFitsFitIdGet :: Text -> Text -> m NoContent{- ^ Result (draws, logger messages) from calling a function defined in stan::services. -}
  , forall (m :: * -> *).
HttpstanBackend m -> Text -> CreateFitRequest -> m Fit
v1ModelsModelIdFitsPost :: Text -> CreateFitRequest -> m Fit{- ^ A request to this endpoint starts a long-running operation. Users can retrieve information about the status of the operation by making a GET request to the operations resource endpoint. When the operation is `done`, the \"fit\" may be downloaded. (A \"fit\" collects all logger and writer messages from Stan.) ``function`` indicates the name of the ``stan::services function`` which should be called given the Stan model associated with the id ``model_id``. For example, if sampling using ``stan::services::sample::hmc_nuts_diag_e_adapt`` then ``function`` is the full function name ``stan::services::sample::hmc_nuts_diag_e_adapt``.  Sampler parameters which are not supplied will be given default values taken from CmdStan.  For example, if ``stan::services::sample::hmc_nuts_diag_e_adapt`` is the function called and the parameter ``num_samples`` is not specified, the value 1000 will be used. For a full list of default values consult the CmdStan documentation. -}
  , forall (m :: * -> *).
HttpstanBackend m
-> Text -> Bool -> m V1ModelsModelIdLogProbGradPost200Response
v1ModelsModelIdLogProbGradPost :: Text -> Bool -> m V1ModelsModelIdLogProbGradPost200Response{- ^ Returns the output of Stan C++ `stan::model::log_prob_grad`. -}
  , forall (m :: * -> *).
HttpstanBackend m
-> Text -> Bool -> m V1ModelsModelIdLogProbPost200Response
v1ModelsModelIdLogProbPost :: Text -> Bool -> m V1ModelsModelIdLogProbPost200Response{- ^ Returns the output of Stan C++ ``log_prob`` model class method. -}
  , forall (m :: * -> *).
HttpstanBackend m
-> Text -> Value -> m V1ModelsModelIdParamsPost200Response
v1ModelsModelIdParamsPost :: Text -> Value -> m V1ModelsModelIdParamsPost200Response{- ^ Returns the output of Stan C++ model class methods: ``constrained_param_names``, ``get_param_names`` and ``get_dims``. -}
  , forall (m :: * -> *).
HttpstanBackend m
-> Text -> Value -> m V1ModelsModelIdTransformInitsPost200Response
v1ModelsModelIdTransformInitsPost :: Text -> Value -> m V1ModelsModelIdTransformInitsPost200Response{- ^ Returns the output of Stan C++ ``transform_inits`` model class method. -}
  , forall (m :: * -> *).
HttpstanBackend m
-> Text -> Bool -> m V1ModelsModelIdWriteArrayPost200Response
v1ModelsModelIdWriteArrayPost :: Text -> Bool -> m V1ModelsModelIdWriteArrayPost200Response{- ^ Returns the output of Stan C++ ``write_array`` model class method. -}
  , forall (m :: * -> *).
HttpstanBackend m -> CreateModelRequest -> m Model
v1ModelsPost :: CreateModelRequest -> m Model{- ^ Compile a Stan model -}
  , forall (m :: * -> *). HttpstanBackend m -> Text -> m Operation
v1OperationsOperationIdGet :: Text -> m Operation{- ^ Return Operation details. Details about an Operation include whether or not the operation is `done` and information about the progress of sampling. -}
  }


newtype HttpstanClient a = HttpstanClient
  { forall a. HttpstanClient a -> ClientEnv -> ExceptT ClientError IO a
runClient :: ClientEnv -> ExceptT ClientError IO a
  } deriving forall a b. a -> HttpstanClient b -> HttpstanClient a
forall a b. (a -> b) -> HttpstanClient a -> HttpstanClient b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HttpstanClient b -> HttpstanClient a
$c<$ :: forall a b. a -> HttpstanClient b -> HttpstanClient a
fmap :: forall a b. (a -> b) -> HttpstanClient a -> HttpstanClient b
$cfmap :: forall a b. (a -> b) -> HttpstanClient a -> HttpstanClient b
Functor

instance Applicative HttpstanClient where
  pure :: forall a. a -> HttpstanClient a
pure a
x = forall a.
(ClientEnv -> ExceptT ClientError IO a) -> HttpstanClient a
HttpstanClient (\ClientEnv
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  (HttpstanClient ClientEnv -> ExceptT ClientError IO (a -> b)
f) <*> :: forall a b.
HttpstanClient (a -> b) -> HttpstanClient a -> HttpstanClient b
<*> (HttpstanClient ClientEnv -> ExceptT ClientError IO a
x) =
    forall a.
(ClientEnv -> ExceptT ClientError IO a) -> HttpstanClient a
HttpstanClient (\ClientEnv
env -> ClientEnv -> ExceptT ClientError IO (a -> b)
f ClientEnv
env forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClientEnv -> ExceptT ClientError IO a
x ClientEnv
env)

instance Monad HttpstanClient where
  (HttpstanClient ClientEnv -> ExceptT ClientError IO a
a) >>= :: forall a b.
HttpstanClient a -> (a -> HttpstanClient b) -> HttpstanClient b
>>= a -> HttpstanClient b
f =
    forall a.
(ClientEnv -> ExceptT ClientError IO a) -> HttpstanClient a
HttpstanClient (\ClientEnv
env -> do
      a
value <- ClientEnv -> ExceptT ClientError IO a
a ClientEnv
env
      forall a. HttpstanClient a -> ClientEnv -> ExceptT ClientError IO a
runClient (a -> HttpstanClient b
f a
value) ClientEnv
env)

instance MonadIO HttpstanClient where
  liftIO :: forall a. IO a -> HttpstanClient a
liftIO IO a
io = forall a.
(ClientEnv -> ExceptT ClientError IO a) -> HttpstanClient a
HttpstanClient (\ClientEnv
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io)

createHttpstanClient :: HttpstanBackend HttpstanClient
createHttpstanClient :: HttpstanBackend HttpstanClient
createHttpstanClient = HttpstanBackend{HttpstanClient NoContent
HttpstanClient V1ModelsGet200Response
Text -> HttpstanClient NoContent
Text -> HttpstanClient Operation
Text
-> Bool -> HttpstanClient V1ModelsModelIdWriteArrayPost200Response
Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbPost200Response
Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbGradPost200Response
Text -> Text -> HttpstanClient NoContent
Text
-> Value
-> HttpstanClient V1ModelsModelIdTransformInitsPost200Response
Text
-> Value -> HttpstanClient V1ModelsModelIdParamsPost200Response
Text -> CreateFitRequest -> HttpstanClient Fit
CreateModelRequest -> HttpstanClient Model
v1OperationsOperationIdGet :: Text -> HttpstanClient Operation
v1ModelsPost :: CreateModelRequest -> HttpstanClient Model
v1ModelsModelIdWriteArrayPost :: Text
-> Bool -> HttpstanClient V1ModelsModelIdWriteArrayPost200Response
v1ModelsModelIdTransformInitsPost :: Text
-> Value
-> HttpstanClient V1ModelsModelIdTransformInitsPost200Response
v1ModelsModelIdParamsPost :: Text
-> Value -> HttpstanClient V1ModelsModelIdParamsPost200Response
v1ModelsModelIdLogProbPost :: Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbPost200Response
v1ModelsModelIdLogProbGradPost :: Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbGradPost200Response
v1ModelsModelIdFitsPost :: Text -> CreateFitRequest -> HttpstanClient Fit
v1ModelsModelIdFitsFitIdGet :: Text -> Text -> HttpstanClient NoContent
v1ModelsModelIdFitsFitIdDelete :: Text -> Text -> HttpstanClient NoContent
v1ModelsModelIdDelete :: Text -> HttpstanClient NoContent
v1ModelsGet :: HttpstanClient V1ModelsGet200Response
v1HealthGet :: HttpstanClient NoContent
v1OperationsOperationIdGet :: Text -> HttpstanClient Operation
v1ModelsPost :: CreateModelRequest -> HttpstanClient Model
v1ModelsModelIdWriteArrayPost :: Text
-> Bool -> HttpstanClient V1ModelsModelIdWriteArrayPost200Response
v1ModelsModelIdTransformInitsPost :: Text
-> Value
-> HttpstanClient V1ModelsModelIdTransformInitsPost200Response
v1ModelsModelIdParamsPost :: Text
-> Value -> HttpstanClient V1ModelsModelIdParamsPost200Response
v1ModelsModelIdLogProbPost :: Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbPost200Response
v1ModelsModelIdLogProbGradPost :: Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbGradPost200Response
v1ModelsModelIdFitsPost :: Text -> CreateFitRequest -> HttpstanClient Fit
v1ModelsModelIdFitsFitIdGet :: Text -> Text -> HttpstanClient NoContent
v1ModelsModelIdFitsFitIdDelete :: Text -> Text -> HttpstanClient NoContent
v1ModelsModelIdDelete :: Text -> HttpstanClient NoContent
v1ModelsGet :: HttpstanClient V1ModelsGet200Response
v1HealthGet :: HttpstanClient NoContent
..}
  where
    ((coerce :: forall a b. Coercible a b => a -> b
coerce -> HttpstanClient NoContent
v1HealthGet) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> HttpstanClient V1ModelsGet200Response
v1ModelsGet) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text -> HttpstanClient NoContent
v1ModelsModelIdDelete) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text -> Text -> HttpstanClient NoContent
v1ModelsModelIdFitsFitIdDelete) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text -> Text -> HttpstanClient NoContent
v1ModelsModelIdFitsFitIdGet) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text -> CreateFitRequest -> HttpstanClient Fit
v1ModelsModelIdFitsPost) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbGradPost200Response
v1ModelsModelIdLogProbGradPost) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
-> Bool -> HttpstanClient V1ModelsModelIdLogProbPost200Response
v1ModelsModelIdLogProbPost) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
-> Value -> HttpstanClient V1ModelsModelIdParamsPost200Response
v1ModelsModelIdParamsPost) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
-> Value
-> HttpstanClient V1ModelsModelIdTransformInitsPost200Response
v1ModelsModelIdTransformInitsPost) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
-> Bool -> HttpstanClient V1ModelsModelIdWriteArrayPost200Response
v1ModelsModelIdWriteArrayPost) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> CreateModelRequest -> HttpstanClient Model
v1ModelsPost) :<|>
     (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text -> HttpstanClient Operation
v1OperationsOperationIdGet) :<|>
     ByteString -> ClientM Response
_) = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy :: Proxy HttpstanAPI)

-- | Run requests in the HttpstanClient monad.
runHttpstanClient :: Config -> HttpstanClient a -> ExceptT ClientError IO a
runHttpstanClient :: forall a. Config -> HttpstanClient a -> ExceptT ClientError IO a
runHttpstanClient Config
clientConfig HttpstanClient a
cl = do
  Manager
manager <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  forall a.
Manager -> Config -> HttpstanClient a -> ExceptT ClientError IO a
runHttpstanClientWithManager Manager
manager Config
clientConfig HttpstanClient a
cl

-- | Run requests in the HttpstanClient monad using a custom manager.
runHttpstanClientWithManager :: Manager -> Config -> HttpstanClient a -> ExceptT ClientError IO a
runHttpstanClientWithManager :: forall a.
Manager -> Config -> HttpstanClient a -> ExceptT ClientError IO a
runHttpstanClientWithManager Manager
manager Config{[Char]
configUrl :: [Char]
configUrl :: Config -> [Char]
..} HttpstanClient a
cl = do
  BaseUrl
url <- forall (m :: * -> *). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl [Char]
configUrl
  forall a. HttpstanClient a -> ClientEnv -> ExceptT ClientError IO a
runClient HttpstanClient a
cl forall a b. (a -> b) -> a -> b
$ Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager BaseUrl
url

-- | Like @runClient@, but returns the response or throws
--   a HttpstanClientError
callHttpstan
  :: (MonadIO m, MonadThrow m)
  => ClientEnv -> HttpstanClient a -> m a
callHttpstan :: forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
ClientEnv -> HttpstanClient a -> m a
callHttpstan ClientEnv
env HttpstanClient a
f = do
  Either ClientError a
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall a. HttpstanClient a -> ClientEnv -> ExceptT ClientError IO a
runClient HttpstanClient a
f ClientEnv
env
  case Either ClientError a
res of
    Left ClientError
err       -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientError -> HttpstanClientError
HttpstanClientError ClientError
err)
    Right a
response -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
response


requestMiddlewareId :: Application -> Application
requestMiddlewareId :: Application -> Application
requestMiddlewareId Application
a = Application
a

-- | Run the Httpstan server at the provided host and port.
runHttpstanServer
  :: (MonadIO m, MonadThrow m)
  => Config -> HttpstanBackend (ExceptT ServerError IO) -> m ()
runHttpstanServer :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Config -> HttpstanBackend (ExceptT ServerError IO) -> m ()
runHttpstanServer Config
config HttpstanBackend (ExceptT ServerError IO)
backend = forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Config
-> (Application -> Application)
-> HttpstanBackend (ExceptT ServerError IO)
-> m ()
runHttpstanMiddlewareServer Config
config Application -> Application
requestMiddlewareId HttpstanBackend (ExceptT ServerError IO)
backend

-- | Run the Httpstan server at the provided host and port.
runHttpstanMiddlewareServer
  :: (MonadIO m, MonadThrow m)
  => Config -> Middleware -> HttpstanBackend (ExceptT ServerError IO) -> m ()
runHttpstanMiddlewareServer :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Config
-> (Application -> Application)
-> HttpstanBackend (ExceptT ServerError IO)
-> m ()
runHttpstanMiddlewareServer Config{[Char]
configUrl :: [Char]
configUrl :: Config -> [Char]
..} Application -> Application
middleware HttpstanBackend (ExceptT ServerError IO)
backend = do
  BaseUrl
url <- forall (m :: * -> *). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl [Char]
configUrl
  let warpSettings :: Settings
warpSettings = Settings
Warp.defaultSettings
        forall a b. a -> (a -> b) -> b
& Int -> Settings -> Settings
Warp.setPort (BaseUrl -> Int
baseUrlPort BaseUrl
url)
        forall a b. a -> (a -> b) -> b
& HostPreference -> Settings -> Settings
Warp.setHost (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ BaseUrl -> [Char]
baseUrlHost BaseUrl
url)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Settings -> Application -> IO ()
Warp.runSettings Settings
warpSettings forall a b. (a -> b) -> a -> b
$ Application -> Application
middleware forall a b. (a -> b) -> a -> b
$ HttpstanBackend (ExceptT ServerError IO) -> Application
serverWaiApplicationHttpstan HttpstanBackend (ExceptT ServerError IO)
backend

-- | Plain "Network.Wai" Application for the Httpstan server.
--
-- Can be used to implement e.g. tests that call the API without a full webserver.
serverWaiApplicationHttpstan :: HttpstanBackend (ExceptT ServerError IO) -> Application
serverWaiApplicationHttpstan :: HttpstanBackend (ExceptT ServerError IO) -> Application
serverWaiApplicationHttpstan HttpstanBackend (ExceptT ServerError IO)
backend = forall api (context :: [*]) (m :: * -> *).
(HasServer api context, ServerContext context) =>
Proxy api
-> Context context
-> (forall x. m x -> Handler x)
-> ServerT api m
-> Application
serveWithContextT (forall {k} (t :: k). Proxy t
Proxy :: Proxy HttpstanAPI) Context '[]
context forall a. a -> a
id (forall {a} {m :: * -> *} {a} {a} {a} {a} {a} {a} {a} {a} {a} {a}
       {a} {a} {m :: * -> *}.
(Coercible a (m NoContent), Coercible a (m V1ModelsGet200Response),
 Coercible a (Text -> m NoContent),
 Coercible a (Text -> Text -> m NoContent),
 Coercible a (Text -> Text -> m NoContent),
 Coercible a (Text -> CreateFitRequest -> m Fit),
 Coercible
   a (Text -> Bool -> m V1ModelsModelIdLogProbGradPost200Response),
 Coercible
   a (Text -> Bool -> m V1ModelsModelIdLogProbPost200Response),
 Coercible
   a (Text -> Value -> m V1ModelsModelIdParamsPost200Response),
 Coercible
   a
   (Text -> Value -> m V1ModelsModelIdTransformInitsPost200Response),
 Coercible
   a (Text -> Bool -> m V1ModelsModelIdWriteArrayPost200Response),
 Coercible a (CreateModelRequest -> m Model),
 Coercible a (Text -> m Operation)) =>
HttpstanBackend m
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> Tagged
                                                                                  m
                                                                                  Application))))))))))))
serverFromBackend HttpstanBackend (ExceptT ServerError IO)
backend)
  where
    context :: Context '[]
context = Context '[]
serverContext
    serverFromBackend :: HttpstanBackend m
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> Tagged
                                                                                  m
                                                                                  Application))))))))))))
serverFromBackend HttpstanBackend{m NoContent
m V1ModelsGet200Response
Text -> m NoContent
Text -> m Operation
Text -> Bool -> m V1ModelsModelIdWriteArrayPost200Response
Text -> Bool -> m V1ModelsModelIdLogProbPost200Response
Text -> Bool -> m V1ModelsModelIdLogProbGradPost200Response
Text -> Text -> m NoContent
Text -> Value -> m V1ModelsModelIdTransformInitsPost200Response
Text -> Value -> m V1ModelsModelIdParamsPost200Response
Text -> CreateFitRequest -> m Fit
CreateModelRequest -> m Model
v1OperationsOperationIdGet :: Text -> m Operation
v1ModelsPost :: CreateModelRequest -> m Model
v1ModelsModelIdWriteArrayPost :: Text -> Bool -> m V1ModelsModelIdWriteArrayPost200Response
v1ModelsModelIdTransformInitsPost :: Text -> Value -> m V1ModelsModelIdTransformInitsPost200Response
v1ModelsModelIdParamsPost :: Text -> Value -> m V1ModelsModelIdParamsPost200Response
v1ModelsModelIdLogProbPost :: Text -> Bool -> m V1ModelsModelIdLogProbPost200Response
v1ModelsModelIdLogProbGradPost :: Text -> Bool -> m V1ModelsModelIdLogProbGradPost200Response
v1ModelsModelIdFitsPost :: Text -> CreateFitRequest -> m Fit
v1ModelsModelIdFitsFitIdGet :: Text -> Text -> m NoContent
v1ModelsModelIdFitsFitIdDelete :: Text -> Text -> m NoContent
v1ModelsModelIdDelete :: Text -> m NoContent
v1ModelsGet :: m V1ModelsGet200Response
v1HealthGet :: m NoContent
v1OperationsOperationIdGet :: forall (m :: * -> *). HttpstanBackend m -> Text -> m Operation
v1ModelsPost :: forall (m :: * -> *).
HttpstanBackend m -> CreateModelRequest -> m Model
v1ModelsModelIdWriteArrayPost :: forall (m :: * -> *).
HttpstanBackend m
-> Text -> Bool -> m V1ModelsModelIdWriteArrayPost200Response
v1ModelsModelIdTransformInitsPost :: forall (m :: * -> *).
HttpstanBackend m
-> Text -> Value -> m V1ModelsModelIdTransformInitsPost200Response
v1ModelsModelIdParamsPost :: forall (m :: * -> *).
HttpstanBackend m
-> Text -> Value -> m V1ModelsModelIdParamsPost200Response
v1ModelsModelIdLogProbPost :: forall (m :: * -> *).
HttpstanBackend m
-> Text -> Bool -> m V1ModelsModelIdLogProbPost200Response
v1ModelsModelIdLogProbGradPost :: forall (m :: * -> *).
HttpstanBackend m
-> Text -> Bool -> m V1ModelsModelIdLogProbGradPost200Response
v1ModelsModelIdFitsPost :: forall (m :: * -> *).
HttpstanBackend m -> Text -> CreateFitRequest -> m Fit
v1ModelsModelIdFitsFitIdGet :: forall (m :: * -> *).
HttpstanBackend m -> Text -> Text -> m NoContent
v1ModelsModelIdFitsFitIdDelete :: forall (m :: * -> *).
HttpstanBackend m -> Text -> Text -> m NoContent
v1ModelsModelIdDelete :: forall (m :: * -> *). HttpstanBackend m -> Text -> m NoContent
v1ModelsGet :: forall (m :: * -> *). HttpstanBackend m -> m V1ModelsGet200Response
v1HealthGet :: forall (m :: * -> *). HttpstanBackend m -> m NoContent
..} =
      (coerce :: forall a b. Coercible a b => a -> b
coerce m NoContent
v1HealthGet forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce m V1ModelsGet200Response
v1ModelsGet forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> m NoContent
v1ModelsModelIdDelete forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> Text -> m NoContent
v1ModelsModelIdFitsFitIdDelete forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> Text -> m NoContent
v1ModelsModelIdFitsFitIdGet forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> CreateFitRequest -> m Fit
v1ModelsModelIdFitsPost forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> Bool -> m V1ModelsModelIdLogProbGradPost200Response
v1ModelsModelIdLogProbGradPost forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> Bool -> m V1ModelsModelIdLogProbPost200Response
v1ModelsModelIdLogProbPost forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> Value -> m V1ModelsModelIdParamsPost200Response
v1ModelsModelIdParamsPost forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> Value -> m V1ModelsModelIdTransformInitsPost200Response
v1ModelsModelIdTransformInitsPost forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> Bool -> m V1ModelsModelIdWriteArrayPost200Response
v1ModelsModelIdWriteArrayPost forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce CreateModelRequest -> m Model
v1ModelsPost forall a b. a -> b -> a :<|> b
:<|>
       coerce :: forall a b. Coercible a b => a -> b
coerce Text -> m Operation
v1OperationsOperationIdGet forall a b. a -> b -> a :<|> b
:<|>
       forall (m :: * -> *). [Char] -> ServerT Raw m
serveDirectoryFileServer [Char]
"static")


serverContext :: Context ('[])
serverContext :: Context '[]
serverContext = Context '[]
EmptyContext