module Data.Radius.Implements (
signPacket, signedPacket,
AuthenticatorError (..),
checkSignedRequest, checkSignedResponse,
) where
import Control.Monad (unless)
import Data.Monoid ((<>))
import Data.Word (Word16)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Serialize.Put (Put, runPut)
import qualified Data.ByteArray as BA
import Crypto.Hash (Digest, hash, MD5)
import Crypto.MAC.HMAC (HMAC, hmac, hmacGetDigest)
import Data.Radius.Packet (Code (..), Header (..), Packet (..))
import Data.Radius.Scalar (AtString (..), Bin128, mayBin128, fromBin128, bin128Zero)
import Data.Radius.Attribute
(Number (MessageAuthenticator), messageAuthenticator,
NumberAbstract (Standard), Attribute' (Attribute'), TypedNumberSets, )
import Data.Radius.StreamGet (Attributes)
import qualified Data.Radius.StreamGet as Get
import qualified Data.Radius.StreamPut as Put
hmacMD5 :: ByteString -> ByteString -> Bin128
hmacMD5 :: ByteString -> ByteString -> Bin128
hmacMD5 ByteString
rsk ByteString
bs =
Bin128 -> (Bin128 -> Bin128) -> Maybe Bin128 -> Bin128
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Bin128
forall a. HasCallStack => [Char] -> a
error [Char]
"hmacMD5: BUG? Invalid result length") Bin128 -> Bin128
forall a. a -> a
id
(Maybe Bin128 -> Bin128)
-> (Digest MD5 -> Maybe Bin128) -> Digest MD5 -> Bin128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Bin128
mayBin128 (ByteString -> Maybe Bin128)
-> (Digest MD5 -> ByteString) -> Digest MD5 -> Maybe Bin128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest MD5 -> Bin128) -> Digest MD5 -> Bin128
forall a b. (a -> b) -> a -> b
$ HMAC MD5 -> Digest MD5
forall a. HMAC a -> Digest a
hmacGetDigest (ByteString -> ByteString -> HMAC MD5
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
rsk ByteString
bs :: HMAC MD5)
md5 :: ByteString -> Bin128
md5 :: ByteString -> Bin128
md5 ByteString
bs = Bin128 -> (Bin128 -> Bin128) -> Maybe Bin128 -> Bin128
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Bin128
forall a. HasCallStack => [Char] -> a
error [Char]
"md5: BUG? Invalid result length") Bin128 -> Bin128
forall a. a -> a
id
(Maybe Bin128 -> Bin128)
-> (ByteString -> Maybe Bin128) -> ByteString -> Bin128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Bin128
mayBin128 (ByteString -> Bin128) -> ByteString -> Bin128
forall a b. (a -> b) -> a -> b
$ Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest MD5
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
bs :: Digest MD5)
signPacket :: (a -> ByteString -> Put)
-> ByteString
-> Bin128
-> (Word16 -> Bin128 -> Header)
-> (Bin128 -> [Attribute' a])
-> (Word16, Bin128, Bin128)
signPacket :: forall a.
(a -> ByteString -> Put)
-> ByteString
-> Bin128
-> (Word16 -> Bin128 -> Header)
-> (Bin128 -> [Attribute' a])
-> (Word16, Bin128, Bin128)
signPacket a -> ByteString -> Put
va ByteString
rsk Bin128
auth Word16 -> Bin128 -> Header
mkH Bin128 -> [Attribute' a]
mkA = (Word16
len, Bin128
msgAuth, Bin128
respAuth)
where
asMsgAuth0 :: [Attribute' a]
asMsgAuth0 = Bin128 -> [Attribute' a]
mkA Bin128
bin128Zero
pput :: Packet [Attribute' a] -> ByteString
pput = Put -> ByteString
runPut (Put -> ByteString)
-> (Packet [Attribute' a] -> Put)
-> Packet [Attribute' a]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
forall a. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
Put.upacket a -> ByteString -> Put
va
len :: Word16
len = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16)
-> (Packet [Attribute' a] -> Int)
-> Packet [Attribute' a]
-> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int)
-> (Packet [Attribute' a] -> ByteString)
-> Packet [Attribute' a]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packet [Attribute' a] -> ByteString
pput
(Packet [Attribute' a] -> Word16)
-> Packet [Attribute' a] -> Word16
forall a b. (a -> b) -> a -> b
$ Packet { header :: Header
header = Word16 -> Bin128 -> Header
mkH Word16
0 Bin128
auth, attributes :: [Attribute' a]
attributes = [Attribute' a]
asMsgAuth0 }
msgAuth :: Bin128
msgAuth = ByteString -> ByteString -> Bin128
hmacMD5 ByteString
rsk (ByteString -> Bin128)
-> (Packet [Attribute' a] -> ByteString)
-> Packet [Attribute' a]
-> Bin128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packet [Attribute' a] -> ByteString
pput
(Packet [Attribute' a] -> Bin128)
-> Packet [Attribute' a] -> Bin128
forall a b. (a -> b) -> a -> b
$ Packet { header :: Header
header = Word16 -> Bin128 -> Header
mkH Word16
len Bin128
auth, attributes :: [Attribute' a]
attributes = [Attribute' a]
asMsgAuth0 }
respAuth :: Bin128
respAuth = ByteString -> Bin128
md5 (ByteString -> Bin128) -> ByteString -> Bin128
forall a b. (a -> b) -> a -> b
$ (Packet [Attribute' a] -> ByteString
pput (Packet [Attribute' a] -> ByteString)
-> Packet [Attribute' a] -> ByteString
forall a b. (a -> b) -> a -> b
$ Packet { header :: Header
header = Word16 -> Bin128 -> Header
mkH Word16
len Bin128
auth, attributes :: [Attribute' a]
attributes = Bin128 -> [Attribute' a]
mkA Bin128
msgAuth }) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
rsk
signedPacket :: (a -> ByteString -> Put)
-> ByteString
-> Bin128
-> (Word16 -> Bin128 -> Header)
-> (Bin128 -> [Attribute' a])
-> Packet [Attribute' a]
signedPacket :: forall a.
(a -> ByteString -> Put)
-> ByteString
-> Bin128
-> (Word16 -> Bin128 -> Header)
-> (Bin128 -> [Attribute' a])
-> Packet [Attribute' a]
signedPacket a -> ByteString -> Put
va ByteString
rsk Bin128
auth Word16 -> Bin128 -> Header
mkH Bin128 -> [Attribute' a]
mkA = case Header -> Code
code (Header -> Code) -> Header -> Code
forall a b. (a -> b) -> a -> b
$ Word16 -> Bin128 -> Header
mkH Word16
len Bin128
auth of
Code
AccessAccept -> Packet [Attribute' a]
response
Code
AccessReject -> Packet [Attribute' a]
response
Code
AccessChallenge -> Packet [Attribute' a]
response
Code
AccessRequest -> Packet [Attribute' a]
other
Other Word8
_ -> Packet [Attribute' a]
other
where
(Word16
len, Bin128
msgAuth, Bin128
respAuth) = (a -> ByteString -> Put)
-> ByteString
-> Bin128
-> (Word16 -> Bin128 -> Header)
-> (Bin128 -> [Attribute' a])
-> (Word16, Bin128, Bin128)
forall a.
(a -> ByteString -> Put)
-> ByteString
-> Bin128
-> (Word16 -> Bin128 -> Header)
-> (Bin128 -> [Attribute' a])
-> (Word16, Bin128, Bin128)
signPacket a -> ByteString -> Put
va ByteString
rsk Bin128
auth Word16 -> Bin128 -> Header
mkH Bin128 -> [Attribute' a]
mkA
response :: Packet [Attribute' a]
response = Packet { header :: Header
header = Word16 -> Bin128 -> Header
mkH Word16
len Bin128
respAuth, attributes :: [Attribute' a]
attributes = Bin128 -> [Attribute' a]
mkA Bin128
msgAuth }
other :: Packet [Attribute' a]
other = Packet { header :: Header
header = Word16 -> Bin128 -> Header
mkH Word16
len Bin128
auth , attributes :: [Attribute' a]
attributes = Bin128 -> [Attribute' a]
mkA Bin128
msgAuth }
data AuthenticatorError v
= NoMessageAuthenticator (Attributes v)
| BadMessageAuthenticator
| MoreThanOneMessageAuthenticator
| BadAuthenticator
| AttributesDecodeError String
| NotRequestPacket Code
| NotResponsePacket Code
instance Show (AuthenticatorError v) where
show :: AuthenticatorError v -> [Char]
show = AuthenticatorError v -> [Char]
forall v. AuthenticatorError v -> [Char]
d where
d :: AuthenticatorError v -> [Char]
d (NoMessageAuthenticator Attributes v
_) = [Char]
"no messageAuthenticator found"
d AuthenticatorError v
BadMessageAuthenticator = [Char]
"bad messageAuthenticator"
d AuthenticatorError v
MoreThanOneMessageAuthenticator = [Char]
"more than one messageAuthenticator found"
d AuthenticatorError v
BadAuthenticator = [Char]
"bad radius packet authenticator"
d (AttributesDecodeError [Char]
s) = [Char]
"fail to decode attributes: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
d (NotRequestPacket Code
c) = [Char]
"not request packet: code: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Code -> [Char]
forall a. Show a => a -> [Char]
show Code
c
d (NotResponsePacket Code
c) = [Char]
"not response packet: code: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Code -> [Char]
forall a. Show a => a -> [Char]
show Code
c
checkSignedRequest :: (TypedNumberSets a, Ord a)
=> (a -> ByteString -> Put)
-> ByteString
-> Packet [Attribute' a]
-> Either (AuthenticatorError a) (Attributes a)
checkSignedRequest :: forall a.
(TypedNumberSets a, Ord a) =>
(a -> ByteString -> Put)
-> ByteString
-> Packet [Attribute' a]
-> Either (AuthenticatorError a) (Attributes a)
checkSignedRequest a -> ByteString -> Put
va ByteString
rsk Packet [Attribute' a]
upkt = case Header -> Code
code (Header -> Code) -> Header -> Code
forall a b. (a -> b) -> a -> b
$ Packet [Attribute' a] -> Header
forall a. Packet a -> Header
header Packet [Attribute' a]
upkt of
c :: Code
c@Code
AccessAccept -> Code -> Either (AuthenticatorError a) (Attributes a)
forall {v} {b}. Code -> Either (AuthenticatorError v) b
notRequestCode Code
c
c :: Code
c@Code
AccessReject -> Code -> Either (AuthenticatorError a) (Attributes a)
forall {v} {b}. Code -> Either (AuthenticatorError v) b
notRequestCode Code
c
c :: Code
c@Code
AccessChallenge -> Code -> Either (AuthenticatorError a) (Attributes a)
forall {v} {b}. Code -> Either (AuthenticatorError v) b
notRequestCode Code
c
Code
AccessRequest -> Either (AuthenticatorError a) (Attributes a)
check
Other Word8
_ -> Either (AuthenticatorError a) (Attributes a)
check
where
notRequestCode :: Code -> Either (AuthenticatorError v) b
notRequestCode = AuthenticatorError v -> Either (AuthenticatorError v) b
forall a b. a -> Either a b
Left (AuthenticatorError v -> Either (AuthenticatorError v) b)
-> (Code -> AuthenticatorError v)
-> Code
-> Either (AuthenticatorError v) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> AuthenticatorError v
forall v. Code -> AuthenticatorError v
NotRequestPacket
check :: Either (AuthenticatorError a) (Attributes a)
check = Bin128
-> [Attribute' a] -> Either (AuthenticatorError a) (Attributes a)
forall a.
(TypedNumberSets a, Ord a) =>
Bin128
-> [Attribute' a] -> Either (AuthenticatorError a) (Attributes a)
checkMA Bin128
calcMsgAuth ([Attribute' a] -> Either (AuthenticatorError a) (Attributes a))
-> [Attribute' a] -> Either (AuthenticatorError a) (Attributes a)
forall a b. (a -> b) -> a -> b
$ [Attribute' a]
attrs
attrs :: [Attribute' a]
attrs = Packet [Attribute' a] -> [Attribute' a]
forall a. Packet a -> a
attributes Packet [Attribute' a]
upkt
calcMsgAuth :: Bin128
calcMsgAuth = ByteString -> ByteString -> Bin128
hmacMD5 ByteString
rsk (ByteString -> Bin128)
-> (Packet [Attribute' a] -> ByteString)
-> Packet [Attribute' a]
-> Bin128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (Packet [Attribute' a] -> Put)
-> Packet [Attribute' a]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
forall a. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
Put.upacket a -> ByteString -> Put
va
(Packet [Attribute' a] -> Bin128)
-> Packet [Attribute' a] -> Bin128
forall a b. (a -> b) -> a -> b
$ Packet [Attribute' a]
upkt { attributes = replace0MA attrs }
checkSignedResponse :: (TypedNumberSets a, Ord a)
=> (a -> ByteString -> Put)
-> ByteString
-> Bin128
-> Packet [Attribute' a]
-> Either (AuthenticatorError a) (Attributes a)
checkSignedResponse :: forall a.
(TypedNumberSets a, Ord a) =>
(a -> ByteString -> Put)
-> ByteString
-> Bin128
-> Packet [Attribute' a]
-> Either (AuthenticatorError a) (Attributes a)
checkSignedResponse a -> ByteString -> Put
va ByteString
rsk Bin128
reqAuth Packet [Attribute' a]
upkt = case Header -> Code
code (Header -> Code) -> Header -> Code
forall a b. (a -> b) -> a -> b
$ Packet [Attribute' a] -> Header
forall a. Packet a -> Header
header Packet [Attribute' a]
upkt of
Code
AccessAccept -> Either (AuthenticatorError a) (Attributes a)
check
Code
AccessReject -> Either (AuthenticatorError a) (Attributes a)
check
Code
AccessChallenge -> Either (AuthenticatorError a) (Attributes a)
check
c :: Code
c@Code
AccessRequest -> Code -> Either (AuthenticatorError a) (Attributes a)
forall {v} {b}. Code -> Either (AuthenticatorError v) b
notResponseCode Code
c
c :: Code
c@(Other Word8
_) -> Code -> Either (AuthenticatorError a) (Attributes a)
forall {v} {b}. Code -> Either (AuthenticatorError v) b
notResponseCode Code
c
where
notResponseCode :: Code -> Either (AuthenticatorError v) b
notResponseCode = AuthenticatorError v -> Either (AuthenticatorError v) b
forall a b. a -> Either a b
Left (AuthenticatorError v -> Either (AuthenticatorError v) b)
-> (Code -> AuthenticatorError v)
-> Code
-> Either (AuthenticatorError v) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> AuthenticatorError v
forall v. Code -> AuthenticatorError v
NotResponsePacket
check :: Either (AuthenticatorError a) (Attributes a)
check = do
Bool
-> Either (AuthenticatorError a) ()
-> Either (AuthenticatorError a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Header -> Bin128
authenticator (Packet [Attribute' a] -> Header
forall a. Packet a -> Header
header Packet [Attribute' a]
upkt) Bin128 -> Bin128 -> Bool
forall a. Eq a => a -> a -> Bool
== Bin128
calcRespAuth) (Either (AuthenticatorError a) ()
-> Either (AuthenticatorError a) ())
-> Either (AuthenticatorError a) ()
-> Either (AuthenticatorError a) ()
forall a b. (a -> b) -> a -> b
$ AuthenticatorError a -> Either (AuthenticatorError a) ()
forall a b. a -> Either a b
Left AuthenticatorError a
forall v. AuthenticatorError v
BadAuthenticator
Bin128
-> [Attribute' a] -> Either (AuthenticatorError a) (Attributes a)
forall a.
(TypedNumberSets a, Ord a) =>
Bin128
-> [Attribute' a] -> Either (AuthenticatorError a) (Attributes a)
checkMA Bin128
calcMsgAuth [Attribute' a]
attrs
attrs :: [Attribute' a]
attrs = Packet [Attribute' a] -> [Attribute' a]
forall a. Packet a -> a
attributes Packet [Attribute' a]
upkt
calcRespAuth :: Bin128
calcRespAuth = ByteString -> Bin128
md5
(ByteString -> Bin128) -> ByteString -> Bin128
forall a b. (a -> b) -> a -> b
$ (Put -> ByteString
runPut (Put -> ByteString)
-> (Packet [Attribute' a] -> Put)
-> Packet [Attribute' a]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
forall a. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
Put.upacket a -> ByteString -> Put
va (Packet [Attribute' a] -> ByteString)
-> Packet [Attribute' a] -> ByteString
forall a b. (a -> b) -> a -> b
$ Packet [Attribute' a]
upkt { header = (header upkt) { authenticator = reqAuth } }) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
rsk
calcMsgAuth :: Bin128
calcMsgAuth = ByteString -> ByteString -> Bin128
hmacMD5 ByteString
rsk (ByteString -> Bin128)
-> (Packet [Attribute' a] -> ByteString)
-> Packet [Attribute' a]
-> Bin128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (Packet [Attribute' a] -> Put)
-> Packet [Attribute' a]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
forall a. (a -> ByteString -> Put) -> Packet [Attribute' a] -> Put
Put.upacket a -> ByteString -> Put
va
(Packet [Attribute' a] -> Bin128)
-> Packet [Attribute' a] -> Bin128
forall a b. (a -> b) -> a -> b
$ Packet [Attribute' a]
upkt { header = (header upkt) { authenticator = reqAuth }
, attributes = replace0MA attrs }
checkMA :: (TypedNumberSets a, Ord a)
=> Bin128 -> [Attribute' a] -> Either (AuthenticatorError a) (Attributes a)
checkMA :: forall a.
(TypedNumberSets a, Ord a) =>
Bin128
-> [Attribute' a] -> Either (AuthenticatorError a) (Attributes a)
checkMA Bin128
calcMsgAuth [Attribute' a]
attrs = do
Attributes a
ta <- ([Char] -> Either (AuthenticatorError a) (Attributes a))
-> (Attributes a -> Either (AuthenticatorError a) (Attributes a))
-> Either [Char] (Attributes a)
-> Either (AuthenticatorError a) (Attributes a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (AuthenticatorError a
-> Either (AuthenticatorError a) (Attributes a)
forall a b. a -> Either a b
Left (AuthenticatorError a
-> Either (AuthenticatorError a) (Attributes a))
-> ([Char] -> AuthenticatorError a)
-> [Char]
-> Either (AuthenticatorError a) (Attributes a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> AuthenticatorError a
forall v. [Char] -> AuthenticatorError v
AttributesDecodeError) Attributes a -> Either (AuthenticatorError a) (Attributes a)
forall a. a -> Either (AuthenticatorError a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] (Attributes a)
-> Either (AuthenticatorError a) (Attributes a))
-> (AttributeGetWT a (Either [Char]) [()]
-> Either [Char] (Attributes a))
-> AttributeGetWT a (Either [Char]) [()]
-> Either (AuthenticatorError a) (Attributes a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeGetWT a (Either [Char]) [()]
-> Either [Char] (Attributes a)
forall (m :: * -> *) v a.
Monad m =>
AttributeGetWT v m a -> m (Attributes v)
Get.extractAttributes (AttributeGetWT a (Either [Char]) [()]
-> Either (AuthenticatorError a) (Attributes a))
-> AttributeGetWT a (Either [Char]) [()]
-> Either (AuthenticatorError a) (Attributes a)
forall a b. (a -> b) -> a -> b
$ (Attribute' a
-> WriterT
(AtList a AtIpV4)
(AtWriterT
a
AtText
(AtWriterT
a
AtInteger
(AtWriterT
a AtString (WriterT (DList (Attribute' a)) (Either [Char])))))
())
-> [Attribute' a] -> AttributeGetWT a (Either [Char]) [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Attribute' a
-> WriterT
(AtList a AtIpV4)
(AtWriterT
a
AtText
(AtWriterT
a
AtInteger
(AtWriterT
a AtString (WriterT (DList (Attribute' a)) (Either [Char])))))
()
forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> AttributeGetWT v (Either [Char]) ()
Get.tellT [Attribute' a]
attrs
case Attributes a -> TypedNumber a AtString -> [AtString]
forall (m :: * -> *) a v.
(MonadPlus m, TypedAttributes a, Eq v) =>
Attributes v -> TypedNumber v a -> m a
Get.takeTyped Attributes a
ta TypedNumber a AtString
forall a. Ord a => TypedNumber a AtString
messageAuthenticator of
[] -> AuthenticatorError a
-> Either (AuthenticatorError a) (Attributes a)
forall a b. a -> Either a b
Left (AuthenticatorError a
-> Either (AuthenticatorError a) (Attributes a))
-> AuthenticatorError a
-> Either (AuthenticatorError a) (Attributes a)
forall a b. (a -> b) -> a -> b
$ Attributes a -> AuthenticatorError a
forall v. Attributes v -> AuthenticatorError v
NoMessageAuthenticator Attributes a
ta
[AtString ByteString
bs] -> do
Bool
-> Either (AuthenticatorError a) ()
-> Either (AuthenticatorError a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Bin128 -> ByteString
fromBin128 Bin128
calcMsgAuth) (Either (AuthenticatorError a) ()
-> Either (AuthenticatorError a) ())
-> Either (AuthenticatorError a) ()
-> Either (AuthenticatorError a) ()
forall a b. (a -> b) -> a -> b
$ AuthenticatorError a -> Either (AuthenticatorError a) ()
forall a b. a -> Either a b
Left AuthenticatorError a
forall v. AuthenticatorError v
BadMessageAuthenticator
Attributes a -> Either (AuthenticatorError a) (Attributes a)
forall a. a -> Either (AuthenticatorError a) a
forall (m :: * -> *) a. Monad m => a -> m a
return Attributes a
ta
AtString
_:AtString
_:[AtString]
_ -> AuthenticatorError a
-> Either (AuthenticatorError a) (Attributes a)
forall a b. a -> Either a b
Left AuthenticatorError a
forall v. AuthenticatorError v
MoreThanOneMessageAuthenticator
replace0MA :: [Attribute' a] -> [Attribute' a]
replace0MA :: forall a. [Attribute' a] -> [Attribute' a]
replace0MA = [Attribute' a] -> [Attribute' a]
forall a. [Attribute' a] -> [Attribute' a]
rec' where
rec' :: [Attribute' v] -> [Attribute' v]
rec' [] =
[]
rec' (Attribute' n :: NumberAbstract v
n@(Standard Number
MessageAuthenticator) ByteString
_ : [Attribute' v]
xs) =
NumberAbstract v -> ByteString -> Attribute' v
forall v. NumberAbstract v -> ByteString -> Attribute' v
Attribute' NumberAbstract v
n (Bin128 -> ByteString
fromBin128 Bin128
bin128Zero) Attribute' v -> [Attribute' v] -> [Attribute' v]
forall a. a -> [a] -> [a]
: [Attribute' v] -> [Attribute' v]
rec' [Attribute' v]
xs
rec' (Attribute' v
x : [Attribute' v]
xs) =
Attribute' v
x Attribute' v -> [Attribute' v] -> [Attribute' v]
forall a. a -> [a] -> [a]
: [Attribute' v] -> [Attribute' v]
rec' [Attribute' v]
xs