removed persistent dependecies from library

app/Main.hs

@@ -5,6 +5,7 @@ module Main (main) where
 import UniWorX
 import Server
 import Control.Applicative ((<|>))
+import Database.Persist (Entity(..))
 import System.Environment (lookupEnv)
 import qualified Data.Map as M
 import qualified Data.Text as T
@@ -14,7 +15,7 @@ main = do
   port <- determinePort
   putStrLn $ "Try: http://localhost:" ++ show port ++ "/auth?scope=ID%20Profile&client_id=42&response_type=code&redirect_uri=http:%2F%2Flocalhost:0000%2F"
   initDB
-  runMockServer @User @(M.Map T.Text T.Text) port
+  runMockServer @(Entity User) @(M.Map T.Text T.Text) port
     where
       determinePort :: IO Int
       determinePort = do

app/UniWorX.hs

@@ -49,7 +49,7 @@ testUsers :: [User] -- TODO move to db
 testUsers =
   [ User "Fallback User" "foo@bar.com"
   , User "Tina Tester" "t@t.tt"
-  , User "Max Muster" "m@m.mm"]
+  , User "Max Muster" "m@m.mm" ]
 
 runDB :: ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> IO a
 runDB action = do
@@ -63,8 +63,8 @@ initDB = runDB $ do
   runMigration migrateAll
   forM_ testUsers $ void . insert
 
-instance UserData User (Map Text Text) where
+instance UserData (Entity User) (Map Text Text) where
-  data Scope User = ID | Profile deriving (Show, Read, Eq)
+  data Scope (Entity User) = ID | Profile deriving (Show, Read, Eq)
   readScope = read
   showScope = show
   userScope (Entity uID _) ID = M.singleton "id" . T.pack $ show uID

oauth2-mock-server.cabal

@@ -37,17 +37,11 @@ library
     , base64
     , blaze-html
     , bytestring
-    , conduit
     , containers
     , http-api-data
     , http-client
     , http-media
     , jose-jwt
-    , monad-logger
-    , mtl
-    , persistent
-    , persistent-postgresql
-    , persistent-template
     , servant
     , servant-client
     , servant-server
@@ -116,18 +110,12 @@ test-suite oauth2-mock-server-test
     , base64
     , blaze-html
     , bytestring
-    , conduit
     , containers
     , http-api-data
     , http-client
     , http-media
     , jose-jwt
-    , monad-logger
-    , mtl
     , oauth2-mock-server
-    , persistent
-    , persistent-postgresql
-    , persistent-template
     , servant
     , servant-client
     , servant-server

package.yaml

@@ -40,12 +40,6 @@ dependencies:
 - blaze-html
 - http-media
 - string-interpolate
-- persistent
-- persistent-postgresql
-- persistent-template
-- monad-logger
-- conduit
-- mtl
 
 ghc-options:
 - -Wall
@@ -71,6 +65,12 @@ executables:
     - -with-rtsopts=-N
     dependencies:
     - oauth2-mock-server
+    - persistent
+    - persistent-postgresql
+    - persistent-template
+    - monad-logger
+    - conduit
+    - mtl
 
 tests:
   oauth2-mock-server-test:

src/AuthCode.hs

@@ -21,8 +21,6 @@ import Data.UUID
 
 import qualified Data.Map.Strict as M
 
-import Database.Persist (Entity(..))
-
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Concurrent.STM.TVar
 import Control.Monad (void, (>=>))
@@ -47,7 +45,7 @@ instance FromJSON JWT where
 data AuthRequest user = AuthRequest
   { client :: String
   , codeExpiration :: NominalDiffTime
-  , user :: Entity user
+  , user :: user
   , scopes :: [Scope user]
   }
 
@@ -55,7 +53,7 @@ data AuthRequest user = AuthRequest
 
 data State user = State
   { activeCodes :: Map Text (AuthRequest user)
-  , activeTokens :: Map UUID (Entity user, [Scope user])
+  , activeTokens :: Map UUID (user, [Scope user])
   , publicKey   :: Jwk
   , privateKey  :: Jwk
   }
@@ -86,7 +84,7 @@ expire code time state = void . forkIO $ do
   atomically . modifyTVar state $ \s -> s{ activeCodes = M.delete code s.activeCodes }
 
 
-verify :: Text -> Maybe String -> AuthState user -> IO (Maybe (Entity user, [Scope user]))
+verify :: Text -> Maybe String -> AuthState user -> IO (Maybe (user, [Scope user]))
 verify code mClientID state = do
   now <- getCurrentTime
   mData <- atomically $ do

src/Server.hs

@@ -34,8 +34,6 @@ import Data.UUID.V4
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Map.Strict as Map
 
-import Database.Persist (Entity(..))
-
 import GHC.Read (readPrec, lexP)
 
 import Jose.Jwa
@@ -247,7 +245,7 @@ tokenEndpoint = provideToken
 
 
 mkToken :: forall user userData . UserData user userData
-        => Entity user -> [Scope user] -> AuthState user -> IO JWTWrapper
+        => user -> [Scope user] -> AuthState user -> IO JWTWrapper
 mkToken u scopes state = do
   pubKey <- atomically $ readTVar state >>= return . publicKey
   now <- getCurrentTime

src/User.hs

@@ -1,50 +1,18 @@
 {-# LANGUAGE OverloadedStrings, RecordWildCards, TypeFamilies, MultiParamTypeClasses, FlexibleInstances, AllowAmbiguousTypes #-}
 
-module User
+module User ( UserData(..) ) where
-( UserData(..)
--- , User (..)
--- , testUsers
-) where
 
 import Data.Aeson
-import Data.List (find)
 import Data.Map.Strict
 import Data.Maybe
-import Data.Text hiding (singleton, find)
+import Data.Text
-
-import Database.Persist (PersistEntity(..), Entity(..))
-
-import GHC.Generics
 
 type UserName = Text
 type Password = Text
 
-class (PersistEntity u, Show u, ToJSON a, Monoid a) => UserData u a where -- TODO Show maybe not necessary
+class (Eq u, Show u, ToJSON a, Monoid a) => UserData u a where -- TODO Show maybe not necessary
   data Scope u
   readScope :: String -> Scope u
   showScope :: Scope u -> String
-  userScope  :: Entity u -> Scope u -> a
+  userScope  :: u -> Scope u -> a
-  lookupUser :: UserName -> Password -> IO (Maybe (Entity u))
+  lookupUser :: UserName -> Password -> IO (Maybe u)
-
-
--- data User = User
---   { name     :: Text
---   , email    :: Text
---   , password :: Text
---   , uID      :: Text
---   } deriving (Eq, Show)
-
--- testUsers :: [User] -- TODO move to db
--- testUsers =
---   [ User {name = "Fallback User", email = "foo@bar.com", password = "0000", uID = "0"}
---   , User {name = "Tina Tester", email = "t@t.tt", password = "1111", uID = "1"}
---   , User {name = "Max Muster", email = "m@m.mm", password = "2222", uID = "2"}]
-
-
--- instance UserData User (Map Text Text) where
---   data Scope User = ID | Profile deriving (Show, Read, Eq)
---   readScope = read
---   showScope = show
---   userScope User{..} ID = singleton "id" uID
---   userScope User{..} Profile = fromList [("name", name), ("email", email)]
---   lookupUser e _ = return $ find (\User{..} -> email == e) testUsers