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)

-- | Make signatures for response packet.
--   When you don't want to use message authenticator attribute,
--   pass a function to make attributes which doesn't use message authenticator argument.
signPacket :: (a -> ByteString -> Put)     -- ^ Printer for vendor specific attribute
           -> ByteString                   -- ^ Radius secret key
           -> Bin128                       -- ^ Request authenticator
           -> (Word16 -> Bin128 -> Header) -- ^ Function to make header
           -> (Bin128 -> [Attribute' a])   -- ^ Function to make attributes from message authenticator
           -> (Word16, Bin128, Bin128)     -- ^ Packet length, message authenticator and response authenticator
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)     -- ^ Printer for vendor specific attribute
             -> ByteString                   -- ^ Radius secret key
             -> Bin128                       -- ^ Request authenticator
             -> (Word16 -> Bin128 -> Header) -- ^ Function to make header
             -> (Bin128 -> [Attribute' a])   -- ^ Function to make attributes from message authenticator
             -> Packet [Attribute' a]        -- ^ Signed packet
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) -- ^ No Message-Authenticator attribute

  | BadMessageAuthenticator               -- ^ Message-Authenticator attribute is not matched
  | MoreThanOneMessageAuthenticator       -- ^ More than one Message-Authenticator attribute pairs found

  | BadAuthenticator                      -- ^ Radius packet authenticator is not matched

  | AttributesDecodeError String          -- ^ Fail to decode attributes, attribute type error etc.

  | NotRequestPacket Code                 -- ^ Not request packet is passed to function to check request packet
  | NotResponsePacket Code                -- ^ Not response packet is passed to function to check response packet

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)     -- ^ Printer for vendor specific attribute
                   -> 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)     -- ^ Printer for vendor specific attribute
                    -> 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