]> git.immae.eu Git - github/fretlink/hmacaroons.git/blame - src/Crypto/Macaroon/Verifier.hs
Basic validation functions
[github/fretlink/hmacaroons.git] / src / Crypto / Macaroon / Verifier.hs
CommitLineData
7f9f7386
JT
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE RankNTypes #-}
4{-# LANGUAGE TypeSynonymInstances #-}
5{-# LANGUAGE UndecidableInstances #-}
b92e3c15
JT
6{-|
7Module : Crypto.Macaroon.Verifier
8Copyright : (c) 2015 Julien Tanguy
9License : BSD3
10
11Maintainer : julien.tanguy@jhome.fr
12Stability : experimental
13Portability : portable
14
15
16
17-}
6f3c0dca 18module Crypto.Macaroon.Verifier (
7f9f7386
JT
19 verify
20 , ValidationError(ValidatorError, ParseError)
21 -- , (.<), (.<=), (.==), (.>), (.>=)
22 -- , module Data.Attoparsec.ByteString.Char8
6f3c0dca 23) where
b92e3c15
JT
24
25
7f9f7386
JT
26import Control.Monad
27import Control.Monad.IO.Class
c830f7c2
JT
28import Data.Attoparsec.ByteString
29import Data.Attoparsec.ByteString.Char8
b92e3c15 30import Data.Bool
c830f7c2 31import qualified Data.ByteString as BS
7f9f7386 32import Data.Either.Combinators
b92e3c15
JT
33
34import Crypto.Macaroon.Internal
7f9f7386 35import Crypto.Macaroon.Verifier.Internal
b92e3c15
JT
36
37
6f3c0dca 38
62576139 39
7f9f7386
JT
40-- (.<) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
41-- (.<) = verifyOpBool "Greater or equal" (<) "<"
42
43-- (.<=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
44-- (.<=) = verifyOpBool "Strictly greater" (<=) "<="
45
46-- (.==) :: (MonadIO m, Eq a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
47-- (.==) = verifyOpBool "Not equal" (==) "="
48
49-- (.>) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
50-- (.>) = verifyOpBool "Less or equal" (>) ">"
51
52-- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
53-- (.>=) = verifyOpBool "Strictly less" (>=) ">="
6f3c0dca 54
857f2f3b 55
7f9f7386
JT
56verify :: MonadIO m => Key -> [Caveat -> m (Maybe (Either ValidationError Caveat))] -> Macaroon -> m (Either ValidationError Macaroon)
57verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers)
58
59
60-- verifyOpBool :: MonadIO m => String -> Parser a -> (a -> a -> Bool) -> BS.ByteString -> Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
61-- verifyOpBool err p f op k val = verifyParser k valueParser $ \s -> do
62-- expected <- val
63-- return $ bool (Left $ ValidatorError err) (Right Win) =<< f expected <$> mapLeft ParseError (parseOnly p s)
64-- where
65-- valueParser = string op *> skipSpace *> takeByteString
66
67verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat))
68verifyParser k p f c = case parseOnly keyParser . cid $ c of
69 Left _ -> return Nothing
70 Right bs -> Just <$> case parseOnly p bs of
71 Left err -> return $ Left $ ParseError err
72 Right a -> fmap (const c) <$> f a
73 where
74 keyParser = string k *> skipSpace *> takeByteString
75