Progress

PEA.cabal

@@ -48,6 +48,9 @@ library
         aeson
         , containers
         , servant-server
+        , time
+        , wai
+        , warp
 
 executable pea-srv
     import: shared-properties

flake.nix

@@ -8,7 +8,7 @@
   };
 
   outputs = { self, nixpkgs, flake-utils, haskellNix }:
-    flake-utils.lib.eachSystem ["x86_64-linux"] (system:
+    flake-utils.lib.eachSystem [ "x86_64-linux" ] (system:
       let
         overlays = [
           haskellNix.overlay
@@ -30,19 +30,45 @@
         };
         flake = pkgs.peaProject.flake { };
       in flake // {
-        checks.basic = let sharedModule = { virtualisation.graphics = false; };
+        checks.integration-test = let
+          sharedModule = { virtualisation.graphics = false; };
+          username = "authenticator";
+          pea-port = 8081;
         in pkgs.nixosTest {
           nodes = {
             server = { config, pkgs, ... }: {
-              services.nginx.enable = true;
+              imports = [ sharedModule ];
+              networking.firewall.allowedTCPPorts = [ pea-port ];
+              users = {
+                  mutableUsers = false;
+                  users = {
+                      root.password = "";
+                      "${username}" = {
+                          isSystemUser = true;
+                          group = "${username}";
+                      };
+                  };
+              };
+
+              systemd.services.pea-srv = {
+                  wantedBy = [ "multi-user.target" ];
+                  after = [ "networking.target" ];
+                  script = "${self.packages.${system}.default}/bin/pea-srv";
+                  serviceConfig.User = username;
+              };
             };
+            client = { config, pkgs, ... }: { imports = [ sharedModule ]; };
           };
 
           testScript = ''
-            server.wait_for_open_port(80)
+            server.wait_for_unit("pea-srv.service")
+            client.succeed(
+                "${pkgs.curl}/bin/curl http://server:${toString pea-port}/tasks"
+            )
           '';
         };
 
         packages.default = flake.packages."PEA:exe:pea-srv";
+        devShells.default = flake.devShell;
       });
 }

src/PEA/Server.hs

@@ -8,11 +8,19 @@ import PEA.Server.API
 import PEA.Server.Data
 
 
-server :: Server All
-server = readAllTasks
+taskServer :: Server Tasks
+taskServer = readAllTasks
     :<|> createTask
     :<|> (\i -> readOneTask i :<|> updateTask i :<|> deleteTask i)
 
+userServer :: Server Users
+userServer = readAllUsers
+    :<|> createUser
+    :<|> (\i -> readOneUser i :<|> updateUser i :<|> deleteUser i)
+
+server :: Server All
+server = taskServer :<|> userServer
+
 api :: Proxy All
 api = Proxy
 

src/PEA/Server/API.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -7,6 +8,7 @@
 
 module PEA.Server.API where
 
+import GHC.TypeLits
 import Servant
 
 import PEA.Types

src/PEA/Server/Data.hs

@@ -1,33 +1,46 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module PEA.Server.Data where
 
-import Data.Aeson
-import Data.Foldable (toList)
-import Data.Sequence (fromList, update)
-import GHC.Generics
 import Servant
 
 import PEA.Types
 
-example :: [Task]
-example =
-    [ Task "Test" "testing" (User "mctestface")
-    , Task "Second" "second" (User "mctestface")
+tasks :: [Task]
+tasks =
+    [ emptyTask "first" "test"
+    , emptyTask "second" "test"
     ]
 
-readAllTasks :: Handler [Task]
-readAllTasks = return example
+users :: [User]
+users = [ emptyUser "test" ]
 
-createTask :: Task -> Handler [Task]
-createTask task = return $ task : example
+readAllTasks :: Handler [Task]
+readAllTasks = return tasks
+
+createTask :: Task -> Handler NoContent
+createTask _ = return NoContent
 
 readOneTask :: Int -> Handler Task
-readOneTask i = return $ example !! i
+readOneTask i = return $ tasks !! i
 
-updateTask :: Int -> Task -> Handler [Task]
-updateTask i task = let s = fromList example in return $ toList $ update i task s
+updateTask :: Int -> Task -> Handler NoContent
+updateTask _ _ = return NoContent
 
 deleteTask :: Int -> Handler NoContent
 deleteTask _ = return NoContent
+
+readAllUsers :: Handler [User]
+readAllUsers = return users
+
+createUser :: User -> Handler NoContent
+createUser _ = return NoContent
+
+readOneUser :: Int -> Handler User
+readOneUser i = return $ users !! i
+
+updateUser :: Int -> User -> Handler NoContent
+updateUser _ _ = return NoContent
+
+deleteUser :: Int -> Handler NoContent
+deleteUser _ = return NoContent

src/PEA/Server/Data/Graph.hs

@@ -0,0 +1 @@
+module PEA.Server.Data.Graph where

src/PEA/Types.hs

@@ -6,6 +6,7 @@ module PEA.Types where
 import Data.Aeson
 import Data.Time.Calendar
 import GHC.Generics
+import qualified Data.Map.Strict as Map
 
 data Task = Task
   { title :: String
@@ -23,20 +24,26 @@ data Task = Task
 instance FromJSON Task
 instance ToJSON Task
 
+emptyTask :: String -> String -> Task
+emptyTask title name = let day = ModifiedJulianDay 0 in Task title "" (emptyUser name) 60 0 0 0 day day []
+
 data User = User
   { name :: String
   , passcode :: String 
-  , active :: Boolean
-  , superuser :: Boolean
+  , active :: Bool
+  , superuser :: Bool
   , registration :: Day
-  , preferences :: Map String String
+  , preferences :: Map.Map String String
   } deriving (Eq, Show, Generic)
 
 instance FromJSON User
 instance ToJSON User
 
+emptyUser :: String -> User
+emptyUser name = User name "" True False (ModifiedJulianDay 0) Map.empty
+
 data Tag = Tag
-  { owner :: User
+  { user :: User
   , text :: String
   } deriving (Eq, Show, Generic)