{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module VertigoIO.TestMain where import Control.Lens ((&), (.~), (?~), (^.)) import Control.Monad (liftM) import Control.Monad.Catch (MonadCatch, MonadThrow) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.AWS (runAWST) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Either (EitherT, runEitherT) import Control.Monad.Trans.Maybe (MaybeT) import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) import Control.Monad.Trans.Resource (ResourceT(..), runResourceT) import Data.Aeson (decode, encode) import Data.Conduit (Consumer, await, awaitForever, ($$), ($$+-), (=$)) import Data.Conduit.Binary (sinkFile, sinkHandle) import Data.Foldable (forM_) import Data.Text.Encoding (encodeUtf8) import Network.AWS import Network.AWS.SNS import Network.HTTP (getResponseBody) import Network.HTTP.Client (Manager) import Network.HTTP.Conduit (checkStatus, http, httpLbs, method, newManager, parseUrl, redirectCount, requestHeaders, responseBody, simpleHttp, tlsManagerSettings, withManager) import System.IO (stdout) import Vertigo.AppM import Vertigo.Ext import Vertigo.Types.Config import Vertigo.Types.DeviceInfo import Vertigo.Types.Error import Vertigo.Web import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import qualified Data.Text as T import qualified Data.UUID as U import qualified Data.UUID.V4 as U import qualified Vertigo.Types.Notification as N import qualified Vertigo.Types.Notification.Ids as N ---------------------------- import Debug.Trace import Helper.Str ---------------------------------------------- -- TODO make tests with assertions, not prints ---------------------------------------------- ------------------------------------------------------------------------------ -- | test encode/decode NotificationType test01 :: IO () test01 = do let l = [General, Social, Search, Sync] let encl = map encode l print encl -- prepend one wrong entry and decode let decl = map dent ("Junk" : encl) print decl where dent x = decode x :: Maybe NotificationType ------------------------------------------------------------------------------ -- | test encode/decode Notification test02 :: IO () test02 = do let i = encodeUtf8 $ T.pack "06a8b2d0-b1a9-441b-9a12-e420002ab0de" let uid = fromJust $ fromBytes i let n = Notification uid General "Message here!" "" -- let uid = toText "06a8b2d0-b1a9-441b-9a12-e420002ab0de" let encN = encode n print encN let decN = decode encN :: Maybe Notification print decN let wrong = "{\"payload\":\"Payload here!\",\"notification_type\":\"Oops\",\"receiver_uid\":\"06a8b2d0-b1a9-441b-9a12-e420002ab0de\"}" print (decode wrong :: Maybe Notification) where fromJust :: Maybe a -> a fromJust Nothing = error "Maybe.fromJust: Nothing" fromJust (Just x) = x -------------------------------------------------- -- | Call user service and get the list of devices test03 :: IO () test03 = do rq0 <- parseUrl "http://user.devvmg.com/rest/device" let accessToken = "eyJhbGciOiJIUzI1NiJ9.eyJleHAiOjE0NTMxMTQ0OTAsIlVzZXJJZCI6IjdkODk5OGNjLTkxYmEtNDhiOS05MTgzLWQ5YTdiYjg2NDI2NSIsImlhdCI6MTQ0NzkzMDQ5MCwic3ViIjoibWFjMiIsIkVtYWlsIjoidXNlckBob3N0LmNvbSJ9.ylnyUVdG6J0zkMK9vnqEJo55-FKeYbw2zq11xC9Hhvg" let req = rq0 { redirectCount = 0 , requestHeaders = ("X-Access-Token", accessToken): (requestHeaders rq0) } traceM $ "req=" ++ show req manager <- newManager tlsManagerSettings let stdOutSink :: (Show a) => Consumer a (ResourceT IO) () stdOutSink = awaitForever $ liftIO . print runResourceT $ do res <- http req manager responseBody res $$+- stdOutSink --sinkFile "output.txt" -------------------------------------------------- -- | Publish message to Amazon SNS -- Analog in scala: -- sns.publish(new PublishRequest -- .withTargetArn "arn:aws:sns:us-west-2:877422789438:endpoint/GCM/nicks-notify-app/56aff09d-1878-3f7f-bae0-2cd31c7cba4c" -- .withMessage "{\"GCM\":\"{\"data\":{\"message\":\"Hello, Nick!\"}}\"}" -- ) test05 :: IO () test05 = do let conf = buildConfig LOCAL ext <- buildEnvironmentExt conf (_, msg, targetArn) <- mySnsData mgr <- newManager tlsManagerSettings liftAppToIO ext $ snsPublish0 msg targetArn print "Message sent" instance Show Env where show e = "envRegion=" ++ show (e ^. envRegion) mySnsData :: (MonadIO m, MonadCatch m) => m (Env, T.Text, T.Text) mySnsData = do e <- newEnv Oregon Discover l <- newLogger Debug stdout let env = e & envLogger `assign` l let targetArn = "arn:aws:sns:us-west-2:876422789438:endpoint/GCM/nicks-notify-app/56aff09d-1878-3f7f-bae0-2cd31c7cba4c" let msg = "{\"GCM\":\"{\"data\":{\"message\":\"Hello, Nick!\"}}\"}" return (env, msg, targetArn) where assign = (.~) ------------------------------------------------------------------------------ -- | Publish message to user service -- test06 :: MaybeT IO () test06 :: IO () test06 = do let token = "eyJhbGciOiJIUzI1NiJ9.eyJleHAiOjE0NTMxMTQ0OTAsIlVzZXJJZCI6IjdkODk5OGNjLTkxYmEtNDhiOS05MTgzLWQ5YTdiYjg2NDI2NSIsImlhdCI6MTQ0NzkzMDQ5MCwic3ViIjoibWFjMiIsIkVtYWlsIjoidXNlckBob3N0LmNvbSJ9.ylnyUVdG6J0zkMK9vnqEJo55-FKeYbw2zq11xC9Hhvg" ext <- buildEnvironmentExt let confE = ext ^. config let mb = U.fromText "06a8b2d0-b1a9-441b-9a12-e420002ab0de" forM_ mb $ \id -> case confE of Left err -> print err Right conf -> do let uid = UserId id let n = Notification uid General "Hello" "" ext <- buildExt conf -- ask user service manager <- newManager tlsManagerSettings dis <- liftAppToIO ext $ userServiceGetDevices manager token uid print dis ------------------------------------------------------------------------------ test07 :: IO () test07 = do let cfg = buildConfig LOCAL ext <- buildEnvironmentExt let deviceToken = "" let paArn = "TODO" ext <- buildEnvironmentExt cfg manager <- newManager tlsManagerSettings -- env <- newEnv Oregon Discover logger <- newLogger Debug stdout env <- liftM (envWithLog logger) $ newEnv Oregon Discover resp <- liftAppToIO ext $ snsCreatePlatformEndpoint0 paArn deviceToken print resp where envWithLog :: Logger -> Env -> Env envWithLog logger env = env & envLogger .~ logger -- case dsMb of -- Just ds -> return ds -- Nothing -> return []