smsaero 0.1.1 → 0.2
raw patch · 6 files changed
+104/−20 lines, 6 files
Files
- CHANGELOG.md +8/−0
- smsaero.cabal +5/−3
- src/SMSAero.hs +8/−0
- src/SMSAero/API.hs +61/−13
- src/SMSAero/Client.hs +8/−0
- src/SMSAero/Utils.hs +14/−4
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+0.2+---+* structure haddock documentation+* add missing ToJSON and FromText instances++0.1.1+-----+* support GHC 7.8
smsaero.cabal view
@@ -1,5 +1,5 @@ name: smsaero-version: 0.1.1+version: 0.2 synopsis: SMSAero API and HTTP client based on servant library. description: Please see README.md homepage: https://github.com/GetShopTV/smsaero@@ -7,10 +7,12 @@ license-file: LICENSE author: Nickolay Kudasov maintainer: nickolay@getshoptv.com--- copyright: +copyright: (c) 2015, GetShopTV category: Web build-type: Simple-extra-source-files: README.md+extra-source-files:+ README.md+ , CHANGELOG.md cabal-version: >=1.10 library
src/SMSAero.hs view
@@ -1,3 +1,11 @@+-- |+-- Module : SMSAero+-- Copyright : (c) 2015, GetShopTV+-- License : BSD3+-- Maintainer : nickolay@getshoptv.com+-- Stability : experimental+--+-- SMSAero API and HTTP client. module SMSAero ( module SMSAero.API, module SMSAero.Client
src/SMSAero/API.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}@@ -8,13 +9,45 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-module SMSAero.API where+-- |+-- Module : SMSAero.API+-- Copyright : (c) 2015, GetShopTV+-- License : BSD3+-- Maintainer : nickolay@getshoptv.com+-- Stability : experimental+--+-- This module describes SMSAero API and defines corresponding types.+module SMSAero.API (+ -- * API+ SMSAeroAPI,+ SendApi,+ StatusApi,+ -- * Combinators+ SmsAeroJson,+ AnswerJson,+ RequireAuth,+ RequiredQueryParam,+ SmsAeroGet,+ -- * Types+ SMSAeroAuth(..),+ Signature(..),+ MessageId(..),+ Phone(..),+ SMSAeroDate(..),+ -- * Responses+ SmsAeroResponse(..),+ SendResponse(..),+ StatusResponse(..),+ BalanceResponse(..),+ SendersResponse(..),+ SignResponse(..),+) where import Data.Aeson import Data.Proxy import Data.Time (UTCTime)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime) import Data.Text (Text) import qualified Data.Text as Text@@ -26,6 +59,8 @@ import Servant.API import Servant.Client +import GHC.Generics+ -- | Content type for SMSAero JSON answer (it has JSON body but "text/plain" Content-Type). data SmsAeroJson @@ -43,10 +78,10 @@ clientWithRoute _ req baseurl param = clientWithRoute (Proxy :: Proxy (QueryParam sym a :> sub)) req baseurl (Just param) -- | SMSAero sender's signature. This is used for the "from" field.-newtype Signature = Signature { getSignature :: Text } deriving (Show, FromJSON, ToText)+newtype Signature = Signature { getSignature :: Text } deriving (Show, FromJSON, ToJSON, ToText, FromText) -- | SMSAero sent message id.-newtype MessageId = MessageId Integer deriving (Show, FromJSON, ToText)+newtype MessageId = MessageId Integer deriving (Show, FromJSON, ToJSON, ToText, FromText) -- | SMSAero authentication data. data SMSAeroAuth = SMSAeroAuth@@ -55,14 +90,19 @@ } -- | Phone number.-newtype Phone = Phone { getPhone :: Integer } deriving (Show, ToText)+newtype Phone = Phone { getPhone :: Integer } deriving (Show, ToText, FromText) --- | Date.+-- | Date. Textually @SMSAeroDate@ is represented as a number of seconds since 01 Jan 1970. newtype SMSAeroDate = SMSAeroDate { getSMSAeroDate :: UTCTime } deriving (Show) instance ToText SMSAeroDate where toText (SMSAeroDate dt) = Text.pack (show (utcTimeToPOSIXSeconds dt)) +instance FromText SMSAeroDate where+ fromText s = do+ n <- fromInteger <$> readMaybe (Text.unpack s)+ return (SMSAeroDate (posixSecondsToUTCTime n))+ -- | SMSAero authentication credentials. data RequireAuth @@ -112,13 +152,17 @@ data SmsAeroResponse a = ResponseOK a -- ^ Some useful payload. | ResponseReject Text -- ^ Rejection reason.- deriving (Show)+ deriving (Show, Generic)+-- | This is a generic instance and __does not match__ @FromJSON@.+instance ToJSON a => ToJSON (SmsAeroResponse a) -- | SMSAero response to a send request. data SendResponse = SendAccepted MessageId -- ^ Message accepted. | SendNoCredits -- ^ No credits to send a message.- deriving (Show)+ deriving (Show, Generic)+-- | This is a generic instance and __does not match__ @FromJSON@.+instance ToJSON SendResponse -- | SMSAero response to a status request. data StatusResponse@@ -128,22 +172,26 @@ | StatusSmscReject -- ^ Message rejected by SMSC. | StatusQueue -- ^ Message queued. | StatusWaitStatus -- ^ Wait for message status.- deriving (Show)+ deriving (Show, Generic)+-- | This is a generic instance and __does not match__ @FromJSON@.+instance ToJSON StatusResponse -- | SMSAero response to a balance request. -- This is a number of available messages to send.-newtype BalanceResponse = BalanceResponse Double deriving (Show)+newtype BalanceResponse = BalanceResponse Double deriving (Show, ToJSON) -- | SMSAero response to a senders request. -- This is just a list of available signatures.-newtype SendersResponse = SendersResponse [Signature] deriving (Show, FromJSON)+newtype SendersResponse = SendersResponse [Signature] deriving (Show, FromJSON, ToJSON) -- | SMSAero response to a sign request. data SignResponse = SignApproved -- ^ Signature is approved. | SignRejected -- ^ Signature is rejected. | SignPending -- ^ Signature is pending.- deriving (Show)+ deriving (Show, Generic)+-- | This is a generic instance and __does not match__ @FromJSON@.+instance ToJSON SignResponse instance FromJSON a => FromJSON (SmsAeroResponse a) where parseJSON (Object o) = do@@ -151,7 +199,7 @@ case result of Just "reject" -> ResponseReject <$> o .: "reason" _ -> ResponseOK <$> parseJSON (Object o)- parseJSON json = ResponseOK <$> parseJSON json+ parseJSON j = ResponseOK <$> parseJSON j instance FromJSON SendResponse where parseJSON (Object o) = do
src/SMSAero/Client.hs view
@@ -1,3 +1,11 @@+-- |+-- Module : SMSAero.Client+-- Copyright : (c) 2015, GetShopTV+-- License : BSD3+-- Maintainer : nickolay@getshoptv.com+-- Stability : experimental+--+-- SMSAero HTTP servant client and individual client functions. module SMSAero.Client where import Control.Monad.Trans.Either
src/SMSAero/Utils.hs view
@@ -2,21 +2,29 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+-- |+-- Module : SMSAero.Utils+-- Copyright : (c) 2015, GetShopTV+-- License : BSD3+-- Maintainer : nickolay@getshoptv.com+-- Stability : experimental+--+-- This module defines @'DistributiveClient'@ class+-- to help distribute functions over alternatives (@':<|>'@). module SMSAero.Utils where -import Control.Applicative import Servant.API.Alternative -- | Distribute a client looking like -- -- @--- a -> (b :<|> ... :<|> c)+-- a -> (b ':<|>' ... ':<|>' c) -- @ -- -- into -- -- @--- (a -> b) :<|> ... :<|> (a -> c)+-- (a -> b) ':<|>' ... ':<|>' (a -> c) -- @ -- -- This is useful to bring authentication credentials to@@ -24,11 +32,13 @@ class DistributiveClient client client' where distributeClient :: client -> client' +-- | Base case. instance DistributiveClient (a -> b) (a -> b) where distributeClient = id +-- | Distribute function over alternative. instance (DistributiveClient (a -> b) b', DistributiveClient (a -> c) c') => DistributiveClient (a -> (b :<|> c)) (b' :<|> c') where- distributeClient client = distributeClient (left <$> client) :<|> distributeClient (right <$> client)+ distributeClient client = distributeClient (fmap left client) :<|> distributeClient (fmap right client) where left (l :<|> _) = l right (_ :<|> r) = r