Initial commit
This commit is contained in:
commit
6fa9746f36
GPG Key ID:
3786C5262ECB4A3F
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
||||
dist-newstyle/
|
||||
5
CHANGELOG.md
Normal file
5
CHANGELOG.md
Normal file
@ -0,0 +1,5 @@
|
||||
# Revision history for soostone
|
||||
|
||||
## 0.1.0.0 -- YYYY-mm-dd
|
||||
|
||||
* First version. Released on an unsuspecting world.
|
||||
29
README.md
Normal file
29
README.md
Normal file
@ -0,0 +1,29 @@
|
||||
# Soostone
|
||||
|
||||
## Start
|
||||
|
||||
First create tables:
|
||||
|
||||
```sh
|
||||
soostone create-tables
|
||||
```
|
||||
|
||||
Then start backend:
|
||||
|
||||
```sh
|
||||
soostone run
|
||||
```
|
||||
|
||||
## Request examples
|
||||
|
||||
### Insert
|
||||
|
||||
```sh
|
||||
curl -v -H 'Content-Type: application/json' -X POST --data '"abc"' http://localhost:9000/api/v1/input
|
||||
```
|
||||
|
||||
### Query
|
||||
|
||||
```sh
|
||||
curl -v -X GET 'http://localhost:9000/api/v1/query?key=abc'
|
||||
```
|
||||
112
app/Main.hs
Normal file
112
app/Main.hs
Normal file
@ -0,0 +1,112 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Soostone ( app, middleWare, AppState(AppState, sqliteFile) )
|
||||
|
||||
import Control.Monad ( void, when )
|
||||
import Data.Version (showVersion)
|
||||
import Database.SQLite.Simple ( execute_, open, Connection )
|
||||
import Network.Wai.Handler.Warp ( run )
|
||||
import Options.Applicative
|
||||
( fullDesc,
|
||||
execParser,
|
||||
progDesc,
|
||||
helper,
|
||||
(<**>),
|
||||
info,
|
||||
command,
|
||||
subparser,
|
||||
strOption,
|
||||
value,
|
||||
showDefault,
|
||||
metavar,
|
||||
eitherReader,
|
||||
option,
|
||||
hidden,
|
||||
help,
|
||||
long,
|
||||
infoOption,
|
||||
Parser )
|
||||
import Paths_soostone ( version )
|
||||
import Prometheus ( register )
|
||||
import Prometheus.Metric.GHC ( ghcMetrics )
|
||||
import Prometheus.Metric.Proc ( procMetrics )
|
||||
import Text.Read ( readEither )
|
||||
|
||||
|
||||
versioner :: Parser (a -> a)
|
||||
versioner = infoOption (showVersion version) (long "version" <> help "Show version" <> hidden)
|
||||
|
||||
data Command = Run ServerConfig
|
||||
| Create ServerConfig
|
||||
|
||||
data Config = Config {
|
||||
serverCommand :: Command
|
||||
}
|
||||
|
||||
parseConfig :: Parser Config
|
||||
parseConfig = Config <$> parseCommands
|
||||
|
||||
data ServerConfig = ServerConfig {
|
||||
serverPort :: Int
|
||||
, sqliteDB :: FilePath
|
||||
}
|
||||
|
||||
parseServerConf :: Parser ServerConfig
|
||||
parseServerConf = ServerConfig
|
||||
<$> option
|
||||
(eitherReader (readEither @Int))
|
||||
(long "server-port" <> metavar "SERVER_PORT" <> help
|
||||
"Port to use for the REST server"
|
||||
<> showDefault
|
||||
<> value 9000
|
||||
)
|
||||
<*> strOption
|
||||
( long "sqlite-db"
|
||||
<> metavar "SQLITE_DB"
|
||||
<> help "SQLite relation/database"
|
||||
<> showDefault
|
||||
<> value "soostone.sqlite3"
|
||||
)
|
||||
|
||||
parseCommands :: Parser Command
|
||||
parseCommands = subparser $
|
||||
command
|
||||
"run"
|
||||
(info
|
||||
(Run <$> parseServerConf <**> helper)
|
||||
( progDesc "Run the REST API webserver"
|
||||
)
|
||||
)
|
||||
<>
|
||||
command
|
||||
"create-tables"
|
||||
(info
|
||||
(Create <$> parseServerConf <**> helper)
|
||||
( progDesc "Create the database"
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
Config{ .. } <-
|
||||
execParser (info (parseConfig <**> helper <**> versioner) (fullDesc <> progDesc "Soostone"))
|
||||
|
||||
case serverCommand of
|
||||
Run ServerConfig{..} -> do
|
||||
when (sqliteDB == ":memory:") $ fail "In-memory DB is not supported!"
|
||||
let appState = AppState { sqliteFile = sqliteDB }
|
||||
void $ register ghcMetrics
|
||||
void $ register procMetrics
|
||||
run serverPort (middleWare $ app appState)
|
||||
Create ServerConfig{..} -> do
|
||||
when (sqliteDB == ":memory:") $ fail "In-memory DB is not supported!"
|
||||
con <- open sqliteDB
|
||||
createTables con
|
||||
where
|
||||
createTables :: Connection -> IO ()
|
||||
createTables con = do
|
||||
execute_ con "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, key TEXT, count INTEGER)"
|
||||
8
cabal.project
Normal file
8
cabal.project
Normal file
@ -0,0 +1,8 @@
|
||||
packages: ./soostone.cabal
|
||||
|
||||
with-compiler: ghc-8.10.7
|
||||
|
||||
optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
allow-newer: text
|
||||
|
||||
216
cabal.project.freeze
Normal file
216
cabal.project.freeze
Normal file
@ -0,0 +1,216 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.6.3.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.Only ==0.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==2.0.3.0,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.ansi-terminal ==0.11.1,
|
||||
ansi-terminal -example,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
any.appar ==0.1.8,
|
||||
any.array ==0.5.4.0,
|
||||
any.asn1-encoding ==0.9.6,
|
||||
any.asn1-parse ==0.9.5,
|
||||
any.asn1-types ==0.3.4,
|
||||
any.assoc ==1.0.2,
|
||||
any.async ==2.2.4,
|
||||
async -bench,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.attoparsec-iso8601 ==1.0.2.1,
|
||||
attoparsec-iso8601 -developer -fast,
|
||||
any.auto-update ==0.1.6,
|
||||
any.base ==4.14.3.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.basement ==0.0.14,
|
||||
any.bifunctors ==5.5.11,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.9.0,
|
||||
any.blaze-builder ==0.4.2.2,
|
||||
any.blaze-html ==0.9.1.2,
|
||||
any.blaze-markup ==0.8.2.8,
|
||||
any.blaze-textual ==0.2.2.1,
|
||||
blaze-textual -developer -integer-simple +native,
|
||||
any.boring ==0.2,
|
||||
boring +tagged,
|
||||
any.bsb-http-chunked ==0.0.0.4,
|
||||
any.byteorder ==1.0.4,
|
||||
any.bytestring ==0.11.3.0,
|
||||
any.cabal-doctest ==1.0.9,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
any.clock ==0.8.3,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.constraints ==0.13.3,
|
||||
any.containers ==0.6.5.1,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cookie ==0.4.5,
|
||||
any.cryptonite ==0.30,
|
||||
cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
|
||||
any.data-default ==0.7.1.1,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-default-instances-containers ==0.0.1,
|
||||
any.data-default-instances-dlist ==0.0.1,
|
||||
any.data-default-instances-old-locale ==0.0.1,
|
||||
any.data-fix ==0.3.2,
|
||||
any.data-sketches ==0.3.1.0,
|
||||
any.data-sketches-core ==0.1.0.0,
|
||||
any.dec ==0.0.4,
|
||||
any.deepseq ==1.4.4.0,
|
||||
any.direct-sqlite ==2.3.26,
|
||||
direct-sqlite +fulltextsearch +haveusleep +json1 -systemlib +urifilenames,
|
||||
any.directory ==1.3.7.0,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
any.dlist ==1.0,
|
||||
dlist -werror,
|
||||
any.easy-file ==0.2.2,
|
||||
any.exceptions ==0.10.4,
|
||||
any.fast-logger ==3.1.1,
|
||||
any.file-embed ==0.0.15.0,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.filtrable ==0.1.6.0,
|
||||
filtrable +containers,
|
||||
any.ghc-boot-th ==8.10.7,
|
||||
any.ghc-prim ==0.6.1,
|
||||
any.hashable ==1.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.hourglass ==0.2.12,
|
||||
any.hsc2hs ==0.68.8,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.http-api-data ==0.4.3,
|
||||
http-api-data -use-text-show,
|
||||
any.http-date ==0.0.11,
|
||||
any.http-media ==0.8.0.0,
|
||||
any.http-types ==0.12.3,
|
||||
any.http2 ==3.0.3,
|
||||
http2 -devel -doc -h2spec,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.integer-gmp ==1.0.3.0,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.iproute ==1.7.12,
|
||||
any.math-functions ==0.3.4.2,
|
||||
math-functions +system-erf +system-expm1,
|
||||
any.memory ==0.17.0,
|
||||
memory +support_bytestring +support_deepseq,
|
||||
any.mime-types ==0.1.0.9,
|
||||
any.mmorph ==1.2.0,
|
||||
any.monad-control ==1.0.3.1,
|
||||
any.mtl ==2.2.2,
|
||||
any.mwc-random ==0.15.0.2,
|
||||
any.network ==3.1.2.7,
|
||||
network -devel,
|
||||
any.network-byte-order ==0.1.6,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.old-locale ==1.0.0.7,
|
||||
any.old-time ==1.1.0.3,
|
||||
any.optparse-applicative ==0.16.1.0,
|
||||
optparse-applicative +process,
|
||||
any.parsec ==3.1.15.0,
|
||||
any.pem ==0.2.4,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.primitive ==0.7.3.0,
|
||||
any.process ==1.6.14.0,
|
||||
any.prometheus-client ==1.1.0,
|
||||
any.prometheus-metrics-ghc ==1.0.1.2,
|
||||
any.prometheus-proc ==0.1.4.0,
|
||||
any.psqueues ==0.2.7.3,
|
||||
any.random ==1.2.1,
|
||||
any.regex-applicative ==0.3.4,
|
||||
any.resourcet ==1.2.4.3,
|
||||
any.rts ==1.0.1,
|
||||
any.scientific ==0.3.7.0,
|
||||
scientific -bytestring-builder -integer-simple,
|
||||
any.semialign ==1.2.0.1,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==5.3.7,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.semigroups ==0.19.2,
|
||||
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
|
||||
any.servant ==0.19,
|
||||
any.servant-server ==0.19.1,
|
||||
any.simple-sendfile ==0.2.30,
|
||||
simple-sendfile +allow-bsd,
|
||||
any.singleton-bool ==0.1.6,
|
||||
any.some ==1.0.3,
|
||||
some +newtype-unsafe,
|
||||
any.sop-core ==0.5.0.2,
|
||||
any.splitmix ==0.1.0.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.sqlite-simple ==0.4.18.0,
|
||||
any.stm ==2.5.0.1,
|
||||
any.streaming-commons ==0.2.2.4,
|
||||
streaming-commons -use-bytestring-builder,
|
||||
any.strict ==0.4.0.1,
|
||||
strict +assoc,
|
||||
any.string-conversions ==0.4.0.1,
|
||||
any.tagged ==0.8.6.1,
|
||||
tagged +deepseq +transformers,
|
||||
any.template-haskell ==2.16.0.0,
|
||||
any.text ==2.0,
|
||||
text -developer +simdutf,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
any.time-compat ==1.9.6.1,
|
||||
time-compat -old-locale,
|
||||
any.time-manager ==0.0.0,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.type-equality ==1,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-compat ==0.5.4,
|
||||
unix-compat -old-time,
|
||||
any.unix-memory ==0.1.2,
|
||||
any.unix-time ==0.4.7,
|
||||
any.unliftio ==0.2.21.0,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.18.0,
|
||||
unordered-containers -debug,
|
||||
any.utf8-string ==1.0.2,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vault ==0.3.1.5,
|
||||
vault +useghc,
|
||||
any.vector ==0.12.3.1,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.vector-algorithms ==0.8.0.4,
|
||||
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
||||
any.wai ==3.2.3,
|
||||
any.wai-app-static ==3.1.7.4,
|
||||
wai-app-static +cryptonite -print,
|
||||
any.wai-extra ==3.1.8,
|
||||
wai-extra -build-example,
|
||||
any.wai-logger ==2.4.0,
|
||||
any.wai-middleware-prometheus ==1.0.0.1,
|
||||
any.warp ==3.3.20,
|
||||
warp +allow-sendfilefd -network-bytestring -warp-debug +x509,
|
||||
any.witherable ==0.4.2,
|
||||
any.word8 ==0.1.3,
|
||||
any.x509 ==1.7.6,
|
||||
any.zlib ==0.6.2.3,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config
|
||||
index-state: hackage.haskell.org 2022-04-09T11:10:06Z
|
||||
35
lib/Soostone.hs
Normal file
35
lib/Soostone.hs
Normal file
@ -0,0 +1,35 @@
|
||||
module Soostone (
|
||||
app
|
||||
, middleWare
|
||||
, module Soostone.API
|
||||
, module Soostone.Types
|
||||
, module Soostone.Handlers
|
||||
) where
|
||||
|
||||
import Soostone.API
|
||||
import Soostone.Handlers
|
||||
import Soostone.Types
|
||||
|
||||
import Control.Monad.Reader (runReaderT)
|
||||
import Network.Wai ( Middleware )
|
||||
import Network.Wai.Middleware.Prometheus ( def, prometheus )
|
||||
import Servant
|
||||
( Application, HasServer(ServerT), Handler, hoistServer, serve )
|
||||
|
||||
|
||||
soostoneServer :: ServerT SoostoneAPI AppM
|
||||
soostoneServer = API api'
|
||||
where
|
||||
api' = MainAPI submitKeyHandler countKeyHandler
|
||||
|
||||
app :: AppState -> Application
|
||||
app !s = \req resp ->
|
||||
serve api (hoistServer api nt soostoneServer) req resp
|
||||
where
|
||||
nt :: AppM a -> Handler a
|
||||
nt x = flip runReaderT s $ runAppM x
|
||||
|
||||
|
||||
middleWare :: Middleware
|
||||
middleWare baseApp =
|
||||
prometheus def baseApp
|
||||
36
lib/Soostone/API.hs
Normal file
36
lib/Soostone/API.hs
Normal file
@ -0,0 +1,36 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Soostone.API where
|
||||
|
||||
import Soostone.Types ( Count, Key )
|
||||
|
||||
import Servant
|
||||
( Proxy(..),
|
||||
JSON,
|
||||
type (:>),
|
||||
ReqBody,
|
||||
Post,
|
||||
QueryParam',
|
||||
Required,
|
||||
Strict,
|
||||
Get,
|
||||
NamedRoutes )
|
||||
import Servant.API.Generic ( Generic, GenericMode(type (:-)) )
|
||||
|
||||
|
||||
type SoostoneAPI = NamedRoutes API
|
||||
type APIVersion = "v1"
|
||||
|
||||
data API mode = API {
|
||||
mainAPI :: mode :- "api" :> APIVersion :> NamedRoutes MainAPI
|
||||
} deriving Generic
|
||||
|
||||
data MainAPI mode = MainAPI {
|
||||
submitKey :: mode :- "input" :> ReqBody '[JSON] Key :> Post '[JSON] ()
|
||||
, countKey :: mode :- "query" :> QueryParam' '[Required, Strict] "key" Key :> Get '[JSON] Count
|
||||
} deriving Generic
|
||||
|
||||
api :: Proxy SoostoneAPI
|
||||
api = Proxy :: Proxy SoostoneAPI
|
||||
46
lib/Soostone/Handlers.hs
Normal file
46
lib/Soostone/Handlers.hs
Normal file
@ -0,0 +1,46 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Soostone.Handlers where
|
||||
|
||||
import Soostone.Types
|
||||
( AppState(AppState, sqliteFile), AppM, Count(..), Key )
|
||||
|
||||
import Data.Functor ( ($>) )
|
||||
import Database.SQLite.Simple
|
||||
( open,
|
||||
Connection,
|
||||
close,
|
||||
executeNamed,
|
||||
queryNamed,
|
||||
withImmediateTransaction,
|
||||
NamedParam((:=)) )
|
||||
import Control.Monad.Catch ( finally )
|
||||
import Control.Monad.Reader ( ask )
|
||||
import Control.Monad.IO.Class ( liftIO )
|
||||
|
||||
|
||||
submitKeyHandler :: Key -> AppM ()
|
||||
submitKeyHandler key = withSQLiteCon $ \con -> do
|
||||
r <- liftIO $ withImmediateTransaction con $ do
|
||||
queryNamed @Count con "SELECT count FROM keys WHERE key=:key" [":key" := key] >>= \case
|
||||
[] -> executeNamed con "INSERT INTO keys (key, count) VALUES (:key, :count)" [":key" := key, ":count" := Count 1] $> Right ()
|
||||
[c] -> executeNamed con "UPDATE keys SET count = :count WHERE key = :key" [":count" := c + 1, ":key" := key] $> Right ()
|
||||
_ -> pure $ Left "Oops"
|
||||
case r of
|
||||
Right _ -> pure ()
|
||||
Left e -> fail e -- internal error
|
||||
|
||||
|
||||
countKeyHandler :: Key -> AppM Count
|
||||
countKeyHandler key = withSQLiteCon $ \con -> do
|
||||
liftIO (queryNamed @Count con "SELECT count FROM keys WHERE key=:key" [":key" := key]) >>= \case
|
||||
[] -> return (Count 0)
|
||||
[c] -> pure c
|
||||
_ -> fail "Oops" -- internal error
|
||||
|
||||
withSQLiteCon :: (Connection -> AppM a) -> AppM a
|
||||
withSQLiteCon action = do
|
||||
AppState{..} <- ask
|
||||
conn <- liftIO $ open sqliteFile
|
||||
action conn `finally` liftIO (close conn)
|
||||
60
lib/Soostone/Types.hs
Normal file
60
lib/Soostone/Types.hs
Normal file
@ -0,0 +1,60 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Soostone.Types where
|
||||
|
||||
import Control.Monad.Catch ( MonadMask, MonadCatch, MonadThrow )
|
||||
import Control.Monad.Error.Class ( MonadError(throwError) )
|
||||
import Control.Monad.IO.Class ( MonadIO(..) )
|
||||
import Control.Monad.Reader.Class ( MonadReader )
|
||||
import Control.Monad.Trans.Reader (ReaderT)
|
||||
import Data.Aeson
|
||||
( defaultOptions, genericToEncoding, FromJSON, ToJSON(toEncoding) )
|
||||
import Data.String ( IsString(fromString) )
|
||||
import Data.Text ( Text )
|
||||
import Database.SQLite.Simple ( field, FromRow(..) )
|
||||
import Database.SQLite.Simple.ToField ( ToField(..) )
|
||||
import Servant
|
||||
( Handler, ServerError(errBody), FromHttpApiData, err500 )
|
||||
import Servant.API.Generic ( Generic )
|
||||
|
||||
|
||||
newtype Key = Key Text
|
||||
deriving (FromHttpApiData, Generic)
|
||||
|
||||
instance ToField Key where
|
||||
toField (Key k) = toField k
|
||||
|
||||
instance ToJSON Key where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
instance FromJSON Key
|
||||
|
||||
|
||||
newtype Count = Count Integer
|
||||
deriving (Generic, Num)
|
||||
|
||||
instance FromRow Count where
|
||||
fromRow = Count <$> field
|
||||
|
||||
instance ToField Count where
|
||||
toField (Count c) = toField c
|
||||
|
||||
|
||||
instance ToJSON Count where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
instance FromJSON Count
|
||||
|
||||
data AppState = AppState {
|
||||
sqliteFile :: FilePath
|
||||
}
|
||||
|
||||
newtype AppM a = AppM { runAppM :: ReaderT AppState Handler a }
|
||||
deriving
|
||||
( Functor, Applicative, Monad, MonadIO, Generic
|
||||
, MonadThrow, MonadCatch, MonadMask
|
||||
, MonadReader AppState
|
||||
, MonadError ServerError
|
||||
)
|
||||
|
||||
instance MonadFail AppM where
|
||||
fail str = throwError $ err500 { errBody = fromString str }
|
||||
69
soostone.cabal
Normal file
69
soostone.cabal
Normal file
@ -0,0 +1,69 @@
|
||||
cabal-version: 2.4
|
||||
name: soostone
|
||||
version: 0.1.0.0
|
||||
synopsis: A stringy backend
|
||||
description: A really stringy backend
|
||||
bug-reports: https://gogs.hasufell.de/hasufell/soostone/issues
|
||||
license: BSD-3-Clause
|
||||
author: Julian Ospald
|
||||
maintainer: hasufell@posteo.de
|
||||
copyright: 2022 Julian Ospald
|
||||
category: Backend
|
||||
extra-source-files: CHANGELOG.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://gogs.hasufell.de/hasufell/soostone.git
|
||||
|
||||
common deps
|
||||
build-depends:
|
||||
, aeson ^>=2.0
|
||||
, base >=4.13 && <5.0
|
||||
, bytestring ^>=0.11
|
||||
, exceptions ^>=0.10
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative ^>=0.16
|
||||
, prometheus-client ^>=1.1
|
||||
, prometheus-metrics-ghc ^>=1.0
|
||||
, prometheus-proc ^>=0.1
|
||||
, servant ^>=0.19
|
||||
, servant-server ^>=0.19
|
||||
, sqlite-simple ^>=0.4
|
||||
, text ^>=2.0
|
||||
, transformers ^>=0.5
|
||||
, wai ^>=3.2.3
|
||||
, wai-middleware-prometheus ^>=1.0
|
||||
, warp ^>=3.3.19
|
||||
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
ImportQualifiedPost
|
||||
LambdaCase
|
||||
MultiWayIf
|
||||
PackageImports
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
StrictData
|
||||
TupleSections
|
||||
|
||||
default-language: Haskell2010
|
||||
ghc-options:
|
||||
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
executable soostone
|
||||
import: deps
|
||||
main-is: Main.hs
|
||||
other-modules: Paths_soostone
|
||||
autogen-modules: Paths_soostone
|
||||
hs-source-dirs: app
|
||||
build-depends: soostone
|
||||
|
||||
library
|
||||
import: deps
|
||||
hs-source-dirs: lib
|
||||
exposed-modules:
|
||||
Soostone
|
||||
Soostone.API
|
||||
Soostone.Handlers
|
||||
Soostone.Types
|
||||
Loading…
Reference in New Issue
Block a user