Compare commits

..

No commits in common. "master" and "get_meta" have entirely different histories.

29 changed files with 813 additions and 476 deletions

2
.gitignore vendored
View file

@ -8,5 +8,3 @@ dist/
.ghc* .ghc*
cabal.project.* cabal.project.*
*.bak* *.bak*
.direnv/
.envrc

153
.plan.nix/mateamt.nix Normal file
View file

@ -0,0 +1,153 @@
let
buildDepError = pkg:
builtins.throw ''
The Haskell package set does not contain the package: ${pkg} (build dependency).
If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
'';
sysDepError = pkg:
builtins.throw ''
The Nixpkgs package set does not contain the package: ${pkg} (system dependency).
You may need to augment the system package mapping in haskell.nix so that it can be found.
'';
pkgConfDepError = pkg:
builtins.throw ''
The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency).
You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found.
'';
exeDepError = pkg:
builtins.throw ''
The local executable components do not include the component: ${pkg} (executable dependency).
'';
legacyExeDepError = pkg:
builtins.throw ''
The Haskell package set does not contain the package: ${pkg} (executable dependency).
If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
'';
buildToolDepError = pkg:
builtins.throw ''
Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency).
If this is a system dependency:
You may need to augment the system package mapping in haskell.nix so that it can be found.
If this is a Haskell dependency:
If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
'';
in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
{
flags = { develop = false; };
package = {
specVersion = "2.4";
identifier = { name = "mateamt"; version = "0.0.0.0"; };
license = "AGPL-3.0-only";
copyright = "";
maintainer = "nek0@nek0.eu";
author = "nek0";
homepage = "";
url = "";
synopsis = "A whole new matemat";
description = "";
buildType = "Simple";
isLocal = true;
detailLevel = "FullDetails";
licenseFiles = [ "LICENSE" ];
dataDir = "";
dataFiles = [];
extraSrcFiles = [ "CHANGELOG.md" ];
extraTmpFiles = [];
extraDocFiles = [];
};
components = {
"library" = {
depends = [
(hsPkgs."base" or (buildDepError "base"))
(hsPkgs."servant" or (buildDepError "servant"))
(hsPkgs."servant-server" or (buildDepError "servant-server"))
(hsPkgs."servant-rawm" or (buildDepError "servant-rawm"))
(hsPkgs."opaleye" or (buildDepError "opaleye"))
(hsPkgs."aeson" or (buildDepError "aeson"))
(hsPkgs."text" or (buildDepError "text"))
(hsPkgs."time" or (buildDepError "time"))
(hsPkgs."profunctors" or (buildDepError "profunctors"))
(hsPkgs."product-profunctors" or (buildDepError "product-profunctors"))
(hsPkgs."postgresql-simple" or (buildDepError "postgresql-simple"))
(hsPkgs."warp" or (buildDepError "warp"))
(hsPkgs."wai" or (buildDepError "wai"))
(hsPkgs."wai-logger" or (buildDepError "wai-logger"))
(hsPkgs."http-types" or (buildDepError "http-types"))
(hsPkgs."http-api-data" or (buildDepError "http-api-data"))
(hsPkgs."bytestring" or (buildDepError "bytestring"))
(hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring"))
(hsPkgs."base64-bytestring" or (buildDepError "base64-bytestring"))
(hsPkgs."random-bytestring" or (buildDepError "random-bytestring"))
(hsPkgs."containers" or (buildDepError "containers"))
(hsPkgs."stm" or (buildDepError "stm"))
(hsPkgs."mtl" or (buildDepError "mtl"))
(hsPkgs."pureMD5" or (buildDepError "pureMD5"))
];
buildable = true;
modules = [
"API"
"Control"
"Control/Buy"
"Control/Journal"
"Control/User"
"Control/Product"
"Control/Auth"
"Control/Avatar"
"Model"
"Model/User"
"Model/Product"
"Model/Auth"
"Model/Amount"
"Model/Journal"
"Model/Avatar"
"Types"
"Types/Auth"
"Types/Product"
"Types/Reader"
"Types/Refine"
"Types/User"
"Types/Purchase"
"Types/Amount"
"Types/Journal"
"Types/Avatar"
"Util"
];
hsSourceDirs = [ "src" ];
};
exes = {
"mateamt" = {
depends = [
(hsPkgs."base" or (buildDepError "base"))
(hsPkgs."mateamt" or (buildDepError "mateamt"))
(hsPkgs."text" or (buildDepError "text"))
(hsPkgs."bytestring" or (buildDepError "bytestring"))
(hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring"))
(hsPkgs."containers" or (buildDepError "containers"))
(hsPkgs."mtl" or (buildDepError "mtl"))
(hsPkgs."opaleye" or (buildDepError "opaleye"))
(hsPkgs."postgresql-simple" or (buildDepError "postgresql-simple"))
(hsPkgs."stm" or (buildDepError "stm"))
(hsPkgs."network" or (buildDepError "network"))
(hsPkgs."servant" or (buildDepError "servant"))
(hsPkgs."servant-server" or (buildDepError "servant-server"))
(hsPkgs."time" or (buildDepError "time"))
(hsPkgs."warp" or (buildDepError "warp"))
(hsPkgs."wai" or (buildDepError "wai"))
(hsPkgs."wai-logger" or (buildDepError "wai-logger"))
(hsPkgs."HsYAML" or (buildDepError "HsYAML"))
(hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative"))
];
buildable = true;
modules = [ "AppTypes" "AppTypes/Configuration" "Janitor" ];
hsSourceDirs = [ "app" ];
mainPath = [ "Main.hs" ];
};
};
};
} // rec { src = (pkgs.lib).mkDefault ../../mateamt; }

135
.plan.nix/matebeamter.nix Normal file
View file

@ -0,0 +1,135 @@
let
buildDepError = pkg:
builtins.throw ''
The Haskell package set does not contain the package: ${pkg} (build dependency).
If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
'';
sysDepError = pkg:
builtins.throw ''
The Nixpkgs package set does not contain the package: ${pkg} (system dependency).
You may need to augment the system package mapping in haskell.nix so that it can be found.
'';
pkgConfDepError = pkg:
builtins.throw ''
The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency).
You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found.
'';
exeDepError = pkg:
builtins.throw ''
The local executable components do not include the component: ${pkg} (executable dependency).
'';
legacyExeDepError = pkg:
builtins.throw ''
The Haskell package set does not contain the package: ${pkg} (executable dependency).
If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
'';
buildToolDepError = pkg:
builtins.throw ''
Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency).
If this is a system dependency:
You may need to augment the system package mapping in haskell.nix so that it can be found.
If this is a Haskell dependency:
If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
'';
in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
{
flags = {};
package = {
specVersion = "2.4";
identifier = { name = "matebeamter"; version = "0.0.0.0"; };
license = "AGPL-3.0-only";
copyright = "";
maintainer = "nek0@nek0.eu";
author = "nek0";
homepage = "";
url = "";
synopsis = "A reference frontent to mateamt";
description = "";
buildType = "Simple";
isLocal = true;
detailLevel = "FullDetails";
licenseFiles = [ "LICENSE" ];
dataDir = "";
dataFiles = [];
extraSrcFiles = [ "CHANGELOG.md" ];
extraTmpFiles = [];
extraDocFiles = [];
};
components = {
exes = {
"matebeamter" = {
depends = [
(hsPkgs."base" or (buildDepError "base"))
(hsPkgs."mateamt" or (buildDepError "mateamt"))
(hsPkgs."servant" or (buildDepError "servant"))
(hsPkgs."servant-server" or (buildDepError "servant-server"))
(hsPkgs."servant-client" or (buildDepError "servant-client"))
(hsPkgs."servant-client-core" or (buildDepError "servant-client-core"))
(hsPkgs."servant-blaze" or (buildDepError "servant-blaze"))
(hsPkgs."servant-rawm" or (buildDepError "servant-rawm"))
(hsPkgs."aeson" or (buildDepError "aeson"))
(hsPkgs."blaze-html" or (buildDepError "blaze-html"))
(hsPkgs."blaze-markup" or (buildDepError "blaze-markup"))
(hsPkgs."text" or (buildDepError "text"))
(hsPkgs."bytestring" or (buildDepError "bytestring"))
(hsPkgs."hashable" or (buildDepError "hashable"))
(hsPkgs."warp" or (buildDepError "warp"))
(hsPkgs."wai" or (buildDepError "wai"))
(hsPkgs."wai-logger" or (buildDepError "wai-logger"))
(hsPkgs."wai-session" or (buildDepError "wai-session"))
(hsPkgs."http-client" or (buildDepError "http-client"))
(hsPkgs."http-api-data" or (buildDepError "http-api-data"))
(hsPkgs."http-types" or (buildDepError "http-types"))
(hsPkgs."cookie" or (buildDepError "cookie"))
(hsPkgs."mtl" or (buildDepError "mtl"))
(hsPkgs."i18n" or (buildDepError "i18n"))
(hsPkgs."cookie" or (buildDepError "cookie"))
(hsPkgs."split" or (buildDepError "split"))
(hsPkgs."random-bytestring" or (buildDepError "random-bytestring"))
(hsPkgs."base64-bytestring" or (buildDepError "base64-bytestring"))
(hsPkgs."cryptonite" or (buildDepError "cryptonite"))
(hsPkgs."stm" or (buildDepError "stm"))
(hsPkgs."stm-containers" or (buildDepError "stm-containers"))
(hsPkgs."either" or (buildDepError "either"))
(hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative"))
(hsPkgs."HsYAML" or (buildDepError "HsYAML"))
];
buildable = true;
modules = [
"API"
"Client"
"ClientAuth"
"Util"
"Hash"
"Types"
"Types/Auth"
"Types/Page"
"Types/Reader"
"Types/Views"
"Types/User"
"Types/Orphans"
"Types/Configuration"
"Control"
"Control/Auth"
"Control/User"
"Control/Buy"
"Control/Journal"
"View"
"View/Scaffold"
"View/Auth"
"View/User"
"View/Buy"
"View/Journal"
];
hsSourceDirs = [ "src" ];
mainPath = [ "Main.hs" ];
};
};
};
} // rec { src = (pkgs.lib).mkDefault .././.; }

23
default.nix Normal file
View file

@ -0,0 +1,23 @@
let
# Import the Haskell.nix library,
pkgs = import <nixpkgs> (import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/master.tar.gz));
# Import the file you will create in the stack-to-nix or cabal-to-nix step.
my-pkgs = import ./pkgs.nix;
# Cabal projects use this:
pkgSet = pkgs.haskell-nix.mkCabalProjectPkgSet {
plan-pkgs = my-pkgs;
pkg-def-extras = [];
modules = [
# specific package overrides would go here
# example:
# packages.cbors.package.ghcOptions = "-Werror";
# packages.cbors.patches = [ ./one.patch ];
# packages.cbors.flags.optimize-gmp = false;
# It may be better to set flags in `cabal.project` instead
# (`plan-to-nix` will include them as defaults).
];
};
in pkgSet.config.hsPkgs // { _config = pkgSet.config; }

View file

@ -1,84 +0,0 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1705309234,
"narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"mateamt-src": {
"inputs": {
"flake-utils": [
"flake-utils"
],
"nixpkgs": [
"nixpkgs"
]
},
"locked": {
"lastModified": 1709116606,
"narHash": "sha256-eFkahVy1E25k2xrozWg8pFuuAZJc9TXU0i7LnnRlp+Y=",
"ref": "refs/heads/master",
"rev": "f2b7b60231e6f465eb0a28fc30f7b7f73a7b73ae",
"revCount": 293,
"type": "git",
"url": "https://gitea.nek0.eu/nek0/mateamt"
},
"original": {
"type": "git",
"url": "https://gitea.nek0.eu/nek0/mateamt"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1709116111,
"narHash": "sha256-V7BbC39cGDOzJsCsmg+hCdBu1Tuhqs7kLcPxw86STh4=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "b84d9f029fa675d5ef312f032f322889149daa82",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"mateamt-src": "mateamt-src",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

View file

@ -1,51 +0,0 @@
{
description = "A game stub written in Haskell";
inputs = {
nixpkgs.url = "github:NixOS/nixpkgs";
flake-utils.url = "github:numtide/flake-utils";
mateamt-src = {
url = "git+https://gitea.nek0.eu/nek0/mateamt";
inputs = {
nixpkgs.follows = "nixpkgs";
flake-utils.follows = "flake-utils";
};
};
};
outputs = { self, nixpkgs, flake-utils, mateamt-src }:
flake-utils.lib.eachDefaultSystem (system:
let
pkgs = nixpkgs.legacyPackages.${system};
haskellPackages = pkgs.haskellPackages.override {
overrides = hself: hsuper: {
i18n = with pkgs.haskell.lib;
doJailbreak (unmarkBroken (dontCheck hsuper.i18n));
};
};
jailbreakUnbreak = pkg:
pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
packageName = "matebeamter";
in rec {
packages.${packageName} = # (ref:haskell-package-def)
haskellPackages.callCabal2nix packageName self rec {
mateamt = mateamt-src.defaultPackage.${system};
};
defaultPackage = self.packages.${system}.${packageName};
devShell = haskellPackages.shellFor {
packages = p: [ defaultPackage ];
withHoogle = true;
buildInputs = with haskellPackages; [
haskell-language-server
ghcid
cabal-install
];
};
});
}

View file

@ -46,9 +46,8 @@ executable matebeamter
, View.Buy , View.Buy
, View.Journal , View.Journal
, View.Product , View.Product
, Paths_matebeamter
-- other-extensions: -- other-extensions:
build-depends: base >=4.12.0.0 && < 5 build-depends: base ^>=4.12.0.0
, mateamt , mateamt
, servant , servant
, servant-server , servant-server
@ -64,7 +63,6 @@ executable matebeamter
, hashable , hashable
, warp , warp
, wai , wai
, wai-app-static
, wai-logger , wai-logger
, wai-session , wai-session
, http-client , http-client
@ -79,9 +77,10 @@ executable matebeamter
, base64-bytestring , base64-bytestring
, cryptonite , cryptonite
, stm , stm
, stm-containers
, either , either
, optparse-applicative , optparse-applicative
, HsYAML ^>=0.2.1.0 , HsYAML
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall

342
pkgs.nix Normal file
View file

@ -0,0 +1,342 @@
{
pkgs = hackage:
{
packages = {
"focus".revision = (((hackage."focus")."1.0.1.3").revisions).default;
"warp".revision = (((hackage."warp")."3.3.4").revisions).default;
"warp".flags.allow-sendfilefd = true;
"warp".flags.network-bytestring = false;
"warp".flags.warp-debug = false;
"http-client".revision = (((hackage."http-client")."0.6.4").revisions).default;
"http-client".flags.network-uri = true;
"cookie".revision = (((hackage."cookie")."0.4.5").revisions).default;
"void".revision = (((hackage."void")."0.7.3").revisions).default;
"void".flags.safe = false;
"semigroupoids".revision = (((hackage."semigroupoids")."5.3.4").revisions).default;
"semigroupoids".flags.comonad = true;
"semigroupoids".flags.doctests = true;
"semigroupoids".flags.unordered-containers = true;
"semigroupoids".flags.distributive = true;
"semigroupoids".flags.tagged = true;
"semigroupoids".flags.containers = true;
"semigroupoids".flags.contravariant = true;
"byteorder".revision = (((hackage."byteorder")."1.0.4").revisions).default;
"singleton-bool".revision = (((hackage."singleton-bool")."0.1.5").revisions).default;
"free".revision = (((hackage."free")."5.1.3").revisions).default;
"Only".revision = (((hackage."Only")."0.1").revisions).default;
"cereal".revision = (((hackage."cereal")."0.5.8.1").revisions).default;
"cereal".flags.bytestring-builder = false;
"exceptions".revision = (((hackage."exceptions")."0.10.3").revisions).default;
"binary".revision = (((hackage."binary")."0.8.6.0").revisions).default;
"attoparsec-iso8601".revision = (((hackage."attoparsec-iso8601")."1.0.1.0").revisions).default;
"attoparsec-iso8601".flags.fast = false;
"attoparsec-iso8601".flags.developer = false;
"product-profunctors".revision = (((hackage."product-profunctors")."0.10.0.0").revisions).default;
"stm-hamt".revision = (((hackage."stm-hamt")."1.2.0.4").revisions).default;
"ghc-prim".revision = (((hackage."ghc-prim")."0.5.3").revisions).default;
"utf8-string".revision = (((hackage."utf8-string")."1.0.1.1").revisions).default;
"old-time".revision = (((hackage."old-time")."1.1.0.3").revisions).default;
"bifunctors".revision = (((hackage."bifunctors")."5.5.6").revisions).default;
"bifunctors".flags.semigroups = true;
"bifunctors".flags.tagged = true;
"split".revision = (((hackage."split")."0.2.3.3").revisions).default;
"stm".revision = (((hackage."stm")."2.5.0.0").revisions).default;
"dec".revision = (((hackage."dec")."0.0.3").revisions).default;
"unix-time".revision = (((hackage."unix-time")."0.4.7").revisions).default;
"http2".revision = (((hackage."http2")."2.0.3").revisions).default;
"http2".flags.devel = false;
"appar".revision = (((hackage."appar")."0.1.8").revisions).default;
"case-insensitive".revision = (((hackage."case-insensitive")."1.2.1.0").revisions).default;
"network-byte-order".revision = (((hackage."network-byte-order")."0.1.2.0").revisions).default;
"unix".revision = (((hackage."unix")."2.7.2.2").revisions).default;
"mtl".revision = (((hackage."mtl")."2.2.2").revisions).default;
"network-uri".revision = (((hackage."network-uri")."2.6.1.0").revisions).default;
"network-info".revision = (((hackage."network-info")."0.2.0.10").revisions).default;
"foldl".revision = (((hackage."foldl")."1.4.5").revisions).default;
"zlib".revision = (((hackage."zlib")."0.6.2.1").revisions).default;
"zlib".flags.non-blocking-ffi = false;
"zlib".flags.pkg-config = false;
"rts".revision = (((hackage."rts")."1.0").revisions).default;
"mmorph".revision = (((hackage."mmorph")."1.1.3").revisions).default;
"cmdargs".revision = (((hackage."cmdargs")."0.10.20").revisions).default;
"cmdargs".flags.testprog = false;
"cmdargs".flags.quotation = true;
"primitive-extras".revision = (((hackage."primitive-extras")."0.8").revisions).default;
"easy-file".revision = (((hackage."easy-file")."0.2.2").revisions).default;
"servant-rawm".revision = (((hackage."servant-rawm")."0.3.2.0").revisions).default;
"servant-rawm".flags.buildexample = false;
"cryptonite".revision = (((hackage."cryptonite")."0.26").revisions).default;
"cryptonite".flags.support_sse = false;
"cryptonite".flags.integer-gmp = true;
"cryptonite".flags.support_rdrand = true;
"cryptonite".flags.support_aesni = true;
"cryptonite".flags.support_deepseq = true;
"cryptonite".flags.support_pclmuldq = false;
"cryptonite".flags.check_alignment = false;
"cryptonite".flags.old_toolchain_inliner = false;
"postgresql-simple".revision = (((hackage."postgresql-simple")."0.6.2").revisions).default;
"adjunctions".revision = (((hackage."adjunctions")."4.4").revisions).default;
"cryptohash-md5".revision = (((hackage."cryptohash-md5")."0.11.100.1").revisions).default;
"invariant".revision = (((hackage."invariant")."0.5.3").revisions).default;
"http-api-data".revision = (((hackage."http-api-data")."0.4.1.1").revisions).default;
"http-api-data".flags.use-text-show = false;
"distributive".revision = (((hackage."distributive")."0.6.1").revisions).default;
"distributive".flags.semigroups = true;
"distributive".flags.tagged = true;
"vector-th-unbox".revision = (((hackage."vector-th-unbox")."0.2.1.7").revisions).default;
"bytestring-builder".revision = (((hackage."bytestring-builder")."0.10.8.2.0").revisions).default;
"bytestring-builder".flags.bytestring_has_builder = true;
"QuickCheck".revision = (((hackage."QuickCheck")."2.13.2").revisions).default;
"QuickCheck".flags.templatehaskell = true;
"scientific".revision = (((hackage."scientific")."0.3.6.2").revisions).default;
"scientific".flags.integer-simple = false;
"scientific".flags.bytestring-builder = false;
"time-manager".revision = (((hackage."time-manager")."0.0.0").revisions).default;
"stm-containers".revision = (((hackage."stm-containers")."1.1.0.4").revisions).default;
"parallel".revision = (((hackage."parallel")."3.2.2.0").revisions).default;
"deepseq".revision = (((hackage."deepseq")."1.4.4.0").revisions).default;
"random".revision = (((hackage."random")."1.1").revisions).default;
"opaleye".revision = (((hackage."opaleye")."0.6.7004.1").revisions).default;
"uuid-types".revision = (((hackage."uuid-types")."1.0.3").revisions).default;
"string-conversions".revision = (((hackage."string-conversions")."0.4.0.1").revisions).default;
"optparse-applicative".revision = (((hackage."optparse-applicative")."0.15.1.0").revisions).default;
"network".revision = (((hackage."network")."3.1.1.1").revisions).default;
"word8".revision = (((hackage."word8")."0.1.3").revisions).default;
"crypto-api".revision = (((hackage."crypto-api")."0.13.3").revisions).default;
"crypto-api".flags.all_cpolys = false;
"splitmix".revision = (((hackage."splitmix")."0.0.3").revisions).default;
"splitmix".flags.optimised-mixer = false;
"splitmix".flags.random = true;
"async".revision = (((hackage."async")."2.2.2").revisions).default;
"async".flags.bench = false;
"dlist".revision = (((hackage."dlist")."0.8.0.7").revisions).default;
"semigroups".revision = (((hackage."semigroups")."0.19.1").revisions).default;
"semigroups".flags.bytestring = true;
"semigroups".flags.unordered-containers = true;
"semigroups".flags.text = true;
"semigroups".flags.tagged = true;
"semigroups".flags.containers = true;
"semigroups".flags.binary = true;
"semigroups".flags.hashable = true;
"semigroups".flags.transformers = true;
"semigroups".flags.deepseq = true;
"semigroups".flags.bytestring-builder = false;
"semigroups".flags.template-haskell = true;
"pureMD5".revision = (((hackage."pureMD5")."2.1.3").revisions).default;
"pureMD5".flags.test = false;
"parsec".revision = (((hackage."parsec")."3.1.13.0").revisions).default;
"http-media".revision = (((hackage."http-media")."0.8.0.0").revisions).default;
"hsc2hs".revision = (((hackage."hsc2hs")."0.68.6").revisions).default;
"hsc2hs".flags.in-ghc-tree = false;
"directory".revision = (((hackage."directory")."1.3.3.0").revisions).default;
"transformers-compat".revision = (((hackage."transformers-compat")."0.6.5").revisions).default;
"transformers-compat".flags.five = false;
"transformers-compat".flags.generic-deriving = true;
"transformers-compat".flags.two = false;
"transformers-compat".flags.five-three = true;
"transformers-compat".flags.mtl = true;
"transformers-compat".flags.four = false;
"transformers-compat".flags.three = false;
"template-haskell".revision = (((hackage."template-haskell")."2.14.0.0").revisions).default;
"psqueues".revision = (((hackage."psqueues")."0.2.7.2").revisions).default;
"vector".revision = (((hackage."vector")."0.12.0.3").revisions).default;
"vector".flags.unsafechecks = false;
"vector".flags.internalchecks = false;
"vector".flags.wall = false;
"vector".flags.boundschecks = true;
"call-stack".revision = (((hackage."call-stack")."0.2.0").revisions).default;
"primitive".revision = (((hackage."primitive")."0.7.0.0").revisions).default;
"profunctors".revision = (((hackage."profunctors")."5.5.1").revisions).default;
"time-locale-compat".revision = (((hackage."time-locale-compat")."0.1.1.5").revisions).default;
"time-locale-compat".flags.old-locale = false;
"safe".revision = (((hackage."safe")."0.3.18").revisions).default;
"blaze-builder".revision = (((hackage."blaze-builder")."0.4.1.0").revisions).default;
"base-compat".revision = (((hackage."base-compat")."0.11.0").revisions).default;
"math-functions".revision = (((hackage."math-functions")."0.3.3.0").revisions).default;
"math-functions".flags.system-expm1 = true;
"math-functions".flags.system-erf = true;
"wai-session".revision = (((hackage."wai-session")."0.3.3").revisions).default;
"time-compat".revision = (((hackage."time-compat")."1.9.2.2").revisions).default;
"time-compat".flags.old-locale = false;
"ansi-terminal".revision = (((hackage."ansi-terminal")."0.10.2").revisions).default;
"ansi-terminal".flags.example = false;
"tagged".revision = (((hackage."tagged")."0.8.6").revisions).default;
"tagged".flags.transformers = true;
"tagged".flags.deepseq = true;
"lens".revision = (((hackage."lens")."4.18.1").revisions).default;
"lens".flags.j = false;
"lens".flags.test-properties = true;
"lens".flags.old-inline-pragmas = false;
"lens".flags.test-templates = true;
"lens".flags.trustworthy = true;
"lens".flags.test-doctests = true;
"lens".flags.benchmark-uniplate = false;
"lens".flags.inlining = true;
"lens".flags.dump-splices = false;
"lens".flags.test-hunit = true;
"lens".flags.safe = false;
"servant-blaze".revision = (((hackage."servant-blaze")."0.9").revisions).default;
"unliftio-core".revision = (((hackage."unliftio-core")."0.1.2.0").revisions).default;
"containers".revision = (((hackage."containers")."0.6.0.1").revisions).default;
"deferred-folds".revision = (((hackage."deferred-folds")."0.9.10.1").revisions).default;
"integer-logarithms".revision = (((hackage."integer-logarithms")."1.0.3").revisions).default;
"integer-logarithms".flags.check-bounds = false;
"integer-logarithms".flags.integer-gmp = true;
"servant-docs".revision = (((hackage."servant-docs")."0.11.4").revisions).default;
"base-prelude".revision = (((hackage."base-prelude")."1.3").revisions).default;
"reflection".revision = (((hackage."reflection")."2.1.5").revisions).default;
"reflection".flags.slow = false;
"reflection".flags.template-haskell = true;
"streaming-commons".revision = (((hackage."streaming-commons")."0.2.1.1").revisions).default;
"streaming-commons".flags.use-bytestring-builder = false;
"bytestring".revision = (((hackage."bytestring")."0.10.8.2").revisions).default;
"ansi-wl-pprint".revision = (((hackage."ansi-wl-pprint")."0.6.9").revisions).default;
"ansi-wl-pprint".flags.example = false;
"mwc-random".revision = (((hackage."mwc-random")."0.14.0.0").revisions).default;
"wai".revision = (((hackage."wai")."3.2.2.1").revisions).default;
"basement".revision = (((hackage."basement")."0.0.11").revisions).default;
"cryptohash-sha1".revision = (((hackage."cryptohash-sha1")."0.11.100.1").revisions).default;
"either".revision = (((hackage."either")."5.0.1.1").revisions).default;
"old-locale".revision = (((hackage."old-locale")."1.0.0.7").revisions).default;
"StateVar".revision = (((hackage."StateVar")."1.2").revisions).default;
"vault".revision = (((hackage."vault")."0.3.1.3").revisions).default;
"vault".flags.useghc = true;
"mime-types".revision = (((hackage."mime-types")."0.1.0.9").revisions).default;
"pcg-random".revision = (((hackage."pcg-random")."0.1.3.6").revisions).default;
"contravariant".revision = (((hackage."contravariant")."1.5.2").revisions).default;
"contravariant".flags.semigroups = true;
"contravariant".flags.tagged = true;
"contravariant".flags.statevar = true;
"HsYAML".revision = (((hackage."HsYAML")."0.2.1.0").revisions).default;
"HsYAML".flags.exe = false;
"type-equality".revision = (((hackage."type-equality")."1").revisions).default;
"vector-builder".revision = (((hackage."vector-builder")."0.3.8").revisions).default;
"blaze-markup".revision = (((hackage."blaze-markup")."0.8.2.3").revisions).default;
"postgresql-libpq".revision = (((hackage."postgresql-libpq")."0.9.4.2").revisions).default;
"postgresql-libpq".flags.use-pkg-config = false;
"uuid".revision = (((hackage."uuid")."1.3.13").revisions).default;
"text".revision = (((hackage."text")."1.2.3.1").revisions).default;
"Cabal".revision = (((hackage."Cabal")."2.4.0.1").revisions).default;
"unordered-containers".revision = (((hackage."unordered-containers")."0.2.10.0").revisions).default;
"unordered-containers".flags.debug = false;
"base64-bytestring".revision = (((hackage."base64-bytestring")."1.0.0.2").revisions).default;
"aeson-pretty".revision = (((hackage."aeson-pretty")."0.8.8").revisions).default;
"aeson-pretty".flags.lib-only = false;
"base".revision = (((hackage."base")."4.12.0.0").revisions).default;
"servant-client".revision = (((hackage."servant-client")."0.16.0.1").revisions).default;
"comonad".revision = (((hackage."comonad")."5.0.6").revisions).default;
"comonad".flags.distributive = true;
"comonad".flags.test-doctests = true;
"comonad".flags.containers = true;
"time".revision = (((hackage."time")."1.8.0.2").revisions).default;
"data-default-class".revision = (((hackage."data-default-class")."0.1.2.0").revisions).default;
"universe-base".revision = (((hackage."universe-base")."1.1.1").revisions).default;
"base16-bytestring".revision = (((hackage."base16-bytestring")."0.1.1.6").revisions).default;
"iproute".revision = (((hackage."iproute")."1.7.8").revisions).default;
"transformers".revision = (((hackage."transformers")."0.5.6.2").revisions).default;
"hashable".revision = (((hackage."hashable")."1.3.0.0").revisions).default;
"hashable".flags.sse2 = true;
"hashable".flags.integer-gmp = true;
"hashable".flags.sse41 = false;
"hashable".flags.examples = false;
"wai-extra".revision = (((hackage."wai-extra")."3.0.28").revisions).default;
"wai-extra".flags.build-example = false;
"attoparsec".revision = (((hackage."attoparsec")."0.13.2.3").revisions).default;
"attoparsec".flags.developer = false;
"blaze-html".revision = (((hackage."blaze-html")."0.9.1.2").revisions).default;
"colour".revision = (((hackage."colour")."2.3.5").revisions).default;
"transformers-base".revision = (((hackage."transformers-base")."0.4.5.2").revisions).default;
"transformers-base".flags.orphaninstances = true;
"file-embed".revision = (((hackage."file-embed")."0.0.11").revisions).default;
"entropy".revision = (((hackage."entropy")."0.4.1.5").revisions).default;
"entropy".flags.halvm = false;
"filepath".revision = (((hackage."filepath")."1.4.2.1").revisions).default;
"auto-update".revision = (((hackage."auto-update")."0.1.6").revisions).default;
"servant-client-core".revision = (((hackage."servant-client-core")."0.16").revisions).default;
"unix-compat".revision = (((hackage."unix-compat")."0.5.2").revisions).default;
"unix-compat".flags.old-time = false;
"monad-control".revision = (((hackage."monad-control")."1.0.2.3").revisions).default;
"process".revision = (((hackage."process")."1.6.5.0").revisions).default;
"list-t".revision = (((hackage."list-t")."1.0.4").revisions).default;
"kan-extensions".revision = (((hackage."kan-extensions")."5.2").revisions).default;
"wai-logger".revision = (((hackage."wai-logger")."2.3.6").revisions).default;
"resourcet".revision = (((hackage."resourcet")."1.2.2").revisions).default;
"pretty".revision = (((hackage."pretty")."1.1.3.6").revisions).default;
"cabal-doctest".revision = (((hackage."cabal-doctest")."1.0.8").revisions).default;
"aeson".revision = (((hackage."aeson")."1.4.6.0").revisions).default;
"aeson".flags.cffi = false;
"aeson".flags.fast = false;
"aeson".flags.bytestring-builder = false;
"aeson".flags.developer = false;
"wai-app-static".revision = (((hackage."wai-app-static")."3.1.6.3").revisions).default;
"wai-app-static".flags.print = false;
"http-types".revision = (((hackage."http-types")."0.12.3").revisions).default;
"ghc-boot-th".revision = (((hackage."ghc-boot-th")."8.6.5").revisions).default;
"i18n".revision = (((hackage."i18n")."0.4.0.0").revisions).default;
"servant-server".revision = (((hackage."servant-server")."0.16.2").revisions).default;
"primitive-unlifted".revision = (((hackage."primitive-unlifted")."0.1.2.0").revisions).default;
"base-orphans".revision = (((hackage."base-orphans")."0.8.1").revisions).default;
"http-date".revision = (((hackage."http-date")."0.0.8").revisions).default;
"random-bytestring".revision = (((hackage."random-bytestring")."0.1.3.2").revisions).default;
"random-bytestring".flags.with-pcg = true;
"servant".revision = (((hackage."servant")."0.16.2").revisions).default;
"th-abstraction".revision = (((hackage."th-abstraction")."0.3.1.0").revisions).default;
"memory".revision = (((hackage."memory")."0.15.0").revisions).default;
"memory".flags.support_bytestring = true;
"memory".flags.support_basement = true;
"memory".flags.support_foundation = true;
"memory".flags.support_deepseq = true;
"fast-logger".revision = (((hackage."fast-logger")."3.0.0").revisions).default;
"bsb-http-chunked".revision = (((hackage."bsb-http-chunked")."0.0.0.4").revisions).default;
"array".revision = (((hackage."array")."0.5.3.0").revisions).default;
"simple-sendfile".revision = (((hackage."simple-sendfile")."0.2.30").revisions).default;
"simple-sendfile".flags.allow-bsd = true;
"integer-gmp".revision = (((hackage."integer-gmp")."1.0.2.0").revisions).default;
};
compiler = {
version = "8.6.5";
nix-name = "ghc865";
packages = {
"binary" = "0.8.6.0";
"ghc-prim" = "0.5.3";
"stm" = "2.5.0.0";
"unix" = "2.7.2.2";
"mtl" = "2.2.2";
"rts" = "1.0";
"deepseq" = "1.4.4.0";
"parsec" = "3.1.13.0";
"directory" = "1.3.3.0";
"template-haskell" = "2.14.0.0";
"containers" = "0.6.0.1";
"bytestring" = "0.10.8.2";
"text" = "1.2.3.1";
"Cabal" = "2.4.0.1";
"base" = "4.12.0.0";
"time" = "1.8.0.2";
"transformers" = "0.5.6.2";
"filepath" = "1.4.2.1";
"process" = "1.6.5.0";
"pretty" = "1.1.3.6";
"ghc-boot-th" = "8.6.5";
"array" = "0.5.3.0";
"integer-gmp" = "1.0.2.0";
};
};
};
extras = hackage:
{
packages = {
mateamt = ./.plan.nix/mateamt.nix;
matebeamter = ./.plan.nix/matebeamter.nix;
};
};
modules = [
({ lib, ... }:
{
packages = {
"mateamt" = { flags = { "develop" = lib.mkOverride 900 false; }; };
"matebeamter" = { flags = {}; };
};
})
];
}

View file

@ -1,20 +1,6 @@
{ pkgs ? import <nixpkgs> {}}: { pkgs ? import <nixpkgs> {} }:
let let
# create a modified haskell package set with my package inside it and broken dependencies hsPkgs = import ./default.nix;
# jailbroken.
hpkgs = pkgs.haskellPackages.override {
overrides = hself: hsuper: {
matebeamter = hself.callCabal2nix "matebeamter" (gitignore ./.) {};
mateamt = hself.callCabal2nix "mateamt" (gitignore ../mateamt) {};
i18n = with pkgs.haskell.lib;
doJailbreak (unmarkBroken (dontCheck hsuper.i18n));
pg-transact = with pkgs.haskell.lib;
doJailbreak (unmarkBroken (dontCheck hsuper.pg-transact));
token-bucket = with pkgs.haskell.lib;
doJailbreak (unmarkBroken (dontCheck hsuper.token-bucket));
};
};
gitignore = dir: pkgs.nix-gitignore.gitignoreSource [] dir;
in in
hpkgs.matebeamter.env hsPkgs.matebeamter.components.all

View file

@ -11,7 +11,7 @@ module API where
import Servant.API import Servant.API
import Servant.Links import Servant.Links
import Servant.RawM -- import Servant.RawM
import Servant.HTML.Blaze import Servant.HTML.Blaze
import Data.Proxy import Data.Proxy
@ -27,8 +27,7 @@ import qualified "mateamt" Types as MT
import Types import Types
type UserAPI = type UserAPI =
Header "Cookie" T.Text :> ( Header "Cookie" T.Text :> (Get '[HTML] UserSelectPage
QueryParam "refine" MT.UserRefine :> Get '[HTML] UserSelectPage
:<|> "user" :> Capture "id" Int :> QueryParam "refine" MT.ProductRefine :<|> "user" :> Capture "id" Int :> QueryParam "refine" MT.ProductRefine
:> Get '[HTML] UserOverviewPage :> Get '[HTML] UserOverviewPage
:<|> "user" :> Capture "id" Int :> "buy" :<|> "user" :> Capture "id" Int :> "buy"
@ -97,7 +96,6 @@ type UserAPI =
:> Post '[HTML] UserSelectPage :> Post '[HTML] UserSelectPage
:<|> "auth" :> "logout" :<|> "auth" :> "logout"
:> Post '[HTML] UserOverviewPage :> Post '[HTML] UserOverviewPage
:<|> "static" :> RawM
) )
( userSelectLink :<|> ( userSelectLink :<|>
@ -124,6 +122,5 @@ type UserAPI =
productPostNewLink :<|> productPostNewLink :<|>
authLink :<|> authLink :<|>
authPostLink :<|> authPostLink :<|>
authLogoutLink :<|> authLogoutLink
staticLink
) = allLinks (Proxy :: Proxy UserAPI) ) = allLinks (Proxy :: Proxy UserAPI)

View file

@ -6,10 +6,10 @@ module ClientAuth where
import Servant.API (AuthProtect) import Servant.API (AuthProtect)
import Servant.Client.Core import Servant.Client.Core
type instance AuthClientData (AuthProtect "Bearer") = String type instance AuthClientData (AuthProtect "header-auth") = String
authenticateReq :: String -> Request -> Request authenticateReq :: String -> Request -> Request
authenticateReq = addHeader "Bearer" authenticateReq = addHeader "Authentication"
nonAuthenticateRequest :: String -> Request -> Request nonAuthenticateRequest :: String -> Request -> Request
nonAuthenticateRequest _ = id nonAuthenticateRequest _ = id

View file

@ -117,10 +117,9 @@ authPostControl
-> Maybe T.Text -> Maybe T.Text
-> AuthReturn -> AuthReturn
-> UserHandler UserSelectPage -> UserHandler UserSelectPage
authPostControl mcookies@(Just cookies) mDestination (AuthReturn pass method) = do authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
let mticket = lookup ("x-ticket-" <> fromString (show method)) $ let mticket = lookup ("x-ticket-" <> fromString (show method)) $
parseCookieText cookies parseCookieText cookies
(_, _, loc, l10n, _, _, _) <- controlInit mcookies
case mticket of case mticket of
Just ticket -> do Just ticket -> do
(ReadState _ backend _ _ _) <- ask (ReadState _ backend _ _ _) <- ask
@ -146,7 +145,7 @@ authPostControl mcookies@(Just cookies) mDestination (AuthReturn pass method) =
(read $ T.unpack user) (read $ T.unpack user)
Nothing Nothing
) )
_ -> errHeaders $ redirect303 (userSelectLink Nothing) _ -> errHeaders $ redirect303 userSelectLink
throwError $ err303 throwError $ err303
{ errHeaders = headers ++ { errHeaders = headers ++
[ ( "Set-Cookie" [ ( "Set-Cookie"
@ -159,18 +158,15 @@ authPostControl mcookies@(Just cookies) mDestination (AuthReturn pass method) =
, "x-method=" <> fromString (show $ fromEnum method) <>";Path=/") , "x-method=" <> fromString (show $ fromEnum method) <>";Path=/")
] ]
} }
Right MT.Denied -> throwError ( Right MT.Denied -> throwError $ err401
addMessage (translate l10n loc "Authentication failed!") $ { errBody = "Authentication failed!"
redirect303 (userSelectLink Nothing) }
)
Left err -> throwError $ err500 Left err -> throwError $ err500
{ errBody = fromString $ show err { errBody = fromString $ show err
} }
Nothing -> throwError $ err400 Nothing -> throwError $ err400
{ errBody = "No ticket cookie present." { errBody = "No ticket cookie present."
} }
where
translate l10n locale = localize l10n locale . gettext
authPostControl Nothing _ _ = throwError $ err400 authPostControl Nothing _ _ = throwError $ err400
{ errBody = "No ticket cookie present." { errBody = "No ticket cookie present."
} }
@ -188,7 +184,7 @@ authLogoutControl mcookie = do
backend backend
case eReturn of case eReturn of
Right _ -> do Right _ -> do
let redirectHeaders = errHeaders (redirect303 $ userSelectLink Nothing) let redirectHeaders = errHeaders (redirect303 userSelectLink)
unsetCookiesHeaders = map unsetCookiesHeaders = map
(\c -> (\c ->
( "Set-Cookie" ( "Set-Cookie"

View file

@ -42,14 +42,14 @@ buyControl
-> [MT.PurchaseDetail] -> [MT.PurchaseDetail]
-> Bool -> Bool
-> UserHandler BuyConfirmPage -> UserHandler BuyConfirmPage
buyControl mcookie uid pds forceBuy = do buyControl mcookie uid pds forceBuy =
(ReadState l10n backend _ symbol version) <- ask
let (token, _) = parseTokenAndUser mcookie
loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
if not (null pds) if not (null pds)
then do then do
let pids = map MT.purchaseDetailProduct pds (ReadState l10n backend _ symbol version) <- ask
let (token, _) = parseTokenAndUser mcookie
loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
pids = map MT.purchaseDetailProduct pds
epsovs <- liftIO $ runClientM epsovs <- liftIO $ runClientM
(productShortList (Just MT.AllProducts)) (productShortList (Just MT.AllProducts))
backend backend
@ -85,14 +85,9 @@ buyControl mcookie uid pds forceBuy = do
Left err -> Left err ->
throwError $ throwError $
addMessage (fromString $ show err) $ addMessage (fromString $ show err) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink
else else
throwError ( throwError (redirect303 $ userOverviewLink uid Nothing)
addMessage (translate l10n loc "Please select items for purchase") $
redirect303 (userOverviewLink uid Nothing)
)
where
translate l10n locale = localize l10n locale . gettext
purchaseControl purchaseControl
:: Maybe T.Text :: Maybe T.Text
@ -184,7 +179,7 @@ purchaseControl mcookie uid pds forceBuy = do
backend backend
throwError throwError
$ addMessage message $ addMessage message
$ redirect303 (userSelectLink Nothing) $ redirect303 userSelectLink
translate l10n locale = localize l10n locale . gettext translate l10n locale = localize l10n locale . gettext
cashBuyOverviewControl cashBuyOverviewControl
@ -245,7 +240,7 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
addMessage addMessage
(translate l10n loc "Please Pay" <> (translate l10n loc "Please Pay" <>
": " <> formatMoney price <> symbol) $ ": " <> formatMoney price <> symbol) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink
(MT.PurchaseResult (MT.PayAmount price) miss) -> do (MT.PurchaseResult (MT.PayAmount price) miss) -> do
eproducts <- liftIO $ runClientM eproducts <- liftIO $ runClientM
(productShortList (productShortList
@ -273,13 +268,13 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
[] []
prods prods
)) ))
$ redirect303 (userSelectLink Nothing) $ redirect303 userSelectLink
Left err -> Left err ->
throwError $ err500 throwError $ err500
{ errBody = fromString (show err) { errBody = fromString (show err)
} }
Left err -> Left err ->
handleClientErr err Nothing (Just (userSelectLink Nothing)) handleClientErr err Nothing (Just userSelectLink)
else else
throwError throwError
$ addMessage (translate l10n loc "Please choose your product(s)") $ addMessage (translate l10n loc "Please choose your product(s)")

View file

@ -15,7 +15,7 @@ import Data.String
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.I18n import Data.Text.I18n
import Data.Maybe (fromMaybe, maybe, fromJust) import Data.Maybe (fromMaybe, maybe)
import Network.HTTP.Types.Status (Status(..)) import Network.HTTP.Types.Status (Status(..))
@ -59,11 +59,11 @@ journalControl mcookie mpage = do
else else
throwError $ throwError $
addMessage (fromString $ show err) $ addMessage (fromString $ show err) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink
othererr -> othererr ->
throwError $ throwError $
addMessage (fromString $ show othererr) $ addMessage (fromString $ show othererr) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink
Nothing -> Nothing ->
redirectOverAuth Nothing (Just $ journalLink mpage) Nothing redirectOverAuth Nothing (Just $ journalLink mpage) Nothing
@ -85,7 +85,7 @@ journalPostCheckControl mcookie (CashCheck floatAmount) = do
eresult <- liftIO $ runClientM eresult <- liftIO $ runClientM
(journalPostCashCheck (journalPostCashCheck
(mkAuthenticatedRequest token authenticateReq) (mkAuthenticatedRequest token authenticateReq)
(MT.JournalCashCheck (fromJust muser) $ floor $ floatAmount * 100) (MT.JournalCashCheck $ floor $ floatAmount * 100)
) )
backend backend
case eresult of case eresult of
@ -93,7 +93,7 @@ journalPostCheckControl mcookie (CashCheck floatAmount) = do
addMessage (translate l10n loc "Cash check received and processed") $ addMessage (translate l10n loc "Cash check received and processed") $
redirect303 (journalLink Nothing) redirect303 (journalLink Nothing)
Left err -> Left err ->
handleClientErr err muser (Just journalGetCheckLink) handleClientErr err (read <$> muser) (Just journalGetCheckLink)
Nothing -> Nothing ->
redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing
where where

View file

@ -45,7 +45,7 @@ productGetPriceList mcookie mrefine = do
Left err -> Left err ->
throwError $ throwError $
addMessage (fromString $ show err) $ addMessage (fromString $ show err) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink
productGetRefill productGetRefill
:: Maybe T.Text :: Maybe T.Text
@ -63,7 +63,7 @@ productGetRefill mcookie = do
Left err -> Left err ->
throwError $ throwError $
addMessage (fromString $ show err) $ addMessage (fromString $ show err) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink
Nothing -> Nothing ->
redirectOverAuth Nothing (Just productGetRefillLink) Nothing redirectOverAuth Nothing (Just productGetRefillLink) Nothing
@ -87,9 +87,9 @@ productPostRefill mcookie refills = do
addMessage (translate l10n loc "Refill successfull") $ addMessage (translate l10n loc "Refill successfull") $
redirect303 productGetRefillLink redirect303 productGetRefillLink
Left err -> Left err ->
handleClientErr err muser (Just productGetRefillLink) handleClientErr err (read <$> muser) (Just productGetRefillLink)
Nothing -> Nothing ->
redirectOverAuth muser (Just productGetRefillLink) Nothing redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
where where
translate l10n loc = localize l10n loc . gettext translate l10n loc = localize l10n loc . gettext
@ -103,7 +103,7 @@ productGetNew mcookie = do
-- TODO: Fetch avatars and suppliers -- TODO: Fetch avatars and suppliers
return $ productNewPage l10n loc version mcookie symbol return $ productNewPage l10n loc version mcookie symbol
Nothing -> Nothing ->
redirectOverAuth muser (Just productGetRefillLink) Nothing redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
productPostNew productPostNew
:: Maybe T.Text :: Maybe T.Text
@ -134,8 +134,8 @@ productPostNew mcookie (ProductSubmit ident flPrice ml max apc ppc artnr) = do
Right _ -> Right _ ->
throwError $ throwError $
addMessage (translate l10n loc "Product created successfully") $ addMessage (translate l10n loc "Product created successfully") $
redirect303 (userOverviewLink user Nothing) redirect303 (userOverviewLink (read user) Nothing)
Nothing -> Nothing ->
redirectOverAuth muser (Just productGetRefillLink) Nothing redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
where where
translate l10n loc = localize l10n loc . gettext translate l10n loc = localize l10n loc . gettext

View file

@ -36,16 +36,13 @@ import Hash
import API import API
import Util import Util
userSelectControl userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage
:: Maybe T.Text userSelectControl mcookie = do
-> Maybe MT.UserRefine (ReadState l10n backend _ symbol version) <- ask
-> UserHandler UserSelectPage
userSelectControl mcookie mrefine = do
(ReadState l10n backend _ _ version) <- ask
let loc = Locale let loc = Locale
(fromMaybe "en" $ lookup "locale" . parseCookieText =<< mcookie) (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
euser <- liftIO $ runClientM euser <- liftIO $ runClientM
(userList mrefine) (userList Nothing)
backend backend
case euser of case euser of
Right uss -> Right uss ->
@ -55,21 +52,24 @@ userSelectControl mcookie mrefine = do
userNewControl :: Maybe T.Text -> UserHandler UserNewPage userNewControl :: Maybe T.Text -> UserHandler UserNewPage
userNewControl mcookie = do userNewControl mcookie = do
(ReadState l10n _ _ _ version) <- ask (ReadState l10n _ _ symbol version) <- ask
let loc = Locale let loc = Locale
(fromMaybe "en" $ lookup "locale" . parseCookieText =<< mcookie) (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
return $ userNewPage l10n loc version mcookie return $ userNewPage l10n loc version mcookie
userNewPostControl userNewPostControl
:: Maybe T.Text :: Maybe T.Text
-> MT.UserSubmit -> MT.UserSubmit
-> UserHandler UserSelectPage -> UserHandler UserSelectPage
userNewPostControl _ us = do userNewPostControl _ us@(MT.UserSubmit _ _ pass) = do
backend <- asks rsBackend backend <- asks rsBackend
hashedPass <- hashPassword pass
void $ liftIO $ runClientM void $ liftIO $ runClientM
(userNew us) (userNew $us
{ MT.userSubmitPassHash = hashedPass
})
backend backend
throwError $ redirect303 (userSelectLink Nothing) throwError $ redirect303 userSelectLink
userOverviewControl userOverviewControl
:: Maybe T.Text :: Maybe T.Text
@ -100,7 +100,7 @@ userOverviewControl mcookie uid mRefine = do
(Right ud, Right prods) -> (Right ud, Right prods) ->
case mMethod of case mMethod of
Just method -> Just method ->
if mAuthUser == Just uid if fmap read mAuthUser == Just uid
then then
return $ return $
userOverviewPage userOverviewPage
@ -118,7 +118,7 @@ userOverviewControl mcookie uid mRefine = do
(Just $ userOverviewLink uid mRefine) (Just $ userOverviewLink uid mRefine)
mRefine mRefine
Nothing -> Nothing ->
redirectOverAuth mAuthUser Nothing mRefine redirectOverAuth (read <$> mAuthUser) Nothing mRefine
(Left uerr, Right _) -> case uerr of (Left uerr, Right _) -> case uerr of
FailureResponse _ resp -> FailureResponse _ resp ->
if statusCode (responseStatusCode resp) == 401 if statusCode (responseStatusCode resp) == 401
@ -146,7 +146,8 @@ userRechargeControl
-> Int -> Int
-> UserHandler UserRechargePage -> UserHandler UserRechargePage
userRechargeControl mcookie uid = do userRechargeControl mcookie uid = do
(ReadState l10n _ _ symbol version) <- ask l10n <- asks rsL10n
(ReadState l10n backend _ symbol version) <- ask
let loc = localeFromCookie mcookie let loc = localeFromCookie mcookie
return $ userRechargePage l10n loc version mcookie uid symbol return $ userRechargePage l10n loc version mcookie uid symbol
@ -185,7 +186,7 @@ userManageControl
-> Int -> Int
-> UserHandler UserManagePage -> UserHandler UserManagePage
userManageControl mcookie uid = do userManageControl mcookie uid = do
(ReadState l10n backend _ _ version) <- ask (ReadState l10n backend _ symbol version) <- ask
let loc = localeFromCookie mcookie let loc = localeFromCookie mcookie
(token, mAuthUser) = parseTokenAndUser mcookie (token, mAuthUser) = parseTokenAndUser mcookie
eUserDetails <- liftIO $ eUserDetails <- liftIO $
@ -198,7 +199,7 @@ userManageControl mcookie uid = do
backend backend
case (eUserDetails, eAuthOverviews) of case (eUserDetails, eAuthOverviews) of
(Right userDetails, Right authOverviews) -> (Right userDetails, Right authOverviews) ->
if Just uid == mAuthUser if Just uid == fmap read mAuthUser
then then
return $ return $
userManagePage l10n loc userDetails authOverviews version mcookie userManagePage l10n loc userDetails authOverviews version mcookie
@ -223,7 +224,7 @@ userManageDetailsSubmitControl mcookie uid uds = do
case eReturn of case eReturn of
Right _ -> throwError $ redirect303 (userManageLink uid) Right _ -> throwError $ redirect303 (userManageLink uid)
Left err -> Left err ->
handleErrors mAuthUser (Just $ userManageLink uid) [Just err] handleErrors (fmap read mAuthUser) (Just $ userManageLink uid) [Just err]
userManageAuthCreateControl userManageAuthCreateControl
:: Maybe T.Text :: Maybe T.Text
@ -243,7 +244,7 @@ userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) =
case eReturn of case eReturn of
Right _ -> throwError $ redirect303 $ userManageLink uid Right _ -> throwError $ redirect303 $ userManageLink uid
Left err -> Left err ->
handleErrors mAuthUser (Just $ userManageLink uid) [Just err] handleErrors (fmap read mAuthUser) (Just $ userManageLink uid) [Just err]
userManageAuthDeleteControl userManageAuthDeleteControl
:: Maybe T.Text :: Maybe T.Text
@ -264,6 +265,5 @@ userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
then then
throwError (redirect303 $ userManageLink uid) throwError (redirect303 $ userManageLink uid)
else else
handleErrors mAuthUser Nothing [Just err] handleErrors (fmap read mAuthUser) Nothing [Just err]
_ -> handleErrors mAuthUser (Just $ userSelectLink Nothing) _ -> handleErrors (fmap read mAuthUser) (Just userSelectLink) [Just err]
[Just err]

View file

@ -20,8 +20,6 @@ import Data.YAML
import Options.Applicative import Options.Applicative
import Network.Wai.Application.Static
-- imports from "mateamt" -- imports from "mateamt"
import qualified "mateamt" Types as MT import qualified "mateamt" Types as MT
@ -109,7 +107,6 @@ userApp initState = serveWithContext userApi EmptyContext $
:<|> authControl mcookie :<|> authControl mcookie
:<|> authPostControl mcookie :<|> authPostControl mcookie
:<|> authLogoutControl mcookie :<|> authLogoutControl mcookie
:<|> (\_ -> return $ staticApp (defaultFileServerSettings "static")) mcookie
) )
userApi :: Proxy UserAPI userApi :: Proxy UserAPI

View file

@ -9,4 +9,5 @@ import Types.Views as T
import Types.User as T import Types.User as T
import Types.Journal as T import Types.Journal as T
import Types.Product as T import Types.Product as T
import Types.Orphans as T
import Types.Configuration as T import Types.Configuration as T

View file

@ -1,10 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
module Types.Page where module Types.Page where
import qualified Data.Text as T import qualified Data.Text as T
import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
data Page markup attr = Page data Page markup attr = Page
{ pageTitle :: attr -- ^ Page title { pageTitle :: attr -- ^ Page title
@ -36,16 +34,7 @@ initPage title = Page
title title
mempty mempty
mempty mempty
(H.link mempty
H.! HA.rel "stylesheet"
H.! HA.type_ "text/css"
H.! HA.href "/static/css/bootstrap.min.css"
<>
H.link
H.! HA.rel "stylesheet"
H.! HA.type_ "text/css"
H.! HA.href "/static/css/style.css"
)
template template
:: Page H.Html T.Text :: Page H.Html T.Text

View file

@ -8,15 +8,17 @@ module Util where
import Servant hiding (addHeader) import Servant hiding (addHeader)
import Servant.Client import Servant.Client
import Servant.Client.Core.Request
import qualified Text.Blaze.Html5.Attributes as HA import qualified Text.Blaze.Html5.Attributes as HA
import Text.Blaze.Internal
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding import Data.Text.Encoding
import Data.Text.I18n import Data.Text.I18n
import Data.ByteString.Builder
import Data.List (intercalate) import Data.List (intercalate)
import Data.List.Split (chunksOf) import Data.List.Split (chunksOf)
@ -24,11 +26,13 @@ import Data.String (fromString)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Web.Cookie
import Text.Printf (printf) import Text.Printf (printf)
import Network.HTTP.Types.Status import Network.HTTP.Types.Status
import Control.Monad.Reader (ask) import Control.Monad.Reader (ask, asks)
-- imports from "mateamt" -- imports from "mateamt"
@ -93,13 +97,13 @@ parseCookieText = map
parseTokenAndUser parseTokenAndUser
:: Maybe T.Text :: Maybe T.Text
-> (String, Maybe Int) -> (String, Maybe String)
parseTokenAndUser mcookie = parseTokenAndUser mcookie =
(token, mAuthUser) (token, mAuthUser)
where where
token = T.unpack $ fromMaybe "secret" token = T.unpack $ fromMaybe "secret"
(lookup "x-token" =<< mParsedCookie) (lookup "x-token" =<< mParsedCookie)
mAuthUser = read . T.unpack <$> mAuthUser = T.unpack <$>
(lookup "x-auth-user" =<< mParsedCookie) (lookup "x-auth-user" =<< mParsedCookie)
mParsedCookie = fmap parseCookieText mcookie mParsedCookie = fmap parseCookieText mcookie
@ -107,7 +111,7 @@ localeFromCookie
:: Maybe T.Text :: Maybe T.Text
-> Locale -> Locale
localeFromCookie mcookie = Locale localeFromCookie mcookie = Locale
(fromMaybe "en" $ lookup "locale" . parseCookieText =<< mcookie) (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
handleErrors handleErrors
:: (Traversable t, Show (t (Maybe ClientError))) :: (Traversable t, Show (t (Maybe ClientError)))
@ -148,7 +152,7 @@ redirectOverAuth muid mLink mRefine = do
fromString (show $ linkURI (case (mLink, muid) of fromString (show $ linkURI (case (mLink, muid) of
(Just link, _) -> link (Just link, _) -> link
(Nothing, Just uid) -> userOverviewLink uid mRefine (Nothing, Just uid) -> userOverviewLink uid mRefine
_ -> userSelectLink Nothing _ -> userSelectLink
)))) ))))
throwError throwError
(err303 (err303
@ -173,9 +177,6 @@ redirectOverAuth muid mLink mRefine = do
} }
) )
productBgStyle
:: AttributeValue
-> Attribute
productBgStyle aid = HA.style $ mconcat productBgStyle aid = HA.style $ mconcat
[ "background-image: url(#" <> aid <> ");" -- FILLME [ "background-image: url(#" <> aid <> ");" -- FILLME
, "backgronud-color: blue;" , "backgronud-color: blue;"
@ -188,18 +189,13 @@ productBgStyle aid = HA.style $ mconcat
controlInit controlInit
:: Maybe T.Text :: Maybe T.Text
-> UserHandler (String, Maybe Int, Locale, L10n, ClientEnv, T.Text, T.Text) -> UserHandler (String, Maybe String, Locale, L10n, ClientEnv, T.Text, T.Text)
controlInit mcookie = do controlInit mcookie = do
let (token, muser) = parseTokenAndUser mcookie let (token, muser) = parseTokenAndUser mcookie
loc = localeFromCookie mcookie loc = localeFromCookie mcookie
(ReadState l10n backend _ symbol version) <- ask (ReadState l10n backend _ symbol version) <- ask
return (token, muser, loc, l10n, backend, symbol, version) return (token, muser, loc, l10n, backend, symbol, version)
handleClientErr
:: ClientError
-> Maybe Int
-> Maybe Link
-> UserHandler UserOverviewPage
handleClientErr err muid authTargetLink = handleClientErr err muid authTargetLink =
case err of case err of
FailureResponse _ resp -> FailureResponse _ resp ->
@ -209,8 +205,8 @@ handleClientErr err muid authTargetLink =
else else
throwError $ throwError $
addMessage (fromString $ show err) $ addMessage (fromString $ show err) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink
othererr -> othererr ->
throwError $ throwError $
addMessage (fromString $ show othererr) $ addMessage (fromString $ show othererr) $
redirect303 (userSelectLink Nothing) redirect303 userSelectLink

View file

@ -72,7 +72,7 @@ authPage l10n locale mDestination version mcookie = scaffold
H.! HA.value "" H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
where where

View file

@ -13,7 +13,7 @@ import Data.String (fromString)
import Data.Text.I18n import Data.Text.I18n
import Data.Maybe (isJust, fromJust) import Data.Maybe (isJust, fromJust, fromMaybe)
import Control.Monad (when) import Control.Monad (when)
@ -59,8 +59,8 @@ buyConfirmPage l10n locale uid ziptups total forceBuy version mcookie symbol =
H.! HA.enctype "application/x-www-form-urlencoded" H.! HA.enctype "application/x-www-form-urlencoded"
$ do $ do
mapM_ mapM_
(\( MT.PurchaseDetail _ _ (\( MT.PurchaseDetail pdid amount
, MT.ProductShortOverview pid ident price amount _ mava) -> , MT.ProductShortOverview pid ident price _ _ mava) ->
H.div H.! HA.class_ "form-group required" $ do H.div H.! HA.class_ "form-group required" $ do
H.input H.input
H.! HA.id ("product-select-" <> fromString (show pid)) H.! HA.id ("product-select-" <> fromString (show pid))
@ -116,14 +116,13 @@ buyConfirmPage l10n locale uid ziptups total forceBuy version mcookie symbol =
H.toHtml symbol H.toHtml symbol
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ if forceBuy $ H.toHtml $ if forceBuy
then translate "Buy anyway" then translate "Buy anyway"
else translate "Buy" else translate "Buy"
when forceBuy $ when forceBuy $
H.button H.button
H.! HA.class_ "btn btn-primary"
H.! HA.formnovalidate "formnovalidate" H.! HA.formnovalidate "formnovalidate"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction H.! HA.formaction
@ -140,44 +139,43 @@ buyProductsForm
-> [MT.ProductShortOverview] -> [MT.ProductShortOverview]
-> H.Html -> H.Html
buyProductsForm l10n locale prods = do buyProductsForm l10n locale prods = do
H.div H.! HA.class_ "tile-list" $ mapM_ (\(MT.ProductShortOverview pid ident price amount ml maid) ->
mapM_ (\(MT.ProductShortOverview pid ident _ _ _ maid) -> H.div $ do
H.div H.div
H.! HA.class_ "tile" H.! HA.class_ "form-group optional"
H.!? H.!?
( isJust maid ( isJust maid
, productBgStyle (fromString $ show $ fromJust maid) , productBgStyle (fromString $ show $ fromJust maid)
) )
$ do $ do
H.label H.label
H.! HA.for ("product-select-" <> fromString (show pid)) $ H.! HA.for ("product-select-" <> fromString (show pid)) $
H.toHtml ident H.toHtml ident
H.! HA.class_ "tile-content form-group optional" H.input
H.input H.! HA.id ("product-select-" <> fromString (show pid))
H.! HA.id ("product-select-" <> fromString (show pid)) H.! HA.class_ "form-control product-select"
H.! HA.class_ "form-control product-select" H.! HA.name ("productSelect-" <> fromString (show pid))
H.! HA.class_ "tile-content form-group optional" H.! HA.type_ "checkbox"
H.! HA.name ("productSelect-" <> fromString (show pid)) H.! HA.value "true"
H.! HA.type_ "checkbox" H.div
-- H.! HA.value "true" H.! HA.class_ "form-group optional"
H.div $ do
$ do H.label
H.label H.! HA.for ("product-amount-" <> fromString (show pid)) $
H.! HA.for ("product-amount-" <> fromString (show pid)) $ H.toHtml (translate "Amount")
H.toHtml (translate "Amount") H.input
H.input H.! HA.id ("product-amount-" <> fromString (show pid))
H.! HA.id ("product-amount-" <> fromString (show pid)) H.! HA.class_ "form-control product-amount"
H.! HA.class_ "form-control product-amount" H.! HA.name ("productAmount-" <> fromString (show pid))
H.! HA.name ("productAmount-" <> fromString (show pid)) H.! HA.type_ "number"
H.! HA.type_ "number" H.! HA.min "0"
H.! HA.min "0" H.! HA.step "1"
H.! HA.step "1" H.! HA.value "1"
H.! HA.value "1" )
) prods
prods
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Proceed" $ H.toHtml $ translate "Proceed"
where where

View file

@ -51,14 +51,13 @@ journalPage l10n loc version mcookie mpage entries =
H.th (H.toHtml $ translate "Amount") H.th (H.toHtml $ translate "Amount")
H.th (H.toHtml $ translate "Total amount") H.th (H.toHtml $ translate "Total amount")
mapM_ mapM_
(\(MT.JournalEntry jid time user action amount total) -> (\(MT.JournalEntry jid desc time amount total check) ->
H.tr H.tr
H.!? (action == MT.CashCheck, HA.class_ "checked") H.!? (check, HA.class_ "checked")
$ do $ do
H.td (H.toHtml $ show jid) H.td (H.toHtml $ show jid)
H.td (H.toHtml $ show time) H.td (H.toHtml $ show time)
H.td (H.toHtml $ fromMaybe "" (show <$> user)) H.td (H.toHtml desc)
H.td (H.toHtml $ show action)
H.td (H.toHtml $ formatMoney amount) H.td (H.toHtml $ formatMoney amount)
H.td (H.toHtml $ formatMoney total) H.td (H.toHtml $ formatMoney total)
) )
@ -81,7 +80,6 @@ journalPage l10n loc version mcookie mpage entries =
$ H.toHtml $ translate "Next Page" $ H.toHtml $ translate "Next Page"
H.form $ H.form $
H.button H.button
H.! HA.class_ "btn btn-primary"
H.! HA.type_ "submit" H.! HA.type_ "submit"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction H.! HA.formaction
@ -126,7 +124,7 @@ journalCheckPage l10n loc version mcookie =
H.! HA.value "0" H.! HA.value "0"
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
where where

View file

@ -81,7 +81,7 @@ productRefillPage l10n loc version mcookie prodList =
H.! HA.enctype "application/x-www-form-urlencoded" H.! HA.enctype "application/x-www-form-urlencoded"
$ do $ do
mapM_ mapM_
(\(MT.ProductShortOverview pid ident _ _ _ maid) -> do (\(MT.ProductShortOverview pid ident price amount ml maid) -> do
H.div H.div
H.! HA.class_ "form-group optional" H.! HA.class_ "form-group optional"
H.!? H.!?
@ -154,7 +154,7 @@ productRefillPage l10n loc version mcookie prodList =
prodList prodList
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
where where
@ -288,7 +288,7 @@ productNewPage l10n loc version mcookie symbol =
-} -}
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
where where

View file

@ -14,12 +14,8 @@ import Data.Text.I18n
import Data.Maybe (fromJust, isJust) import Data.Maybe (fromJust, isJust)
import Data.Version (showVersion)
import Control.Monad (when) import Control.Monad (when)
import qualified Paths_matebeamter as MyPath (version)
-- internal imports -- internal imports
import Types.Page import Types.Page
@ -36,7 +32,7 @@ scaffold
-> H.Html -> H.Html
scaffold l10n locale version mcookie page content = template page $ do scaffold l10n locale version mcookie page content = template page $ do
H.header $ H.nav $ H.ul $ do H.header $ H.nav $ H.ul $ do
H.li $ H.a H.! HA.href ("/" <> fromString (show $ linkURI (userSelectLink Nothing))) $ H.li $ H.a H.! HA.href ("/" <> fromString (show $ linkURI userSelectLink)) $
H.toHtml $ translate "Home" H.toHtml $ translate "Home"
maybe maybe
(return ()) (return ())
@ -45,7 +41,7 @@ scaffold l10n locale version mcookie page content = template page $ do
(fromString $ show $ linkURI $ userOverviewLink (read uid) Nothing)) $ (fromString $ show $ linkURI $ userOverviewLink (read uid) Nothing)) $
H.toHtml $ translate "User Page" H.toHtml $ translate "User Page"
) )
(show <$> getLogin mcookie) (getLogin mcookie)
H.hr H.hr
when (isJust message) when (isJust message)
(H.div H.! HA.id "message" H.! HA.class_ "message" $ (H.div H.! HA.id "message" H.! HA.class_ "message" $
@ -56,29 +52,23 @@ scaffold l10n locale version mcookie page content = template page $ do
H.hr H.hr
H.footer $ H.form $ do H.footer $ H.form $ do
H.button H.button
H.! HA.class_ "btn btn-primary"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction ("/" <> H.! HA.formaction ("/" <>
(fromString $ show $ linkURI $ productGetPriceListLink Nothing)) (fromString $ show $ linkURI $ productGetPriceListLink Nothing))
$ H.toHtml $ translate "Price List" $ H.toHtml $ translate "Price List"
-- maybe maybe
-- (return ()) (return ())
-- (\_ -> (\_ ->
-- H.button H.button
-- H.! HA.class_ "btn btn-primary" H.! HA.formmethod "get"
-- H.! HA.formmethod "get" H.! HA.formaction ("/" <>
-- H.! HA.formaction ("/" <> (fromString $ show $ linkURI $ productGetRefillLink))
-- (fromString $ show $ linkURI $ productGetRefillLink)) $ H.toHtml $ translate "Refill stock"
-- $ H.toHtml $ translate "Refill stock" )
-- ) (getLogin mcookie)
-- (getLogin mcookie)
H.div H.div
H.! HA.class_ "backend-version" H.! HA.class_ "backend-version"
$ H.toHtml $ $ H.toHtml $ (translate "Powered by mateamt version") <> " " <> version
(translate "Powered by ") <> "matebeamter " <>
(fromString $ showVersion MyPath.version) <> " " <>
(translate "connected to ") <> "mateamt " <>
version
where where
message = lookup "message" =<< fmap parseCookieText mcookie message = lookup "message" =<< fmap parseCookieText mcookie
translate = localize l10n locale . gettext translate = localize l10n locale . gettext

View file

@ -39,31 +39,18 @@ userSelectPage l10n locale uss version mcookie =
translate "Matebeamter" <> translate "Matebeamter" <>
" - " <> " - " <>
translate "Home" translate "Home"
) $ H.ul ) $ do
H.! HA.class_ "tile-list" H.a H.! HA.href ("/" <> fromString
$ do (show $ linkURI $ cashBuyLink Nothing)
H.li H.! HA.class_ "tile function" $ H.a ) $
H.! HA.class_ "tile-content" H.toHtml $ translate "Buy with cash"
H.! HA.href ("/" <> fromString mapM_ (\(MT.UserSummary uid ident _) ->
(show $ linkURI $ cashBuyLink Nothing) H.a H.! HA.href ("/" <> fromString (show $ linkURI $
) $ userOverviewLink uid Nothing)) $
H.toHtml $ translate "Buy with cash" H.toHtml ident
mapM_ (\(MT.UserSummary uid ident _) -> ) uss
H.li H.! HA.class_ "tile" $ H.a H.a H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
H.! HA.class_ "tile-content" H.toHtml $ translate "New user"
H.! HA.href ("/" <> fromString (show $ linkURI $
userOverviewLink uid Nothing)) $
H.toHtml ident
) uss
H.li H.! HA.class_ "tile function" $ H.a
H.! HA.class_ "tile-content"
H.! HA.href ("/" <> fromString
(show $ linkURI $ userSelectLink (Just MT.OldUsers))) $
H.toHtml $ translate "Show inactive users"
H.li H.! HA.class_ "tile function" $ H.a
H.! HA.class_ "tile-content"
H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
H.toHtml $ translate "New user"
where where
translate = localize l10n locale . gettext translate = localize l10n locale . gettext
@ -96,7 +83,7 @@ userOverviewPage l10n locale method ud pos version mcookie symbol =
H.! HA.enctype "application/x-www-form-urlencoded" $ H.! HA.enctype "application/x-www-form-urlencoded" $
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Logout" $ H.toHtml $ translate "Logout"
case method of case method of
@ -112,7 +99,6 @@ userOverviewPage l10n locale method ud pos version mcookie symbol =
buyForm = do buyForm = do
H.div $ H.form $ H.div $ H.form $
H.button H.button
H.! HA.class_ "btn btn-primary"
H.! HA.type_ "submit" H.! HA.type_ "submit"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction ("/" <> H.! HA.formaction ("/" <>
@ -135,21 +121,18 @@ userSettingsPointer
userSettingsPointer l10n locale uid = userSettingsPointer l10n locale uid =
H.form $ do H.form $ do
H.button H.button
H.! HA.class_ "btn btn-primary"
H.! HA.type_ "submit" H.! HA.type_ "submit"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction H.! HA.formaction
("/" <> fromString (show $ linkURI $ userManageLink uid)) ("/" <> fromString (show $ linkURI $ userManageLink uid))
$ H.toHtml $ translate "Manage user settings" $ H.toHtml $ translate "Manage user settings"
H.button H.button
H.! HA.class_ "btn btn-primary"
H.! HA.type_ "submit" H.! HA.type_ "submit"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction H.! HA.formaction
("/" <> fromString (show $ linkURI $ journalLink Nothing)) ("/" <> fromString (show $ linkURI $ journalLink Nothing))
$ H.toHtml $ translate "View Journal" $ H.toHtml $ translate "View Journal"
H.button H.button
H.! HA.class_ "btn btn-primary"
H.! HA.type_ "submit" H.! HA.type_ "submit"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction H.! HA.formaction
@ -163,19 +146,15 @@ productList
-> H.Html -> H.Html
productList pos = productList pos =
H.p $ H.p $
H.ul H.! HA.class_ "tile-list" $ H.ul H.! HA.class_ "product_list" $
mapM_ mapM_
(\(MT.ProductShortOverview pid ident _ _ _ avatarid) -> (\(MT.ProductShortOverview pid ident _ _ _ avatarid) ->
H.li H.li H.! HA.class_ "product" H.!?
H.! HA.class_ "tile" (isJust avatarid
H.!? , productBgStyle (fromString $ show $ fromJust avatarid)
(isJust avatarid ) $
, productBgStyle (fromString $ show $ fromJust avatarid) H.a H.! HA.href ("#" <> fromString (show pid)) $
) $ H.toHtml ident
H.a
H.! HA.class_ "tile-content"
H.! HA.href ("#" <> fromString (show pid)) $
H.toHtml ident
) )
pos pos
@ -223,7 +202,7 @@ userNewPage l10n locale version mcookie =
H.! HA.value "" H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
where where
@ -260,7 +239,7 @@ userRechargePage l10n locale version mcookie uid symbol =
H.toHtml symbol H.toHtml symbol
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Recharge" $ H.toHtml $ translate "Recharge"
where where
@ -310,13 +289,13 @@ userManagePage l10n locale userDetails authOverviews version mcookie =
(MT.userDetailsEmail userDetails)) (MT.userDetailsEmail userDetails))
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
H.p $ do H.p $ do
H.toHtml $ translate "Authentication details" H.toHtml $ translate "Authentication details"
mapM_ mapM_
(\(MT.AuthOverview aoid _ comment method) -> H.form (\(MT.AuthOverview aoid comment method) -> H.form
H.! HA.method "post" H.! HA.method "post"
H.! HA.action ("/" <> H.! HA.action ("/" <>
fromString (show $ linkURI $ fromString (show $ linkURI $
@ -339,7 +318,7 @@ userManagePage l10n locale userDetails authOverviews version mcookie =
H.! HA.value (fromString $ show aoid) H.! HA.value (fromString $ show aoid)
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Delete" $ H.toHtml $ translate "Delete"
) )
@ -388,7 +367,7 @@ userManagePage l10n locale userDetails authOverviews version mcookie =
H.toHtml $ translate "Primary password" H.toHtml $ translate "Primary password"
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-primary" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
where where

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View file

@ -1,92 +0,0 @@
:root {
--tile-color: #36c30023;
--function-tile-color: #c300d223;
}
body {
margin: 30px;
}
form button, nav ul > li {
margin: 5px;
}
.tile-list, nav ul {
list-style: none;
padding: 0;
}
nav ul > li {
display: inline-block;
border-radius: 6px;
background-color: var(--function-tile-color);
padding : 10px;
}
.tile {
display: inline-flex;
flex-direction: column;
align-content: stretch;
align-items: stretch;
justify-content: center;
border-radius: 6px;
background-color: var(--tile-color);
box-shadow: 0 0 3px #c3c3c3;
margin: 30px 30px 0 5px;
width: 200px;
height: 200px;
text-align: center;
}
.tile > label, .tile > * {
flex: 1 1 auto;
}
.tile-content {
flex: 1 1 auto;
display: flex;
justify-content: center;
flex-direction: column;
align-content: stretch;
align-items: stretch;
}
.tile-content * {
flex: 1 1 auto;
display: inline-block;
width: 100%;
justify-content: center;
flex-direction: column;
align-content: stretch;
align-items: stretch;
margin: 0;
padding: 0;
}
.tile input[type="checkbox"] {
display: none;
}
.tile input[type="checkbox"] + * {
display: none;
opacity: 0;
transition: opacity 0.5s;
}
.tile input[type="checkbox"]:checked + * {
display: inline-block;
opacity: 1;
transition: opacity 0.5s;
}
.function {
background-color: var(--function-tile-color);
}
.tile-list + * {
margin-top: 30px;
}
hr {
margin-top: 30px;
}