{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

module Snap.Snaplet.CustomAuth.Types where

import Control.Lens.TH
import Data.Binary
import Data.Binary.Instances ()
import Data.ByteString
import Data.Text (Text)
import Data.Time.Clock (UTCTime, NominalDiffTime)
import GHC.Generics (Generic)
import Network.OAuth.OAuth2 (OAuth2)
import URI.ByteString (URI)

import Snap.Core (Cookie(..))

data LoginFailure =
  NoSession | SessionRecoverFail | UsernameMissing | PasswordMissing | WrongPasswordOrUsername
  deriving (Int -> LoginFailure -> ShowS
[LoginFailure] -> ShowS
LoginFailure -> String
(Int -> LoginFailure -> ShowS)
-> (LoginFailure -> String)
-> ([LoginFailure] -> ShowS)
-> Show LoginFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoginFailure] -> ShowS
$cshowList :: [LoginFailure] -> ShowS
show :: LoginFailure -> String
$cshow :: LoginFailure -> String
showsPrec :: Int -> LoginFailure -> ShowS
$cshowsPrec :: Int -> LoginFailure -> ShowS
Show, LoginFailure -> LoginFailure -> Bool
(LoginFailure -> LoginFailure -> Bool)
-> (LoginFailure -> LoginFailure -> Bool) -> Eq LoginFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginFailure -> LoginFailure -> Bool
$c/= :: LoginFailure -> LoginFailure -> Bool
== :: LoginFailure -> LoginFailure -> Bool
$c== :: LoginFailure -> LoginFailure -> Bool
Eq, ReadPrec [LoginFailure]
ReadPrec LoginFailure
Int -> ReadS LoginFailure
ReadS [LoginFailure]
(Int -> ReadS LoginFailure)
-> ReadS [LoginFailure]
-> ReadPrec LoginFailure
-> ReadPrec [LoginFailure]
-> Read LoginFailure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LoginFailure]
$creadListPrec :: ReadPrec [LoginFailure]
readPrec :: ReadPrec LoginFailure
$creadPrec :: ReadPrec LoginFailure
readList :: ReadS [LoginFailure]
$creadList :: ReadS [LoginFailure]
readsPrec :: Int -> ReadS LoginFailure
$creadsPrec :: Int -> ReadS LoginFailure
Read)

data AuthFailure e =
    UserError e
  | Login LoginFailure
  | Create CreateFailure
  | Action OAuth2ActionFailure
  deriving (Int -> AuthFailure e -> ShowS
[AuthFailure e] -> ShowS
AuthFailure e -> String
(Int -> AuthFailure e -> ShowS)
-> (AuthFailure e -> String)
-> ([AuthFailure e] -> ShowS)
-> Show (AuthFailure e)
forall e. Show e => Int -> AuthFailure e -> ShowS
forall e. Show e => [AuthFailure e] -> ShowS
forall e. Show e => AuthFailure e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthFailure e] -> ShowS
$cshowList :: forall e. Show e => [AuthFailure e] -> ShowS
show :: AuthFailure e -> String
$cshow :: forall e. Show e => AuthFailure e -> String
showsPrec :: Int -> AuthFailure e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> AuthFailure e -> ShowS
Show)

data CreateFailure =
    MissingName | InvalidName
  | DuplicateName
  | PasswordFailure PasswordFailure
  | OAuth2Failure OAuth2Failure
  deriving (CreateFailure -> CreateFailure -> Bool
(CreateFailure -> CreateFailure -> Bool)
-> (CreateFailure -> CreateFailure -> Bool) -> Eq CreateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFailure -> CreateFailure -> Bool
$c/= :: CreateFailure -> CreateFailure -> Bool
== :: CreateFailure -> CreateFailure -> Bool
$c== :: CreateFailure -> CreateFailure -> Bool
Eq, Int -> CreateFailure -> ShowS
[CreateFailure] -> ShowS
CreateFailure -> String
(Int -> CreateFailure -> ShowS)
-> (CreateFailure -> String)
-> ([CreateFailure] -> ShowS)
-> Show CreateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFailure] -> ShowS
$cshowList :: [CreateFailure] -> ShowS
show :: CreateFailure -> String
$cshow :: CreateFailure -> String
showsPrec :: Int -> CreateFailure -> ShowS
$cshowsPrec :: Int -> CreateFailure -> ShowS
Show, ReadPrec [CreateFailure]
ReadPrec CreateFailure
Int -> ReadS CreateFailure
ReadS [CreateFailure]
(Int -> ReadS CreateFailure)
-> ReadS [CreateFailure]
-> ReadPrec CreateFailure
-> ReadPrec [CreateFailure]
-> Read CreateFailure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFailure]
$creadListPrec :: ReadPrec [CreateFailure]
readPrec :: ReadPrec CreateFailure
$creadPrec :: ReadPrec CreateFailure
readList :: ReadS [CreateFailure]
$creadList :: ReadS [CreateFailure]
readsPrec :: Int -> ReadS CreateFailure
$creadsPrec :: Int -> ReadS CreateFailure
Read)

data OAuth2Failure =
    StateNotStored | StateNotReceived | ExpiredState | BadState
  | ConfigurationError | IdExtractionFailed (Maybe Text) | NoStoredToken
  | AlreadyUser | AlreadyLoggedIn
  | IdentityInUse
  | ProviderError (Maybe Text)
  | AccessTokenFetchError
  deriving (Int -> OAuth2Failure -> ShowS
[OAuth2Failure] -> ShowS
OAuth2Failure -> String
(Int -> OAuth2Failure -> ShowS)
-> (OAuth2Failure -> String)
-> ([OAuth2Failure] -> ShowS)
-> Show OAuth2Failure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2Failure] -> ShowS
$cshowList :: [OAuth2Failure] -> ShowS
show :: OAuth2Failure -> String
$cshow :: OAuth2Failure -> String
showsPrec :: Int -> OAuth2Failure -> ShowS
$cshowsPrec :: Int -> OAuth2Failure -> ShowS
Show, ReadPrec [OAuth2Failure]
ReadPrec OAuth2Failure
Int -> ReadS OAuth2Failure
ReadS [OAuth2Failure]
(Int -> ReadS OAuth2Failure)
-> ReadS [OAuth2Failure]
-> ReadPrec OAuth2Failure
-> ReadPrec [OAuth2Failure]
-> Read OAuth2Failure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OAuth2Failure]
$creadListPrec :: ReadPrec [OAuth2Failure]
readPrec :: ReadPrec OAuth2Failure
$creadPrec :: ReadPrec OAuth2Failure
readList :: ReadS [OAuth2Failure]
$creadList :: ReadS [OAuth2Failure]
readsPrec :: Int -> ReadS OAuth2Failure
$creadsPrec :: Int -> ReadS OAuth2Failure
Read, OAuth2Failure -> OAuth2Failure -> Bool
(OAuth2Failure -> OAuth2Failure -> Bool)
-> (OAuth2Failure -> OAuth2Failure -> Bool) -> Eq OAuth2Failure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2Failure -> OAuth2Failure -> Bool
$c/= :: OAuth2Failure -> OAuth2Failure -> Bool
== :: OAuth2Failure -> OAuth2Failure -> Bool
$c== :: OAuth2Failure -> OAuth2Failure -> Bool
Eq)

data OAuth2ActionFailure =
  ActionTimeout | ActionDecodeError | ActionUserMismatch
  | AttachNotLoggedIn | AlreadyAttached
  deriving (Int -> OAuth2ActionFailure -> ShowS
[OAuth2ActionFailure] -> ShowS
OAuth2ActionFailure -> String
(Int -> OAuth2ActionFailure -> ShowS)
-> (OAuth2ActionFailure -> String)
-> ([OAuth2ActionFailure] -> ShowS)
-> Show OAuth2ActionFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2ActionFailure] -> ShowS
$cshowList :: [OAuth2ActionFailure] -> ShowS
show :: OAuth2ActionFailure -> String
$cshow :: OAuth2ActionFailure -> String
showsPrec :: Int -> OAuth2ActionFailure -> ShowS
$cshowsPrec :: Int -> OAuth2ActionFailure -> ShowS
Show, OAuth2ActionFailure -> OAuth2ActionFailure -> Bool
(OAuth2ActionFailure -> OAuth2ActionFailure -> Bool)
-> (OAuth2ActionFailure -> OAuth2ActionFailure -> Bool)
-> Eq OAuth2ActionFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2ActionFailure -> OAuth2ActionFailure -> Bool
$c/= :: OAuth2ActionFailure -> OAuth2ActionFailure -> Bool
== :: OAuth2ActionFailure -> OAuth2ActionFailure -> Bool
$c== :: OAuth2ActionFailure -> OAuth2ActionFailure -> Bool
Eq, ReadPrec [OAuth2ActionFailure]
ReadPrec OAuth2ActionFailure
Int -> ReadS OAuth2ActionFailure
ReadS [OAuth2ActionFailure]
(Int -> ReadS OAuth2ActionFailure)
-> ReadS [OAuth2ActionFailure]
-> ReadPrec OAuth2ActionFailure
-> ReadPrec [OAuth2ActionFailure]
-> Read OAuth2ActionFailure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OAuth2ActionFailure]
$creadListPrec :: ReadPrec [OAuth2ActionFailure]
readPrec :: ReadPrec OAuth2ActionFailure
$creadPrec :: ReadPrec OAuth2ActionFailure
readList :: ReadS [OAuth2ActionFailure]
$creadList :: ReadS [OAuth2ActionFailure]
readsPrec :: Int -> ReadS OAuth2ActionFailure
$creadsPrec :: Int -> ReadS OAuth2ActionFailure
Read)

data PasswordFailure = Missing | Mismatch
  deriving (Int -> PasswordFailure -> ShowS
[PasswordFailure] -> ShowS
PasswordFailure -> String
(Int -> PasswordFailure -> ShowS)
-> (PasswordFailure -> String)
-> ([PasswordFailure] -> ShowS)
-> Show PasswordFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordFailure] -> ShowS
$cshowList :: [PasswordFailure] -> ShowS
show :: PasswordFailure -> String
$cshow :: PasswordFailure -> String
showsPrec :: Int -> PasswordFailure -> ShowS
$cshowsPrec :: Int -> PasswordFailure -> ShowS
Show, PasswordFailure -> PasswordFailure -> Bool
(PasswordFailure -> PasswordFailure -> Bool)
-> (PasswordFailure -> PasswordFailure -> Bool)
-> Eq PasswordFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordFailure -> PasswordFailure -> Bool
$c/= :: PasswordFailure -> PasswordFailure -> Bool
== :: PasswordFailure -> PasswordFailure -> Bool
$c== :: PasswordFailure -> PasswordFailure -> Bool
Eq, ReadPrec [PasswordFailure]
ReadPrec PasswordFailure
Int -> ReadS PasswordFailure
ReadS [PasswordFailure]
(Int -> ReadS PasswordFailure)
-> ReadS [PasswordFailure]
-> ReadPrec PasswordFailure
-> ReadPrec [PasswordFailure]
-> Read PasswordFailure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PasswordFailure]
$creadListPrec :: ReadPrec [PasswordFailure]
readPrec :: ReadPrec PasswordFailure
$creadPrec :: ReadPrec PasswordFailure
readList :: ReadS [PasswordFailure]
$creadList :: ReadS [PasswordFailure]
readsPrec :: Int -> ReadS PasswordFailure
$creadsPrec :: Int -> ReadS PasswordFailure
Read)

data OAuth2Stage = SCallback | SLogin | SCreate | SAction
  deriving (Int -> OAuth2Stage -> ShowS
[OAuth2Stage] -> ShowS
OAuth2Stage -> String
(Int -> OAuth2Stage -> ShowS)
-> (OAuth2Stage -> String)
-> ([OAuth2Stage] -> ShowS)
-> Show OAuth2Stage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2Stage] -> ShowS
$cshowList :: [OAuth2Stage] -> ShowS
show :: OAuth2Stage -> String
$cshow :: OAuth2Stage -> String
showsPrec :: Int -> OAuth2Stage -> ShowS
$cshowsPrec :: Int -> OAuth2Stage -> ShowS
Show, OAuth2Stage -> OAuth2Stage -> Bool
(OAuth2Stage -> OAuth2Stage -> Bool)
-> (OAuth2Stage -> OAuth2Stage -> Bool) -> Eq OAuth2Stage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2Stage -> OAuth2Stage -> Bool
$c/= :: OAuth2Stage -> OAuth2Stage -> Bool
== :: OAuth2Stage -> OAuth2Stage -> Bool
$c== :: OAuth2Stage -> OAuth2Stage -> Bool
Eq, ReadPrec [OAuth2Stage]
ReadPrec OAuth2Stage
Int -> ReadS OAuth2Stage
ReadS [OAuth2Stage]
(Int -> ReadS OAuth2Stage)
-> ReadS [OAuth2Stage]
-> ReadPrec OAuth2Stage
-> ReadPrec [OAuth2Stage]
-> Read OAuth2Stage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OAuth2Stage]
$creadListPrec :: ReadPrec [OAuth2Stage]
readPrec :: ReadPrec OAuth2Stage
$creadPrec :: ReadPrec OAuth2Stage
readList :: ReadS [OAuth2Stage]
$creadList :: ReadS [OAuth2Stage]
readsPrec :: Int -> ReadS OAuth2Stage
$creadsPrec :: Int -> ReadS OAuth2Stage
Read)

data Provider = Provider
  { Provider -> Text
providerName :: Text
  , Provider -> Maybe URI
discovery :: Maybe URI
  , Provider -> Text
scope :: Text
  , Provider -> URI
identityEndpoint :: URI
  , Provider -> Text
identityField :: Text
  , Provider -> OAuth2
oauth :: OAuth2
  }
  deriving (Int -> Provider -> ShowS
[Provider] -> ShowS
Provider -> String
(Int -> Provider -> ShowS)
-> (Provider -> String) -> ([Provider] -> ShowS) -> Show Provider
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Provider] -> ShowS
$cshowList :: [Provider] -> ShowS
show :: Provider -> String
$cshow :: Provider -> String
showsPrec :: Int -> Provider -> ShowS
$cshowsPrec :: Int -> Provider -> ShowS
Show)

data SavedAction = SavedAction
  { SavedAction -> Text
actionProvider :: Text
  , SavedAction -> UTCTime
actionStamp :: UTCTime
  , SavedAction -> Maybe ByteString
actionUser :: Maybe ByteString
  -- | Is the action expected to match with an ID attached to the
  -- user.  Use False if using the action to attach a new ID.
  , SavedAction -> Bool
requireUser :: Bool
  , SavedAction -> ByteString
savedAction :: ByteString
  } deriving ((forall x. SavedAction -> Rep SavedAction x)
-> (forall x. Rep SavedAction x -> SavedAction)
-> Generic SavedAction
forall x. Rep SavedAction x -> SavedAction
forall x. SavedAction -> Rep SavedAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SavedAction x -> SavedAction
$cfrom :: forall x. SavedAction -> Rep SavedAction x
Generic)

instance Binary SavedAction

data AuthUser = AuthUser
  { AuthUser -> Text
name :: Text
  , AuthUser -> ByteString
session :: ByteString
  , AuthUser -> ByteString
csrfToken :: ByteString
  } deriving (Int -> AuthUser -> ShowS
[AuthUser] -> ShowS
AuthUser -> String
(Int -> AuthUser -> ShowS)
-> (AuthUser -> String) -> ([AuthUser] -> ShowS) -> Show AuthUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthUser] -> ShowS
$cshowList :: [AuthUser] -> ShowS
show :: AuthUser -> String
$cshow :: AuthUser -> String
showsPrec :: Int -> AuthUser -> ShowS
$cshowsPrec :: Int -> AuthUser -> ShowS
Show)

data AuthSettings = AuthSettings
  { AuthSettings -> Text
_authName :: Text
  , AuthSettings -> Maybe NominalDiffTime
_authCookieLifetime :: Maybe NominalDiffTime
  }

makeLenses ''AuthSettings

defAuthSettings :: AuthSettings
defAuthSettings :: AuthSettings
defAuthSettings = Text -> Maybe NominalDiffTime -> AuthSettings
AuthSettings Text
"auth" Maybe NominalDiffTime
forall a. Maybe a
Nothing