src/Crypto/Macaroon/Serializer/Base64.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-|
   3 Module      : Crypto.Macaroon.Serializer.Base64
   4 Copyright   : (c) 2015 Julien Tanguy
   5 License     : BSD3
   6
   7 Maintainer  : julien.tanguy@jhome.fr
   8 Stability   : experimental
   9 Portability : portable
  10
  11 Base64 serializer/deserializer
  12
  13 -}
  14 module Crypto.Macaroon.Serializer.Base64 (
  15         serialize
  16       , deserialize
  17       ) where
  18
  19 import           Control.Applicative
  20 import           Control.Monad
  21 import           Crypto.Macaroon.Internal
  22 import           Data.Attoparsec.ByteString
  23 import qualified Data.Attoparsec.ByteString.Char8 as A8
  24 import           Data.Bits
  25 import qualified Data.ByteString                  as BS
  26 import qualified Data.ByteString.Base64.URL       as B64
  27 import qualified Data.ByteString.Char8            as B8
  28 import           Data.Char
  29 import           Data.Hex
  30 import           Data.Int
  31 import           Data.List
  32 import           Data.Maybe
  33 import           Data.Serialize
  34 import           Data.Word
  35
  36
  37 -- | Serialize a macaroon in an URL-safe Base64 encoding
  38 serialize :: Macaroon -> BS.ByteString
  39 serialize m = B8.filter (/= '=') . B64.encode . runPut $ do
  40     packetize "location" (location m)
  41     packetize "identifier" (identifier m)
  42     forM_ (caveats m) $ \c -> do
  43         packetize "cid" (cid c)
  44         unless (cl c == location m && vid c == BS.empty) $ do
  45             packetize "vid" (vid c)
  46             packetize "cl" (cl c)
  47     packetize "signature" (signature m)
  48
  49 packetize :: BS.ByteString -> BS.ByteString -> Put
  50 packetize key dat = do
  51     let size = 4 + 2 + BS.length key + BS.length dat
  52     putByteString $ B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
  53     putByteString key
  54     putByteString " "
  55     putByteString dat
  56     putByteString "\n"
  57
  58 deserialize :: BS.ByteString -> Either String Macaroon
  59 deserialize = parseOnly macaroon . B64.decodeLenient
  60
  61
  62 macaroon :: Parser Macaroon
  63 macaroon = do
  64     ps <- many packet <* endOfInput
  65     let ([("location",l),("identifier",i)],ps') = splitAt 2 ps
  66     let (caveats,sig) = splitAt (length ps' - 1) ps'
  67     let [("signature",s)] = sig
  68     return $ MkMacaroon l i (map (mkCaveat l) (groupBy splitCavs caveats)) s
  69   where
  70     mkCaveat _ [("cid",c),("vid",v),("cl",l)] = MkCaveat c v l
  71     mkCaveat l [("cid",c)] = MkCaveat c BS.empty l
  72     mkCaveat _ _ = error "Malformed caveat"
  73     splitCavs _ ("cid",_) = False
  74     splitCavs _ _ = True
  75
  76 packet :: Parser (BS.ByteString, BS.ByteString)
  77 packet = do
  78     size <- A8.take 4
  79     case A8.parseOnly (A8.hexadecimal :: Parser Word16) size of
  80         Left e -> fail e
  81         Right s -> do
  82             bs <- A8.take (fromIntegral $ s - 4)
  83             let (key, dat) = B8.break (== ' ') bs
  84             return (key, B8.tail $ B8.init dat)
  85