got it working again after some idle time

This commit is contained in:
nek0 2021-06-09 23:45:43 +02:00
parent e472a92fde
commit 0d7c68836b
8 changed files with 209 additions and 161 deletions

View file

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

View file

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

View file

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

View file

@ -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 -- A longer description of the package.
version: 0.0.0.0
synopsis: A whole new matemat
-- description: -- description:
homepage: https://gitea.nek0.eu/nek0/mateamt/
-- A URL where users can report bugs.
-- bug-reports: -- bug-reports:
license: AGPL-3.0-only license: AGPL-3.0-or-later
license-file: LICENSE license-file: LICENSE
author: nek0 author: nek0
maintainer: nek0@nek0.eu maintainer: nek0@nek0.eu
-- A copyright notice.
-- copyright: -- copyright:
category: Web category: Web
extra-source-files: CHANGELOG.md extra-source-files:
README.md
CHANGELOG.md
flag develop flag develop
description: compile mateamt in developer mode. Authentication disabled, description: Compile mateamt in developer mode. Authenitcation disabled.
default: False default: False
manual: True manual: True
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
library library
exposed-modules: API exposed-modules:
, Control Model
, Control.Buy Types
, Control.Journal Control
, Control.User API
, Control.Product Classes
, Control.Auth Util
, Control.Avatar Model.Product
, Control.Meta Model.Auth
, Control.Role Model.User
, Model Model.Role
, Model.User Model.Journal
, Model.Product Model.Amount
, Model.Auth Model.Avatar
, Model.Amount Types.Reader
, Model.Journal Types.Refine
, Model.Avatar Types.Product
, Model.Role Types.Auth
, Types Types.User
, Types.Auth Types.Role
, Types.Product Types.Purchase
, Types.Reader Types.Journal
, Types.Refine Types.Settings
, Types.User Types.Meta
, Types.Purchase Types.Amount
, Types.Amount Types.Avatar
, Types.Journal Control.Product
, Types.Avatar Control.Auth
, Types.Meta Control.User
, Types.Role Control.Buy
, Classes Control.Role
, Classes.FromDatabase Control.Journal
, Classes.ToDatabase Control.Meta
, Util Control.Avatar
-- other-extensions: Classes.ToDatabase
build-depends: base >=4.12.0.0 && < 5 Classes.FromDatabase
, 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
test-suite spec -- Modules included in this library but not exported.
type: exitcode-stdio-1.0 -- other-modules:
main-is: Main.hs other-extensions:
hs-source-dirs: test DataKinds TypeOperators FlexibleInstances MultiParamTypeClasses
ghc-options: -Wall RankNTypes ScopedTypeVariables FlexibleContexts OverloadedStrings
build-depends: base Arrows CPP LambdaCase DeriveGeneric TypeFamilies
, mateamt TypeSynonymInstances
, hspec
, hspec-wai build-depends:
, hspec-wai-json base ^>=4.14.1.0
, warp , text ^>=1.2.4.1
, wai , time ^>=1.9.3
, pg-transact , mtl ^>=2.2.2
, tmp-postgres , containers ^>=0.6.2.1
, bytestring , bytestring ^>=0.10.12.0
, resource-pool , base16-bytestring
, postgresql-simple , base64-bytestring
other-modules: TestUtil , random-bytestring
, Spec , servant
, AppMainSpec , servant-server
default-language: Haskell2010 , servant-rawm >= 0.3.0.0
build-tool-depends: hspec-discover:hspec-discover , 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: Main.hs
-- Modules included in this executable, other than Main.
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 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

View file

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

View file

@ -148,5 +148,7 @@ userNotify
-> [PurchaseDetail] -> [PurchaseDetail]
-> PurchaseResult -> PurchaseResult
-> MateHandler () -> 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"
}

View file

@ -3,20 +3,23 @@ module Types.Settings where
import qualified Data.Text as T import qualified Data.Text as T
import Classes
data Settings = Settings data Settings = Settings
{ settingsCurrency :: T.Text { settingsCurrency :: T.Text
, settingsDecimalPlaces :: Int , settingsDecimalPlaces :: Int
, settingsBlockRegistration :: Bool , settingsBlockRegistration :: Bool
} }
deriving (Show)
instance ToDatabase Settings where 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) 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 fromDatabase (currency, places, reg) = Settings currency places reg