{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Data.ZAuth.Validation
  ( Env,
    Validate,
    mkEnv,
    runValidate,
    Failure (..),
    validate,
    validateUser,
    validateAccess,
    validateBot,
    validateProvider,
    check,
  )
where

import Control.Lens
import Control.Monad.Except
import Data.ByteString qualified as Strict
import Data.ByteString.Conversion
import Data.Time.Clock.POSIX
import Data.Vector (Vector, (!))
import Data.Vector qualified as Vec
import Data.ZAuth.Token
import Imports
import Sodium.Crypto.Sign (PublicKey, Signature, verifyWith)

data Failure
  = -- | The token signature is incorrect.
    Falsified
  | -- | The token is expired.
    Expired
  | -- | Invalid token.
    Invalid
  | -- | This operation is unsupported on this token type
    Unsupported
  deriving (Failure -> Failure -> Bool
(Failure -> Failure -> Bool)
-> (Failure -> Failure -> Bool) -> Eq Failure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Failure -> Failure -> Bool
== :: Failure -> Failure -> Bool
$c/= :: Failure -> Failure -> Bool
/= :: Failure -> Failure -> Bool
Eq, Int -> Failure -> ShowS
[Failure] -> ShowS
Failure -> String
(Int -> Failure -> ShowS)
-> (Failure -> String) -> ([Failure] -> ShowS) -> Show Failure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Failure -> ShowS
showsPrec :: Int -> Failure -> ShowS
$cshow :: Failure -> String
show :: Failure -> String
$cshowList :: [Failure] -> ShowS
showList :: [Failure] -> ShowS
Show)

instance Exception Failure

newtype Env = Env
  {Env -> Vector (Signature -> ByteString -> IO Bool)
verifyFns :: Vector (Signature -> Strict.ByteString -> IO Bool)}

newtype Validate a = Validate
  { forall a. Validate a -> ExceptT Failure (ReaderT Env IO) a
valid :: ExceptT Failure (ReaderT Env IO) a
  }
  deriving
    ( (forall a b. (a -> b) -> Validate a -> Validate b)
-> (forall a b. a -> Validate b -> Validate a) -> Functor Validate
forall a b. a -> Validate b -> Validate a
forall a b. (a -> b) -> Validate a -> Validate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Validate a -> Validate b
fmap :: forall a b. (a -> b) -> Validate a -> Validate b
$c<$ :: forall a b. a -> Validate b -> Validate a
<$ :: forall a b. a -> Validate b -> Validate a
Functor,
      Functor Validate
Functor Validate =>
(forall a. a -> Validate a)
-> (forall a b. Validate (a -> b) -> Validate a -> Validate b)
-> (forall a b c.
    (a -> b -> c) -> Validate a -> Validate b -> Validate c)
-> (forall a b. Validate a -> Validate b -> Validate b)
-> (forall a b. Validate a -> Validate b -> Validate a)
-> Applicative Validate
forall a. a -> Validate a
forall a b. Validate a -> Validate b -> Validate a
forall a b. Validate a -> Validate b -> Validate b
forall a b. Validate (a -> b) -> Validate a -> Validate b
forall a b c.
(a -> b -> c) -> Validate a -> Validate b -> Validate c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Validate a
pure :: forall a. a -> Validate a
$c<*> :: forall a b. Validate (a -> b) -> Validate a -> Validate b
<*> :: forall a b. Validate (a -> b) -> Validate a -> Validate b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Validate a -> Validate b -> Validate c
liftA2 :: forall a b c.
(a -> b -> c) -> Validate a -> Validate b -> Validate c
$c*> :: forall a b. Validate a -> Validate b -> Validate b
*> :: forall a b. Validate a -> Validate b -> Validate b
$c<* :: forall a b. Validate a -> Validate b -> Validate a
<* :: forall a b. Validate a -> Validate b -> Validate a
Applicative,
      Applicative Validate
Applicative Validate =>
(forall a b. Validate a -> (a -> Validate b) -> Validate b)
-> (forall a b. Validate a -> Validate b -> Validate b)
-> (forall a. a -> Validate a)
-> Monad Validate
forall a. a -> Validate a
forall a b. Validate a -> Validate b -> Validate b
forall a b. Validate a -> (a -> Validate b) -> Validate b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Validate a -> (a -> Validate b) -> Validate b
>>= :: forall a b. Validate a -> (a -> Validate b) -> Validate b
$c>> :: forall a b. Validate a -> Validate b -> Validate b
>> :: forall a b. Validate a -> Validate b -> Validate b
$creturn :: forall a. a -> Validate a
return :: forall a. a -> Validate a
Monad,
      Monad Validate
Monad Validate =>
(forall a. IO a -> Validate a) -> MonadIO Validate
forall a. IO a -> Validate a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Validate a
liftIO :: forall a. IO a -> Validate a
MonadIO,
      MonadError Failure
    )

mkEnv :: PublicKey -> [PublicKey] -> Env
mkEnv :: PublicKey -> [PublicKey] -> Env
mkEnv PublicKey
k [PublicKey]
kk = Vector (Signature -> ByteString -> IO Bool) -> Env
Env (Vector (Signature -> ByteString -> IO Bool) -> Env)
-> Vector (Signature -> ByteString -> IO Bool) -> Env
forall a b. (a -> b) -> a -> b
$ [Signature -> ByteString -> IO Bool]
-> Vector (Signature -> ByteString -> IO Bool)
forall a. [a] -> Vector a
Vec.fromList ((PublicKey -> Signature -> ByteString -> IO Bool)
-> [PublicKey] -> [Signature -> ByteString -> IO Bool]
forall a b. (a -> b) -> [a] -> [b]
map PublicKey -> Signature -> ByteString -> IO Bool
verifyWith (PublicKey
k PublicKey -> [PublicKey] -> [PublicKey]
forall a. a -> [a] -> [a]
: [PublicKey]
kk))

runValidate :: (MonadIO m) => Env -> Validate a -> m (Either Failure a)
runValidate :: forall (m :: * -> *) a.
MonadIO m =>
Env -> Validate a -> m (Either Failure a)
runValidate Env
v Validate a
m = IO (Either Failure a) -> m (Either Failure a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Failure a) -> m (Either Failure a))
-> IO (Either Failure a) -> m (Either Failure a)
forall a b. (a -> b) -> a -> b
$ ReaderT Env IO (Either Failure a) -> Env -> IO (Either Failure a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ExceptT Failure (ReaderT Env IO) a
-> ReaderT Env IO (Either Failure a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Validate a -> ExceptT Failure (ReaderT Env IO) a
forall a. Validate a -> ExceptT Failure (ReaderT Env IO) a
valid Validate a
m)) Env
v

validateUser :: ByteString -> Validate (Token User)
validateUser :: ByteString -> Validate (Token User)
validateUser ByteString
t = Validate (Token User)
-> (Token User -> Validate (Token User))
-> Maybe (Token User)
-> Validate (Token User)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> Validate (Token User)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid) Token User -> Validate (Token User)
forall a. ToByteString a => Token a -> Validate (Token a)
check (ByteString -> Maybe (Token User)
forall a. FromByteString a => ByteString -> Maybe a
fromByteString ByteString
t)

validateAccess :: ByteString -> Validate (Token Access)
validateAccess :: ByteString -> Validate (Token Access)
validateAccess ByteString
t = Validate (Token Access)
-> (Token Access -> Validate (Token Access))
-> Maybe (Token Access)
-> Validate (Token Access)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> Validate (Token Access)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid) Token Access -> Validate (Token Access)
forall a. ToByteString a => Token a -> Validate (Token a)
check (ByteString -> Maybe (Token Access)
forall a. FromByteString a => ByteString -> Maybe a
fromByteString ByteString
t)

validateBot :: ByteString -> Validate (Token Bot)
validateBot :: ByteString -> Validate (Token Bot)
validateBot ByteString
t = Validate (Token Bot)
-> (Token Bot -> Validate (Token Bot))
-> Maybe (Token Bot)
-> Validate (Token Bot)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> Validate (Token Bot)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid) Token Bot -> Validate (Token Bot)
forall a. ToByteString a => Token a -> Validate (Token a)
check (ByteString -> Maybe (Token Bot)
forall a. FromByteString a => ByteString -> Maybe a
fromByteString ByteString
t)

validateProvider :: ByteString -> Validate (Token Provider)
validateProvider :: ByteString -> Validate (Token Provider)
validateProvider ByteString
t = Validate (Token Provider)
-> (Token Provider -> Validate (Token Provider))
-> Maybe (Token Provider)
-> Validate (Token Provider)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> Validate (Token Provider)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid) Token Provider -> Validate (Token Provider)
forall a. ToByteString a => Token a -> Validate (Token a)
check (ByteString -> Maybe (Token Provider)
forall a. FromByteString a => ByteString -> Maybe a
fromByteString ByteString
t)

-----------------------------------------------------------------------------
-- User & Access Validation
--
-- It is not allowed to only have a user, but no access token for
-- validation purposes.

validate ::
  -- | assumed to be a 'Token User'
  Maybe ByteString ->
  -- | assumed to be a 'Token Access'
  Maybe ByteString ->
  Validate (Token Access)
validate :: Maybe ByteString -> Maybe ByteString -> Validate (Token Access)
validate Maybe ByteString
Nothing Maybe ByteString
Nothing = Failure -> Validate (Token Access)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid
validate (Just ByteString
_) Maybe ByteString
Nothing = Failure -> Validate (Token Access)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid
validate Maybe ByteString
Nothing (Just ByteString
t) = ByteString -> Validate (Token Access)
validateAccess ByteString
t
validate (Just ByteString
c) (Just ByteString
t) = do
  Token User
u <- Validate (Token User)
-> (Token User -> Validate (Token User))
-> Maybe (Token User)
-> Validate (Token User)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> Validate (Token User)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid) Token User -> Validate (Token User)
forall a. a -> Validate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe (Token User)
forall a. FromByteString a => ByteString -> Maybe a
fromByteString ByteString
c)
  Token Access
a <- Validate (Token Access)
-> (Token Access -> Validate (Token Access))
-> Maybe (Token Access)
-> Validate (Token Access)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> Validate (Token Access)
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid) Token Access -> Validate (Token Access)
forall a. a -> Validate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe (Token Access)
forall a. FromByteString a => ByteString -> Maybe a
fromByteString ByteString
t)
  Validate (Token User) -> Validate ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Validate (Token User) -> Validate ())
-> Validate (Token User) -> Validate ()
forall a b. (a -> b) -> a -> b
$ Token User -> Validate (Token User)
forall a. ToByteString a => Token a -> Validate (Token a)
check Token User
u
  Validate (Token Access) -> Validate ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Validate (Token Access) -> Validate ())
-> Validate (Token Access) -> Validate ()
forall a b. (a -> b) -> a -> b
$ Token Access -> Validate (Token Access)
forall a. ToByteString a => Token a -> Validate (Token a)
check Token Access
a
  Bool -> Validate () -> Validate ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Token User
u Token User -> Getting UUID (Token User) UUID -> UUID
forall s a. s -> Getting a s a -> a
^. (User -> Const UUID User) -> Token User -> Const UUID (Token User)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(a -> f a) -> Token a -> f (Token a)
body ((User -> Const UUID User)
 -> Token User -> Const UUID (Token User))
-> ((UUID -> Const UUID UUID) -> User -> Const UUID User)
-> Getting UUID (Token User) UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UUID -> Const UUID UUID) -> User -> Const UUID User
Lens' User UUID
user UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== Token Access
a Token Access -> Getting UUID (Token Access) UUID -> UUID
forall s a. s -> Getting a s a -> a
^. (Access -> Const UUID Access)
-> Token Access -> Const UUID (Token Access)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(a -> f a) -> Token a -> f (Token a)
body ((Access -> Const UUID Access)
 -> Token Access -> Const UUID (Token Access))
-> ((UUID -> Const UUID UUID) -> Access -> Const UUID Access)
-> Getting UUID (Token Access) UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UUID -> Const UUID UUID) -> Access -> Const UUID Access
Lens' Access UUID
userId) (Validate () -> Validate ()) -> Validate () -> Validate ()
forall a b. (a -> b) -> a -> b
$
    Failure -> Validate ()
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid
  Token Access -> Validate (Token Access)
forall a. a -> Validate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Token Access
a

check :: (ToByteString a) => Token a -> Validate (Token a)
check :: forall a. ToByteString a => Token a -> Validate (Token a)
check Token a
t = do
  Vector (Signature -> ByteString -> IO Bool)
ff <- ExceptT
  Failure
  (ReaderT Env IO)
  (Vector (Signature -> ByteString -> IO Bool))
-> Validate (Vector (Signature -> ByteString -> IO Bool))
forall a. ExceptT Failure (ReaderT Env IO) a -> Validate a
Validate (ExceptT
   Failure
   (ReaderT Env IO)
   (Vector (Signature -> ByteString -> IO Bool))
 -> Validate (Vector (Signature -> ByteString -> IO Bool)))
-> ExceptT
     Failure
     (ReaderT Env IO)
     (Vector (Signature -> ByteString -> IO Bool))
-> Validate (Vector (Signature -> ByteString -> IO Bool))
forall a b. (a -> b) -> a -> b
$ ReaderT Env IO (Vector (Signature -> ByteString -> IO Bool))
-> ExceptT
     Failure
     (ReaderT Env IO)
     (Vector (Signature -> ByteString -> IO Bool))
forall (m :: * -> *) a. Monad m => m a -> ExceptT Failure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Env IO (Vector (Signature -> ByteString -> IO Bool))
 -> ExceptT
      Failure
      (ReaderT Env IO)
      (Vector (Signature -> ByteString -> IO Bool)))
-> ReaderT Env IO (Vector (Signature -> ByteString -> IO Bool))
-> ExceptT
     Failure
     (ReaderT Env IO)
     (Vector (Signature -> ByteString -> IO Bool))
forall a b. (a -> b) -> a -> b
$ (Env -> Vector (Signature -> ByteString -> IO Bool))
-> ReaderT Env IO (Vector (Signature -> ByteString -> IO Bool))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Vector (Signature -> ByteString -> IO Bool)
verifyFns
  let dat :: ByteString
dat = Builder -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Header -> a -> Builder
forall a. ToByteString a => Header -> a -> Builder
writeData (Token a
t Token a -> Getting Header (Token a) Header -> Header
forall s a. s -> Getting a s a -> a
^. Getting Header (Token a) Header
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Header -> f Header) -> Token a -> f (Token a)
header) (Token a
t Token a -> Getting a (Token a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Token a) a
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(a -> f a) -> Token a -> f (Token a)
body)
  let k :: Int
k = Token a
t Token a -> Getting Int (Token a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Header -> Const Int Header) -> Token a -> Const Int (Token a)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Header -> f Header) -> Token a -> f (Token a)
header ((Header -> Const Int Header) -> Token a -> Const Int (Token a))
-> ((Int -> Const Int Int) -> Header -> Const Int Header)
-> Getting Int (Token a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Header -> Const Int Header
Lens' Header Int
key
  Bool -> Validate () -> Validate ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector (Signature -> ByteString -> IO Bool) -> Int
forall a. Vector a -> Int
Vec.length Vector (Signature -> ByteString -> IO Bool)
ff) (Validate () -> Validate ()) -> Validate () -> Validate ()
forall a b. (a -> b) -> a -> b
$
    Failure -> Validate ()
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Invalid
  Bool
ok <- IO Bool -> Validate Bool
forall a. IO a -> Validate a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Validate Bool) -> IO Bool -> Validate Bool
forall a b. (a -> b) -> a -> b
$ (Vector (Signature -> ByteString -> IO Bool)
ff Vector (Signature -> ByteString -> IO Bool)
-> Int -> Signature -> ByteString -> IO Bool
forall a. Vector a -> Int -> a
! (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Token a
t Token a -> Getting Signature (Token a) Signature -> Signature
forall s a. s -> Getting a s a -> a
^. Getting Signature (Token a) Signature
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Signature -> f Signature) -> Token a -> f (Token a)
signature) ByteString
dat
  Bool -> Validate () -> Validate ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (Validate () -> Validate ()) -> Validate () -> Validate ()
forall a b. (a -> b) -> a -> b
$
    Failure -> Validate ()
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Falsified
  Bool
isExpired <-
    if Token a
t Token a -> Getting Integer (Token a) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. (Header -> Const Integer Header)
-> Token a -> Const Integer (Token a)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Header -> f Header) -> Token a -> f (Token a)
header ((Header -> Const Integer Header)
 -> Token a -> Const Integer (Token a))
-> ((Integer -> Const Integer Integer)
    -> Header -> Const Integer Header)
-> Getting Integer (Token a) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const Integer Integer)
-> Header -> Const Integer Header
Lens' Header Integer
time Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -Integer
1
      then Bool -> Validate Bool
forall a. a -> Validate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      else (Token a
t Token a -> Getting Integer (Token a) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. (Header -> Const Integer Header)
-> Token a -> Const Integer (Token a)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Header -> f Header) -> Token a -> f (Token a)
header ((Header -> Const Integer Header)
 -> Token a -> Const Integer (Token a))
-> ((Integer -> Const Integer Integer)
    -> Header -> Const Integer Header)
-> Getting Integer (Token a) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const Integer Integer)
-> Header -> Const Integer Header
Lens' Header Integer
time <) (Integer -> Bool) -> Validate Integer -> Validate Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validate Integer
forall (m :: * -> *). MonadIO m => m Integer
now
  Bool -> Validate () -> Validate ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isExpired (Validate () -> Validate ()) -> Validate () -> Validate ()
forall a b. (a -> b) -> a -> b
$
    Failure -> Validate ()
forall a. Failure -> Validate a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Failure
Expired
  Token a -> Validate (Token a)
forall a. a -> Validate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Token a
t

now :: (MonadIO m) => m Integer
now :: forall (m :: * -> *). MonadIO m => m Integer
now = POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer) -> m POSIXTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime