{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.Xmpp.IM.Roster where

import           Control.Applicative ((<$>))
import           Control.Concurrent.STM
import           Control.Monad
import           Data.List (nub)
#if MIN_VERSION_containers(0, 5, 0)
import qualified Data.Map.Strict as Map
#else
import qualified Data.Map as Map
#endif
import           Data.Maybe (isJust, fromMaybe)
import           Data.Text (Text)
import           Data.XML.Pickle
import           Data.XML.Types
import           System.Log.Logger

import           Network.Xmpp.Concurrent.Basic
import           Network.Xmpp.Concurrent.IQ
import           Network.Xmpp.Concurrent.Types
import           Network.Xmpp.IM.Roster.Types
import           Network.Xmpp.Marshal
import           Network.Xmpp.Types

-- | Timeout to use with IQ requests
timeout :: Maybe Integer
timeout :: Maybe Integer
timeout = forall a. a -> Maybe a
Just Integer
3000000 -- 3 seconds

-- | Add or update an item to the roster.
--
-- To update the item just send the complete set of new data.
rosterSet :: Jid -- ^ JID of the item
          -> Maybe Text -- ^ Name alias
          -> [Text] -- ^ Groups (duplicates will be removed)
          -> Session
          -> IO (Either IQSendError (Annotated IQResponse))
rosterSet :: Jid
-> Maybe Text
-> [Text]
-> Session
-> IO (Either IQSendError (Annotated IQResponse))
rosterSet Jid
j Maybe Text
n [Text]
gs Session
session = do
    let el :: Element
el = forall a. PU [Node] a -> a -> Element
pickleElem PU [Node] Query
xpQuery (Maybe Text -> [QueryItem] -> Query
Query forall a. Maybe a
Nothing
                                 [QueryItem { qiApproved :: Maybe Bool
qiApproved = forall a. Maybe a
Nothing
                                            , qiAsk :: Bool
qiAsk = Bool
False
                                            , qiJid :: Jid
qiJid = Jid
j
                                            , qiName :: Maybe Text
qiName = Maybe Text
n
                                            , qiSubscription :: Maybe Subscription
qiSubscription = forall a. Maybe a
Nothing
                                            , qiGroups :: [Text]
qiGroups = forall a. Eq a => [a] -> [a]
nub [Text]
gs
                                            }])
    Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either IQSendError (Annotated IQResponse))
sendIQA' Maybe Integer
timeout forall a. Maybe a
Nothing IQRequestType
Set forall a. Maybe a
Nothing Element
el [] Session
session

-- | Synonym to rosterSet
rosterAdd :: Jid
          -> Maybe Text
          -> [Text]
          -> Session
          -> IO (Either IQSendError (Annotated IQResponse))
rosterAdd :: Jid
-> Maybe Text
-> [Text]
-> Session
-> IO (Either IQSendError (Annotated IQResponse))
rosterAdd = Jid
-> Maybe Text
-> [Text]
-> Session
-> IO (Either IQSendError (Annotated IQResponse))
rosterSet

-- | Remove an item from the roster. Return 'True' when the item is sucessfully
-- removed or if it wasn't in the roster to begin with.
rosterRemove :: Jid -> Session -> IO Bool
rosterRemove :: Jid -> Session -> IO Bool
rosterRemove Jid
j Session
sess = do
    Roster
roster <- Session -> IO Roster
getRoster Session
sess
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Jid
j (Roster -> Map Jid Item
items Roster
roster) of
        Maybe Item
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True -- jid is not on the Roster
        Just Item
_ -> do
            Either IQSendError (Annotated IQResponse)
res <- Item -> Session -> IO (Either IQSendError (Annotated IQResponse))
rosterPush (Bool -> Bool -> Jid -> Maybe Text -> Subscription -> [Text] -> Item
Item Bool
False Bool
False Jid
j forall a. Maybe a
Nothing Subscription
Remove []) Session
sess
            case Either IQSendError (Annotated IQResponse)
res of
                Right (IQResponseResult IQResult{}, [Annotation]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                Either IQSendError (Annotated IQResponse)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  where
    rosterPush :: Item
               -> Session
               -> IO (Either IQSendError (Annotated IQResponse))
    rosterPush :: Item -> Session -> IO (Either IQSendError (Annotated IQResponse))
rosterPush Item
item Session
session = do
        let el :: Element
el = forall a. PU [Node] a -> a -> Element
pickleElem PU [Node] Query
xpQuery (Maybe Text -> [QueryItem] -> Query
Query forall a. Maybe a
Nothing [Item -> QueryItem
fromItem Item
item])
        Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either IQSendError (Annotated IQResponse))
sendIQA' Maybe Integer
timeout forall a. Maybe a
Nothing IQRequestType
Set forall a. Maybe a
Nothing Element
el [] Session
session

-- | Retrieve the current Roster state (STM version)
getRosterSTM :: Session -> STM Roster
getRosterSTM :: Session -> STM Roster
getRosterSTM Session
session = forall a. TVar a -> STM a
readTVar (Session -> TVar Roster
rosterRef Session
session)

-- | Retrieve the current Roster state
getRoster :: Session -> IO Roster
getRoster :: Session -> IO Roster
getRoster Session
session = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ Session -> STM Roster
getRosterSTM Session
session

-- | Get the initial roster or refresh the roster. You don't need to call this
-- on your own.
initRoster :: Session -> IO ()
initRoster :: Session -> IO ()
initRoster Session
session = do
    Roster
oldRoster <- Session -> IO Roster
getRoster Session
session
    Maybe Roster
mbRoster <- Maybe Roster -> Session -> IO (Maybe Roster)
retrieveRoster (if forall a. Maybe a -> Bool
isJust (Roster -> Maybe Text
ver Roster
oldRoster) then forall a. a -> Maybe a
Just Roster
oldRoster
                                                          else forall a. Maybe a
Nothing ) Session
session
    case Maybe Roster
mbRoster of
        Maybe Roster
Nothing -> [Char] -> [Char] -> IO ()
errorM [Char]
"Pontarius.Xmpp"
                          [Char]
"Server did not return a roster: "
        Just Roster
roster -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar (Session -> TVar Roster
rosterRef Session
session) Roster
roster

handleRoster :: Maybe Jid
             -> TVar Roster
             -> RosterPushCallback
             -> StanzaHandler
handleRoster :: Maybe Jid -> TVar Roster -> RosterPushCallback -> StanzaHandler
handleRoster Maybe Jid
mbBoundJid TVar Roster
ref RosterPushCallback
onUpdate XmppElement -> IO (Either XmppFailure ())
out XmppElement
sta [Annotation]
_ = do
    case XmppElement
sta of
        XmppStanza (IQRequestS (iqr :: IQRequest
iqr@IQRequest{iqRequestPayload :: IQRequest -> Element
iqRequestPayload =
                                              iqb :: Element
iqb@Element{elementName :: Element -> Name
elementName = Name
en}}))
            | Name -> Maybe Text
nameNamespace Name
en forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"jabber:iq:roster" -> do
                let doHandle :: Bool
doHandle = case (IQRequest -> Maybe Jid
iqRequestFrom IQRequest
iqr, Maybe Jid
mbBoundJid) of
                        -- We don't need to check our own JID when the IQ
                        -- request was sent without a from address
                        (Maybe Jid
Nothing, Maybe Jid
_) -> Bool
True
                        -- We don't have a Jid bound, so we can't verify that
                        -- the from address matches our bare jid
                        (Just Jid
_fr, Maybe Jid
Nothing) -> Bool
False
                        -- Check that the from address matches our bare jid
                        (Just Jid
fr, Just Jid
boundJid) | Jid
fr forall a. Eq a => a -> a -> Bool
== Jid -> Jid
toBare Jid
boundJid -> Bool
True
                                                 | Bool
otherwise -> Bool
False
                if Bool
doHandle
                    then case forall a. PU [Node] a -> Element -> Either UnpickleError a
unpickleElem PU [Node] Query
xpQuery Element
iqb of
                        Right Query{ queryVer :: Query -> Maybe Text
queryVer = Maybe Text
v
                                   , queryItems :: Query -> [QueryItem]
queryItems = [QueryItem
update]
                                   } -> do
                            Maybe Text -> QueryItem -> IO ()
handleUpdate Maybe Text
v QueryItem
update
                            Either XmppFailure ()
_ <- XmppElement -> IO (Either XmppFailure ())
out forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stanza -> XmppElement
XmppStanza forall a b. (a -> b) -> a -> b
$ IQRequest -> Stanza
result IQRequest
iqr
                            forall (m :: * -> *) a. Monad m => a -> m a
return []
                        Either UnpickleError Query
_ -> do
                            [Char] -> [Char] -> IO ()
errorM [Char]
"Pontarius.Xmpp" [Char]
"Invalid roster query"
                            Either XmppFailure ()
_ <- XmppElement -> IO (Either XmppFailure ())
out forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stanza -> XmppElement
XmppStanza forall a b. (a -> b) -> a -> b
$ IQRequest -> Stanza
badRequest IQRequest
iqr
                            forall (m :: * -> *) a. Monad m => a -> m a
return []
                    -- Don't handle roster pushes from unauthorized sources
                    else forall (m :: * -> *) a. Monad m => a -> m a
return [(XmppElement
sta, [])]
        XmppElement
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [(XmppElement
sta, [])]
  where
    handleUpdate :: Maybe Text -> QueryItem -> IO ()
handleUpdate Maybe Text
v' QueryItem
update = do
        Roster
oldRoster <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar Roster
ref
        case QueryItem -> Maybe Subscription
qiSubscription QueryItem
update of
         Just Subscription
Remove -> do
             let j :: Jid
j = QueryItem -> Jid
qiJid QueryItem
update
             RosterPushCallback
onUpdate Roster
oldRoster forall a b. (a -> b) -> a -> b
$ Jid -> RosterUpdate
RosterUpdateRemove Jid
j
             (Map Jid Item -> Map Jid Item) -> IO ()
updateRoster (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Jid
j)
         Maybe Subscription
_ -> do
             let i :: Item
i = (QueryItem -> Item
toItem QueryItem
update)
             RosterPushCallback
onUpdate Roster
oldRoster forall a b. (a -> b) -> a -> b
$ Item -> RosterUpdate
RosterUpdateAdd Item
i
             (Map Jid Item -> Map Jid Item) -> IO ()
updateRoster forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (QueryItem -> Jid
qiJid QueryItem
update) Item
i
      where
        updateRoster :: (Map Jid Item -> Map Jid Item) -> IO ()
updateRoster Map Jid Item -> Map Jid Item
f = forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar Roster
ref forall a b. (a -> b) -> a -> b
$
                           \(Roster Maybe Text
v Map Jid Item
is) -> Maybe Text -> Map Jid Item -> Roster
Roster (Maybe Text
v' forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
v) (Map Jid Item -> Map Jid Item
f Map Jid Item
is)

    badRequest :: IQRequest -> Stanza
badRequest (IQRequest Text
iqid Maybe Jid
from Maybe Jid
_to Maybe LangTag
lang IQRequestType
_tp Element
bd [ExtendedAttribute]
_attrs) =
        IQError -> Stanza
IQErrorS forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> Maybe Element
-> [ExtendedAttribute]
-> IQError
IQError Text
iqid forall a. Maybe a
Nothing Maybe Jid
from Maybe LangTag
lang StanzaError
errBR (forall a. a -> Maybe a
Just Element
bd) []
    errBR :: StanzaError
errBR = StanzaErrorType
-> StanzaErrorCondition
-> Maybe (Maybe LangTag, NonemptyText)
-> Maybe Element
-> StanzaError
StanzaError StanzaErrorType
Cancel StanzaErrorCondition
BadRequest forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    result :: IQRequest -> Stanza
result (IQRequest Text
iqid Maybe Jid
from Maybe Jid
_to Maybe LangTag
lang IQRequestType
_tp Element
_bd [ExtendedAttribute]
_attrs) =
        IQResult -> Stanza
IQResultS forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> Maybe Element
-> [ExtendedAttribute]
-> IQResult
IQResult Text
iqid forall a. Maybe a
Nothing Maybe Jid
from Maybe LangTag
lang forall a. Maybe a
Nothing []

retrieveRoster :: Maybe Roster -> Session -> IO (Maybe Roster)
retrieveRoster :: Maybe Roster -> Session -> IO (Maybe Roster)
retrieveRoster Maybe Roster
mbOldRoster Session
sess = do
    Bool
useVersioning <- forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamFeatures -> Maybe Bool
streamFeaturesRosterVer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session -> IO StreamFeatures
getFeatures Session
sess
    let version :: Maybe Text
version = if Bool
useVersioning
                then case Maybe Roster
mbOldRoster of
                      Maybe Roster
Nothing -> forall a. a -> Maybe a
Just Text
""
                      Just Roster
oldRoster -> Roster -> Maybe Text
ver Roster
oldRoster
                else forall a. Maybe a
Nothing
    Either IQSendError IQResponse
res <- Maybe Integer
-> Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> [ExtendedAttribute]
-> Session
-> IO (Either IQSendError IQResponse)
sendIQ' Maybe Integer
timeout forall a. Maybe a
Nothing IQRequestType
Get forall a. Maybe a
Nothing
                   (forall a. PU [Node] a -> a -> Element
pickleElem PU [Node] Query
xpQuery (Maybe Text -> [QueryItem] -> Query
Query Maybe Text
version []))
                   []
                   Session
sess
    case Either IQSendError IQResponse
res of
        Left IQSendError
e -> do
            [Char] -> [Char] -> IO ()
errorM [Char]
"Pontarius.Xmpp.Roster" forall a b. (a -> b) -> a -> b
$ [Char]
"getRoster: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show IQSendError
e
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Right (IQResponseResult IQResult{iqResultPayload :: IQResult -> Maybe Element
iqResultPayload = Just Element
ros})
            -> case forall a. PU [Node] a -> Element -> Either UnpickleError a
unpickleElem PU [Node] Query
xpQuery Element
ros of
            Left UnpickleError
_e -> do
                [Char] -> [Char] -> IO ()
errorM [Char]
"Pontarius.Xmpp.Roster" [Char]
"getRoster: invalid query element"
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Right Query
ros' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Query -> Roster
toRoster Query
ros'
        Right (IQResponseResult IQResult{iqResultPayload :: IQResult -> Maybe Element
iqResultPayload = Maybe Element
Nothing}) -> do
            forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Roster
mbOldRoster
                -- sever indicated that no roster updates are necessary
        Right (IQResponseError IQError
e) -> do
            [Char] -> [Char] -> IO ()
errorM [Char]
"Pontarius.Xmpp.Roster" forall a b. (a -> b) -> a -> b
$ [Char]
"getRoster: server returned error"
                   forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show IQError
e
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  where
    toRoster :: Query -> Roster
toRoster (Query Maybe Text
v [QueryItem]
is) = Maybe Text -> Map Jid Item -> Roster
Roster Maybe Text
v (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                                             forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\QueryItem
i -> (QueryItem -> Jid
qiJid QueryItem
i, QueryItem -> Item
toItem QueryItem
i))
                                               [QueryItem]
is)

toItem :: QueryItem -> Item
toItem :: QueryItem -> Item
toItem QueryItem
qi = Item { riApproved :: Bool
riApproved = forall a. a -> Maybe a -> a
fromMaybe Bool
False (QueryItem -> Maybe Bool
qiApproved QueryItem
qi)
                 , riAsk :: Bool
riAsk = QueryItem -> Bool
qiAsk QueryItem
qi
                 , riJid :: Jid
riJid = QueryItem -> Jid
qiJid QueryItem
qi
                 , riName :: Maybe Text
riName = QueryItem -> Maybe Text
qiName QueryItem
qi
                 , riSubscription :: Subscription
riSubscription = Maybe Subscription -> Subscription
fromSubscription (QueryItem -> Maybe Subscription
qiSubscription QueryItem
qi)
                 , riGroups :: [Text]
riGroups = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ QueryItem -> [Text]
qiGroups QueryItem
qi
                 }
  where
    fromSubscription :: Maybe Subscription -> Subscription
fromSubscription Maybe Subscription
Nothing = Subscription
None
    fromSubscription (Just Subscription
s) | Subscription
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Subscription
None, Subscription
To, Subscription
From, Subscription
Both] = Subscription
s
                              | Bool
otherwise = Subscription
None

fromItem :: Item -> QueryItem
fromItem :: Item -> QueryItem
fromItem Item
i = QueryItem { qiApproved :: Maybe Bool
qiApproved = forall a. Maybe a
Nothing
                       , qiAsk :: Bool
qiAsk = Bool
False
                       , qiJid :: Jid
qiJid = Item -> Jid
riJid Item
i
                       , qiName :: Maybe Text
qiName = Item -> Maybe Text
riName Item
i
                       , qiSubscription :: Maybe Subscription
qiSubscription = case Item -> Subscription
riSubscription Item
i of
                           Subscription
Remove -> forall a. a -> Maybe a
Just Subscription
Remove
                           Subscription
_ -> forall a. Maybe a
Nothing
                       , qiGroups :: [Text]
qiGroups = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ Item -> [Text]
riGroups Item
i
                       }

xpItems :: PU [Node] [QueryItem]
xpItems :: PU [Node] [QueryItem]
xpItems = forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap (forall a b. (a -> b) -> [a] -> [b]
map (\((Maybe Bool
app_, Bool
ask_, Jid
jid_, Maybe Text
name_, Maybe Subscription
sub_), [Text]
groups_) ->
                        Maybe Bool
-> Bool
-> Jid
-> Maybe Text
-> Maybe Subscription
-> [Text]
-> QueryItem
QueryItem Maybe Bool
app_ Bool
ask_ Jid
jid_ Maybe Text
name_ Maybe Subscription
sub_ [Text]
groups_))
                 (forall a b. (a -> b) -> [a] -> [b]
map (\(QueryItem Maybe Bool
app_ Bool
ask_ Jid
jid_ Maybe Text
name_ Maybe Subscription
sub_ [Text]
groups_) ->
                        ((Maybe Bool
app_, Bool
ask_, Jid
jid_, Maybe Text
name_, Maybe Subscription
sub_), [Text]
groups_))) forall a b. (a -> b) -> a -> b
$
          forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] [(a, n)]
xpElems Name
"{jabber:iq:roster}item"
          (forall a a1 a2 a3 a4 a5.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] (a1, a2, a3, a4, a5)
xp5Tuple
            (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttribute' Name
"approved" PU Text Bool
xpBool)
            (forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap forall a. Maybe a -> Bool
isJust
                    (\Bool
p -> if Bool
p then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
                     forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ Name -> Text -> PU [Attribute] ()
xpAttribute_ Name
"ask" Text
"subscribe")
            (forall a. Name -> PU Text a -> PU [Attribute] a
xpAttribute  Name
"jid" PU Text Jid
xpJid)
            (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttribute' Name
"name" PU Text Text
xpText)
            (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttribute' Name
"subscription" PU Text Subscription
xpSubscription)
          )
          (forall b a. PU [b] a -> PU [b] [a]
xpFindMatches forall a b. (a -> b) -> a -> b
$ Name -> PU [Node] Text
xpElemText Name
"{jabber:iq:roster}group")

xpQuery :: PU [Node] Query
xpQuery :: PU [Node] Query
xpQuery = forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap (\(Maybe Text
ver_, [QueryItem]
items_) -> Maybe Text -> [QueryItem] -> Query
Query Maybe Text
ver_ [QueryItem]
items_ )
                 (\(Query Maybe Text
ver_ [QueryItem]
items_) -> (Maybe Text
ver_, [QueryItem]
items_)) forall a b. (a -> b) -> a -> b
$
          forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:iq:roster}query"
            (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttribute' Name
"ver" PU Text Text
xpText)
            PU [Node] [QueryItem]
xpItems

xpSubscription :: PU Text Subscription
xpSubscription :: PU Text Subscription
xpSubscription = (Text
"xpSubscription", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso forall {a}. (Eq a, IsString a) => a -> Subscription
subscriptionFromText
              forall {a}. IsString a => Subscription -> a
subscriptionToText
  where
    subscriptionFromText :: a -> Subscription
subscriptionFromText a
"none" = Subscription
None
    subscriptionFromText a
"to" = Subscription
To
    subscriptionFromText a
"from" = Subscription
From
    subscriptionFromText a
"both" = Subscription
Both
    subscriptionFromText a
"remove" = Subscription
Remove
    subscriptionFromText a
_ = Subscription
None
    subscriptionToText :: Subscription -> a
subscriptionToText Subscription
None = a
"none"
    subscriptionToText Subscription
To = a
"to"
    subscriptionToText Subscription
From = a
"from"
    subscriptionToText Subscription
Both = a
"both"
    subscriptionToText Subscription
Remove = a
"remove"