windowslive-0.2: test/Test.hs

module Main
where

import Control.Monad.Error ( MonadError )
import qualified Network.WindowsLive.App as Live
import qualified Data.URLEncoded as URLEnc
import Network.WindowsLive.Login ( processToken, getLoginUrl, baseUrl )
import Network.WindowsLive.ConsentToken ( processConsentToken )
import Network.URI ( relativeTo, uriQuery )
import Test.HUnit
import System.Exit
import System.IO ( stderr )

-- A login token from a response from login.live.com
loginToken :: String
loginToken =
    "0HlkHc47u2pVQKrkm3zzvvfUbIxS%2FfdOkiHsvbUnUUeVlZ21O%2F%2BYbvXDGTEMc%2BG\
    \%2BQ78pf8LLG1lsO3FAcbsJdeMcOZhwuaqubx7%2BDZq2WtOdK%2F3XJw39kWMPSvUrzwSa\
    \6aT1l1oi6UHPFuBpKSVq4NXHbnZb0IfSWwv%2BNa3BkiIY%2BZyxCjV5k%2BYbLD4Xz9%2B\
    \s"

-- A consent token from a response from consent.live.com
consentToken :: String
consentToken =
    "eact%3DvFcrnZDughQ9O2jrtckfcEF26jJcvdYE6U3Dh%252Fs6y2ZAB8T%252FyaFoehz1\
    \Y8Flp%252Bh6o3FB2BFormNo4on3xXDYmCc6NXnw4HLnO314bmsl4apTga1ekfbo49xfzjh\
    \1uncXJNwKrRYdeF5qeqBAdtdFbz3vwKsqxlbLuMnEdImGervS5UNE88lbGaS7bVv28FySwQ\
    \d1U9dlOi5H%252FUf7X9hfPCVquifMG%252BFLfdUgRUFRbFXJlp%252F8iV4J7uzV1JX3Q\
    \l7TAKtj%252FOHeL0Cmr5q5qJZxO55JljZwFfhy6NNKcZniQzWFsKqFAAzEYEnBuNSU4sRR\
    \dm5hHS7LzrTdSdo1EcZLT01PdmE%252FcUEH2W9m7cO1FNuKSzxWcdi%252BojCUK6UwbSD\
    \TxFMs3zEiUHsHh5Ue24JCq9ocTpPg3GJTebVLLVltQHfvXXsycS12FetlrGxbgvxrfqqX7F\
    \gw04aDyQjCOFidub9Rtfh9%252BF4VsqAHS2uedCs%252FC7kjBT8pwyP0GBeELRlDmZ1Uy\
    \3LwZSNK%252FycC8so%252BaH%252FQAQJDfIk%252F539ZiNkQkyukrRx9eceirNr24gUj\
    \8h7%252BzC9%252FuPAkubOJAXOVKx0ROr1EcDJZpUeLax4RDx53tM0S5egPgmpLQ%252Br\
    \gdWeCgWZuXmah71lWt65ewqggRs%252FEWsBvFbqZ0UVWQnN6iOx1h%252B6qrDjS5wx5Nv\
    \tmT6E1rHGzPkLUAh8BT1TioltoLwpnZYRr8vimahrYgI19QSft5Lplouay8t9POSCG%252B\
    \RrZLLGUXvvyW6EkdNLdNQbeudcBt3kE7H5iYiZWL8n0nAukqJtEql100tKEfntAW1PZQ4Zy\
    \yIA%252F%252BaXwfVXOVztu1GnYmVGl8uK4%252BqsqW797bgvktj%252BroGfY5CbBwlU\
    \rywUA2Zy4NupJH3jm0rf5PvN6UzyscygPTNnPxgrzvdVHJizvz9%252BIcf%252F%252Bs8\
    \Oh4OIiwXKBXW4CvmVu1yFqD%252FvkrqF8P4UpqE7fiJOP20Lw%252FfRpac5Dl0gvJK08I\
    \E8unTy8s0uKwdy0BIa2EpZV4Nlupp%252BWfZl2rgYDjtF8rCzA73LMtkrUpByO3JwbmRiB\
    \URjvYJR%252FMvdlcWaw1CTt%252B6pOrr9YLesmJe%252FxqjfjquDx%252B%252BdkJRF\
    \GT%252B2gGo4YfTTpoy7IsiQy1b1NDVVJRYmINmIj1HLOuHbKl%252F0JMOJMr0jjn7GXwT\
    \wgSCg3TMZtK1W7xdoqOC8xOFdw"

appId :: String
appId = "000000004C00F507"

secret :: String
secret = "wfMkKPJdTHHi64sWrmQlGE9uBY27Pjgl"

getApp :: MonadError e m => m Live.App
getApp = Live.new appId secret

-- Very weak tests: test that processing these good strings does not
-- throw an exception
processLoginTest :: Live.App -> Test
processLoginTest app = test (processToken app loginToken >> return () :: IO ())

processConsentTest :: Live.App -> Test
processConsentTest app =
    test (processConsentToken app consentToken >> return () :: IO ())

badAppTest :: Test
badAppTest =
 test [ "validates secret" ~: assert $ fails (Live.new appId "")
      , "validates app id" ~: assert $ fails (Live.new "" secret)
      ]
    where fails :: Either String Live.App -> Bool
          fails (Left _) = True
          fails _ = False

loginUrlTest :: Live.App -> Test
loginUrlTest app =
    test $ do
      let mkt = "> =&abc#://"
          ctx = "123/?<{}!456"
          relLoginUri = getLoginUrl app (Just ctx) (Just mkt)

      uri <- case relLoginUri `relativeTo` baseUrl of
               Nothing -> fail $ "Failed to combine: " ++ show relLoginUri
                          ++ " and " ++ show baseUrl
               Just u -> return u

      q <- case uriQuery uri of
             '?':qs -> URLEnc.importString qs
             "" -> URLEnc.importString ""
             unexpected ->
                 fail $ "No ? at start of query string: " ++ show unexpected

      let assertQ (k, v) = assertEqual k v =<< URLEnc.lookup1 k q
      mapM_ assertQ [ ("appid", Live.appId app)
                    , ("mkt", mkt)
                    , ("appctx", ctx)
                    ]

main :: IO ()
main = do
  app <- getApp
  let tests = [ processConsentTest app
              , processLoginTest app
              , loginUrlTest app
              , badAppTest
              ]
  (testResults, _) <- runTestText (putTextToHandle stderr False) $ test tests
  exitWith $ if (errors testResults + failures testResults) /= 0
             then ExitFailure 1
             else ExitSuccess