diff options
-rw-r--r-- | bragi.nix | 33 | ||||
-rwxr-xr-x | bragi/bar.hs | 80 |
2 files changed, 113 insertions, 0 deletions
@@ -282,6 +282,7 @@ in rec { | |||
282 | ExecStart = ''${pkgs.thermoprint-server}/bin/thermoprint-server --force-reconf''; | 282 | ExecStart = ''${pkgs.thermoprint-server}/bin/thermoprint-server --force-reconf''; |
283 | User = users.extraUsers."thermoprint".name; | 283 | User = users.extraUsers."thermoprint".name; |
284 | Group = users.extraUsers."thermoprint".group; | 284 | Group = users.extraUsers."thermoprint".group; |
285 | WorkingDirectory = "~"; | ||
285 | }; | 286 | }; |
286 | }; | 287 | }; |
287 | 288 | ||
@@ -292,6 +293,30 @@ in rec { | |||
292 | ExecStart = ''${pkgs.thermoprint-webgui}/bin/thermoprint-webgui -P 80 -A localhost -F /thermoprint/api/ -a "localhost" -p 8081''; | 293 | ExecStart = ''${pkgs.thermoprint-webgui}/bin/thermoprint-webgui -P 80 -A localhost -F /thermoprint/api/ -a "localhost" -p 8081''; |
293 | User = users.extraUsers."thermoprint".name; | 294 | User = users.extraUsers."thermoprint".name; |
294 | Group = users.extraUsers."thermoprint".group; | 295 | Group = users.extraUsers."thermoprint".group; |
296 | WorkingDirectory = "~"; | ||
297 | }; | ||
298 | }; | ||
299 | |||
300 | users.extraUsers."bar" = { | ||
301 | name = "bar"; | ||
302 | group = "bar"; | ||
303 | isSystemUser = true; | ||
304 | createHome = true; | ||
305 | home = "/var/lib/bar"; | ||
306 | }; | ||
307 | |||
308 | systemd.services."bar" = { | ||
309 | environment = { | ||
310 | PORT = 8082; | ||
311 | }; | ||
312 | requires = [ "postgresql.service" ]; | ||
313 | wantedBy = [ "default.target" ]; | ||
314 | serviceConfig = { | ||
315 | Type = "simple"; | ||
316 | ExecStart = ./bragi/bar.hs; | ||
317 | User = users.extraUsers."bar".name; | ||
318 | Group = users.extraUsers."bar".group; | ||
319 | WorkingDirectory = "~"; | ||
295 | }; | 320 | }; |
296 | }; | 321 | }; |
297 | 322 | ||
@@ -348,6 +373,10 @@ in rec { | |||
348 | location /thermoprint/ { | 373 | location /thermoprint/ { |
349 | proxy_pass http://localhost:8081/; | 374 | proxy_pass http://localhost:8081/; |
350 | } | 375 | } |
376 | |||
377 | location /bar/ { | ||
378 | proxy_pass http://localhost:8082/; | ||
379 | }; | ||
351 | } | 380 | } |
352 | ''; | 381 | ''; |
353 | }; | 382 | }; |
@@ -361,6 +390,10 @@ in rec { | |||
361 | CREATE USER thermoprint; | 390 | CREATE USER thermoprint; |
362 | CREATE DATABASE thermoprint WITH OWNER = thermoprint; | 391 | CREATE DATABASE thermoprint WITH OWNER = thermoprint; |
363 | GRANT ALL ON DATABASE thermoprint TO thermoprint; | 392 | GRANT ALL ON DATABASE thermoprint TO thermoprint; |
393 | |||
394 | CREATE USER bar; | ||
395 | CREATE DATABASE bar WITH OWNER = bar; | ||
396 | GRANT ALL ON DATABASE bar TO bar; | ||
364 | ''; | 397 | ''; |
365 | }; | 398 | }; |
366 | 399 | ||
diff --git a/bragi/bar.hs b/bragi/bar.hs new file mode 100755 index 00000000..43e1306b --- /dev/null +++ b/bragi/bar.hs | |||
@@ -0,0 +1,80 @@ | |||
1 | #! /usr/bin/env nix-shell | ||
2 | #! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (p: with p; [ yesod persistent-postgresql ])" | ||
3 | |||
4 | |||
5 | {-# LANGUAGE RecordWildCards #-} | ||
6 | {-# LANGUAGE FlexibleContexts #-} | ||
7 | {-# LANGUAGE GADTs #-} | ||
8 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
9 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
10 | {-# LANGUAGE OverloadedStrings #-} | ||
11 | {-# LANGUAGE QuasiQuotes #-} | ||
12 | {-# LANGUAGE TemplateHaskell #-} | ||
13 | {-# LANGUAGE TypeFamilies #-} | ||
14 | {-# LANGUAGE FlexibleInstances #-} | ||
15 | |||
16 | |||
17 | import Yesod | ||
18 | import Database.Persist.Postgresql | ||
19 | import Control.Monad.Logger (runStderrLoggingT) | ||
20 | import Control.Monad.Reader | ||
21 | |||
22 | import Data.Time.Calendar | ||
23 | |||
24 | import Data.Text (Text) | ||
25 | import qualified Data.Text as Text | ||
26 | |||
27 | import Data.Map.Lazy (Map) | ||
28 | import qualified Data.Map.Lazy as Map | ||
29 | |||
30 | import Data.Aeson | ||
31 | |||
32 | |||
33 | share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| | ||
34 | Item | ||
35 | kind Text | ||
36 | bought Day Maybe | ||
37 | expires Day Maybe | ||
38 | opened Day Maybe | ||
39 | deriving Show | ||
40 | |] | ||
41 | |||
42 | instance ToJSON Item where | ||
43 | toJSON Item{..} = object | ||
44 | [ "kind" .= itemKind | ||
45 | , "bought" .= itemBought | ||
46 | , "expires" .= itemExpires | ||
47 | , "opened" .= itemOpened | ||
48 | ] | ||
49 | |||
50 | instance ToJSON (Entity Item) where | ||
51 | toJSON = entityIdToJSON | ||
52 | |||
53 | |||
54 | data BarInventory = BarInventory | ||
55 | { sqlPool :: ConnectionPool | ||
56 | } | ||
57 | |||
58 | mkYesod "BarInventory" [parseRoutes| | ||
59 | / InventoryR GET | ||
60 | |] | ||
61 | |||
62 | instance Yesod BarInventory | ||
63 | |||
64 | instance YesodPersist BarInventory where | ||
65 | type YesodPersistBackend BarInventory = SqlBackend | ||
66 | |||
67 | runDB action = runSqlPool action . sqlPool =<< getYesod | ||
68 | |||
69 | |||
70 | main = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT $ do | ||
71 | sqlPool <- ask | ||
72 | liftIO . warpEnv $ BarInventory{..} | ||
73 | |||
74 | |||
75 | getInventoryR :: Handler TypedContent | ||
76 | getInventoryR = do | ||
77 | stock <- runDB $ selectList [] [] | ||
78 | |||
79 | selectRep $ do | ||
80 | provideRep . return . toJSON $ (stock :: [Entity Item]) | ||