module SMSAero.API where
import Data.Aeson
import Data.Proxy
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Text (Text)
import qualified Data.Text as Text
import Control.Applicative
import GHC.TypeLits (Symbol, KnownSymbol)
import Text.Read (readMaybe)
import Servant.API
import Servant.Client
data SmsAeroJson
instance Accept SmsAeroJson where
contentType _ = contentType (Proxy :: Proxy PlainText)
instance FromJSON a => MimeUnrender SmsAeroJson a where
mimeUnrender _ = mimeUnrender (Proxy :: Proxy JSON)
data RequiredQueryParam (sym :: Symbol) a
instance (HasClient sub, KnownSymbol sym, ToText a) => HasClient (RequiredQueryParam sym a :> sub) where
type Client (RequiredQueryParam sym a :> sub) = a -> Client sub
clientWithRoute _ req baseurl param = clientWithRoute (Proxy :: Proxy (QueryParam sym a :> sub)) req baseurl (Just param)
newtype Signature = Signature { getSignature :: Text } deriving (Show, FromJSON, ToText)
newtype MessageId = MessageId Integer deriving (Show, FromJSON, ToText)
data SMSAeroAuth = SMSAeroAuth
{ authUser :: Text
, authPassword :: Text
}
newtype Phone = Phone { getPhone :: Integer } deriving (Show, ToText)
newtype SMSAeroDate = SMSAeroDate { getSMSAeroDate :: UTCTime } deriving (Show)
instance ToText SMSAeroDate where
toText (SMSAeroDate dt) = Text.pack (show (utcTimeToPOSIXSeconds dt))
data RequireAuth
instance HasClient sub => HasClient (RequireAuth :> sub) where
type Client (RequireAuth :> sub) = SMSAeroAuth -> Client sub
clientWithRoute _ req baseurl SMSAeroAuth{..} =
clientWithRoute
(Proxy :: Proxy (RequiredQueryParam "user" Text :>
RequiredQueryParam "password" Text :>
sub))
req
baseurl
authUser
authPassword
data AnswerJson
instance HasClient sub => HasClient (AnswerJson :> sub) where
type Client (AnswerJson :> sub) = Client sub
clientWithRoute _ req baseurl = clientWithRoute (Proxy :: Proxy (RequiredQueryParam "answer" Text :> sub)) req baseurl "json"
type SmsAeroGet a = Get '[SmsAeroJson] (SmsAeroResponse a)
type SMSAeroAPI = RequireAuth :> AnswerJson :>
("send" :> SendApi
:<|> "status" :> StatusApi
:<|> "balance" :> SmsAeroGet BalanceResponse
:<|> "senders" :> SmsAeroGet SendersResponse
:<|> "sign" :> SmsAeroGet SignResponse)
type SendApi =
RequiredQueryParam "to" Phone :>
RequiredQueryParam "text" Text :>
RequiredQueryParam "from" Signature :>
QueryParam "date" SMSAeroDate :>
SmsAeroGet SendResponse
type StatusApi = RequiredQueryParam "id" MessageId :> SmsAeroGet StatusResponse
data SmsAeroResponse a
= ResponseOK a
| ResponseReject Text
deriving (Show)
data SendResponse
= SendAccepted MessageId
| SendNoCredits
deriving (Show)
data StatusResponse
= StatusDeliverySuccess
| StatusDeliveryFailure
| StatusSmscSubmit
| StatusSmscReject
| StatusQueue
| StatusWaitStatus
deriving (Show)
newtype BalanceResponse = BalanceResponse Double deriving (Show)
newtype SendersResponse = SendersResponse [Signature] deriving (Show, FromJSON)
data SignResponse
= SignApproved
| SignRejected
| SignPending
deriving (Show)
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 json = ResponseOK <$> parseJSON json
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 FromJSON StatusResponse where
parseJSON (Object o) = do
result :: Text <- o .: "result"
case result of
"delivery success" -> pure StatusDeliverySuccess
"delivery failure" -> pure StatusDeliveryFailure
"smsc submit" -> pure StatusSmscSubmit
"smsc reject" -> pure StatusSmscReject
"queue" -> pure StatusQueue
"wait status" -> pure StatusWaitStatus
_ -> empty
parseJSON _ = empty
instance FromJSON BalanceResponse where
parseJSON (Object o) = do
balance <- o .: "balance"
case readMaybe balance of
Just x -> pure (BalanceResponse x)
Nothing -> empty
parseJSON _ = empty
instance FromJSON SignResponse where
parseJSON (Object o) = do
accepted :: Text <- o .: "accepted"
case accepted of
"approved" -> pure SignApproved
"rejected" -> pure SignRejected
"pending" -> pure SignPending
_ -> empty
parseJSON _ = empty