module Data.Radius.StreamPut.Base (
upacket, packet,
header, attribute', vendorID, simpleVendorAttribute,
code, bin128,
atText, atString, atInteger, atIpV4,
) where
import Data.Word (Word8, Word32)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Serialize.Put
(Put, putWord8, putWord16be, putWord32be,
putByteString, runPut)
import Data.Radius.Scalar
(Bin128, fromBin128, AtText (..), AtString (..), AtInteger (..), AtIpV4 (..))
import Data.Radius.Packet (Code, Header, Packet, codeToWord)
import qualified Data.Radius.Packet as Data
import Data.Radius.Attribute (NumberAbstract (..), Attribute' (..))
import qualified Data.Radius.Attribute as Attribute
code :: Code -> Put
code c = putWord8 $ codeToWord c
pktId :: Word8 -> Put
pktId = putWord8
bin128 :: Bin128 -> Put
bin128 = putByteString . fromBin128
header :: Header -> Put
header h = do
code $ Data.code h
pktId $ Data.pktId h
putWord16be $ Data.pktLength h
bin128 $ Data.authenticator h
packet :: (a -> Put) -> Packet a -> Put
packet putAttrs pkt = do
header $ Data.header pkt
putAttrs $ Data.attributes pkt
radiusNumber :: Attribute.Number -> Put
radiusNumber = putWord8 . Attribute.toWord
vendorID :: Word32 -> Put
vendorID = putWord32be
simpleVendorAttribute :: Word8
-> ByteString
-> Put
simpleVendorAttribute n bs = do
putWord8 n
putWord8 $ fromIntegral (BS.length bs) + 2
putByteString bs
vendorAttribute :: (a -> ByteString -> Put)
-> a -> ByteString -> Put
vendorAttribute = id
attribute' :: (a -> ByteString -> Put)
-> (Attribute' a) -> Put
attribute' vp (Attribute' an bs) = do
case an of
Standard n -> do
radiusNumber n
putWord8 $ fromIntegral (BS.length bs) + 2
putByteString bs
Vendors nn -> do
radiusNumber Attribute.VendorSpecific
let bsn = runPut $ vendorAttribute vp nn bs
putWord8 . fromIntegral $ BS.length bsn + 2
putByteString bsn
upacket :: (a -> ByteString -> Put)
-> Packet [Attribute' a] -> Put
upacket vp = packet $ mapM_ $ attribute' vp
atText :: AtText -> Put
atText (AtText t) = putByteString . Text.encodeUtf8 $ Text.pack t
atString :: AtString -> Put
atString (AtString s) = putByteString s
atInteger :: AtInteger -> Put
atInteger (AtInteger i) = putWord32be i
atIpV4 :: AtIpV4 -> Put
atIpV4 (AtIpV4 ip) = putWord32be ip