blerg
This commit is contained in:
parent
672d0ac474
commit
18ecc04eab
7 changed files with 124 additions and 77 deletions
|
@ -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
|
||||
|
|
|
@ -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))"
|
||||
|
||||
|
|
|
@ -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)"
|
||||
|
||||
|
|
|
@ -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
28
src/Types/Beverage.hs
Normal 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
20
src/Types/Token.hs
Normal 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
65
src/Types/User.hs
Normal 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
|
Loading…
Add table
Reference in a new issue