nationstates 0.4.0.0 → 0.5.0.0

raw patch · 7 files changed

+145/−49 lines, 7 filesdep +tlsPVP ok

version bump matches the API change (PVP)

Dependencies added: tls

API changes (from Hackage documentation)

Files

• NationStates.hs +2/−2
• NationStates/Core.hs +53/−26
• NationStates/Nation.hs +8/−8
• NationStates/Region.hs +19/−12
• NationStates/Types.hs +9/−0
• NationStates/Verify.hs +51/−0
• nationstates.cabal +3/−1

@@ -23,7 +23,7 @@     :: String         -- ^ User agent     -> IO Context-newContext userAgent = newContext' userAgent False+newContext userAgent = newContext' userAgent True   -- | Create a new 'Context', with extra options.@@ -31,7 +31,7 @@     :: String         -- ^ User agent     -> Bool-        -- ^ Use HTTPS (experimental)+        -- ^ Use HTTPS     -> IO Context newContext' userAgent isSecure = do     man <- newManager $

@@ -17,6 +17,10 @@      -- * Query strings     Query(..),+    shard,+    shard',+    withOptions,+    withParams,      -- * Connection manager     Context(..),@@ -34,6 +38,7 @@   import Control.Applicative+import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BC import Data.Functor.Compose import qualified Data.Foldable as F@@ -87,28 +92,20 @@     -> String         -- ^ XML element name     -> NS String-makeNS shard elemName = makeNS' shard Nothing [] parse+makeNS shardName elemName = makeNS' (shard shardName) parse   where     parse _ = strContent . fromMaybe errorMissing . findChild (unqual elemName)     errorMissing = error $ "missing <" ++ elemName ++ "> element"  --- | Construct a request for a single shard.+-- | Construct a request. makeNS'-    :: String-        -- ^ Shard name-    -> Maybe Integer-        -- ^ Shard ID-    -> [(String, String)]-        -- ^ List of options+    :: Query+        -- ^ Query string     -> (Query -> Element -> a)         -- ^ Function for parsing the response     -> NS a-makeNS' name maybeId options parse = Compose-    (Query {-        queryShards = Map.singleton name (Set.singleton maybeId),-        queryOptions = Map.fromList options-    }, Compose parse)+makeNS' query parse = Compose (query, Compose parse)   -- | Perform a request on the NationStates API.@@ -126,16 +123,13 @@   where     parse = p q . fromMaybe (error "invalid response") . parseXMLDoc     req = initRequest {-        queryString-            = HTTP.renderQuery True (HTTP.toQuery $-                F.toList kindAndName ++ [("q", shards), ("v", show apiVersion)])-            <> BC.pack options,+        queryString = queryToString kindAndName q,         requestHeaders             = ("User-Agent", BC.pack $ contextUserAgent c)             : requestHeaders initRequest,+        port = if contextIsSecure c then 443 else 80,         secure = contextIsSecure c         }-    (shards, options) = queryToUrl q  initRequest :: Request Just initRequest = parseUrl "http://www.nationstates.net/cgi-bin/api.cgi"@@ -169,28 +163,61 @@ -- | Keeps track of the set of shards to request. data Query = Query {     queryShards :: Map String (Set (Maybe Integer)),-    queryOptions :: Map String String+    queryOptions :: Map String String,+    queryParams :: Map String String     } deriving Show  instance Monoid Query where-    mempty = Query mempty mempty+    mempty = Query mempty mempty mempty     mappend a b = Query {         queryShards = Map.unionWith Set.union             (queryShards a) (queryShards b),         queryOptions = Map.unionWithKey mergeOptions-            (queryOptions a) (queryOptions b)+            (queryOptions a) (queryOptions b),+        queryParams = Map.unionWithKey mergeOptions+            (queryParams a) (queryParams b)         }       where         mergeOptions key _ _             = error $ "conflicting values for option " ++ show key  -queryToUrl :: Query -> (String, String)-queryToUrl q = (shards, options)+-- | Create a query for a single shard.+shard :: String -> Query+shard name = mempty {+    queryShards = Map.singleton name (Set.singleton Nothing) }++-- | Create a query for a single shard, with an extra ID.+--+-- For example, the @censusscore-23@ shard would be written as:+-- @shard' "censusscore" 23@.+shard' :: String -> Integer -> Query+shard' name id' = mempty {+    queryShards = Map.singleton name (Set.singleton (Just id')) }++-- | Add extra @;@-delimited arguments.+withOptions :: [(String, String)] -> Query+withOptions options = mempty { queryOptions = Map.fromList options }++-- | Add extra @&@-delimited arguments.+withParams :: [(String, String)] -> Query+withParams params = mempty { queryParams = Map.fromList params }+++queryToString :: Maybe (String, String) -> Query -> ByteString+queryToString kindAndName q+    = HTTP.renderQuery True (HTTP.toQuery $+        F.toList kindAndName+            ++ Map.toList (queryParams q)+            ++ [("q", shards), ("v", show apiVersion)])+    <> BC.pack options   where-    shards = intercalate "+" [ name ++ F.foldMap (\i -> "-" ++ show i) maybeId |-        (name, is) <- Map.toList $ queryShards q,-        maybeId <- Set.toList is ]+    shards+        | Map.null (queryShards q) = "null"+        | otherwise+            = intercalate "+" [ name ++ F.foldMap (\i -> "-" ++ show i) maybeId |+                (name, is) <- Map.toList $ queryShards q,+                maybeId <- Set.toList is ]     options = concat [ ";" ++ k ++ "=" ++ v |         (k, v) <- Map.toList $ queryOptions q ] 

@@ -168,22 +168,22 @@ -- | General assembly vote. -- -- > Just True-gavote :: Nation WAVote-gavote = Nation . fmap (expect "General Assembly vote" <*> readWAVote) $+gavote :: Nation (Maybe WAVote)+gavote = Nation . fmap (expect "General Assembly vote" <*> readWAVote') $     makeNS "gavote" "GAVOTE"  -- | Security council vote. -- -- > Nothing-scvote :: Nation WAVote-scvote = Nation . fmap (expect "Security Council vote" <*> readWAVote) $+scvote :: Nation (Maybe WAVote)+scvote = Nation . fmap (expect "Security Council vote" <*> readWAVote') $     makeNS "scvote" "SCVOTE"  -- | Description of civil rights, economy, and political freedoms. -- -- > ("Excellent","Strong","Very Good") freedom :: Nation (String, String, String)-freedom = Nation $ makeNS' "freedom" Nothing [] parse+freedom = Nation $ makeNS' (shard "freedom") parse   where     parse _ root         | Just parent <- findChild (unqual "FREEDOM") root@@ -246,7 +246,7 @@ -- -- > ["v1","o4","b14","t23","m3"] banners :: Nation [String]-banners = Nation $ makeNS' "banners" Nothing [] parse+banners = Nation $ makeNS' (shard "banners") parse   where     parse _ root         | Just parent <- findChild (unqual "BANNERS") root@@ -260,7 +260,7 @@ -- -- > (24,6.0) censusscore :: Nation (Integer, Double)-censusscore = Nation $ makeNS' "censusscore" Nothing [] parse+censusscore = Nation $ makeNS' (shard "censusscore") parse   where     parse q root         | Just (i, _) <- MultiSet.minView $ MultiSet.difference response request@@ -278,7 +278,7 @@ -- -- > 94.0 censusscore' :: Integer -> Nation Double-censusscore' i = Nation $ makeNS' "censusscore" (Just i) [] parse+censusscore' i = Nation $ makeNS' (shard' "censusscore" i) parse   where     parse _ = fromMaybe (error $ "could not find census " ++ show i) .         lookup i . extractCensusScores

@@ -124,9 +124,11 @@ -- | The number of votes for and against the current General Assembly -- resolution. ----- > (28,11)-gavote :: Region (Integer, Integer)-gavote = Region $ makeNS' "gavote" Nothing [] parse+-- Returns @Nothing@ when there is no proposal at vote.+--+-- > Just (28,11)+gavote :: Region (Maybe (Integer, Integer))+gavote = Region $ makeNS' (shard "gavote") parse   where     parse _ = expect "GA vote counts" <$> showElement <*>         (grabVotes <=< findChild (unqual "GAVOTE"))@@ -134,17 +136,22 @@ -- | The number of votes for and against the current Security Council -- resolution. ----- > (20,34)-scvote :: Region (Integer, Integer)-scvote = Region $ makeNS' "scvote" Nothing [] parse+-- Returns @Nothing@ when there is no proposal at vote.+--+-- > Just (20,34)+scvote :: Region (Maybe (Integer, Integer))+scvote = Region $ makeNS' (shard "scvote") parse   where     parse _ = expect "SC vote counts" <$> showElement <*>         (grabVotes <=< findChild (unqual "SCVOTE")) -grabVotes :: Element -> Maybe (Integer, Integer)-grabVotes root = (,)-    <$> (readMaybe . strContent =<< findChild (unqual "FOR") root)-    <*> (readMaybe . strContent =<< findChild (unqual "AGAINST") root)+grabVotes :: Element -> Maybe (Maybe (Integer, Integer))+grabVotes root = do+    forStr <- grab "FOR"+    againstStr <- grab "AGAINST"+    return $ (,) <$> readMaybe forStr <*> readMaybe againstStr+  where+    grab childName = strContent <$> findChild (unqual childName) root  -- | Region founder. --@@ -170,7 +177,7 @@ -- -- > ["New Lunar Republic","Tareldanore"] embassies :: Region [String]-embassies = Region $ makeNS' "embassies" Nothing [] parse+embassies = Region $ makeNS' (shard "embassies") parse   where     parse _ = expect "embassy names" <$> showElement <*>         fmap (grabChildren "EMBASSY") . findChild (unqual "EMBASSIES")@@ -179,7 +186,7 @@ -- -- > ["Silly","Monarchist","Large"] tags :: Region [String]-tags = Region $ makeNS' "tags" Nothing [] parse+tags = Region $ makeNS' (shard "tags") parse   where     parse _ = expect "region tags" <$> showElement <*>         fmap (grabChildren "TAG") . findChild (unqual "TAGS")

@@ -3,6 +3,10 @@ module NationStates.Types where  +import Control.Applicative+import Prelude  -- GHC 7.10++ -- | Nation category. -- -- This datum summarizes a nation's personal, economic, and political@@ -122,6 +126,11 @@     "FOR" -> Just $ Just True     "AGAINST" -> Just $ Just False     _ -> Nothing++readWAVote' :: String -> Maybe (Maybe WAVote)+readWAVote' s+    | null s = Just Nothing+    | otherwise = Just <$> readWAVote s  showWAVote :: WAVote -> String showWAVote v = case v of

@@ -0,0 +1,51 @@+-- | The Authentication API.+--+-- See <https://www.nationstates.net/pages/api.html#authentication>.+--+-- Here's a short example:+--+-- @+-- import NationStates+-- import qualified NationStates.Nation as Nation+-- import qualified NationStates.Verify as Nation+--+-- main = do+--     c <- 'NationStates.newContext' "ExampleBot/2000"+--     ok <- Nation.run "The Vines" (Nation.verify checksum token) c+--     putStrLn $ if ok then \"Success\" else \"Failure\"+--   where+--     checksum = \"CCT60sf2CfylDqSNzCMleqsvxrwjiG-9Zw4TXZjdMmk\"+--     token = Just "testing123"+-- @++module NationStates.Verify (+    verify,+    ) where+++import qualified Data.Foldable as F+import Text.XML.Light++import NationStates.Core+import NationStates.Nation (Nation(..))+++-- | Add an authentication token to an existing 'Nation' request.+verify+    :: String+        -- ^ Checksum+    -> Maybe String+        -- ^ Site-specific token+    -> Nation Bool+verify checksum token = Nation $ makeNS' query parse+  where+    query = withParams $+        [("a", "verify"), ("checksum", checksum)]+        ++ F.foldMap (\t -> [("token", t)]) token+    parse _ root+        | Just e <- findChild (unqual "VERIFY") root =+            case strContent e of+                "0" -> False+                "1" -> True+                s -> error $ "invalid value for <VERIFY>: " ++ show s+        | otherwise = error "missing <VERIFY> element"

@@ -1,5 +1,5 @@ name: nationstates-version: 0.4.0.0+version: 0.5.0.0 synopsis: NationStates API client description:     NationStates API client@@ -24,6 +24,7 @@         NationStates.Nation         NationStates.Region         NationStates.Types+        NationStates.Verify     build-depends:         base >= 4.6 && < 5,         bytestring,@@ -33,6 +34,7 @@         http-client-tls,         http-types,         multiset,+        tls >= 1.3.3,         transformers,         xml     default-language: Haskell2010