diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Nigel Rantor (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,7 @@ +# twfy-api-client + +They Work For You REST API Client Bindings + +## Status + +Under development diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Servant.Client (ServantError) +import System.Environment (lookupEnv) +import qualified Data.Text as T + +import Twfy.Client + +-- TODO: add applicative opt parsing for urls, api key etc and commands for different API calls + +-- TODO: take from command line or env +readApiKey :: IO (Maybe ApiKey) +readApiKey = do + envKey <- lookupEnv "TWFY_API_KEY" + let textKey = fmap T.pack envKey + return textKey + +displayResult :: Show a => (Either ServantError a) -> IO () +displayResult result = do + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right something -> do + print something + +run :: ApiKey -> IO () +run apiKey = do + c <- client apiKey Nothing Nothing + putStrLn $ show c + getConstituencies c >>= displayResult + getConstituency c Nothing (Just "TW8 0QU") >>= displayResult + getMP c Nothing (Just "Manchester, Gorton") Nothing (Just False) >>= displayResult + getMPs c Nothing (Just "Labour") Nothing >>= displayResult + +main :: IO () +main = do + apiKey <- readApiKey + maybe (putStrLn "Can't run without API KEY") run apiKey diff --git a/src/Twfy/Api.hs b/src/Twfy/Api.hs new file mode 100644 --- /dev/null +++ b/src/Twfy/Api.hs @@ -0,0 +1,114 @@ +{-| +Module : Twfy.Api +Description : Client API definition + +Servant client API for + +Different calls are being implemented as needed for now so if you require any of the API calls that are not yet implemented please either submit a pull request via github or let me know you want it and I will add it myself. + +TODO: getPerson, getMPInfo, getMPsInfo, getLord, getLords, getMLA, getMLAs, getMSP, getMSPs, getGeometry, getBoundary, getCommittee, getDebates, getWrans, getWMS, getHansard, getComments +-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Twfy.Api + ( + TwfyAPI + , ApiKey + , getConstituency + , getConstituencies + , getMP + , getMPs + ) + where + +import Data.Proxy +import Servant.API +import Servant.Client +import qualified Data.Text as T + +import Twfy.Data.JsonIso8859 +import Twfy.Data.Constituency +import Twfy.Data.MP + +-- | API Key +type ApiKey = T.Text + +-- | Servant API definition +type TwfyAPI = "getConstituency" + :> QueryParam "key" ApiKey + :> QueryParam "name" T.Text + :> QueryParam "postcode" T.Text + :> Get '[JsonIso8859] Constituency + :<|> + "getConstituencies" + :> QueryParam "key" ApiKey + :> Get '[JsonIso8859] [Constituency] + :<|> + "getMP" + :> QueryParam "key" ApiKey + :> QueryParam "id" Int + :> QueryParam "constituency" T.Text + :> QueryParam "postcode" T.Text + :> QueryParam "always_return" Bool + :> Get '[JsonIso8859] MP + :<|> + "getMPs" + :> QueryParam "key" ApiKey + :> QueryParam "search" T.Text + :> QueryParam "party" T.Text + :> QueryParam "date" T.Text -- TODO: change this to a date + :> Get '[JsonIso8859] [MP] + +twfyAPI :: Proxy TwfyAPI +twfyAPI = Proxy + +-- TODO: convertURL + +-- | The 'getConstituency' function retreives a constituency based on name or post code +getConstituency :: Maybe ApiKey -- ^ API key + -> Maybe T.Text -- ^ Name + -> Maybe T.Text -- ^ Post code + -> ClientM Constituency + +-- | The 'getConstituencies' function retreives all constituencies +getConstituencies :: Maybe ApiKey -- ^ API key + -> ClientM [Constituency] + +-- | The 'getMP' function retreives an MP +getMP :: Maybe ApiKey -- ^ API key + -> Maybe Int -- ^ Id + -> Maybe T.Text -- ^ Constituency name + -> Maybe T.Text -- ^ Post code + -> Maybe Bool -- ^ Always return + -> ClientM MP + +-- | The 'getMPs' function retreives a list of MPs +getMPs :: Maybe ApiKey -- ^ API key + -> Maybe T.Text -- ^ Name search + -> Maybe T.Text -- ^ party name + -> Maybe T.Text -- ^ Date + -> ClientM [MP] + +-- TODO: getPerson +-- TODO: getMPInfo +-- TODO: getMPsInfo +-- TODO: getLord +-- TODO: getLords +-- TODO: getMLA +-- TODO: getMLAs +-- TODO: getMSP +-- TODO: getMSPs +-- TODO: getGeometry +-- TODO: getBoundary +-- TODO: getCommittee +-- TODO: getDebates +-- TODO: getWrans +-- TODO: getWMS +-- TODO: getHansard +-- TODO: getComments + +(getConstituency :<|> getConstituencies :<|> getMP :<|> getMPs) = client twfyAPI diff --git a/src/Twfy/Client.hs b/src/Twfy/Client.hs new file mode 100644 --- /dev/null +++ b/src/Twfy/Client.hs @@ -0,0 +1,102 @@ +{-| +Module : Twfy.Client +Description : Client +-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Twfy.Client + ( + A.ApiKey + , Client(..) + , client + , getConstituency + , getConstituencies + , getMP + , getMPs + ) + where + +import Servant.Client hiding(Client(..), client) +import Network.HTTP.Client (Manager, newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Servant.Common.BaseUrl (parseBaseUrl) + +import qualified Data.Text as T + +import qualified Twfy.Api as A +import Twfy.Data.Constituency +import Twfy.Data.MP + +-- | Client - very subject to change, use the 'client' function to create +data Client = Client { + clientApiKey :: A.ApiKey -- ^ API Key + , clientApiUri :: String -- ^ API URL + , clientManager :: Manager -- ^ HTTP client manager + , clientEnv :: ClientEnv -- ^ Servant client env + } + +instance Show Client where + show c = let k = show (clientApiKey c) + u = show (clientApiUri c) + in "twfy-client: " ++ k ++ " - " ++ u + +-- | Create a client. +-- +client :: A.ApiKey -- ^ API Key + -> Maybe String -- ^ API URI - defaults to "https://www.theyworkforyou.com/api" + -> Maybe Manager -- ^ HTTP Client manager - uses default TLS settings if not provided + -> IO Client +client k u m = let defaultUri = "https://www.theyworkforyou.com/api" + defaultManagerAction = newManager tlsManagerSettings + key = k + uri = maybe defaultUri id u + in do + baseUrl <- parseBaseUrl uri + manager <- maybe defaultManagerAction return m + let env = ClientEnv manager baseUrl + return $ Client key uri manager env + +-- | The 'getConstituency' function retreives a constituency based on name or post code +getConstituency :: Client + -> Maybe T.Text -- ^ Name + -> Maybe T.Text -- ^ Post code + -> IO (Either ServantError Constituency) +getConstituency c = do + let key = Just $ clientApiKey c + env = clientEnv c + (\name postCode -> (flip runClientM) env (A.getConstituency key name postCode)) + +-- | The 'getConstituencies' function retreives all constituencies +getConstituencies :: Client + -> IO (Either ServantError [Constituency]) +getConstituencies c = do + let key = Just $ clientApiKey c + env = clientEnv c + (flip runClientM) env (A.getConstituencies key) + +-- | The 'getMP' function retreives an MP +getMP :: Client + -> Maybe Int -- ^ Id + -> Maybe T.Text -- ^ Constituency name + -> Maybe T.Text -- ^ Post code + -> Maybe Bool -- ^ Always return + -> IO (Either ServantError MP) +getMP c = do + let key = Just $ clientApiKey c + env = clientEnv c + (\mpId constituencyName postCode alwaysReturn -> (flip runClientM) env (A.getMP key mpId constituencyName postCode alwaysReturn)) + +-- | The 'getMPs' function retreives a list of MPs +getMPs :: Client + -> Maybe T.Text -- ^ Name search + -> Maybe T.Text -- ^ Party name + -> Maybe T.Text -- ^ Date + -> IO (Either ServantError [MP]) +getMPs c = do + let key = Just $ clientApiKey c + env = clientEnv c + (\personName partyName date -> (flip runClientM) env (A.getMPs key personName partyName date)) diff --git a/src/Twfy/Data/Constituency.hs b/src/Twfy/Data/Constituency.hs new file mode 100644 --- /dev/null +++ b/src/Twfy/Data/Constituency.hs @@ -0,0 +1,50 @@ +{-| +Module : Twfy.Data.Constituency +Description : Constituency data types + +Constituency data types +-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Twfy.Data.Constituency + ( + Constituency(..) + ) + where + +import GHC.Generics +import Data.Aeson.TH +import Data.Maybe (catMaybes) +import qualified Data.Text as T +import Twfy.Util.Json (recordNameToJsonName) + +-- | Constituency Data +data Constituency = Constiutency { + -- | Constituency name + consituencyName :: T.Text + -- | BBC ID for constituency. Arrives as text but appears to be integer + , constituencyBbcConstituencyId :: Maybe T.Text + -- | Guardian ID for constituency. Arrives as text but appears to be integer + , constituencyGuardianId :: Maybe T.Text + -- | Guardian name for constituency + , constituencyGuardianName :: Maybe T.Text + -- | Guardian election results URL + , constituencyGuardianElectionResults :: Maybe T.Text + -- | TOOD: find out what this is. Arrives as text but appears to be integer. + , constituencyPaId :: Maybe T.Text + } + deriving (Generic) +$(deriveJSON defaultOptions { fieldLabelModifier = recordNameToJsonName } ''Constituency) + +instance Show Constituency where + -- | Convert a constituency to a String + show c = let name = Just $ consituencyName c + bbc = fmap (mappend "bbc_id: ") $ constituencyBbcConstituencyId c + guardian_id = fmap (mappend "guardian_id: ") $ constituencyGuardianId c + guardian_name = fmap (mappend "guardian_name: ") $ constituencyGuardianName c + parts = catMaybes [ name, bbc, guardian_id, guardian_name ] + in show $ T.intercalate " - " parts diff --git a/src/Twfy/Data/JsonIso8859.hs b/src/Twfy/Data/JsonIso8859.hs new file mode 100644 --- /dev/null +++ b/src/Twfy/Data/JsonIso8859.hs @@ -0,0 +1,38 @@ +{-| +Module : Twfy.Data.JsonIso8859 +Description : Content-Type not provided by Servant + +Instances for Accept and MimeUnrender to allow Servant client to read 'text/javascript; charset=iso-8859-1' +-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Twfy.Data.JsonIso8859 + ( + JsonIso8859 + ) + where + +import Prelude () +import Prelude.Compat + +import Servant +import Data.Aeson + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text.Encoding as TE +import qualified Network.HTTP.Media as Media + +-- | Type for 'text/plain; charset=iso8859-1' +data JsonIso8859 + +instance Accept JsonIso8859 where + contentType _ = "text" Media.// "javascript" Media./: ("charset", "iso-8859-1") + +instance FromJSON a => MimeUnrender JsonIso8859 a where + mimeUnrender _ = eitherDecode . from8859ToUtf8 + +from8859ToUtf8 :: LBS.ByteString -> LBS.ByteString +from8859ToUtf8 iso = let isoText = TE.decodeLatin1 $ LBS.toStrict iso + utf8 = TE.encodeUtf8 isoText + in LBS.fromStrict utf8 diff --git a/src/Twfy/Data/MP.hs b/src/Twfy/Data/MP.hs new file mode 100644 --- /dev/null +++ b/src/Twfy/Data/MP.hs @@ -0,0 +1,108 @@ +{-| +Module : Twfy.Data.MP +Description : MP data types + +MP data types +-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Twfy.Data.MP + ( + MP(..) + ) + where + +import GHC.Generics +import Data.Aeson.TH +import qualified Data.Text as T +import Twfy.Util.Json (recordNameToJsonName) + +-- | MP Data +-- +-- Does not yet include office data +data MP = MP { + + -- | Member ID (TODO:who allocates these?). Arrives as text but appears to be integer + mpMemberId :: T.Text + + -- | House (TODO: semantics?). Arrives as text but appears to be integer + , mpHouse :: T.Text + + -- | Constituency name + , mpConstituency :: T.Text + + -- | Party name. (TODO: what does independant show?) + , mpParty :: T.Text + + -- | Date entered house. (TODO: convert to date - format appears to be YYYY-MM-DD) + , mpEnteredHouse :: T.Text + + -- | Date left house. (TODO: convert to date - format appears to be YYYY-MM-DD and 9999-12-31 for Still Here) + , mpLeftHouse :: T.Text + + -- | Reason for entering house + , mpEnteredReason :: T.Text + + -- | Reason for leaving house + , mpLeftReason :: T.Text + + -- | Person ID (TODO:who allocates these?). Arrives as text but appears to be integer + , mpPersonId :: T.Text + + -- | Last update time stamp. (TODO: convert to time - format appears to be ''YYYY-MM-DD HH:MM:SS') + , mpLastupdate :: T.Text + + -- | Title + , mpTitle :: T.Text + + -- | Given name + , mpGivenName :: T.Text + + -- | Family name + , mpFamilyName :: T.Text + + -- | Full name + , mpFullName :: T.Text + + -- | URL (TODO: looks like a URL Path for the TWFY site, should maybe create a URL here somehow) + , mpUrl :: T.Text + + -- | Image (TODO: looks like a URL Path for the TWFY site, should maybe create a URL here somehow) + , mpImage :: T.Text + + -- | Image height + , mpImageHeight :: Int + + -- | Image width + , mpImageWidth :: Int + + -- TODO: , mpOffice :: [Office] + } + deriving (Show,Generic) +$(deriveJSON defaultOptions { fieldLabelModifier = recordNameToJsonName } ''MP) + +-- SAMPLE output from API - remaining stuff not included above +-- { +-- "office":[ +-- { +-- "moffice_id":"uk.parliament.data/Member/4389/OppositionPost/1177", +-- "dept":"", +-- "position":"Shadow Minister (Housing)", +-- "from_date":"2016-10-10", +-- "to_date":"9999-12-31", +-- "person":"25343","source":"" +-- }, +-- { +-- "moffice_id":"uk.parliament.data/Member/4389/Committee/328", +-- "dept":"Women and Equalities Committee", +-- "position":"Member", +-- "from_date":"2015-07-06", +-- "to_date":"9999-12-31", +-- "person":"25343","source":"" +-- } +-- ] +-- } diff --git a/src/Twfy/Util/Json.hs b/src/Twfy/Util/Json.hs new file mode 100644 --- /dev/null +++ b/src/Twfy/Util/Json.hs @@ -0,0 +1,26 @@ +{-| +Module : Twfy.Util.Json +Description : JSON Utilities + +Convert record field names between haskell/JSON versions +-} +module Twfy.Util.Json + ( + recordNameToJsonName + ) where + +import Data.Char (isUpper, toLower) + +-- | Convert a haskell record field name in camelCase to JSON snake_case. +recordNameToJsonName :: String -- ^ Record name + -> String -- ^ JSON name +recordNameToJsonName xs = let suffix = dropWhile (not . isUpper) xs + camel = (toLower (head suffix)) : tail suffix + in camelToSnake camel + +camelToSnake :: String -> String +camelToSnake [] = [] +camelToSnake xs@(_:[]) = xs +camelToSnake (x:xs) = if isUpper x + then '_' : ( (toLower x) : (camelToSnake xs) ) + else x : (camelToSnake xs) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/twfy-api-client.cabal b/twfy-api-client.cabal new file mode 100644 --- /dev/null +++ b/twfy-api-client.cabal @@ -0,0 +1,70 @@ +name: twfy-api-client +version: 0.1.0.0 +synopsis: They Work For You API Client Library +description: Please see README.md +homepage: https://github.com/wiggly/twfy-api-client#readme +license: BSD3 +license-file: LICENSE +author: Nigel Rantor +maintainer: wiggly@wiggly.org +copyright: 2016 Nigel Rantor +category: API +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 +stability: alpha +bug-reports: https://github.com/wiggly/twfy-api-client/issues + +library + hs-source-dirs: src + exposed-modules: Twfy.Client Twfy.Api Twfy.Data.Constituency Twfy.Data.MP Twfy.Data.JsonIso8859 Twfy.Util.Json + build-depends: base >= 4.7 && < 5 + , base-compat + , mtl + , either + , transformers + , exceptions + , bytestring + , text + , aeson + , aeson-compat + , servant >= 0.9.1 + , servant-client >= 0.9.1 + , servant-server >= 0.9.1 + , http-client + , http-client-tls + , http-media + default-language: Haskell2010 + +executable twfy-api-client + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , twfy-api-client + , http-client + , base-compat + , mtl + , either + , transformers + , text + , aeson + , aeson-compat + , servant >= 0.9.1 + , servant-client >= 0.9.1 + , http-client + , http-client-tls + default-language: Haskell2010 + +test-suite twfy-api-client-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , twfy-api-client + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/wiggly/twfy-api-client