This commit is contained in:
nek0 2019-04-17 16:14:44 +02:00
parent 672d0ac474
commit 18ecc04eab
7 changed files with 124 additions and 77 deletions

View file

@ -22,8 +22,10 @@ executable mateamt
, Model.User
, Model.Beverage
, Types
, Types.Refine
, Types.Auth
, Types.Beverage
, Types.Refine
, Types.User
-- other-extensions:
build-depends: base ^>=4.12.0.0
, servant

View file

@ -15,26 +15,6 @@ import GHC.Generics
import Opaleye as O
data Beverage = Beverage
{ beverageIdent :: T.Text
, beveragePrice :: Int
, beverageAmount :: Int
, beverageVanish :: Int
, beverageMl :: Int
, beverageAvatar :: Maybe Word
, beverageSupplier :: Maybe Word
, beverageMaxAmount :: Int
, beverageTotalBought :: Int
, beverageAmonutPerCrate :: Int
, beveragePricePerCrate :: Maybe Int
, beverageArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON Beverage where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Beverage
initBeverage :: PGS.Query
initBeverage = "create Table if not exists \"beverage\" (id serial primary key, ident varchar(128) not null, price integer not null, amount integer not null, vanish integer not null, ml integer not null, avatar integer, supplier integer, max_amount integer not null, total_bought integer not null, amount_per_crate integer not null, price_per_crate integer, art_nr varchar(128))"

View file

@ -8,14 +8,12 @@ import Data.Time.Calendar
import Data.Time.Clock
import Data.Profunctor.Product (p9)
import Data.Aeson
import Data.Int (Int64)
import Data.Maybe (fromJust, fromMaybe)
import Data.Maybe (fromJust, isJust, fromMaybe)
import Data.ByteString hiding (head)
import Data.Int (Int64)
import qualified Database.PostgreSQL.Simple as PGS
import GHC.Generics
@ -27,59 +25,10 @@ import qualified Opaleye.Constant as C
-- internal imports
import Types.User
import Types.Refine
import Types.Auth
data User
= User
{ userId :: Int
, userIdent :: T.Text
, userBalance :: Int
, userTimeStamp :: Day
, userEmail :: Maybe T.Text
, userAvatar :: Maybe Int
, userSalt :: AuthSalt
, userHash :: Maybe AuthHash
, userAlgo :: Maybe Int
}
| QueryUser
{ userId :: Int
, userIdent :: T.Text
, userAvatar :: Maybe Int
}
deriving (Generic, Show)
instance ToJSON User where
toEncoding (User id ident balance ts email avatar _ _ _) =
pairs
( "userId" .= id
<> "userIdent" .= ident
<> "userBalance" .= balance
<> "userTimeStamp" .= ts
<> "userEmail" .= email
<> "userAvatar" .= avatar
)
toEncoding (QueryUser id ident avatar) =
pairs
( "userId" .= id
<> "userIdent" .= ident
<> "userAvatar" .= avatar
)
instance FromJSON User
data UserSubmit = UserSubmit
{ userSubmitIdent :: T.Text
, userSubmitEmail :: Maybe T.Text
--, userSubmitPin :: Maybe T.Text
}
deriving (Generic, Show)
instance ToJSON UserSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserSubmit
initUser :: PGS.Query
initUser = "create table if not exists \"user\" (id serial primary key, ident varchar(128) not null, balance integer not null, time_stamp date not null, email varchar(128), avatar integer, salt bytea not null, hash bytea, algo integer)"

View file

@ -2,5 +2,8 @@ module Types
( module T
) where
import Types.Refine as T
import Types.Auth as T
import Types.Beverage as T
import Types.Refine as T
import Types.Token as T
import Types.User as T

28
src/Types/Beverage.hs Normal file
View file

@ -0,0 +1,28 @@
{-# LANGUAGE DeriveGeneric #-}
module Types.Beverage where
import GHC.Generics
import Data.Aeson
import qualified Data.Text as T
data Beverage = Beverage
{ beverageIdent :: T.Text
, beveragePrice :: Int
, beverageAmount :: Int
, beverageVanish :: Int
, beverageMl :: Int
, beverageAvatar :: Maybe Word
, beverageSupplier :: Maybe Word
, beverageMaxAmount :: Int
, beverageTotalBought :: Int
, beverageAmonutPerCrate :: Int
, beveragePricePerCrate :: Maybe Int
, beverageArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON Beverage where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Beverage

20
src/Types/Token.hs Normal file
View file

@ -0,0 +1,20 @@
{-# LANGUAGE DeriveGeneric #-}
module Types.Token where
import GHC.Generics
import Data.Aeson
import Data.ByteString
import Data.Time.Clock (UTCTime)
data Token = Token
{ tokenString :: ByteString
, tokenUser :: Int
, tokenExpiry :: UTCTime
}
deriving (Generic, Show)
instance ToJSON Token where
toJSON (Token s _ _) = toJSON s

65
src/Types/User.hs Normal file
View file

@ -0,0 +1,65 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Types.User where
import GHC.Generics
import Data.Time.Calendar (Day)
import Data.Aeson
import qualified Data.Text as T
-- internal imports
import Types.Auth
data User
= User
{ userId :: Int
, userIdent :: T.Text
, userBalance :: Int
, userTimeStamp :: Day
, userEmail :: Maybe T.Text
, userAvatar :: Maybe Int
, userSalt :: AuthSalt
, userHash :: Maybe AuthHash
, userAlgo :: Maybe Int
}
| QueryUser
{ userId :: Int
, userIdent :: T.Text
, userAvatar :: Maybe Int
}
deriving (Generic, Show)
instance ToJSON User where
toEncoding (User id ident balance ts email avatar _ _ _) =
pairs
( "userId" .= id
<> "userIdent" .= ident
<> "userBalance" .= balance
<> "userTimeStamp" .= ts
<> "userEmail" .= email
<> "userAvatar" .= avatar
)
toEncoding (QueryUser id ident avatar) =
pairs
( "userId" .= id
<> "userIdent" .= ident
<> "userAvatar" .= avatar
)
instance FromJSON User
data UserSubmit = UserSubmit
{ userSubmitIdent :: T.Text
, userSubmitEmail :: Maybe T.Text
--, userSubmitPin :: Maybe T.Text
}
deriving (Generic, Show)
instance ToJSON UserSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserSubmit