From 5052da408a92789628bef30c83ad6da65d7d6fc9 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 10 Mar 2017 00:43:03 +0100
Subject: Bar.hs

---
 bragi.nix    | 33 +++++++++++++++++++++++++
 bragi/bar.hs | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 113 insertions(+)
 create mode 100755 bragi/bar.hs

diff --git a/bragi.nix b/bragi.nix
index 7e29ec43..474ccb1a 100644
--- a/bragi.nix
+++ b/bragi.nix
@@ -282,6 +282,7 @@ in rec {
       ExecStart = ''${pkgs.thermoprint-server}/bin/thermoprint-server --force-reconf'';
       User = users.extraUsers."thermoprint".name;
       Group = users.extraUsers."thermoprint".group;
+      WorkingDirectory = "~";
     };
   };
 
@@ -292,6 +293,30 @@ in rec {
       ExecStart = ''${pkgs.thermoprint-webgui}/bin/thermoprint-webgui -P 80 -A localhost -F /thermoprint/api/ -a "localhost" -p 8081'';
       User = users.extraUsers."thermoprint".name;
       Group = users.extraUsers."thermoprint".group;
+      WorkingDirectory = "~";
+    };
+  };
+
+  users.extraUsers."bar" = {
+    name = "bar";
+    group = "bar";
+    isSystemUser = true;
+    createHome = true;
+    home = "/var/lib/bar";
+  };
+
+  systemd.services."bar" = {
+    environment = {
+      PORT = 8082;
+    };
+    requires = [ "postgresql.service" ];
+    wantedBy = [ "default.target" ];
+    serviceConfig = {
+      Type = "simple";
+      ExecStart = ./bragi/bar.hs;
+      User = users.extraUsers."bar".name;
+      Group = users.extraUsers."bar".group;
+      WorkingDirectory = "~";
     };
   };
 
@@ -348,6 +373,10 @@ in rec {
         location /thermoprint/ {
           proxy_pass http://localhost:8081/;
         }
+
+        location /bar/ {
+          proxy_pass http://localhost:8082/;
+        };
       }
     '';
   };
@@ -361,6 +390,10 @@ in rec {
       CREATE USER thermoprint;
       CREATE DATABASE thermoprint WITH OWNER = thermoprint;
       GRANT ALL ON DATABASE thermoprint TO thermoprint;
+
+      CREATE USER bar;
+      CREATE DATABASE bar WITH OWNER = bar;
+      GRANT ALL ON DATABASE bar TO bar;
     '';
   };
 
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 @@
+#! /usr/bin/env nix-shell
+#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (p: with p; [ yesod persistent-postgresql ])"
+
+
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE FlexibleInstances          #-}
+  
+
+import Yesod
+import Database.Persist.Postgresql
+import Control.Monad.Logger (runStderrLoggingT)
+import Control.Monad.Reader
+
+import Data.Time.Calendar
+
+import Data.Text (Text)
+import qualified Data.Text as Text
+
+import Data.Map.Lazy (Map)
+import qualified Data.Map.Lazy as Map
+
+import Data.Aeson
+
+
+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
+Item
+    kind Text
+    bought Day Maybe
+    expires Day Maybe
+    opened Day Maybe
+    deriving Show
+|]
+
+instance ToJSON Item where
+  toJSON Item{..} = object
+    [ "kind" .= itemKind
+    , "bought" .= itemBought
+    , "expires" .= itemExpires
+    , "opened" .= itemOpened
+    ]
+  
+instance ToJSON (Entity Item) where
+  toJSON = entityIdToJSON
+
+
+data BarInventory = BarInventory
+  { sqlPool :: ConnectionPool
+  }
+
+mkYesod "BarInventory" [parseRoutes|
+/ InventoryR GET
+|]
+
+instance Yesod BarInventory
+
+instance YesodPersist BarInventory where
+  type YesodPersistBackend BarInventory = SqlBackend
+
+  runDB action = runSqlPool action . sqlPool =<< getYesod
+
+
+main = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT $ do
+  sqlPool <- ask
+  liftIO . warpEnv $ BarInventory{..}
+
+
+getInventoryR :: Handler TypedContent
+getInventoryR = do
+  stock <- runDB $ selectList [] []
+  
+  selectRep $ do
+    provideRep . return . toJSON $ (stock :: [Entity Item])
-- 
cgit v1.2.3