{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.ProtoLens.Any
( Any
, pack
, packWithPrefix
, unpack
, UnpackError(..)
) where
import Control.Exception (Exception(..))
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as Text
import Data.Text (Text)
import Data.ProtoLens
( decodeMessage
, defMessage
, encodeMessage
, Message(..)
)
import Data.Proxy (Proxy(..))
import Lens.Family2 ((&), (.~), (^.))
import Proto.Google.Protobuf.Any
import Proto.Google.Protobuf.Any_Fields (typeUrl, value)
-- | Packs the given message into an 'Any' using the default type URL prefix
-- "type.googleapis.com".
pack :: forall a . Message a => a -> Any
pack = packWithPrefix googleApisPrefix
googleApisPrefix :: Text
googleApisPrefix = "type.googleapis.com"
-- | Packs the given message into an 'Any' using the given type URL prefix.
packWithPrefix :: forall a . Message a => Text -> a -> Any
packWithPrefix prefix x =
defMessage
& typeUrl .~ (prefix <> "/" <> name)
& value .~ encodeMessage x
where
name = messageName (Proxy @a)
-- | A description of a failure during `unpack` to decode an `Any` message
-- into the expected type.
data UnpackError
= DifferentType
{ expectedMessageType :: Text -- ^ The expected @packagename.messagename@
, actualUrl :: Text -- ^ The typeUrl in the 'Any' being unpacked
}
| DecodingError Text -- ^ The error from decodeMessage
deriving (Show, Eq)
instance Exception UnpackError
-- | Unpacks the given 'Any' into the given message type. Returns 'Nothing'
-- if the type doesn't match or parsing the payload has failed.
--
-- Ignores the type URL prefix.
unpack :: forall a . Message a => Any -> Either UnpackError a
unpack a
| expectedName /= snd (Text.breakOnEnd "/" $ a ^. typeUrl)
= Left DifferentType
{ expectedMessageType = expectedName
, actualUrl = a ^. typeUrl
}
| otherwise = case decodeMessage (a ^. value) of
Left e -> Left $ DecodingError $ Text.pack e
Right x -> Right x
where
expectedName = messageName (Proxy @a)