Browse Source

got it working again after some idle time

master
nek0 4 months ago
parent
commit
0d7c68836b
  1. 2
      app/Main.hs
  2. 2
      cabal.project
  3. 35
      default.nix
  4. 304
      mateamt.cabal
  5. 10
      src/Control/Buy.hs
  6. 6
      src/Control/User.hs
  7. 9
      src/Types/Settings.hs
  8. 0
      test/TestMain.hs

2
app/AppMain.hs → app/Main.hs

@ -3,7 +3,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module AppMain where
module Main where
import Prelude as P

2
cabal.project

@ -1 +1,3 @@
index-state: 2021-02-05T00:00:00Z
packages:
./

35
default.nix

@ -1,21 +1,28 @@
{ # Fetch the latest haskell.nix and import its default.nix
haskellNix ? import (builtins.fetchTarball "https://github.com/input-output-hk/haskell.nix/archive/master.tar.gz") {}
let
# Read in the Niv sources
sources = import ./nix/sources.nix {};
# If ./nix/sources.nix file is not found run:
# niv init
# niv add input-output-hk/haskell.nix -n haskellNix
# haskell.nix provides access to the nixpkgs pins which are used by our CI,
# hence you will be more likely to get cache hits when using these.
# But you can also just use your own, e.g. '<nixpkgs>'.
, nixpkgsSrc ? haskellNix.sources.nixpkgs-2009
# Fetch the haskell.nix commit we have pinned with Niv
haskellNix = import sources.haskellNix {};
# If haskellNix is not found run:
# niv add input-output-hk/haskell.nix -n haskellNix
# haskell.nix provides some arguments to be passed to nixpkgs, including some
# patches and also the haskell.nix functionality itself as an overlay.
, nixpkgsArgs ? haskellNix.nixpkgsArgs
# import nixpkgs with overlays
, pkgs ? import nixpkgsSrc nixpkgsArgs
}: pkgs.haskell-nix.project {
# Import nixpkgs and pass the haskell.nix provided nixpkgsArgs
pkgs = import
# haskell.nix provides access to the nixpkgs pins which are used by our CI,
# hence you will be more likely to get cache hits when using these.
# But you can also just use your own, e.g. '<nixpkgs>'.
haskellNix.sources.nixpkgs-2009
# These arguments passed to nixpkgs, include some patches and also
# the haskell.nix functionality itself as an overlay.
haskellNix.nixpkgsArgs;
in pkgs.haskell-nix.project {
# 'cleanGit' cleans a source directory based on the files known by git
src = pkgs.haskell-nix.haskellLib.cleanGit {
name = "mateamt";
name = "haskell-nix-project";
src = ./.;
};
# Specify the GHC version to use.

304
mateamt.cabal

@ -1,145 +1,179 @@
cabal-version: 2.4
cabal-version: 3.0
name: mateamt
version: 0.0.0.0
synopsis: A whole new matemat
name: mateamt
version: 0.0.0.0
synopsis: A whole new matemat
-- A longer description of the package.
-- description:
homepage: https://gitea.nek0.eu/nek0/mateamt/
-- A URL where users can report bugs.
-- bug-reports:
license: AGPL-3.0-only
license-file: LICENSE
author: nek0
maintainer: nek0@nek0.eu
license: AGPL-3.0-or-later
license-file: LICENSE
author: nek0
maintainer: nek0@nek0.eu
-- A copyright notice.
-- copyright:
category: Web
extra-source-files: CHANGELOG.md
category: Web
extra-source-files:
README.md
CHANGELOG.md
flag develop
description: compile mateamt in developer mode. Authentication disabled,
default: False
manual: True
description: Compile mateamt in developer mode. Authenitcation disabled.
default: False
manual: True
library
exposed-modules:
Model
Types
Control
API
Classes
Util
Model.Product
Model.Auth
Model.User
Model.Role
Model.Journal
Model.Amount
Model.Avatar
Types.Reader
Types.Refine
Types.Product
Types.Auth
Types.User
Types.Role
Types.Purchase
Types.Journal
Types.Settings
Types.Meta
Types.Amount
Types.Avatar
Control.Product
Control.Auth
Control.User
Control.Buy
Control.Role
Control.Journal
Control.Meta
Control.Avatar
Classes.ToDatabase
Classes.FromDatabase
-- Modules included in this library but not exported.
-- other-modules:
other-extensions:
DataKinds TypeOperators FlexibleInstances MultiParamTypeClasses
RankNTypes ScopedTypeVariables FlexibleContexts OverloadedStrings
Arrows CPP LambdaCase DeriveGeneric TypeFamilies
TypeSynonymInstances
build-depends:
base ^>=4.14.1.0
, text ^>=1.2.4.1
, time ^>=1.9.3
, mtl ^>=2.2.2
, containers ^>=0.6.2.1
, bytestring ^>=0.10.12.0
, base16-bytestring
, base64-bytestring
, random-bytestring
, servant
, servant-server
, servant-rawm >= 0.3.0.0
, servant-rawm-server
, opaleye
, aeson
, profunctors
, product-profunctors
, postgresql-simple
, warp
, wai
, wai-logger
, http-types
, http-api-data
, stm
, pureMD5
, extra
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall
executable mateamt
main-is: AppMain.hs
other-modules: AppTypes
, AppTypes.Configuration
, Janitor
, Paths_mateamt
-- other-extensions:
build-depends: base >=4.12.0.0 && < 5
, mateamt
, text
, bytestring
, base16-bytestring
, containers
, mtl
, opaleye
, postgresql-simple
, postgresql-simple-migration
, stm
, network
, servant
, servant-server
, time
, warp
, wai
, wai-logger
, wai-middleware-throttle
, HsYAML >= 0.2.1.0
, optparse-applicative
, case-insensitive
, iproute
, clock
hs-source-dirs: app
ghc-options: -Wall
default-language: Haskell2010
main-is: Main.hs
-- Modules included in this executable, other than Main.
library
exposed-modules: API
, Control
, Control.Buy
, Control.Journal
, Control.User
, Control.Product
, Control.Auth
, Control.Avatar
, Control.Meta
, Control.Role
, Model
, Model.User
, Model.Product
, Model.Auth
, Model.Amount
, Model.Journal
, Model.Avatar
, Model.Role
, Types
, Types.Auth
, Types.Product
, Types.Reader
, Types.Refine
, Types.User
, Types.Purchase
, Types.Amount
, Types.Journal
, Types.Avatar
, Types.Meta
, Types.Role
, Classes
, Classes.FromDatabase
, Classes.ToDatabase
, Util
-- other-extensions:
build-depends: base >=4.12.0.0 && < 5
, servant
, servant-server
, servant-rawm >= 0.3.0.0
, servant-rawm-server
, opaleye
, aeson
, text
, time
, profunctors
, product-profunctors
, postgresql-simple
, warp
, wai
, wai-logger
, http-types
, http-api-data
, bytestring
, base16-bytestring
, base64-bytestring
, random-bytestring
, containers
, stm
, mtl
, pureMD5
, extra
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall
if flag(develop)
cpp-options: -DDEVELOP
other-modules:
AppTypes
AppTypes.Configuration
Janitor
Paths_mateamt
other-extensions:
DataKinds TypeOperators FlexibleInstances MultiParamTypeClasses
RankNTypes ScopedTypeVariables FlexibleContexts OverloadedStrings
Arrows CPP LambdaCase DeriveGeneric TypeFamilies
TypeSynonymInstances
build-depends:
base ^>=4.14.1.0
, mateamt
, text ^>=1.2.4.1
, time ^>=1.9.3
, mtl ^>=2.2.2
, containers ^>=0.6.2.1
, bytestring ^>=0.10.12.0
, base16-bytestring
, opaleye
, postgresql-simple
, postgresql-simple-migration
, stm
, network
, servant
, servant-server
, warp
, wai
, wai-logger
, wai-middleware-throttle
, HsYAML >= 0.2.1.0
, optparse-applicative
, case-insensitive
, iproute
, clock
hs-source-dirs: app
default-language: Haskell2010
ghc-options: -Wall
test-suite spec
type: exitcode-stdio-1.0
main-is: Main.hs
hs-source-dirs: test
ghc-options: -Wall
build-depends: base
, mateamt
, hspec
, hspec-wai
, hspec-wai-json
, warp
, wai
, pg-transact
, tmp-postgres
, bytestring
, resource-pool
, postgresql-simple
other-modules: TestUtil
, Spec
, AppMainSpec
default-language: Haskell2010
build-tool-depends: hspec-discover:hspec-discover
test-suite mateamt-test
default-language: Haskell2010
type: exitcode-stdio-1.0
hs-source-dirs: test
ghc-options: -Wall
main-is: TestMain.hs
build-depends:
base ^>=4.14.1.0
, mateamt
, text ^>=1.2.4.1
, time ^>=1.9.3
, mtl ^>=2.2.2
, containers ^>=0.6.2.1
, bytestring ^>=0.10.12.0
, hspec
, hspec-wai
, hspec-wai-json
, warp
, wai
, pg-transact
, tmp-postgres
, resource-pool
, postgresql-simple
build-tool-depends:
hspec-discover:hspec-discover
other-modules:
TestUtil
AppMainSpec

10
src/Control/Buy.hs

@ -44,11 +44,11 @@ buy auth pds = do
newBalance <- userBalanceSelect conn auid
userUpdateTimestamp auth
let result = PurchaseResult
( if newBalance < 0
then PurchaseDebtful
else PurchaseOK
)
missing
( if newBalance < 0
then PurchaseDebtful
else PurchaseOK
)
missing
userNotify auth real result
return result
Nothing -> do

6
src/Control/User.hs

@ -148,5 +148,7 @@ userNotify
-> [PurchaseDetail]
-> PurchaseResult
-> MateHandler ()
userNotify (Just (auid, method)) boughtItems (PruchaseResult flag missing) = do
userNotify (Just (auid, method)) boughtItems (PurchaseResult flag missing) = do
throwError $ err501
{ errBody = "userNotify: Not implemented yet"
}

9
src/Types/Settings.hs

@ -3,20 +3,23 @@ module Types.Settings where
import qualified Data.Text as T
import Classes
data Settings = Settings
{ settingsCurrency :: T.Text
, settingsDecimalPlaces :: Int
, settingsBlockRegistration :: Bool
}
deriving (Show)
instance ToDatabase Settings where
data InTuple Settings = (T.Text, Int, Bool)
type InTuple Settings = (T.Text, Int, Bool)
toDatabase (Settings currency places reg) = (currency, places, reg)
instance FromDatabase Settins where
instance FromDatabase Settings where
data OutTuple Settings = (T.Text, Int, Bool)
type OutTuple Settings = (T.Text, Int, Bool)
fromDatabase (currency, places, reg) = Settings currency places reg

0
test/Main.hs → test/TestMain.hs

Loading…
Cancel
Save