{-# LANGUAGE CPP #-}
module Servant.Auth.Server.Internal.Types where
import Control.Applicative
import Control.Monad (MonadPlus(..), ap)
import Control.Monad.Reader
import Control.Monad.Time
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import Data.Time (getCurrentTime)
import GHC.Generics (Generic)
import Network.Wai (Request)
import qualified Control.Monad.Fail as Fail
data AuthResult val
= BadPassword
| NoSuchUser
| Authenticated val
| Indefinite
deriving (AuthResult val -> AuthResult val -> Bool
forall val. Eq val => AuthResult val -> AuthResult val -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthResult val -> AuthResult val -> Bool
$c/= :: forall val. Eq val => AuthResult val -> AuthResult val -> Bool
== :: AuthResult val -> AuthResult val -> Bool
$c== :: forall val. Eq val => AuthResult val -> AuthResult val -> Bool
Eq, Int -> AuthResult val -> ShowS
forall val. Show val => Int -> AuthResult val -> ShowS
forall val. Show val => [AuthResult val] -> ShowS
forall val. Show val => AuthResult val -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthResult val] -> ShowS
$cshowList :: forall val. Show val => [AuthResult val] -> ShowS
show :: AuthResult val -> String
$cshow :: forall val. Show val => AuthResult val -> String
showsPrec :: Int -> AuthResult val -> ShowS
$cshowsPrec :: forall val. Show val => Int -> AuthResult val -> ShowS
Show, ReadPrec [AuthResult val]
ReadPrec (AuthResult val)
ReadS [AuthResult val]
forall val. Read val => ReadPrec [AuthResult val]
forall val. Read val => ReadPrec (AuthResult val)
forall val. Read val => Int -> ReadS (AuthResult val)
forall val. Read val => ReadS [AuthResult val]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthResult val]
$creadListPrec :: forall val. Read val => ReadPrec [AuthResult val]
readPrec :: ReadPrec (AuthResult val)
$creadPrec :: forall val. Read val => ReadPrec (AuthResult val)
readList :: ReadS [AuthResult val]
$creadList :: forall val. Read val => ReadS [AuthResult val]
readsPrec :: Int -> ReadS (AuthResult val)
$creadsPrec :: forall val. Read val => Int -> ReadS (AuthResult val)
Read, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall val x. Rep (AuthResult val) x -> AuthResult val
forall val x. AuthResult val -> Rep (AuthResult val) x
$cto :: forall val x. Rep (AuthResult val) x -> AuthResult val
$cfrom :: forall val x. AuthResult val -> Rep (AuthResult val) x
Generic, AuthResult val -> AuthResult val -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {val}. Ord val => Eq (AuthResult val)
forall val. Ord val => AuthResult val -> AuthResult val -> Bool
forall val. Ord val => AuthResult val -> AuthResult val -> Ordering
forall val.
Ord val =>
AuthResult val -> AuthResult val -> AuthResult val
min :: AuthResult val -> AuthResult val -> AuthResult val
$cmin :: forall val.
Ord val =>
AuthResult val -> AuthResult val -> AuthResult val
max :: AuthResult val -> AuthResult val -> AuthResult val
$cmax :: forall val.
Ord val =>
AuthResult val -> AuthResult val -> AuthResult val
>= :: AuthResult val -> AuthResult val -> Bool
$c>= :: forall val. Ord val => AuthResult val -> AuthResult val -> Bool
> :: AuthResult val -> AuthResult val -> Bool
$c> :: forall val. Ord val => AuthResult val -> AuthResult val -> Bool
<= :: AuthResult val -> AuthResult val -> Bool
$c<= :: forall val. Ord val => AuthResult val -> AuthResult val -> Bool
< :: AuthResult val -> AuthResult val -> Bool
$c< :: forall val. Ord val => AuthResult val -> AuthResult val -> Bool
compare :: AuthResult val -> AuthResult val -> Ordering
$ccompare :: forall val. Ord val => AuthResult val -> AuthResult val -> Ordering
Ord, forall a b. a -> AuthResult b -> AuthResult a
forall a b. (a -> b) -> AuthResult a -> AuthResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AuthResult b -> AuthResult a
$c<$ :: forall a b. a -> AuthResult b -> AuthResult a
fmap :: forall a b. (a -> b) -> AuthResult a -> AuthResult b
$cfmap :: forall a b. (a -> b) -> AuthResult a -> AuthResult b
Functor, Functor AuthResult
Foldable AuthResult
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AuthResult (m a) -> m (AuthResult a)
forall (f :: * -> *) a.
Applicative f =>
AuthResult (f a) -> f (AuthResult a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AuthResult a -> m (AuthResult b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AuthResult a -> f (AuthResult b)
sequence :: forall (m :: * -> *) a.
Monad m =>
AuthResult (m a) -> m (AuthResult a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
AuthResult (m a) -> m (AuthResult a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AuthResult a -> m (AuthResult b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AuthResult a -> m (AuthResult b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AuthResult (f a) -> f (AuthResult a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
AuthResult (f a) -> f (AuthResult a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AuthResult a -> f (AuthResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AuthResult a -> f (AuthResult b)
Traversable, forall a. Eq a => a -> AuthResult a -> Bool
forall a. Num a => AuthResult a -> a
forall a. Ord a => AuthResult a -> a
forall m. Monoid m => AuthResult m -> m
forall a. AuthResult a -> Bool
forall a. AuthResult a -> Int
forall a. AuthResult a -> [a]
forall a. (a -> a -> a) -> AuthResult a -> a
forall m a. Monoid m => (a -> m) -> AuthResult a -> m
forall b a. (b -> a -> b) -> b -> AuthResult a -> b
forall a b. (a -> b -> b) -> b -> AuthResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => AuthResult a -> a
$cproduct :: forall a. Num a => AuthResult a -> a
sum :: forall a. Num a => AuthResult a -> a
$csum :: forall a. Num a => AuthResult a -> a
minimum :: forall a. Ord a => AuthResult a -> a
$cminimum :: forall a. Ord a => AuthResult a -> a
maximum :: forall a. Ord a => AuthResult a -> a
$cmaximum :: forall a. Ord a => AuthResult a -> a
elem :: forall a. Eq a => a -> AuthResult a -> Bool
$celem :: forall a. Eq a => a -> AuthResult a -> Bool
length :: forall a. AuthResult a -> Int
$clength :: forall a. AuthResult a -> Int
null :: forall a. AuthResult a -> Bool
$cnull :: forall a. AuthResult a -> Bool
toList :: forall a. AuthResult a -> [a]
$ctoList :: forall a. AuthResult a -> [a]
foldl1 :: forall a. (a -> a -> a) -> AuthResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AuthResult a -> a
foldr1 :: forall a. (a -> a -> a) -> AuthResult a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> AuthResult a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> AuthResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AuthResult a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AuthResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AuthResult a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AuthResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AuthResult a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AuthResult a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> AuthResult a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> AuthResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AuthResult a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AuthResult a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AuthResult a -> m
fold :: forall m. Monoid m => AuthResult m -> m
$cfold :: forall m. Monoid m => AuthResult m -> m
Foldable)
instance Semigroup (AuthResult val) where
AuthResult val
Indefinite <> :: AuthResult val -> AuthResult val -> AuthResult val
<> AuthResult val
y = AuthResult val
y
AuthResult val
x <> AuthResult val
_ = AuthResult val
x
instance Monoid (AuthResult val) where
mempty :: AuthResult val
mempty = forall val. AuthResult val
Indefinite
mappend :: AuthResult val -> AuthResult val -> AuthResult val
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Applicative AuthResult where
pure :: forall a. a -> AuthResult a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. AuthResult (a -> b) -> AuthResult a -> AuthResult b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad AuthResult where
return :: forall a. a -> AuthResult a
return = forall a. a -> AuthResult a
Authenticated
Authenticated a
v >>= :: forall a b. AuthResult a -> (a -> AuthResult b) -> AuthResult b
>>= a -> AuthResult b
f = a -> AuthResult b
f a
v
AuthResult a
BadPassword >>= a -> AuthResult b
_ = forall val. AuthResult val
BadPassword
AuthResult a
NoSuchUser >>= a -> AuthResult b
_ = forall val. AuthResult val
NoSuchUser
AuthResult a
Indefinite >>= a -> AuthResult b
_ = forall val. AuthResult val
Indefinite
instance Alternative AuthResult where
empty :: forall val. AuthResult val
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall val. AuthResult val -> AuthResult val -> AuthResult val
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadPlus AuthResult where
mzero :: forall val. AuthResult val
mzero = forall a. Monoid a => a
mempty
mplus :: forall val. AuthResult val -> AuthResult val -> AuthResult val
mplus = forall a. Semigroup a => a -> a -> a
(<>)
newtype AuthCheck val = AuthCheck
{ forall val. AuthCheck val -> Request -> IO (AuthResult val)
runAuthCheck :: Request -> IO (AuthResult val) }
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall val x. Rep (AuthCheck val) x -> AuthCheck val
forall val x. AuthCheck val -> Rep (AuthCheck val) x
$cto :: forall val x. Rep (AuthCheck val) x -> AuthCheck val
$cfrom :: forall val x. AuthCheck val -> Rep (AuthCheck val) x
Generic, forall a b. a -> AuthCheck b -> AuthCheck a
forall a b. (a -> b) -> AuthCheck a -> AuthCheck b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AuthCheck b -> AuthCheck a
$c<$ :: forall a b. a -> AuthCheck b -> AuthCheck a
fmap :: forall a b. (a -> b) -> AuthCheck a -> AuthCheck b
$cfmap :: forall a b. (a -> b) -> AuthCheck a -> AuthCheck b
Functor)
instance Semigroup (AuthCheck val) where
AuthCheck Request -> IO (AuthResult val)
f <> :: AuthCheck val -> AuthCheck val -> AuthCheck val
<> AuthCheck Request -> IO (AuthResult val)
g = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall a b. (a -> b) -> a -> b
$ \Request
x -> do
AuthResult val
fx <- Request -> IO (AuthResult val)
f Request
x
case AuthResult val
fx of
AuthResult val
Indefinite -> Request -> IO (AuthResult val)
g Request
x
AuthResult val
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult val
r
instance Monoid (AuthCheck val) where
mempty :: AuthCheck val
mempty = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
mappend :: AuthCheck val -> AuthCheck val -> AuthCheck val
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Applicative AuthCheck where
pure :: forall a. a -> AuthCheck a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. AuthCheck (a -> b) -> AuthCheck a -> AuthCheck b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad AuthCheck where
return :: forall a. a -> AuthCheck a
return = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
AuthCheck Request -> IO (AuthResult a)
ac >>= :: forall a b. AuthCheck a -> (a -> AuthCheck b) -> AuthCheck b
>>= a -> AuthCheck b
f = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall a b. (a -> b) -> a -> b
$ \Request
req -> do
AuthResult a
aresult <- Request -> IO (AuthResult a)
ac Request
req
case AuthResult a
aresult of
Authenticated a
usr -> forall val. AuthCheck val -> Request -> IO (AuthResult val)
runAuthCheck (a -> AuthCheck b
f a
usr) Request
req
AuthResult a
BadPassword -> forall (m :: * -> *) a. Monad m => a -> m a
return forall val. AuthResult val
BadPassword
AuthResult a
NoSuchUser -> forall (m :: * -> *) a. Monad m => a -> m a
return forall val. AuthResult val
NoSuchUser
AuthResult a
Indefinite -> forall (m :: * -> *) a. Monad m => a -> m a
return forall val. AuthResult val
Indefinite
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail AuthCheck where
fail :: forall a. String -> AuthCheck a
fail String
_ = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall val. AuthResult val
Indefinite
instance MonadReader Request AuthCheck where
ask :: AuthCheck Request
ask = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall a b. (a -> b) -> a -> b
$ \Request
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> AuthResult a
Authenticated Request
x)
local :: forall a. (Request -> Request) -> AuthCheck a -> AuthCheck a
local Request -> Request
f (AuthCheck Request -> IO (AuthResult a)
check) = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall a b. (a -> b) -> a -> b
$ \Request
req -> Request -> IO (AuthResult a)
check (Request -> Request
f Request
req)
instance MonadIO AuthCheck where
liftIO :: forall a. IO a -> AuthCheck a
liftIO IO a
action = forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. a -> AuthResult a
Authenticated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
action
instance MonadTime AuthCheck where
currentTime :: AuthCheck UTCTime
currentTime = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
instance Alternative AuthCheck where
empty :: forall val. AuthCheck val
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall val. AuthCheck val -> AuthCheck val -> AuthCheck val
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadPlus AuthCheck where
mzero :: forall val. AuthCheck val
mzero = forall a. Monoid a => a
mempty
mplus :: forall val. AuthCheck val -> AuthCheck val -> AuthCheck val
mplus = forall a. Semigroup a => a -> a -> a
(<>)