Add user, message types

guide.cabal

@@ -53,13 +53,15 @@ library
       Guide.Types.Core
       Guide.Types.Edit
       Guide.Types.Action
+      Guide.Types.User
+      Guide.Types.Message
     Guide.Handlers
     Guide.Utils
     Guide.Merge
-    Guide.Cache
     Guide.Markdown
     Guide.JS
     Guide.View
+    Guide.Cache
     Guide.SafeCopy
   other-modules:
     Imports
@@ -106,6 +108,7 @@ library
                      , random >= 1.1
                      , reroute
                      , safecopy
+                     , scrypt
                      , semigroups
                      , shortcut-links >= 0.4.2
                      , slave-thread
@@ -117,6 +120,7 @@ library
                      , time >= 1.5
                      , transformers
                      , uniplate
+                     , uuid
                      , vector
                      , wai
                      , wai-middleware-metrics

src/Guide/Types.hs

@@ -4,11 +4,12 @@ module Guide.Types
   module Guide.Types.Core,
   module Guide.Types.Edit,
   module Guide.Types.Action,
+  module Guide.Types.User,
 )
 where
 
-
 import Guide.Types.Hue
 import Guide.Types.Core
 import Guide.Types.Edit
 import Guide.Types.Action
+import Guide.Types.User

src/Guide/Types/Message.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Guide.Types.Message
+(
+  Message(..),
+)
+where
+
+import Imports
+
+-- Text
+import qualified Data.Text.All as T
+-- acid-state
+import Data.SafeCopy hiding (kind)
+
+import Guide.Utils
+import Guide.SafeCopy
+import Guide.Types.Core
+import Guide.Types.Edit
+
+data Message = Message {
+  messageID       :: Uid Message,
+  messageDate     :: UTCTime,
+  messageText     :: Text }
+  deriving (Show)
+
+deriveSafeCopySorted 0 'base ''Message

src/Guide/Types/User.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Guide.Types.User
+(
+  User(..),
+  makeUser,
+)
+where
+
+import Imports
+
+
+-- acid-state
+import Data.SafeCopy hiding (kind)
+-- scrypt
+import Crypto.Scrypt (Pass, encryptPassIO', getEncryptedPass)
+
+import Guide.Utils
+import Guide.SafeCopy
+-- import Guide.Types.Core
+-- import Guide.Types.Edit
+
+data User = User {
+  userID          :: Uid User,
+  userName        :: Text,
+  userEmail       :: Text,
+  userPassword    :: Maybe ByteString
+  }
+  deriving (Show)
+
+makeUser :: MonadIO m => Text -> Text -> Pass -> m User
+makeUser username email password = do
+  encPass <- liftIO $ encryptPassIO' password
+  userID <- randomLongUid 
+  return User {
+    userID = userID,
+    userName = username,
+    userEmail = email,
+    userPassword = Just $ getEncryptedPass encPass
+  }
+
+deriveSafeCopySorted 0 'base ''User

src/site/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import qualified Guide.Server
+import Prelude (IO)
 
 main :: IO ()
 main = Guide.Server.main