{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FunctionalDependencies #-}

module Snap.Snaplet.CustomAuth.AuthManager
  (
    AuthManager(..)
  , IAuthBackend(..)
  , UserData(..)
  , HasAuth(..)
  , AuthFailure(..)
  , OAuth2Settings(..)
  ) where

import Data.Binary (Binary)
import Data.ByteString (ByteString)
import Data.HashMap.Lazy (HashMap)
import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime)
import Network.HTTP.Client (Manager)

import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.CustomAuth.Types
import Snap.Snaplet.Session

class UserData a where
  extractUser :: a -> AuthUser

class UserData u => HasAuth u a where
  extractAuth :: a -> AuthManager u e b

class (UserData u, Binary i, Show e, Eq e) => IAuthBackend u i e b | u -> b, b -> e, e -> i where
  preparePasswordCreate :: Maybe u -> Text -> Handler b (AuthManager u e b) (Either e i)
  cancelPrepare :: i -> Handler b (AuthManager u e b) ()
  create :: Text -> i -> Handler b (AuthManager u e b) (Either (Either e CreateFailure) u)
  attachLoginMethod :: u -> i -> Handler b (AuthManager u e b) (Either e ())
  login :: Text -> Text -> Handler b (AuthManager u e b) (Either e (Maybe u))
  logout :: Text -> Handler b (AuthManager u e b) ()
  recover :: Text -> Handler b (AuthManager u e b) (Either (AuthFailure e) u)
  getUserId :: u -> Handler b (AuthManager u e b) ByteString
  isDuplicateError :: e -> Handler b (AuthManager u e b) Bool

data AuthManager u e b = forall i. IAuthBackend u i e b => AuthManager
  { AuthManager u e b -> UserData u => Maybe u
activeUser :: UserData u => Maybe u
  , AuthManager u e b -> Maybe NominalDiffTime
cookieLifetime :: Maybe NominalDiffTime
  , AuthManager u e b -> ByteString
sessionCookieName :: ByteString
  , AuthManager u e b -> ByteString
userField :: ByteString
  , AuthManager u e b -> ByteString
passwordField :: ByteString
  , AuthManager u e b -> SnapletLens (Snaplet b) SessionManager
stateStore' :: SnapletLens (Snaplet b) SessionManager
  , AuthManager u e b -> Maybe Text
oauth2Provider :: Maybe Text
  , AuthManager u e b -> Maybe (AuthFailure e)
authFailData :: Maybe (AuthFailure e)
  , AuthManager u e b -> HashMap Text Provider
providers :: HashMap Text Provider
  }

data OAuth2Settings u i e b = IAuthBackend u i e b => OAuth2Settings {
    OAuth2Settings u i e b
-> Text
-> Text
-> Handler b (AuthManager u e b) (Either e (Maybe ByteString))
oauth2Check :: Text -> Text -> Handler b (AuthManager u e b) (Either e (Maybe ByteString))
  , OAuth2Settings u i e b
-> Text
-> Text
-> Handler b (AuthManager u e b) (Either e (Maybe u))
oauth2Login :: Text -> Text -> Handler b (AuthManager u e b) (Either e (Maybe u))
  , OAuth2Settings u i e b
-> OAuth2Stage -> Handler b (AuthManager u e b) ()
oauth2Failure :: OAuth2Stage -> Handler b (AuthManager u e b) ()
  , OAuth2Settings u i e b
-> Text -> Text -> Handler b (AuthManager u e b) (Either e i)
prepareOAuth2Create :: Text -> Text -> Handler b (AuthManager u e b) (Either e i)
  , OAuth2Settings u i e b -> u -> Handler b (AuthManager u e b) ()
oauth2AccountCreated :: u -> Handler b (AuthManager u e b) ()
  , OAuth2Settings u i e b -> Handler b (AuthManager u e b) ()
oauth2LoginDone :: Handler b (AuthManager u e b) ()
  , OAuth2Settings u i e b
-> Text -> Text -> ByteString -> Handler b (AuthManager u e b) ()
resumeAction :: Text -> Text -> ByteString -> Handler b (AuthManager u e b) ()
  , OAuth2Settings u i e b -> SnapletLens (Snaplet b) SessionManager
stateStore :: SnapletLens (Snaplet b) SessionManager
  , OAuth2Settings u i e b -> Manager
httpManager :: Manager
  , OAuth2Settings u i e b
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
bracket :: Handler b (AuthManager u e b) () -> Handler b (AuthManager u e b) ()
  }