module SMSAero.API (
SMSAeroAPI,
SendApi,
SendToGroupApi,
StatusApi,
GroupApi,
PhoneApi,
BlacklistApi,
AnswerJson,
RequireAuth,
RequiredQueryParam,
SmsAeroGet,
SmsAeroResponse(..),
SendResponse(..),
MessageStatus(..),
CheckSendingResponse,
BalanceResponse(..),
CheckTariffResponse,
SendersResponse(..),
SignResponse(..),
GroupResponse(..),
PhoneResponse(..),
BlacklistResponse(..),
) where
import Data.Aeson
import Data.Proxy
import Data.Time (UTCTime(UTCTime))
import Data.Time.Calendar (fromGregorian)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Map (Map)
import Text.Read (readEither)
import Control.Applicative
import GHC.TypeLits (Symbol, KnownSymbol)
import Servant.API
import Servant.Client
import Servant.Docs
import Servant.Docs.Internal (_params)
import Web.HttpApiData
import GHC.Generics
import SMSAero.Types
#if MIN_VERSION_aeson(1,0,0)
#else
import Data.Maybe (catMaybes)
import Control.Arrow ((***))
import qualified Data.Map as Map
#endif
data RequiredQueryParam (sym :: Symbol) a
instance (HasClient sub, KnownSymbol sym, ToHttpApiData a) => HasClient (RequiredQueryParam sym a :> sub) where
type Client (RequiredQueryParam sym a :> sub) = a -> Client sub
clientWithRoute _ req param = clientWithRoute (Proxy :: Proxy (QueryParam sym a :> sub)) req (Just param)
instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sub) => HasDocs (RequiredQueryParam sym a :> sub) where
docsFor _ (endpoint, action) =
docsFor subP (endpoint, action')
where subP = Proxy :: Proxy sub
paramP = Proxy :: Proxy (QueryParam sym a)
action' = action { _params = params' }
params' = _params action ++ [toParam paramP]
data RequireAuth
instance HasClient sub => HasClient (RequireAuth :> sub) where
type Client (RequireAuth :> sub) = SMSAeroAuth -> Client sub
clientWithRoute _ req SMSAeroAuth{..} =
clientWithRoute
(Proxy :: Proxy (RequiredQueryParam "user" Text :>
RequiredQueryParam "password" Text :>
sub))
req
authUser
authPassword
instance HasDocs sub => HasDocs (RequireAuth :> sub) where
docsFor _ (endpoint, action) =
docsFor subP (endpoint, action')
where subP = Proxy :: Proxy sub
userP = DocQueryParam "user"
["alice@example.com", "bob@example.com"]
"SMSAero username (email) for authentication."
Normal
passP = DocQueryParam "password"
["5f4dcc3b5aa765d61d8327deb882cf99", "d8578edf8458ce06fbc5bb76a58c5ca4"]
"MD5 hash of a password."
Normal
action' = action { _params = params' }
params' = _params action ++ [userP, passP]
data AnswerJson
instance HasClient sub => HasClient (AnswerJson :> sub) where
type Client (AnswerJson :> sub) = Client sub
clientWithRoute _ req = clientWithRoute (Proxy :: Proxy (RequiredQueryParam "answer" Text :> sub)) req "json"
instance HasDocs sub => HasDocs (AnswerJson :> sub) where
docsFor _ (endpoint, action) = docsFor subP (endpoint, action')
where
subP = Proxy :: Proxy sub
answerP = DocQueryParam "answer"
["json"]
"When present makes SMSAero REST API to respond with JSON."
Normal
action' = action { _params = params' }
params' = _params action ++ [answerP]
type SmsAeroGet a = Get '[JSON] (SmsAeroResponse a)
type SMSAeroAPI = RequireAuth :> AnswerJson :>
("send" :> SendApi
:<|> "sendtogroup" :> SendToGroupApi
:<|> "status" :> StatusApi
:<|> "checksending" :> CheckSendingApi
:<|> "balance" :> SmsAeroGet BalanceResponse
:<|> "checktarif" :> SmsAeroGet CheckTariffResponse
:<|> "senders" :> SmsAeroGet SendersResponse
:<|> "sign" :> SmsAeroGet SignResponse
:<|> GroupApi
:<|> PhoneApi
:<|> "addblacklist" :> BlacklistApi)
type SendApi =
RequiredQueryParam "to" Phone :>
RequiredQueryParam "text" MessageBody :>
RequiredQueryParam "from" Signature :>
QueryParam "date" SMSAeroDate :>
QueryParam "type" SendType :>
QueryParam "digital" DigitalChannel :>
SmsAeroGet SendResponse
instance ToParam (QueryParam "to" Phone) where
toParam _ = DocQueryParam "to"
["74951234567"]
"Recipient phone number."
Normal
instance ToParam (QueryParam "text" MessageBody) where
toParam _ = DocQueryParam "text"
["Hello, world!"]
"Message content."
Normal
instance ToParam (QueryParam "from" Signature) where
toParam _ = DocQueryParam "from"
["My Company"]
"Sender's signature."
Normal
instance ToParam (QueryParam "date" SMSAeroDate) where
toParam _ = DocQueryParam "date"
[Text.unpack (toQueryParam (SMSAeroDate (UTCTime (fromGregorian 2015 01 31) 0)))]
"Requested datetime of delivery as number of seconds since 01 Jan 1970."
Normal
instance ToParam (QueryParam "type" SendType) where
toParam _ = DocQueryParam "type"
(map (Text.unpack . toQueryParam) [minBound..maxBound::SendType])
"Send type to describe send channel, equals to '2' (free literal signature for all operators except MTS) by default. Can't be used with 'digital' parameter."
Normal
instance ToParam (QueryParam "digital" DigitalChannel) where
toParam _ = DocQueryParam "digital"
[Text.unpack (toQueryParam DigitalChannel)]
"Send type for digital send channel. Can't be used with 'type' parameter."
Normal
type SendToGroupApi =
RequiredQueryParam "group" Group :>
RequiredQueryParam "text" MessageBody :>
RequiredQueryParam "from" Signature :>
QueryParam "date" SMSAeroDate :>
QueryParam "type" SendType :>
QueryParam "digital" DigitalChannel :>
SmsAeroGet SendResponse
instance ToParam (QueryParam "group" Group) where
toParam _ = DocQueryParam "group"
["all", "groupname"]
"Group name to broadcast a message."
Normal
type StatusApi = RequiredQueryParam "id" MessageId :> SmsAeroGet MessageStatus
instance ToParam (QueryParam "id" MessageId) where
toParam _ = DocQueryParam "id"
["12345"]
"Message ID, returned previously by SMSAero."
Normal
type CheckSendingApi = RequiredQueryParam "id" MessageId :> SmsAeroGet CheckSendingResponse
type GroupApi =
"checkgroup" :> SmsAeroGet [Group]
:<|> "addgroup" :> RequiredQueryParam "group" Group :> SmsAeroGet GroupResponse
:<|> "delgroup" :> RequiredQueryParam "group" Group :> SmsAeroGet GroupResponse
type PhoneApi =
"addphone" :>
RequiredQueryParam "phone" Phone :>
QueryParam "group" Group :>
QueryParam "lname" Name :>
QueryParam "fname" Name :>
QueryParam "sname" Name :>
QueryParam "bday" BirthDate :>
QueryParam "param" Text :>
SmsAeroGet PhoneResponse
:<|> "delphone" :> RequiredQueryParam "phone" Phone :> QueryParam "group" Group :> SmsAeroGet PhoneResponse
type BlacklistApi = RequiredQueryParam "phone" Phone :> SmsAeroGet BlacklistResponse
data SmsAeroResponse a
= ResponseOK a
| ResponseReject Text
deriving (Eq, Show, Generic)
data SendResponse
= SendAccepted MessageId
| SendNoCredits
deriving (Eq, Show, Generic)
instance ToSample (SmsAeroResponse SendResponse) where
toSamples _ =
[ ("When message is sent successfully.", ResponseOK (SendAccepted (MessageId 12345)))
, ("When SMSAero account does not have enough credit.", ResponseOK SendNoCredits)
, ("When message sender is incorrect.", ResponseReject "incorrect sender name") ]
data MessageStatus
= StatusDeliverySuccess
| StatusDeliveryFailure
| StatusSmscSubmit
| StatusSmscReject
| StatusQueue
| StatusWaitStatus
deriving (Eq, Enum, Bounded, Show, Read, Generic)
instance ToSample (SmsAeroResponse MessageStatus) where
toSamples _ =
[ ("When message has been delivered successfully.", ResponseOK StatusDeliverySuccess)
, ("When message has been queued.", ResponseOK StatusQueue) ]
newtype BalanceResponse = BalanceResponse Double deriving (Eq, Show)
instance ToSample (SmsAeroResponse BalanceResponse) where
toSamples _ =
[ ("Just balance.", ResponseOK (BalanceResponse 247))
, ("When auth credentials are incorrect.", ResponseReject "incorrect user or password") ]
type CheckTariffResponse = Map ChannelName Double
type CheckSendingResponse = Map MessageId MessageStatus
newtype SendersResponse = SendersResponse [Signature] deriving (Eq, Show, FromJSON, ToJSON)
instance ToSample (SmsAeroResponse SendersResponse) where
toSamples _ = singleSample (ResponseOK (SendersResponse [Signature "TEST", Signature "My Company"]))
data SignResponse
= SignApproved
| SignRejected
| SignPending
deriving (Eq, Enum, Bounded, Show, Generic)
instance ToSample (SmsAeroResponse SignResponse) where
toSamples _ =
[ ("When a new signature is approved.", ResponseOK SignApproved)
, ("When a new signature is rejected.", ResponseOK SignRejected) ]
newtype GroupResponse = GroupResponse Text deriving (Eq, Show, FromJSON, ToJSON)
newtype PhoneResponse = PhoneResponse Text deriving (Eq, Show, FromJSON, ToJSON)
newtype BlacklistResponse = BlacklistResponse Text deriving (Eq, Show, FromJSON, ToJSON)
instance FromJSON a => FromJSON (SmsAeroResponse a) where
parseJSON (Object o) = do
result :: Maybe Text <- o .:? "result"
case result of
Just "reject" -> ResponseReject <$> o .: "reason"
_ -> ResponseOK <$> parseJSON (Object o)
parseJSON j = ResponseOK <$> parseJSON j
instance ToJSON a => ToJSON (SmsAeroResponse a) where
toJSON (ResponseOK x) = toJSON x
toJSON (ResponseReject reason) = object
[ "result" .= ("reject" :: Text)
, "reason" .= reason ]
instance FromJSON SendResponse where
parseJSON (Object o) = do
result :: Text <- o .: "result"
case result of
"accepted" -> SendAccepted <$> o .: "id"
"no credits" -> pure SendNoCredits
_ -> empty
parseJSON _ = empty
instance ToJSON SendResponse where
toJSON (SendAccepted n) = object
[ "result" .= ("accepted" :: Text)
, "id" .= toJSON n ]
toJSON SendNoCredits = object
[ "result" .= ("no credits" :: Text)]
instance FromHttpApiData MessageStatus where
parseQueryParam = parseBoundedQueryParam
instance ToHttpApiData MessageStatus where
toQueryParam StatusDeliverySuccess = "delivery success"
toQueryParam StatusDeliveryFailure = "delivery failure"
toQueryParam StatusSmscSubmit = "smsc submit"
toQueryParam StatusSmscReject = "smsc reject"
toQueryParam StatusQueue = "queue"
toQueryParam StatusWaitStatus = "wait status"
instance FromJSON MessageStatus where
parseJSON (Object o) = do
result :: Text <- o .: "result"
case (parseUrlPiece result :: Either Text MessageStatus) of
Left _ -> empty
Right status -> return status
parseJSON _ = empty
instance ToJSON MessageStatus where
toJSON status = object [ "result" .= toUrlPiece status ]
instance FromJSON BalanceResponse where
parseJSON (Object o) = do
str <- o .: "balance"
case readEither str of
Left err -> fail err
Right b -> return (BalanceResponse b)
parseJSON _ = empty
instance ToJSON BalanceResponse where
toJSON (BalanceResponse n) = object [ "balance" .= show n ]
instance ToHttpApiData SignResponse where
toQueryParam SignApproved = "approved"
toQueryParam SignRejected = "rejected"
toQueryParam SignPending = "pending"
instance FromHttpApiData SignResponse where
parseQueryParam = parseBoundedQueryParam
instance FromJSON SignResponse where
parseJSON (Object o) = do
accepted :: Text <- o .: "accepted"
case (parseUrlPiece accepted :: Either Text SignResponse) of
Left _ -> empty
Right resp -> return resp
parseJSON _ = empty
instance ToJSON SignResponse where
toJSON s = object [ "accepted" .= toUrlPiece s ]
#if MIN_VERSION_aeson(1,0,0)
#else
instance ToJSON CheckSendingResponse where
toJSON = toJSON . Map.mapKeys toQueryParam . fmap toQueryParam
instance FromJSON CheckSendingResponse where
parseJSON js =
Map.fromList . catMaybes . map dist . map (parseQueryParamMaybe *** parseQueryParamMaybe) . Map.toList <$> parseJSON js
where
dist (x, y) = (,) <$> x <*> y
#endif