{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE InstanceSigs #-}

{-|
Module      : System.Random.Atmospheric.Api
Description : Haskell bindings to the RANDOM.ORG Core API
Copyright   : Copyright 2022-2024 Mike Pilgrem
License     : BSD-3-Clause
Maintainer  : public@pilgrem.com
Stability   : Experimental
Portability : Portable

Haskell bindings to the [RANDOM.ORG](https://random.org) Core API (Release 4).
The API provides access to a true random number generator (TRNG) based on
atmospheric noise.

NB: The use of the API's services is subject to the terms and conditions of
Randomness and Integrity Services Limited.

This module has no connection with Randomness and Integrity Services Limited or
its affilates or the RANDOM.ORG domain.

The Core API comprises the Basic API and the Signed API.
-}

module System.Random.Atmospheric.Api
  ( -- * The Basic API

    --

    -- | For each API method yielding random data there are four functions. For

    -- example:

    --

    -- * 'genIntegers'

    -- * 'genIntegers''

    -- * 'genWithSeedIntegers'

    -- * 'genWithSeedIntegers''

    --

    -- The functions with and without a prime character differ in the type of

    -- the value they yield. This can be simple:

    --

    -- > IO (Maybe (a, Int))

    --

    -- where the second value of the tuple represents the advised delay in

    -- milliseconds before next calling the API, or complex:

    --

    -- > IO (Either ClientError (JsonRpcResponse Value (RandomResponse a)))

    --

    -- The type synonym 'RndResponse' is used to simplify the type signatures

    -- of the complex functions:

    --

    -- > type RndResponse a = JsonRpcResponse Value (RandomResponse a)

    --

    -- The @genWithSeed...@ functions are more general, taking an optional seed

    -- which, if specified, causes the API to use pregenerated noise.

    --

    -- > genIntegers mgr key == genWithSeedIntegers mgr key Nothing

    --

    -- > genIntegers' mgr key == genWithSeedIntegers' mgr key Nothing

    --

    -- Certain optional API parameters (@base@, default @10@) are not

    -- implemented.


    -- ** Simple functions yielding random data

    genIntegers
  , genIntegerSequences
  , genIntegerSequencesMultiform
  , genDecimalFractions
  , genGaussians
  , genStrings
  , genUUIDs
  , genBlobs
    -- ** Complex functions yielding random data

  , genIntegers'
  , genIntegerSequences'
  , genIntegerSequencesMultiform'
  , genDecimalFractions'
  , genGaussians'
  , genStrings'
  , genUUIDs'
  , genBlobs'
    -- ** Simple functions yielding random data, maybe from pregenerated randomization

  , genWithSeedIntegers
  , genWithSeedIntegerSequences
  , genWithSeedIntegerSequencesMultiform
  , genWithSeedDecimalFractions
  , genWithSeedGaussians
  , genWithSeedStrings
  , genWithSeedUUIDs
  , genWithSeedBlobs
    -- ** Complex functions yielding random data, maybe from pregenerated randomization

  , genWithSeedIntegers'
  , genWithSeedIntegerSequences'
  , genWithSeedIntegerSequencesMultiform'
  , genWithSeedDecimalFractions'
  , genWithSeedGaussians'
  , genWithSeedStrings'
  , genWithSeedUUIDs'
  , genWithSeedBlobs'
    -- *  The Signed API

    --

    -- | For each API method yielding random data there are two functions. For

    -- example:

    --

    -- * 'genSignedIntegers'

    -- * 'genWithSeedSignedIntegers'

    --

    -- The @genWithSeed...@ functions are more general, taking an optional seed

    -- which, if specified, causes the API to use pregenerated noise.

    --

    -- > genIntegers mgr key == genWithSeedIntegers mgr key Nothing

    --

    -- > genIntegers' mgr key == genWithSeedIntegers' mgr key Nothing

    --

    -- The type synonym 'SigRndResponse' is used to simplify the type signatures

    -- of the functions:

    --

    -- > type SigRndResponse a b = JsonRpcResponse Value (SignedRandomResponse a b)

    --

    -- Certain optional API parameters (@base@, default @10@) are not

    -- implemented.


    -- ** Functions yielding signed random data

  , genSignedIntegers
  , genSignedIntegerSequences
  , genSignedIntegerSequencesMultiform
  , genSignedDecimalFractions
  , genSignedGaussians
  , genSignedStrings
  , genSignedUUIDs
  , genSignedBlobs
    -- ** Functions yielding signed random data, maybe from pregenerated randomization

  , genWithSeedSignedIntegers
  , genWithSeedSignedIntegerSequences
  , genWithSeedSignedIntegerSequencesMultiform
  , genWithSeedSignedDecimalFractions
  , genWithSeedSignedGaussians
  , genWithSeedSignedStrings
  , genWithSeedSignedUUIDs
  , genWithSeedSignedBlobs
    -- ** Functions related to serial numbers

  , getResult
    -- ** Functions related to tickets

  , createTickets
  , createTickets'
  , revealTickets
  , revealTickets'
  , listTickets
  , listTickets'
  , getTicket
  , getTicket'
    -- ** Functions related to verification

  , verifySignedResponse
  , verifySignedResponse'
    -- * Usage of the Core API

  , getUsage
  , getUsage'
    -- * Types and type synonyms

    -- ** The Core API

  , Key (..)
  , Seed
  , MkSeedError
  , mkSeedfromDate
  , mkSeedFromId
  , Boundary (..)
  , Blob (..)
  , BlobFormat (..)
  , RandomResponse (..)
  , RndResponse
  , UsageResponse (..)
  , Status (..)
    -- ** The Signed API only

  , ApiKey (..)
  , Method (..)
  , LicenseData (..)
  , CurrencyAmount (..)
  , Currency (..)
  , TicketResponse (..)
  , TicketData (..)
  , TicketId (..)
  , TicketType (..)
  , Signature (..)
  , SignedRandomResponse (..)
  , GenIntegersParams (..)
  , GenIntegerSequencesParams (..)
  , GenIntegerSequencesMultiformParams (..)
  , GenDecimalFractionsParams (..)
  , GenGaussiansParams (..)
  , GenStringsParams (..)
  , GenUUIDsParams (..)
  , GenBlobsParams (..)
  , ClientSigResponse
  , GetResultResponse (..)
  , CreateTicketsResponse (..)
  , RevealTicketsResponse (..)
  , TicketInfoResponse (..)
  , VerifySignatureResponse (..)
  , SigRndResponse
  ) where

import           Control.Applicative ( (<|>) )
import           Data.Aeson.Encoding ( unsafeToEncoding )
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as Map
#endif
import           Data.Aeson.Types
                   ( FromJSON (..), Object, Options (..), SumEncoding (..)
                   , ToJSON (..), Value (..), (.:), defaultOptions
                   , fieldLabelModifier, genericParseJSON, genericToEncoding
                   , genericToJSON, withObject, withText
                   )
import           Data.Binary.Builder ( fromByteString )
import           Data.ByteString ( ByteString )
import           Data.Char ( toLower )
#if !MIN_VERSION_aeson(2,0,0)
import qualified Data.HashMap.Strict as Map
#endif
import           Data.Proxy ( Proxy (..) )
import qualified Data.Text as T
import           Data.Text ( Text )
import           Data.Text.Encoding ( decodeUtf8, encodeUtf8 )
import           Data.Time ( Day, UTCTime )
import           Data.UUID.Types ( UUID )
import           GHC.Generics ( Generic )
import           Network.HTTP.Client ( Manager )
import           Servant.API ( (:<|>) (..), (:>), JSON )
import           Servant.Client
                   ( BaseUrl (BaseUrl), ClientEnv (..), ClientM, Scheme (Https)
                   , client
#if MIN_VERSION_servant_client(0,17,0)
                   , defaultMakeClientRequest
#endif
                   , runClientM
                   )
#if MIN_VERSION_servant_client(0,16,0)
import           Servant.Client.Core ( ClientError )
#else
import           Servant.Client.Core ( ServantError )
#endif
import           Servant.Client.JsonRpc
                   ( JsonRpc, JsonRpcResponse (..), RawJsonRpc )
import           System.Random.Atmospheric.Api.DateTime ( DateTime (..) )

#if !MIN_VERSION_servant_client(0,16,0)
type ClientError = ServantError
#endif

-- |Type synonym to simplify type signatures defining the Basic API.

type Rnd a b c = JsonRpc a b Value (RandomResponse c)

type SigRnd a b c d = JsonRpc a b Value (SignedRandomResponse c d)

-- |Type synonym to simplify type signatures defining responses from the Basic

-- API.

type RndResponse a = JsonRpcResponse Value (RandomResponse a)

-- |Type synonym to simplify type signatures defining responses from the Signed

-- API.

type SigRndResponse a b = JsonRpcResponse Value (SignedRandomResponse a b)

-- |Type synonym to simplify type signatures defining responses from the Signed

-- API.

type ClientSigResponse a b = Either ClientError (SigRndResponse a b)

type GenIntegers =
   Rnd "generateIntegers" GenIntegersParams [Int]

type GenIntegerSequences =
  Rnd "generateIntegerSequences" GenIntegerSequencesParams [[Int]]

type GenIntegerSequencesMultiform =
  Rnd "generateIntegerSequences" GenIntegerSequencesMultiformParams [[Int]]

type GenDecimalFractions =
  Rnd "generateDecimalFractions" GenDecimalFractionsParams [Double]

type GenGaussians =
   Rnd "generateGaussians" GenGaussiansParams [Double]

type GenStrings =
   Rnd "generateStrings" GenStringsParams [Text]

type GenUUIDs =
   Rnd "generateUUIDs" GenUUIDsParams [UUID]

type GenBlobs =
  Rnd "generateBlobs" GenBlobsParams [Blob]

type GenSigIntegers =
  SigRnd "generateSignedIntegers" GenSigIntegersParams [Int] GenIntegersParams

type GenSigIntegerSequences =
  SigRnd
    "generateSignedIntegerSequences"
    GenSigIntegerSequencesParams
    [[Int]]
    GenIntegerSequencesParams

type GenSigIntegerSequencesMultiform =
  SigRnd
    "generateSignedIntegerSequences"
    GenSigIntegerSequencesMultiformParams
    [[Int]]
    GenIntegerSequencesMultiformParams

type GenSigDecimalFractions =
  SigRnd
    "generateSignedDecimalFractions"
    GenSigDecimalFractionsParams
    [Double]
    GenDecimalFractionsParams

type GenSigGaussians =
  SigRnd
    "generateSignedGaussians"
    GenSigGaussiansParams
    [Double]
    GenGaussiansParams

type GenSigStrings =
  SigRnd "generateSignedStrings" GenSigStringsParams [Text] GenStringsParams

type GenSigUUIDs =
  SigRnd "generateSignedUUIDs" GenSigUUIDsParams [UUID] GenUUIDsParams

type GenSigBlobs =
  SigRnd "generateSignedBlobs" GenSigBlobsParams [Blob] GenBlobsParams

type GetResult =
   JsonRpc "getResult" GetResultParams Value GetResultResponse

type CreateTickets =
  JsonRpc "createTickets" CreateTicketsParams Value CreateTicketsResponse

type RevealTickets =
  JsonRpc "revealTickets" RevealTicketsParams Value RevealTicketsResponse

type ListTickets =
  JsonRpc "listTickets" ListTicketsParams Value [TicketInfoResponse]

type GetTicket =
   JsonRpc "getTicket" GetTicketParams Value TicketInfoResponse

type VerifySignature =
   JsonRpc "verifySignature" VerifySignatureParams Value VerifySignatureResponse

type GetUsage =
  JsonRpc "getUsage" GetUsageParams Value UsageResponse

type RpcAPI =
       GenIntegers
  :<|> GenIntegerSequences
  :<|> GenIntegerSequencesMultiform
  :<|> GenDecimalFractions
  :<|> GenGaussians
  :<|> GenStrings
  :<|> GenUUIDs
  :<|> GenBlobs
  :<|> GenSigIntegers
  :<|> GenSigIntegerSequences
  :<|> GenSigIntegerSequencesMultiform
  :<|> GenSigDecimalFractions
  :<|> GenSigGaussians
  :<|> GenSigStrings
  :<|> GenSigUUIDs
  :<|> GenSigBlobs
  :<|> GetResult
  :<|> CreateTickets
  :<|> RevealTickets
  :<|> ListTickets
  :<|> GetTicket
  :<|> VerifySignature
  :<|> GetUsage

type JsonRpcAPI =
  "json-rpc" :> "4" :> "invoke" :> RawJsonRpc JSON RpcAPI

-- | Type representing Binary Large OBjects (BLOBs).

newtype Blob = Blob
  { Blob -> ByteString
unBlob :: ByteString
  } deriving (Blob -> Blob -> Bool
(Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Blob -> Blob -> Bool
== :: Blob -> Blob -> Bool
$c/= :: Blob -> Blob -> Bool
/= :: Blob -> Blob -> Bool
Eq, (forall x. Blob -> Rep Blob x)
-> (forall x. Rep Blob x -> Blob) -> Generic Blob
forall x. Rep Blob x -> Blob
forall x. Blob -> Rep Blob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Blob -> Rep Blob x
from :: forall x. Blob -> Rep Blob x
$cto :: forall x. Rep Blob x -> Blob
to :: forall x. Rep Blob x -> Blob
Generic, Int -> Blob -> ShowS
[Blob] -> ShowS
Blob -> String
(Int -> Blob -> ShowS)
-> (Blob -> String) -> ([Blob] -> ShowS) -> Show Blob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Blob -> ShowS
showsPrec :: Int -> Blob -> ShowS
$cshow :: Blob -> String
show :: Blob -> String
$cshowList :: [Blob] -> ShowS
showList :: [Blob] -> ShowS
Show)

instance FromJSON Blob where

  parseJSON :: Value -> Parser Blob
parseJSON = String -> (Text -> Parser Blob) -> Value -> Parser Blob
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Blob" (Blob -> Parser Blob
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blob -> Parser Blob) -> (Text -> Blob) -> Text -> Parser Blob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Blob
Blob (ByteString -> Blob) -> (Text -> ByteString) -> Text -> Blob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)

instance ToJSON Blob where

  toJSON :: Blob -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Blob -> Text) -> Blob -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Blob -> ByteString) -> Blob -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> ByteString
unBlob
  toEncoding :: Blob -> Encoding
toEncoding = Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding) -> (Blob -> Builder) -> Blob -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromByteString (ByteString -> Builder) -> (Blob -> ByteString) -> Blob -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> ByteString
unBlob

-- | Type representing signed data.

data SignedData = SignedData
  { SignedData -> Maybe LicenseData
sd_licenseData :: Maybe LicenseData
  , SignedData -> Maybe Object
sd_userData    :: Maybe Object
  , SignedData -> Maybe TicketId
sd_ticketId    :: Maybe TicketId
  } deriving (SignedData -> SignedData -> Bool
(SignedData -> SignedData -> Bool)
-> (SignedData -> SignedData -> Bool) -> Eq SignedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignedData -> SignedData -> Bool
== :: SignedData -> SignedData -> Bool
$c/= :: SignedData -> SignedData -> Bool
/= :: SignedData -> SignedData -> Bool
Eq, (forall x. SignedData -> Rep SignedData x)
-> (forall x. Rep SignedData x -> SignedData) -> Generic SignedData
forall x. Rep SignedData x -> SignedData
forall x. SignedData -> Rep SignedData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SignedData -> Rep SignedData x
from :: forall x. SignedData -> Rep SignedData x
$cto :: forall x. Rep SignedData x -> SignedData
to :: forall x. Rep SignedData x -> SignedData
Generic, Int -> SignedData -> ShowS
[SignedData] -> ShowS
SignedData -> String
(Int -> SignedData -> ShowS)
-> (SignedData -> String)
-> ([SignedData] -> ShowS)
-> Show SignedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignedData -> ShowS
showsPrec :: Int -> SignedData -> ShowS
$cshow :: SignedData -> String
show :: SignedData -> String
$cshowList :: [SignedData] -> ShowS
showList :: [SignedData] -> ShowS
Show)

instance ToJSON SignedData where

  toJSON :: SignedData -> Value
toJSON = Options -> SignedData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 3}

  toEncoding :: SignedData -> Encoding
toEncoding = Options -> SignedData -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 3}

instance FromJSON SignedData where

  parseJSON :: Value -> Parser SignedData
parseJSON = Options -> Value -> Parser SignedData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = drop 3}

-- | Type representing data required by the Signed API for certain licences.

newtype LicenseData = LicenseData
  { LicenseData -> CurrencyAmount
ld_maxPayoutValue :: CurrencyAmount
  } deriving (LicenseData -> LicenseData -> Bool
(LicenseData -> LicenseData -> Bool)
-> (LicenseData -> LicenseData -> Bool) -> Eq LicenseData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LicenseData -> LicenseData -> Bool
== :: LicenseData -> LicenseData -> Bool
$c/= :: LicenseData -> LicenseData -> Bool
/= :: LicenseData -> LicenseData -> Bool
Eq, (forall x. LicenseData -> Rep LicenseData x)
-> (forall x. Rep LicenseData x -> LicenseData)
-> Generic LicenseData
forall x. Rep LicenseData x -> LicenseData
forall x. LicenseData -> Rep LicenseData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LicenseData -> Rep LicenseData x
from :: forall x. LicenseData -> Rep LicenseData x
$cto :: forall x. Rep LicenseData x -> LicenseData
to :: forall x. Rep LicenseData x -> LicenseData
Generic, Int -> LicenseData -> ShowS
[LicenseData] -> ShowS
LicenseData -> String
(Int -> LicenseData -> ShowS)
-> (LicenseData -> String)
-> ([LicenseData] -> ShowS)
-> Show LicenseData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LicenseData -> ShowS
showsPrec :: Int -> LicenseData -> ShowS
$cshow :: LicenseData -> String
show :: LicenseData -> String
$cshowList :: [LicenseData] -> ShowS
showList :: [LicenseData] -> ShowS
Show)

instance ToJSON LicenseData where

  toJSON :: LicenseData -> Value
toJSON = Options -> LicenseData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 3}
  toEncoding :: LicenseData -> Encoding
toEncoding = Options -> LicenseData -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 3}

instance FromJSON LicenseData where

  parseJSON :: Value -> Parser LicenseData
parseJSON = Options -> Value -> Parser LicenseData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = drop 3}

-- | Type representing monetary amounts.

data CurrencyAmount = CurrencyAmount
  { CurrencyAmount -> Currency
ca_currency :: Currency
  , CurrencyAmount -> Double
ca_amount   :: Double
  } deriving (CurrencyAmount -> CurrencyAmount -> Bool
(CurrencyAmount -> CurrencyAmount -> Bool)
-> (CurrencyAmount -> CurrencyAmount -> Bool) -> Eq CurrencyAmount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CurrencyAmount -> CurrencyAmount -> Bool
== :: CurrencyAmount -> CurrencyAmount -> Bool
$c/= :: CurrencyAmount -> CurrencyAmount -> Bool
/= :: CurrencyAmount -> CurrencyAmount -> Bool
Eq, (forall x. CurrencyAmount -> Rep CurrencyAmount x)
-> (forall x. Rep CurrencyAmount x -> CurrencyAmount)
-> Generic CurrencyAmount
forall x. Rep CurrencyAmount x -> CurrencyAmount
forall x. CurrencyAmount -> Rep CurrencyAmount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CurrencyAmount -> Rep CurrencyAmount x
from :: forall x. CurrencyAmount -> Rep CurrencyAmount x
$cto :: forall x. Rep CurrencyAmount x -> CurrencyAmount
to :: forall x. Rep CurrencyAmount x -> CurrencyAmount
Generic, Int -> CurrencyAmount -> ShowS
[CurrencyAmount] -> ShowS
CurrencyAmount -> String
(Int -> CurrencyAmount -> ShowS)
-> (CurrencyAmount -> String)
-> ([CurrencyAmount] -> ShowS)
-> Show CurrencyAmount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CurrencyAmount -> ShowS
showsPrec :: Int -> CurrencyAmount -> ShowS
$cshow :: CurrencyAmount -> String
show :: CurrencyAmount -> String
$cshowList :: [CurrencyAmount] -> ShowS
showList :: [CurrencyAmount] -> ShowS
Show)

instance ToJSON CurrencyAmount where

  toJSON :: CurrencyAmount -> Value
toJSON = Options -> CurrencyAmount -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 3}
  toEncoding :: CurrencyAmount -> Encoding
toEncoding = Options -> CurrencyAmount -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 3}

instance FromJSON CurrencyAmount where

  parseJSON :: Value -> Parser CurrencyAmount
parseJSON = Options -> Value -> Parser CurrencyAmount
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = drop 3}

-- | Type representing currencies recognised by the Signed API.

data Currency
  = USD -- ^ United State dollar

  | EUR -- ^ Euro

  | GBP -- ^ British pound

  | BTC -- ^ Bitcoin cryptocurrency

  | ETH -- ^ Ether cryptocurrency

  deriving (Currency -> Currency -> Bool
(Currency -> Currency -> Bool)
-> (Currency -> Currency -> Bool) -> Eq Currency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Currency -> Currency -> Bool
== :: Currency -> Currency -> Bool
$c/= :: Currency -> Currency -> Bool
/= :: Currency -> Currency -> Bool
Eq, (forall x. Currency -> Rep Currency x)
-> (forall x. Rep Currency x -> Currency) -> Generic Currency
forall x. Rep Currency x -> Currency
forall x. Currency -> Rep Currency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Currency -> Rep Currency x
from :: forall x. Currency -> Rep Currency x
$cto :: forall x. Rep Currency x -> Currency
to :: forall x. Rep Currency x -> Currency
Generic, Int -> Currency -> ShowS
[Currency] -> ShowS
Currency -> String
(Int -> Currency -> ShowS)
-> (Currency -> String) -> ([Currency] -> ShowS) -> Show Currency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Currency -> ShowS
showsPrec :: Int -> Currency -> ShowS
$cshow :: Currency -> String
show :: Currency -> String
$cshowList :: [Currency] -> ShowS
showList :: [Currency] -> ShowS
Show)

instance ToJSON Currency

instance FromJSON Currency

-- | Type representing the IDs of unique single-use tickets.

newtype TicketId = TicketId
  { TicketId -> ByteString
unTicketId :: ByteString
  } deriving (TicketId -> TicketId -> Bool
(TicketId -> TicketId -> Bool)
-> (TicketId -> TicketId -> Bool) -> Eq TicketId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TicketId -> TicketId -> Bool
== :: TicketId -> TicketId -> Bool
$c/= :: TicketId -> TicketId -> Bool
/= :: TicketId -> TicketId -> Bool
Eq, (forall x. TicketId -> Rep TicketId x)
-> (forall x. Rep TicketId x -> TicketId) -> Generic TicketId
forall x. Rep TicketId x -> TicketId
forall x. TicketId -> Rep TicketId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TicketId -> Rep TicketId x
from :: forall x. TicketId -> Rep TicketId x
$cto :: forall x. Rep TicketId x -> TicketId
to :: forall x. Rep TicketId x -> TicketId
Generic, Int -> TicketId -> ShowS
[TicketId] -> ShowS
TicketId -> String
(Int -> TicketId -> ShowS)
-> (TicketId -> String) -> ([TicketId] -> ShowS) -> Show TicketId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TicketId -> ShowS
showsPrec :: Int -> TicketId -> ShowS
$cshow :: TicketId -> String
show :: TicketId -> String
$cshowList :: [TicketId] -> ShowS
showList :: [TicketId] -> ShowS
Show)

instance ToJSON TicketId where

  toJSON :: TicketId -> Value
toJSON = Text -> Value
String (Text -> Value) -> (TicketId -> Text) -> TicketId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (TicketId -> ByteString) -> TicketId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TicketId -> ByteString
unTicketId
  toEncoding :: TicketId -> Encoding
toEncoding = Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding)
-> (TicketId -> Builder) -> TicketId -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromByteString (ByteString -> Builder)
-> (TicketId -> ByteString) -> TicketId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TicketId -> ByteString
unTicketId

instance FromJSON TicketId where

  parseJSON :: Value -> Parser TicketId
parseJSON = String -> (Text -> Parser TicketId) -> Value -> Parser TicketId
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TicketId" (TicketId -> Parser TicketId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TicketId -> Parser TicketId)
-> (Text -> TicketId) -> Text -> Parser TicketId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> TicketId
TicketId (ByteString -> TicketId)
-> (Text -> ByteString) -> Text -> TicketId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)

-- | Type representing \'seeds\' used to generate random data from historical,

-- pregenerated randomization.

data Seed
  = DateSeed Day
    -- ^ A seed based on a past date or the current date.

  | IdSeed Text
    -- ^ A seed based on an id of 1 to 64 characters in length.

  deriving (Seed -> Seed -> Bool
(Seed -> Seed -> Bool) -> (Seed -> Seed -> Bool) -> Eq Seed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Seed -> Seed -> Bool
== :: Seed -> Seed -> Bool
$c/= :: Seed -> Seed -> Bool
/= :: Seed -> Seed -> Bool
Eq, (forall x. Seed -> Rep Seed x)
-> (forall x. Rep Seed x -> Seed) -> Generic Seed
forall x. Rep Seed x -> Seed
forall x. Seed -> Rep Seed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Seed -> Rep Seed x
from :: forall x. Seed -> Rep Seed x
$cto :: forall x. Rep Seed x -> Seed
to :: forall x. Rep Seed x -> Seed
Generic, Int -> Seed -> ShowS
[Seed] -> ShowS
Seed -> String
(Int -> Seed -> ShowS)
-> (Seed -> String) -> ([Seed] -> ShowS) -> Show Seed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Seed -> ShowS
showsPrec :: Int -> Seed -> ShowS
$cshow :: Seed -> String
show :: Seed -> String
$cshowList :: [Seed] -> ShowS
showList :: [Seed] -> ShowS
Show)

-- | Type representing errors form 'mkSeedFromId'.

data MkSeedError
  = FutureDate
    -- ^ The date for an date seed cannot be a future date.

  | NullId
    -- ^ The text for an id seed cannot be null.

  | OversizedId
    -- ^ The text for an id seen cannot be longer than 64 characters.

  deriving (MkSeedError -> MkSeedError -> Bool
(MkSeedError -> MkSeedError -> Bool)
-> (MkSeedError -> MkSeedError -> Bool) -> Eq MkSeedError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MkSeedError -> MkSeedError -> Bool
== :: MkSeedError -> MkSeedError -> Bool
$c/= :: MkSeedError -> MkSeedError -> Bool
/= :: MkSeedError -> MkSeedError -> Bool
Eq, Int -> MkSeedError -> ShowS
[MkSeedError] -> ShowS
MkSeedError -> String
(Int -> MkSeedError -> ShowS)
-> (MkSeedError -> String)
-> ([MkSeedError] -> ShowS)
-> Show MkSeedError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MkSeedError -> ShowS
showsPrec :: Int -> MkSeedError -> ShowS
$cshow :: MkSeedError -> String
show :: MkSeedError -> String
$cshowList :: [MkSeedError] -> ShowS
showList :: [MkSeedError] -> ShowS
Show)

-- | Construct a seed from a date. Given the current date, checks that the date

-- is a past date or the current date.

mkSeedfromDate ::
     Day
     -- ^ The current date (not verified).

  -> Day
     -- ^ A past date or the current date.

  -> Either MkSeedError Seed
mkSeedfromDate :: Day -> Day -> Either MkSeedError Seed
mkSeedfromDate Day
today Day
date
  | Day
date Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
today = Seed -> Either MkSeedError Seed
forall a b. b -> Either a b
Right (Day -> Seed
DateSeed Day
date)
  | Bool
otherwise = MkSeedError -> Either MkSeedError Seed
forall a b. a -> Either a b
Left MkSeedError
FutureDate

-- | Construct a seed from an id. Checks that the id is between 1 to 64

-- characters in length.

mkSeedFromId :: Text -> Either MkSeedError Seed
mkSeedFromId :: Text -> Either MkSeedError Seed
mkSeedFromId Text
t
  | Text -> Bool
T.null Text
t = MkSeedError -> Either MkSeedError Seed
forall a b. a -> Either a b
Left MkSeedError
NullId
  | Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 = MkSeedError -> Either MkSeedError Seed
forall a b. a -> Either a b
Left MkSeedError
OversizedId
  | Bool
otherwise = Seed -> Either MkSeedError Seed
forall a b. b -> Either a b
Right (Text -> Seed
IdSeed Text
t)

instance ToJSON Seed where

  toJSON :: Seed -> Value
toJSON (DateSeed Day
day) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"date" (Day -> Value
forall a. ToJSON a => a -> Value
toJSON Day
day)
  toJSON (IdSeed Text
identifier) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"id" (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
identifier)

instance FromJSON Seed where

  parseJSON :: Value -> Parser Seed
parseJSON = String -> (Object -> Parser Seed) -> Value -> Parser Seed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Seed" ((Object -> Parser Seed) -> Value -> Parser Seed)
-> (Object -> Parser Seed) -> Value -> Parser Seed
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Day -> Seed
DateSeed (Day -> Seed) -> Parser Day -> Parser Seed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Day
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"date" Parser Seed -> Parser Seed -> Parser Seed
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Seed
IdSeed (Text -> Seed) -> Parser Text -> Parser Seed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

-- | Type representing parameters to the generateIntegers API method.

data GenIntegersParams = GenIntegersParams
  { GenIntegersParams -> ApiKey
gip_apiKey                    :: ApiKey
  , GenIntegersParams -> Int
gip_n                         :: Int
  , GenIntegersParams -> Int
gip_min                       :: Int
  , GenIntegersParams -> Int
gip_max                       :: Int
  , GenIntegersParams -> Bool
gip_replacement               :: Bool
  , GenIntegersParams -> Int
gip_base                      :: Int
  , GenIntegersParams -> Maybe Seed
gip_pregeneratedRandomization :: Maybe Seed
  } deriving (GenIntegersParams -> GenIntegersParams -> Bool
(GenIntegersParams -> GenIntegersParams -> Bool)
-> (GenIntegersParams -> GenIntegersParams -> Bool)
-> Eq GenIntegersParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenIntegersParams -> GenIntegersParams -> Bool
== :: GenIntegersParams -> GenIntegersParams -> Bool
$c/= :: GenIntegersParams -> GenIntegersParams -> Bool
/= :: GenIntegersParams -> GenIntegersParams -> Bool
Eq, (forall x. GenIntegersParams -> Rep GenIntegersParams x)
-> (forall x. Rep GenIntegersParams x -> GenIntegersParams)
-> Generic GenIntegersParams
forall x. Rep GenIntegersParams x -> GenIntegersParams
forall x. GenIntegersParams -> Rep GenIntegersParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenIntegersParams -> Rep GenIntegersParams x
from :: forall x. GenIntegersParams -> Rep GenIntegersParams x
$cto :: forall x. Rep GenIntegersParams x -> GenIntegersParams
to :: forall x. Rep GenIntegersParams x -> GenIntegersParams
Generic, Int -> GenIntegersParams -> ShowS
[GenIntegersParams] -> ShowS
GenIntegersParams -> String
(Int -> GenIntegersParams -> ShowS)
-> (GenIntegersParams -> String)
-> ([GenIntegersParams] -> ShowS)
-> Show GenIntegersParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenIntegersParams -> ShowS
showsPrec :: Int -> GenIntegersParams -> ShowS
$cshow :: GenIntegersParams -> String
show :: GenIntegersParams -> String
$cshowList :: [GenIntegersParams] -> ShowS
showList :: [GenIntegersParams] -> ShowS
Show)

instance ToJSON GenIntegersParams where
  toJSON :: GenIntegersParams -> Value
toJSON = Options -> GenIntegersParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}
  toEncoding :: GenIntegersParams -> Encoding
toEncoding = Options -> GenIntegersParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

instance FromJSON GenIntegersParams where

  parseJSON :: Value -> Parser GenIntegersParams
parseJSON = Options -> Value -> Parser GenIntegersParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenIntegersParams)
-> Options -> Value -> Parser GenIntegersParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
4

-- | Type representing parameters to the generateSignedIntegers API method.

data GenSigIntegersParams = GenSigIntegersParams
  { GenSigIntegersParams -> GenIntegersParams
sgip_params :: GenIntegersParams
  , GenSigIntegersParams -> SignedData
sgip_data   :: SignedData
  } deriving (GenSigIntegersParams -> GenSigIntegersParams -> Bool
(GenSigIntegersParams -> GenSigIntegersParams -> Bool)
-> (GenSigIntegersParams -> GenSigIntegersParams -> Bool)
-> Eq GenSigIntegersParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigIntegersParams -> GenSigIntegersParams -> Bool
== :: GenSigIntegersParams -> GenSigIntegersParams -> Bool
$c/= :: GenSigIntegersParams -> GenSigIntegersParams -> Bool
/= :: GenSigIntegersParams -> GenSigIntegersParams -> Bool
Eq, Int -> GenSigIntegersParams -> ShowS
[GenSigIntegersParams] -> ShowS
GenSigIntegersParams -> String
(Int -> GenSigIntegersParams -> ShowS)
-> (GenSigIntegersParams -> String)
-> ([GenSigIntegersParams] -> ShowS)
-> Show GenSigIntegersParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigIntegersParams -> ShowS
showsPrec :: Int -> GenSigIntegersParams -> ShowS
$cshow :: GenSigIntegersParams -> String
show :: GenSigIntegersParams -> String
$cshowList :: [GenSigIntegersParams] -> ShowS
showList :: [GenSigIntegersParams] -> ShowS
Show)

sigParamsToJSON ::
     (ToJSON a1, ToJSON a2)
  => t
  -> (t -> a1)
  -> (t -> a2)
  -> Value
sigParamsToJSON :: forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON t
p t -> a1
pParams t -> a2
pData =
  case (a1 -> Value
forall a. ToJSON a => a -> Value
toJSON (a1 -> Value) -> a1 -> Value
forall a b. (a -> b) -> a -> b
$ t -> a1
pParams t
p, a2 -> Value
forall a. ToJSON a => a -> Value
toJSON (a2 -> Value) -> a2 -> Value
forall a b. (a -> b) -> a -> b
$ t -> a2
pData t
p) of
    (Object Object
o_params, Object Object
o_data) -> Object -> Value
Object (Object
o_params Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
o_data)
    (Value, Value)
_ -> String -> Value
forall a. HasCallStack => String -> a
error String
"error"

instance ToJSON GenSigIntegersParams where

  toJSON :: GenSigIntegersParams -> Value
toJSON GenSigIntegersParams
p = GenSigIntegersParams
-> (GenSigIntegersParams -> GenIntegersParams)
-> (GenSigIntegersParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigIntegersParams
p GenSigIntegersParams -> GenIntegersParams
sgip_params GenSigIntegersParams -> SignedData
sgip_data

instance FromJSON GenSigIntegersParams where

  parseJSON :: Value -> Parser GenSigIntegersParams
parseJSON Value
v = do
    GenIntegersParams
sgip_params <- Value -> Parser GenIntegersParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sgip_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigIntegersParams -> Parser GenSigIntegersParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigIntegersParams {GenIntegersParams
SignedData
$sel:sgip_params:GenSigIntegersParams :: GenIntegersParams
$sel:sgip_data:GenSigIntegersParams :: SignedData
sgip_params :: GenIntegersParams
sgip_data :: SignedData
..}

-- | Type representing parameters to the generateIntegerSequences API method.

data GenIntegerSequencesParams = GenIntegerSequencesParams
  { GenIntegerSequencesParams -> ApiKey
gisp_apiKey                    :: ApiKey
  , GenIntegerSequencesParams -> Int
gisp_n                         :: Int
  , GenIntegerSequencesParams -> Int
gisp_length                    :: Int
  , GenIntegerSequencesParams -> Int
gisp_min                       :: Int
  , GenIntegerSequencesParams -> Int
gisp_max                       :: Int
  , GenIntegerSequencesParams -> Bool
gisp_replacement               :: Bool
  , GenIntegerSequencesParams -> Int
gisp_base                      :: Int
  , GenIntegerSequencesParams -> Maybe Seed
gisp_pregeneratedRandomization :: Maybe Seed
  } deriving (GenIntegerSequencesParams -> GenIntegerSequencesParams -> Bool
(GenIntegerSequencesParams -> GenIntegerSequencesParams -> Bool)
-> (GenIntegerSequencesParams -> GenIntegerSequencesParams -> Bool)
-> Eq GenIntegerSequencesParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenIntegerSequencesParams -> GenIntegerSequencesParams -> Bool
== :: GenIntegerSequencesParams -> GenIntegerSequencesParams -> Bool
$c/= :: GenIntegerSequencesParams -> GenIntegerSequencesParams -> Bool
/= :: GenIntegerSequencesParams -> GenIntegerSequencesParams -> Bool
Eq, (forall x.
 GenIntegerSequencesParams -> Rep GenIntegerSequencesParams x)
-> (forall x.
    Rep GenIntegerSequencesParams x -> GenIntegerSequencesParams)
-> Generic GenIntegerSequencesParams
forall x.
Rep GenIntegerSequencesParams x -> GenIntegerSequencesParams
forall x.
GenIntegerSequencesParams -> Rep GenIntegerSequencesParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GenIntegerSequencesParams -> Rep GenIntegerSequencesParams x
from :: forall x.
GenIntegerSequencesParams -> Rep GenIntegerSequencesParams x
$cto :: forall x.
Rep GenIntegerSequencesParams x -> GenIntegerSequencesParams
to :: forall x.
Rep GenIntegerSequencesParams x -> GenIntegerSequencesParams
Generic, Int -> GenIntegerSequencesParams -> ShowS
[GenIntegerSequencesParams] -> ShowS
GenIntegerSequencesParams -> String
(Int -> GenIntegerSequencesParams -> ShowS)
-> (GenIntegerSequencesParams -> String)
-> ([GenIntegerSequencesParams] -> ShowS)
-> Show GenIntegerSequencesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenIntegerSequencesParams -> ShowS
showsPrec :: Int -> GenIntegerSequencesParams -> ShowS
$cshow :: GenIntegerSequencesParams -> String
show :: GenIntegerSequencesParams -> String
$cshowList :: [GenIntegerSequencesParams] -> ShowS
showList :: [GenIntegerSequencesParams] -> ShowS
Show)

instance ToJSON GenIntegerSequencesParams where
  toJSON :: GenIntegerSequencesParams -> Value
toJSON = Options -> GenIntegerSequencesParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 5}
  toEncoding :: GenIntegerSequencesParams -> Encoding
toEncoding = Options -> GenIntegerSequencesParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 5}

customOptions :: Int -> Options
customOptions :: Int -> Options
customOptions Int
n = Options
defaultOptions
  { fieldLabelModifier = \String
l -> case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
n String
l of
      String
"apiKey" -> String
"hashedApiKey"
      String
l' -> String
l'
  }

instance FromJSON GenIntegerSequencesParams where

  parseJSON :: Value -> Parser GenIntegerSequencesParams
parseJSON = Options -> Value -> Parser GenIntegerSequencesParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenIntegerSequencesParams)
-> Options -> Value -> Parser GenIntegerSequencesParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
5

-- | Type representing parameters to the generateSignedIntegerSequences API

-- method for non-multiform sequences.

data GenSigIntegerSequencesParams = GenSigIntegerSequencesParams
  { GenSigIntegerSequencesParams -> GenIntegerSequencesParams
sgisp_params :: GenIntegerSequencesParams
  , GenSigIntegerSequencesParams -> SignedData
sgisp_data   :: SignedData
  } deriving (GenSigIntegerSequencesParams
-> GenSigIntegerSequencesParams -> Bool
(GenSigIntegerSequencesParams
 -> GenSigIntegerSequencesParams -> Bool)
-> (GenSigIntegerSequencesParams
    -> GenSigIntegerSequencesParams -> Bool)
-> Eq GenSigIntegerSequencesParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigIntegerSequencesParams
-> GenSigIntegerSequencesParams -> Bool
== :: GenSigIntegerSequencesParams
-> GenSigIntegerSequencesParams -> Bool
$c/= :: GenSigIntegerSequencesParams
-> GenSigIntegerSequencesParams -> Bool
/= :: GenSigIntegerSequencesParams
-> GenSigIntegerSequencesParams -> Bool
Eq, Int -> GenSigIntegerSequencesParams -> ShowS
[GenSigIntegerSequencesParams] -> ShowS
GenSigIntegerSequencesParams -> String
(Int -> GenSigIntegerSequencesParams -> ShowS)
-> (GenSigIntegerSequencesParams -> String)
-> ([GenSigIntegerSequencesParams] -> ShowS)
-> Show GenSigIntegerSequencesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigIntegerSequencesParams -> ShowS
showsPrec :: Int -> GenSigIntegerSequencesParams -> ShowS
$cshow :: GenSigIntegerSequencesParams -> String
show :: GenSigIntegerSequencesParams -> String
$cshowList :: [GenSigIntegerSequencesParams] -> ShowS
showList :: [GenSigIntegerSequencesParams] -> ShowS
Show)

instance ToJSON GenSigIntegerSequencesParams where

  toJSON :: GenSigIntegerSequencesParams -> Value
  toJSON :: GenSigIntegerSequencesParams -> Value
toJSON GenSigIntegerSequencesParams
p = GenSigIntegerSequencesParams
-> (GenSigIntegerSequencesParams -> GenIntegerSequencesParams)
-> (GenSigIntegerSequencesParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigIntegerSequencesParams
p GenSigIntegerSequencesParams -> GenIntegerSequencesParams
sgisp_params GenSigIntegerSequencesParams -> SignedData
sgisp_data

instance FromJSON GenSigIntegerSequencesParams where

  parseJSON :: Value -> Parser GenSigIntegerSequencesParams
parseJSON Value
v = do
    GenIntegerSequencesParams
sgisp_params <- Value -> Parser GenIntegerSequencesParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sgisp_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigIntegerSequencesParams -> Parser GenSigIntegerSequencesParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigIntegerSequencesParams {GenIntegerSequencesParams
SignedData
$sel:sgisp_params:GenSigIntegerSequencesParams :: GenIntegerSequencesParams
$sel:sgisp_data:GenSigIntegerSequencesParams :: SignedData
sgisp_params :: GenIntegerSequencesParams
sgisp_data :: SignedData
..}

-- | Type representing parameters to the generateIntegerSequences API method for

-- multiform sequences.

data GenIntegerSequencesMultiformParams = GenIntegerSequencesMultiformParams
  { GenIntegerSequencesMultiformParams -> ApiKey
gismp_apiKey                    :: ApiKey
  , GenIntegerSequencesMultiformParams -> Int
gismp_n                         :: Int
  , GenIntegerSequencesMultiformParams -> [Int]
gismp_length                    :: [Int]
  , GenIntegerSequencesMultiformParams -> Boundary
gismp_min                       :: Boundary
  , GenIntegerSequencesMultiformParams -> Boundary
gismp_max                       :: Boundary
  , GenIntegerSequencesMultiformParams -> Bool
gismp_replacement               :: Bool
  , GenIntegerSequencesMultiformParams -> Int
gismp_base                      :: Int
  , GenIntegerSequencesMultiformParams -> Maybe Seed
gismp_pregeneratedRandomization :: Maybe Seed
  } deriving (GenIntegerSequencesMultiformParams
-> GenIntegerSequencesMultiformParams -> Bool
(GenIntegerSequencesMultiformParams
 -> GenIntegerSequencesMultiformParams -> Bool)
-> (GenIntegerSequencesMultiformParams
    -> GenIntegerSequencesMultiformParams -> Bool)
-> Eq GenIntegerSequencesMultiformParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenIntegerSequencesMultiformParams
-> GenIntegerSequencesMultiformParams -> Bool
== :: GenIntegerSequencesMultiformParams
-> GenIntegerSequencesMultiformParams -> Bool
$c/= :: GenIntegerSequencesMultiformParams
-> GenIntegerSequencesMultiformParams -> Bool
/= :: GenIntegerSequencesMultiformParams
-> GenIntegerSequencesMultiformParams -> Bool
Eq, (forall x.
 GenIntegerSequencesMultiformParams
 -> Rep GenIntegerSequencesMultiformParams x)
-> (forall x.
    Rep GenIntegerSequencesMultiformParams x
    -> GenIntegerSequencesMultiformParams)
-> Generic GenIntegerSequencesMultiformParams
forall x.
Rep GenIntegerSequencesMultiformParams x
-> GenIntegerSequencesMultiformParams
forall x.
GenIntegerSequencesMultiformParams
-> Rep GenIntegerSequencesMultiformParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GenIntegerSequencesMultiformParams
-> Rep GenIntegerSequencesMultiformParams x
from :: forall x.
GenIntegerSequencesMultiformParams
-> Rep GenIntegerSequencesMultiformParams x
$cto :: forall x.
Rep GenIntegerSequencesMultiformParams x
-> GenIntegerSequencesMultiformParams
to :: forall x.
Rep GenIntegerSequencesMultiformParams x
-> GenIntegerSequencesMultiformParams
Generic, Int -> GenIntegerSequencesMultiformParams -> ShowS
[GenIntegerSequencesMultiformParams] -> ShowS
GenIntegerSequencesMultiformParams -> String
(Int -> GenIntegerSequencesMultiformParams -> ShowS)
-> (GenIntegerSequencesMultiformParams -> String)
-> ([GenIntegerSequencesMultiformParams] -> ShowS)
-> Show GenIntegerSequencesMultiformParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenIntegerSequencesMultiformParams -> ShowS
showsPrec :: Int -> GenIntegerSequencesMultiformParams -> ShowS
$cshow :: GenIntegerSequencesMultiformParams -> String
show :: GenIntegerSequencesMultiformParams -> String
$cshowList :: [GenIntegerSequencesMultiformParams] -> ShowS
showList :: [GenIntegerSequencesMultiformParams] -> ShowS
Show)

-- | Type representing boundaries of multiform @generateIntegerSequences@.

data Boundary
  = Fixed Int        -- ^ Fixed boundary for all sequences.

  | Multiform [Int]  -- ^ List of boundaries for each sequence.

  deriving (Boundary -> Boundary -> Bool
(Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Bool) -> Eq Boundary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Boundary -> Boundary -> Bool
== :: Boundary -> Boundary -> Bool
$c/= :: Boundary -> Boundary -> Bool
/= :: Boundary -> Boundary -> Bool
Eq, (forall x. Boundary -> Rep Boundary x)
-> (forall x. Rep Boundary x -> Boundary) -> Generic Boundary
forall x. Rep Boundary x -> Boundary
forall x. Boundary -> Rep Boundary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Boundary -> Rep Boundary x
from :: forall x. Boundary -> Rep Boundary x
$cto :: forall x. Rep Boundary x -> Boundary
to :: forall x. Rep Boundary x -> Boundary
Generic, Int -> Boundary -> ShowS
[Boundary] -> ShowS
Boundary -> String
(Int -> Boundary -> ShowS)
-> (Boundary -> String) -> ([Boundary] -> ShowS) -> Show Boundary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Boundary -> ShowS
showsPrec :: Int -> Boundary -> ShowS
$cshow :: Boundary -> String
show :: Boundary -> String
$cshowList :: [Boundary] -> ShowS
showList :: [Boundary] -> ShowS
Show)

instance ToJSON Boundary where
  toJSON :: Boundary -> Value
toJSON (Fixed Int
b) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
b
  toJSON (Multiform [Int]
bs) = [Int] -> Value
forall a. ToJSON a => a -> Value
toJSON [Int]
bs
  toEncoding :: Boundary -> Encoding
toEncoding (Fixed Int
b) = Int -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Int
b
  toEncoding (Multiform [Int]
bs) = [Int] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Int]
bs

instance FromJSON Boundary where

  parseJSON :: Value -> Parser Boundary
parseJSON = Options -> Value -> Parser Boundary
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {sumEncoding = UntaggedValue}

instance ToJSON GenIntegerSequencesMultiformParams where
  toJSON :: GenIntegerSequencesMultiformParams -> Value
toJSON = Options -> GenIntegerSequencesMultiformParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 6}
  toEncoding :: GenIntegerSequencesMultiformParams -> Encoding
toEncoding = Options -> GenIntegerSequencesMultiformParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 6}

instance FromJSON GenIntegerSequencesMultiformParams where

  parseJSON :: Value -> Parser GenIntegerSequencesMultiformParams
parseJSON = Options -> Value -> Parser GenIntegerSequencesMultiformParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenIntegerSequencesMultiformParams)
-> Options -> Value -> Parser GenIntegerSequencesMultiformParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
6

-- | Type representing parameters to the generateSignedIntegerSequences API

-- method for multiform sequences.

data GenSigIntegerSequencesMultiformParams =
  GenSigIntegerSequencesMultiformParams
    { GenSigIntegerSequencesMultiformParams
-> GenIntegerSequencesMultiformParams
sgismp_params :: GenIntegerSequencesMultiformParams
    , GenSigIntegerSequencesMultiformParams -> SignedData
sgismp_data   :: SignedData
    } deriving (GenSigIntegerSequencesMultiformParams
-> GenSigIntegerSequencesMultiformParams -> Bool
(GenSigIntegerSequencesMultiformParams
 -> GenSigIntegerSequencesMultiformParams -> Bool)
-> (GenSigIntegerSequencesMultiformParams
    -> GenSigIntegerSequencesMultiformParams -> Bool)
-> Eq GenSigIntegerSequencesMultiformParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigIntegerSequencesMultiformParams
-> GenSigIntegerSequencesMultiformParams -> Bool
== :: GenSigIntegerSequencesMultiformParams
-> GenSigIntegerSequencesMultiformParams -> Bool
$c/= :: GenSigIntegerSequencesMultiformParams
-> GenSigIntegerSequencesMultiformParams -> Bool
/= :: GenSigIntegerSequencesMultiformParams
-> GenSigIntegerSequencesMultiformParams -> Bool
Eq, Int -> GenSigIntegerSequencesMultiformParams -> ShowS
[GenSigIntegerSequencesMultiformParams] -> ShowS
GenSigIntegerSequencesMultiformParams -> String
(Int -> GenSigIntegerSequencesMultiformParams -> ShowS)
-> (GenSigIntegerSequencesMultiformParams -> String)
-> ([GenSigIntegerSequencesMultiformParams] -> ShowS)
-> Show GenSigIntegerSequencesMultiformParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigIntegerSequencesMultiformParams -> ShowS
showsPrec :: Int -> GenSigIntegerSequencesMultiformParams -> ShowS
$cshow :: GenSigIntegerSequencesMultiformParams -> String
show :: GenSigIntegerSequencesMultiformParams -> String
$cshowList :: [GenSigIntegerSequencesMultiformParams] -> ShowS
showList :: [GenSigIntegerSequencesMultiformParams] -> ShowS
Show)

instance ToJSON GenSigIntegerSequencesMultiformParams where

  toJSON :: GenSigIntegerSequencesMultiformParams -> Value
toJSON GenSigIntegerSequencesMultiformParams
p = GenSigIntegerSequencesMultiformParams
-> (GenSigIntegerSequencesMultiformParams
    -> GenIntegerSequencesMultiformParams)
-> (GenSigIntegerSequencesMultiformParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigIntegerSequencesMultiformParams
p GenSigIntegerSequencesMultiformParams
-> GenIntegerSequencesMultiformParams
sgismp_params GenSigIntegerSequencesMultiformParams -> SignedData
sgismp_data

instance FromJSON GenSigIntegerSequencesMultiformParams where

  parseJSON :: Value -> Parser GenSigIntegerSequencesMultiformParams
parseJSON Value
v = do
    GenIntegerSequencesMultiformParams
sgismp_params <- Value -> Parser GenIntegerSequencesMultiformParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sgismp_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigIntegerSequencesMultiformParams
-> Parser GenSigIntegerSequencesMultiformParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigIntegerSequencesMultiformParams {GenIntegerSequencesMultiformParams
SignedData
$sel:sgismp_params:GenSigIntegerSequencesMultiformParams :: GenIntegerSequencesMultiformParams
$sel:sgismp_data:GenSigIntegerSequencesMultiformParams :: SignedData
sgismp_params :: GenIntegerSequencesMultiformParams
sgismp_data :: SignedData
..}

-- | Type representing parameters to the @generateDecimalFractions@ API method.

data GenDecimalFractionsParams = GenDecimalFractionsParams
  { GenDecimalFractionsParams -> ApiKey
gdfp_apiKey                    :: ApiKey
  , GenDecimalFractionsParams -> Int
gdfp_n                         :: Int
  , GenDecimalFractionsParams -> Int
gdfp_decimalPlaces             :: Int
  , GenDecimalFractionsParams -> Bool
gdfp_replacement               :: Bool
  , GenDecimalFractionsParams -> Maybe Seed
gdfp_pregeneratedRandomization :: Maybe Seed
  } deriving (GenDecimalFractionsParams -> GenDecimalFractionsParams -> Bool
(GenDecimalFractionsParams -> GenDecimalFractionsParams -> Bool)
-> (GenDecimalFractionsParams -> GenDecimalFractionsParams -> Bool)
-> Eq GenDecimalFractionsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenDecimalFractionsParams -> GenDecimalFractionsParams -> Bool
== :: GenDecimalFractionsParams -> GenDecimalFractionsParams -> Bool
$c/= :: GenDecimalFractionsParams -> GenDecimalFractionsParams -> Bool
/= :: GenDecimalFractionsParams -> GenDecimalFractionsParams -> Bool
Eq, (forall x.
 GenDecimalFractionsParams -> Rep GenDecimalFractionsParams x)
-> (forall x.
    Rep GenDecimalFractionsParams x -> GenDecimalFractionsParams)
-> Generic GenDecimalFractionsParams
forall x.
Rep GenDecimalFractionsParams x -> GenDecimalFractionsParams
forall x.
GenDecimalFractionsParams -> Rep GenDecimalFractionsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GenDecimalFractionsParams -> Rep GenDecimalFractionsParams x
from :: forall x.
GenDecimalFractionsParams -> Rep GenDecimalFractionsParams x
$cto :: forall x.
Rep GenDecimalFractionsParams x -> GenDecimalFractionsParams
to :: forall x.
Rep GenDecimalFractionsParams x -> GenDecimalFractionsParams
Generic, Int -> GenDecimalFractionsParams -> ShowS
[GenDecimalFractionsParams] -> ShowS
GenDecimalFractionsParams -> String
(Int -> GenDecimalFractionsParams -> ShowS)
-> (GenDecimalFractionsParams -> String)
-> ([GenDecimalFractionsParams] -> ShowS)
-> Show GenDecimalFractionsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenDecimalFractionsParams -> ShowS
showsPrec :: Int -> GenDecimalFractionsParams -> ShowS
$cshow :: GenDecimalFractionsParams -> String
show :: GenDecimalFractionsParams -> String
$cshowList :: [GenDecimalFractionsParams] -> ShowS
showList :: [GenDecimalFractionsParams] -> ShowS
Show)

instance ToJSON GenDecimalFractionsParams where
  toJSON :: GenDecimalFractionsParams -> Value
toJSON = Options -> GenDecimalFractionsParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 5}
  toEncoding :: GenDecimalFractionsParams -> Encoding
toEncoding = Options -> GenDecimalFractionsParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 5}

instance FromJSON GenDecimalFractionsParams where

  parseJSON :: Value -> Parser GenDecimalFractionsParams
parseJSON = Options -> Value -> Parser GenDecimalFractionsParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenDecimalFractionsParams)
-> Options -> Value -> Parser GenDecimalFractionsParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
5

-- | Type representing parameters to the @generateSignedDecimalFractions@ API

-- method.

data GenSigDecimalFractionsParams = GenSigDecimalFractionsParams
    { GenSigDecimalFractionsParams -> GenDecimalFractionsParams
sgdfp_params :: GenDecimalFractionsParams
    , GenSigDecimalFractionsParams -> SignedData
sgdfp_data   :: SignedData
    } deriving (GenSigDecimalFractionsParams
-> GenSigDecimalFractionsParams -> Bool
(GenSigDecimalFractionsParams
 -> GenSigDecimalFractionsParams -> Bool)
-> (GenSigDecimalFractionsParams
    -> GenSigDecimalFractionsParams -> Bool)
-> Eq GenSigDecimalFractionsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigDecimalFractionsParams
-> GenSigDecimalFractionsParams -> Bool
== :: GenSigDecimalFractionsParams
-> GenSigDecimalFractionsParams -> Bool
$c/= :: GenSigDecimalFractionsParams
-> GenSigDecimalFractionsParams -> Bool
/= :: GenSigDecimalFractionsParams
-> GenSigDecimalFractionsParams -> Bool
Eq, Int -> GenSigDecimalFractionsParams -> ShowS
[GenSigDecimalFractionsParams] -> ShowS
GenSigDecimalFractionsParams -> String
(Int -> GenSigDecimalFractionsParams -> ShowS)
-> (GenSigDecimalFractionsParams -> String)
-> ([GenSigDecimalFractionsParams] -> ShowS)
-> Show GenSigDecimalFractionsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigDecimalFractionsParams -> ShowS
showsPrec :: Int -> GenSigDecimalFractionsParams -> ShowS
$cshow :: GenSigDecimalFractionsParams -> String
show :: GenSigDecimalFractionsParams -> String
$cshowList :: [GenSigDecimalFractionsParams] -> ShowS
showList :: [GenSigDecimalFractionsParams] -> ShowS
Show)

instance ToJSON GenSigDecimalFractionsParams where

  toJSON :: GenSigDecimalFractionsParams -> Value
toJSON GenSigDecimalFractionsParams
p = GenSigDecimalFractionsParams
-> (GenSigDecimalFractionsParams -> GenDecimalFractionsParams)
-> (GenSigDecimalFractionsParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigDecimalFractionsParams
p GenSigDecimalFractionsParams -> GenDecimalFractionsParams
sgdfp_params GenSigDecimalFractionsParams -> SignedData
sgdfp_data

instance FromJSON GenSigDecimalFractionsParams where

  parseJSON :: Value -> Parser GenSigDecimalFractionsParams
parseJSON Value
v = do
    GenDecimalFractionsParams
sgdfp_params <- Value -> Parser GenDecimalFractionsParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sgdfp_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigDecimalFractionsParams -> Parser GenSigDecimalFractionsParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigDecimalFractionsParams {GenDecimalFractionsParams
SignedData
$sel:sgdfp_params:GenSigDecimalFractionsParams :: GenDecimalFractionsParams
$sel:sgdfp_data:GenSigDecimalFractionsParams :: SignedData
sgdfp_params :: GenDecimalFractionsParams
sgdfp_data :: SignedData
..}

-- | Type representing parameters to the @generateGaussianss@ API method.

data GenGaussiansParams = GenGaussiansParams
  { GenGaussiansParams -> ApiKey
ggp_apiKey                    :: ApiKey
  , GenGaussiansParams -> Int
ggp_n                         :: Int
  , GenGaussiansParams -> Double
ggp_mean                      :: Double
  , GenGaussiansParams -> Double
ggp_standardDeviation         :: Double
  , GenGaussiansParams -> Int
ggp_significantDigits         :: Int
  , GenGaussiansParams -> Maybe Seed
ggp_pregeneratedRandomization :: Maybe Seed
  } deriving (GenGaussiansParams -> GenGaussiansParams -> Bool
(GenGaussiansParams -> GenGaussiansParams -> Bool)
-> (GenGaussiansParams -> GenGaussiansParams -> Bool)
-> Eq GenGaussiansParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenGaussiansParams -> GenGaussiansParams -> Bool
== :: GenGaussiansParams -> GenGaussiansParams -> Bool
$c/= :: GenGaussiansParams -> GenGaussiansParams -> Bool
/= :: GenGaussiansParams -> GenGaussiansParams -> Bool
Eq, (forall x. GenGaussiansParams -> Rep GenGaussiansParams x)
-> (forall x. Rep GenGaussiansParams x -> GenGaussiansParams)
-> Generic GenGaussiansParams
forall x. Rep GenGaussiansParams x -> GenGaussiansParams
forall x. GenGaussiansParams -> Rep GenGaussiansParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenGaussiansParams -> Rep GenGaussiansParams x
from :: forall x. GenGaussiansParams -> Rep GenGaussiansParams x
$cto :: forall x. Rep GenGaussiansParams x -> GenGaussiansParams
to :: forall x. Rep GenGaussiansParams x -> GenGaussiansParams
Generic, Int -> GenGaussiansParams -> ShowS
[GenGaussiansParams] -> ShowS
GenGaussiansParams -> String
(Int -> GenGaussiansParams -> ShowS)
-> (GenGaussiansParams -> String)
-> ([GenGaussiansParams] -> ShowS)
-> Show GenGaussiansParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenGaussiansParams -> ShowS
showsPrec :: Int -> GenGaussiansParams -> ShowS
$cshow :: GenGaussiansParams -> String
show :: GenGaussiansParams -> String
$cshowList :: [GenGaussiansParams] -> ShowS
showList :: [GenGaussiansParams] -> ShowS
Show)

instance ToJSON GenGaussiansParams where
  toJSON :: GenGaussiansParams -> Value
toJSON = Options -> GenGaussiansParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}
  toEncoding :: GenGaussiansParams -> Encoding
toEncoding = Options -> GenGaussiansParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

instance FromJSON GenGaussiansParams where

  parseJSON :: Value -> Parser GenGaussiansParams
parseJSON = Options -> Value -> Parser GenGaussiansParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenGaussiansParams)
-> Options -> Value -> Parser GenGaussiansParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
4

-- | Type representing parameters to the @generateSignedGaussianss@ API method.

data GenSigGaussiansParams = GenSigGaussiansParams
  { GenSigGaussiansParams -> GenGaussiansParams
sggp_params :: GenGaussiansParams
  , GenSigGaussiansParams -> SignedData
sggp_data   :: SignedData
  } deriving (GenSigGaussiansParams -> GenSigGaussiansParams -> Bool
(GenSigGaussiansParams -> GenSigGaussiansParams -> Bool)
-> (GenSigGaussiansParams -> GenSigGaussiansParams -> Bool)
-> Eq GenSigGaussiansParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigGaussiansParams -> GenSigGaussiansParams -> Bool
== :: GenSigGaussiansParams -> GenSigGaussiansParams -> Bool
$c/= :: GenSigGaussiansParams -> GenSigGaussiansParams -> Bool
/= :: GenSigGaussiansParams -> GenSigGaussiansParams -> Bool
Eq, Int -> GenSigGaussiansParams -> ShowS
[GenSigGaussiansParams] -> ShowS
GenSigGaussiansParams -> String
(Int -> GenSigGaussiansParams -> ShowS)
-> (GenSigGaussiansParams -> String)
-> ([GenSigGaussiansParams] -> ShowS)
-> Show GenSigGaussiansParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigGaussiansParams -> ShowS
showsPrec :: Int -> GenSigGaussiansParams -> ShowS
$cshow :: GenSigGaussiansParams -> String
show :: GenSigGaussiansParams -> String
$cshowList :: [GenSigGaussiansParams] -> ShowS
showList :: [GenSigGaussiansParams] -> ShowS
Show)

instance ToJSON GenSigGaussiansParams where

  toJSON :: GenSigGaussiansParams -> Value
toJSON GenSigGaussiansParams
p = GenSigGaussiansParams
-> (GenSigGaussiansParams -> GenGaussiansParams)
-> (GenSigGaussiansParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigGaussiansParams
p GenSigGaussiansParams -> GenGaussiansParams
sggp_params GenSigGaussiansParams -> SignedData
sggp_data

instance FromJSON GenSigGaussiansParams where

  parseJSON :: Value -> Parser GenSigGaussiansParams
parseJSON Value
v = do
    GenGaussiansParams
sggp_params <- Value -> Parser GenGaussiansParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sggp_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigGaussiansParams -> Parser GenSigGaussiansParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigGaussiansParams {GenGaussiansParams
SignedData
$sel:sggp_params:GenSigGaussiansParams :: GenGaussiansParams
$sel:sggp_data:GenSigGaussiansParams :: SignedData
sggp_params :: GenGaussiansParams
sggp_data :: SignedData
..}

-- | Type representing parameters to the @generateStrings@ API method.

data GenStringsParams = GenStringsParams
  { GenStringsParams -> ApiKey
gsp_apiKey                    :: ApiKey
  , GenStringsParams -> Int
gsp_n                         :: Int
  , GenStringsParams -> Int
gsp_length                    :: Int
  , GenStringsParams -> String
gsp_characters                :: [Char]
  , GenStringsParams -> Bool
gsp_replacement               :: Bool
  , GenStringsParams -> Maybe Seed
gsp_pregeneratedRandomization :: Maybe Seed
  } deriving (GenStringsParams -> GenStringsParams -> Bool
(GenStringsParams -> GenStringsParams -> Bool)
-> (GenStringsParams -> GenStringsParams -> Bool)
-> Eq GenStringsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenStringsParams -> GenStringsParams -> Bool
== :: GenStringsParams -> GenStringsParams -> Bool
$c/= :: GenStringsParams -> GenStringsParams -> Bool
/= :: GenStringsParams -> GenStringsParams -> Bool
Eq, (forall x. GenStringsParams -> Rep GenStringsParams x)
-> (forall x. Rep GenStringsParams x -> GenStringsParams)
-> Generic GenStringsParams
forall x. Rep GenStringsParams x -> GenStringsParams
forall x. GenStringsParams -> Rep GenStringsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenStringsParams -> Rep GenStringsParams x
from :: forall x. GenStringsParams -> Rep GenStringsParams x
$cto :: forall x. Rep GenStringsParams x -> GenStringsParams
to :: forall x. Rep GenStringsParams x -> GenStringsParams
Generic, Int -> GenStringsParams -> ShowS
[GenStringsParams] -> ShowS
GenStringsParams -> String
(Int -> GenStringsParams -> ShowS)
-> (GenStringsParams -> String)
-> ([GenStringsParams] -> ShowS)
-> Show GenStringsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenStringsParams -> ShowS
showsPrec :: Int -> GenStringsParams -> ShowS
$cshow :: GenStringsParams -> String
show :: GenStringsParams -> String
$cshowList :: [GenStringsParams] -> ShowS
showList :: [GenStringsParams] -> ShowS
Show)

instance ToJSON GenStringsParams where
  toJSON :: GenStringsParams -> Value
toJSON = Options -> GenStringsParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}
  toEncoding :: GenStringsParams -> Encoding
toEncoding = Options -> GenStringsParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

instance FromJSON GenStringsParams where

  parseJSON :: Value -> Parser GenStringsParams
parseJSON = Options -> Value -> Parser GenStringsParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenStringsParams)
-> Options -> Value -> Parser GenStringsParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
4

-- | Type representing parameters to the @generateSignedStrings@ API method.

data GenSigStringsParams = GenSigStringsParams
  { GenSigStringsParams -> GenStringsParams
sgsp_params :: GenStringsParams
  , GenSigStringsParams -> SignedData
sgsp_data   :: SignedData
  } deriving (GenSigStringsParams -> GenSigStringsParams -> Bool
(GenSigStringsParams -> GenSigStringsParams -> Bool)
-> (GenSigStringsParams -> GenSigStringsParams -> Bool)
-> Eq GenSigStringsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigStringsParams -> GenSigStringsParams -> Bool
== :: GenSigStringsParams -> GenSigStringsParams -> Bool
$c/= :: GenSigStringsParams -> GenSigStringsParams -> Bool
/= :: GenSigStringsParams -> GenSigStringsParams -> Bool
Eq, Int -> GenSigStringsParams -> ShowS
[GenSigStringsParams] -> ShowS
GenSigStringsParams -> String
(Int -> GenSigStringsParams -> ShowS)
-> (GenSigStringsParams -> String)
-> ([GenSigStringsParams] -> ShowS)
-> Show GenSigStringsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigStringsParams -> ShowS
showsPrec :: Int -> GenSigStringsParams -> ShowS
$cshow :: GenSigStringsParams -> String
show :: GenSigStringsParams -> String
$cshowList :: [GenSigStringsParams] -> ShowS
showList :: [GenSigStringsParams] -> ShowS
Show)

instance ToJSON GenSigStringsParams where

  toJSON :: GenSigStringsParams -> Value
toJSON GenSigStringsParams
p = GenSigStringsParams
-> (GenSigStringsParams -> GenStringsParams)
-> (GenSigStringsParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigStringsParams
p GenSigStringsParams -> GenStringsParams
sgsp_params GenSigStringsParams -> SignedData
sgsp_data

instance FromJSON GenSigStringsParams where

  parseJSON :: Value -> Parser GenSigStringsParams
parseJSON Value
v = do
    GenStringsParams
sgsp_params <- Value -> Parser GenStringsParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sgsp_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigStringsParams -> Parser GenSigStringsParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigStringsParams {GenStringsParams
SignedData
$sel:sgsp_params:GenSigStringsParams :: GenStringsParams
$sel:sgsp_data:GenSigStringsParams :: SignedData
sgsp_params :: GenStringsParams
sgsp_data :: SignedData
..}

-- | Type representing parameters to the @generateUUIDs@ API method.

data GenUUIDsParams = GenUUIDsParams
  { GenUUIDsParams -> ApiKey
gup_apiKey                    :: ApiKey
  , GenUUIDsParams -> Int
gup_n                         :: Int
  , GenUUIDsParams -> Maybe Seed
gup_pregeneratedRandomization :: Maybe Seed
  } deriving (GenUUIDsParams -> GenUUIDsParams -> Bool
(GenUUIDsParams -> GenUUIDsParams -> Bool)
-> (GenUUIDsParams -> GenUUIDsParams -> Bool) -> Eq GenUUIDsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenUUIDsParams -> GenUUIDsParams -> Bool
== :: GenUUIDsParams -> GenUUIDsParams -> Bool
$c/= :: GenUUIDsParams -> GenUUIDsParams -> Bool
/= :: GenUUIDsParams -> GenUUIDsParams -> Bool
Eq, (forall x. GenUUIDsParams -> Rep GenUUIDsParams x)
-> (forall x. Rep GenUUIDsParams x -> GenUUIDsParams)
-> Generic GenUUIDsParams
forall x. Rep GenUUIDsParams x -> GenUUIDsParams
forall x. GenUUIDsParams -> Rep GenUUIDsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenUUIDsParams -> Rep GenUUIDsParams x
from :: forall x. GenUUIDsParams -> Rep GenUUIDsParams x
$cto :: forall x. Rep GenUUIDsParams x -> GenUUIDsParams
to :: forall x. Rep GenUUIDsParams x -> GenUUIDsParams
Generic, Int -> GenUUIDsParams -> ShowS
[GenUUIDsParams] -> ShowS
GenUUIDsParams -> String
(Int -> GenUUIDsParams -> ShowS)
-> (GenUUIDsParams -> String)
-> ([GenUUIDsParams] -> ShowS)
-> Show GenUUIDsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenUUIDsParams -> ShowS
showsPrec :: Int -> GenUUIDsParams -> ShowS
$cshow :: GenUUIDsParams -> String
show :: GenUUIDsParams -> String
$cshowList :: [GenUUIDsParams] -> ShowS
showList :: [GenUUIDsParams] -> ShowS
Show)

instance ToJSON GenUUIDsParams where
  toJSON :: GenUUIDsParams -> Value
toJSON = Options -> GenUUIDsParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}
  toEncoding :: GenUUIDsParams -> Encoding
toEncoding = Options -> GenUUIDsParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

instance FromJSON GenUUIDsParams where

  parseJSON :: Value -> Parser GenUUIDsParams
parseJSON = Options -> Value -> Parser GenUUIDsParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenUUIDsParams)
-> Options -> Value -> Parser GenUUIDsParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
4

-- | Type representing parameters to the @generateSignedUUIDs@ API method.

data GenSigUUIDsParams = GenSigUUIDsParams
  { GenSigUUIDsParams -> GenUUIDsParams
sgup_params :: GenUUIDsParams
  , GenSigUUIDsParams -> SignedData
sgup_data   :: SignedData
  } deriving (GenSigUUIDsParams -> GenSigUUIDsParams -> Bool
(GenSigUUIDsParams -> GenSigUUIDsParams -> Bool)
-> (GenSigUUIDsParams -> GenSigUUIDsParams -> Bool)
-> Eq GenSigUUIDsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigUUIDsParams -> GenSigUUIDsParams -> Bool
== :: GenSigUUIDsParams -> GenSigUUIDsParams -> Bool
$c/= :: GenSigUUIDsParams -> GenSigUUIDsParams -> Bool
/= :: GenSigUUIDsParams -> GenSigUUIDsParams -> Bool
Eq, Int -> GenSigUUIDsParams -> ShowS
[GenSigUUIDsParams] -> ShowS
GenSigUUIDsParams -> String
(Int -> GenSigUUIDsParams -> ShowS)
-> (GenSigUUIDsParams -> String)
-> ([GenSigUUIDsParams] -> ShowS)
-> Show GenSigUUIDsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigUUIDsParams -> ShowS
showsPrec :: Int -> GenSigUUIDsParams -> ShowS
$cshow :: GenSigUUIDsParams -> String
show :: GenSigUUIDsParams -> String
$cshowList :: [GenSigUUIDsParams] -> ShowS
showList :: [GenSigUUIDsParams] -> ShowS
Show)

instance ToJSON GenSigUUIDsParams where

  toJSON :: GenSigUUIDsParams -> Value
toJSON GenSigUUIDsParams
p = GenSigUUIDsParams
-> (GenSigUUIDsParams -> GenUUIDsParams)
-> (GenSigUUIDsParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigUUIDsParams
p GenSigUUIDsParams -> GenUUIDsParams
sgup_params GenSigUUIDsParams -> SignedData
sgup_data

instance FromJSON GenSigUUIDsParams where

  parseJSON :: Value -> Parser GenSigUUIDsParams
parseJSON Value
v = do
    GenUUIDsParams
sgup_params <- Value -> Parser GenUUIDsParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sgup_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigUUIDsParams -> Parser GenSigUUIDsParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigUUIDsParams {GenUUIDsParams
SignedData
$sel:sgup_params:GenSigUUIDsParams :: GenUUIDsParams
$sel:sgup_data:GenSigUUIDsParams :: SignedData
sgup_params :: GenUUIDsParams
sgup_data :: SignedData
..}

-- | Type representing parameters to the @generateBlobs@ API method.

data GenBlobsParams = GenBlobsParams
  { GenBlobsParams -> ApiKey
gbp_apiKey                    :: ApiKey
  , GenBlobsParams -> Int
gbp_n                         :: Int
  , GenBlobsParams -> Int
gbp_size                      :: Int
  , GenBlobsParams -> BlobFormat
gbp_format                    :: BlobFormat
  , GenBlobsParams -> Maybe Seed
gbp_pregeneratedRandomization :: Maybe Seed
  } deriving (GenBlobsParams -> GenBlobsParams -> Bool
(GenBlobsParams -> GenBlobsParams -> Bool)
-> (GenBlobsParams -> GenBlobsParams -> Bool) -> Eq GenBlobsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenBlobsParams -> GenBlobsParams -> Bool
== :: GenBlobsParams -> GenBlobsParams -> Bool
$c/= :: GenBlobsParams -> GenBlobsParams -> Bool
/= :: GenBlobsParams -> GenBlobsParams -> Bool
Eq, (forall x. GenBlobsParams -> Rep GenBlobsParams x)
-> (forall x. Rep GenBlobsParams x -> GenBlobsParams)
-> Generic GenBlobsParams
forall x. Rep GenBlobsParams x -> GenBlobsParams
forall x. GenBlobsParams -> Rep GenBlobsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenBlobsParams -> Rep GenBlobsParams x
from :: forall x. GenBlobsParams -> Rep GenBlobsParams x
$cto :: forall x. Rep GenBlobsParams x -> GenBlobsParams
to :: forall x. Rep GenBlobsParams x -> GenBlobsParams
Generic, Int -> GenBlobsParams -> ShowS
[GenBlobsParams] -> ShowS
GenBlobsParams -> String
(Int -> GenBlobsParams -> ShowS)
-> (GenBlobsParams -> String)
-> ([GenBlobsParams] -> ShowS)
-> Show GenBlobsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenBlobsParams -> ShowS
showsPrec :: Int -> GenBlobsParams -> ShowS
$cshow :: GenBlobsParams -> String
show :: GenBlobsParams -> String
$cshowList :: [GenBlobsParams] -> ShowS
showList :: [GenBlobsParams] -> ShowS
Show)

instance ToJSON GenBlobsParams where
  toJSON :: GenBlobsParams -> Value
toJSON = Options -> GenBlobsParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}
  toEncoding :: GenBlobsParams -> Encoding
toEncoding = Options -> GenBlobsParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

instance FromJSON GenBlobsParams where

  parseJSON :: Value -> Parser GenBlobsParams
parseJSON = Options -> Value -> Parser GenBlobsParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GenBlobsParams)
-> Options -> Value -> Parser GenBlobsParams
forall a b. (a -> b) -> a -> b
$ Int -> Options
customOptions Int
4

-- | Type representing BLOB formats.

data BlobFormat
  = Base64
  | Hex
  deriving (BlobFormat -> BlobFormat -> Bool
(BlobFormat -> BlobFormat -> Bool)
-> (BlobFormat -> BlobFormat -> Bool) -> Eq BlobFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlobFormat -> BlobFormat -> Bool
== :: BlobFormat -> BlobFormat -> Bool
$c/= :: BlobFormat -> BlobFormat -> Bool
/= :: BlobFormat -> BlobFormat -> Bool
Eq, (forall x. BlobFormat -> Rep BlobFormat x)
-> (forall x. Rep BlobFormat x -> BlobFormat) -> Generic BlobFormat
forall x. Rep BlobFormat x -> BlobFormat
forall x. BlobFormat -> Rep BlobFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlobFormat -> Rep BlobFormat x
from :: forall x. BlobFormat -> Rep BlobFormat x
$cto :: forall x. Rep BlobFormat x -> BlobFormat
to :: forall x. Rep BlobFormat x -> BlobFormat
Generic, Int -> BlobFormat -> ShowS
[BlobFormat] -> ShowS
BlobFormat -> String
(Int -> BlobFormat -> ShowS)
-> (BlobFormat -> String)
-> ([BlobFormat] -> ShowS)
-> Show BlobFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlobFormat -> ShowS
showsPrec :: Int -> BlobFormat -> ShowS
$cshow :: BlobFormat -> String
show :: BlobFormat -> String
$cshowList :: [BlobFormat] -> ShowS
showList :: [BlobFormat] -> ShowS
Show)

instance ToJSON BlobFormat where

  toJSON :: BlobFormat -> Value
toJSON = Options -> BlobFormat -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier = map toLower}

  toEncoding :: BlobFormat -> Encoding
toEncoding =
    Options -> BlobFormat -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier = map toLower}

instance FromJSON BlobFormat where

  parseJSON :: Value -> Parser BlobFormat
parseJSON =
    Options -> Value -> Parser BlobFormat
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {constructorTagModifier = map toLower}

-- | Type representing parameters to the @generateSignedBlobs@ API method.

data GenSigBlobsParams = GenSigBlobsParams
  { GenSigBlobsParams -> GenBlobsParams
sgbp_params :: GenBlobsParams
  , GenSigBlobsParams -> SignedData
sgbp_data   :: SignedData
  } deriving (GenSigBlobsParams -> GenSigBlobsParams -> Bool
(GenSigBlobsParams -> GenSigBlobsParams -> Bool)
-> (GenSigBlobsParams -> GenSigBlobsParams -> Bool)
-> Eq GenSigBlobsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenSigBlobsParams -> GenSigBlobsParams -> Bool
== :: GenSigBlobsParams -> GenSigBlobsParams -> Bool
$c/= :: GenSigBlobsParams -> GenSigBlobsParams -> Bool
/= :: GenSigBlobsParams -> GenSigBlobsParams -> Bool
Eq, Int -> GenSigBlobsParams -> ShowS
[GenSigBlobsParams] -> ShowS
GenSigBlobsParams -> String
(Int -> GenSigBlobsParams -> ShowS)
-> (GenSigBlobsParams -> String)
-> ([GenSigBlobsParams] -> ShowS)
-> Show GenSigBlobsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenSigBlobsParams -> ShowS
showsPrec :: Int -> GenSigBlobsParams -> ShowS
$cshow :: GenSigBlobsParams -> String
show :: GenSigBlobsParams -> String
$cshowList :: [GenSigBlobsParams] -> ShowS
showList :: [GenSigBlobsParams] -> ShowS
Show)

instance ToJSON GenSigBlobsParams where

  toJSON :: GenSigBlobsParams -> Value
toJSON GenSigBlobsParams
p = GenSigBlobsParams
-> (GenSigBlobsParams -> GenBlobsParams)
-> (GenSigBlobsParams -> SignedData)
-> Value
forall a1 a2 t.
(ToJSON a1, ToJSON a2) =>
t -> (t -> a1) -> (t -> a2) -> Value
sigParamsToJSON GenSigBlobsParams
p GenSigBlobsParams -> GenBlobsParams
sgbp_params GenSigBlobsParams -> SignedData
sgbp_data

instance FromJSON GenSigBlobsParams where

  parseJSON :: Value -> Parser GenSigBlobsParams
parseJSON Value
v = do
    GenBlobsParams
sgbp_params <- Value -> Parser GenBlobsParams
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    SignedData
sgbp_data <- Value -> Parser SignedData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    GenSigBlobsParams -> Parser GenSigBlobsParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenSigBlobsParams {GenBlobsParams
SignedData
$sel:sgbp_params:GenSigBlobsParams :: GenBlobsParams
$sel:sgbp_data:GenSigBlobsParams :: SignedData
sgbp_params :: GenBlobsParams
sgbp_data :: SignedData
..}

data GetResultParams = GetResultParams
  { GetResultParams -> Key
grp_apiKey       :: Key
  , GetResultParams -> Int
grp_serialNumber :: Int
  } deriving (GetResultParams -> GetResultParams -> Bool
(GetResultParams -> GetResultParams -> Bool)
-> (GetResultParams -> GetResultParams -> Bool)
-> Eq GetResultParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetResultParams -> GetResultParams -> Bool
== :: GetResultParams -> GetResultParams -> Bool
$c/= :: GetResultParams -> GetResultParams -> Bool
/= :: GetResultParams -> GetResultParams -> Bool
Eq, (forall x. GetResultParams -> Rep GetResultParams x)
-> (forall x. Rep GetResultParams x -> GetResultParams)
-> Generic GetResultParams
forall x. Rep GetResultParams x -> GetResultParams
forall x. GetResultParams -> Rep GetResultParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetResultParams -> Rep GetResultParams x
from :: forall x. GetResultParams -> Rep GetResultParams x
$cto :: forall x. Rep GetResultParams x -> GetResultParams
to :: forall x. Rep GetResultParams x -> GetResultParams
Generic, Int -> GetResultParams -> ShowS
[GetResultParams] -> ShowS
GetResultParams -> String
(Int -> GetResultParams -> ShowS)
-> (GetResultParams -> String)
-> ([GetResultParams] -> ShowS)
-> Show GetResultParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetResultParams -> ShowS
showsPrec :: Int -> GetResultParams -> ShowS
$cshow :: GetResultParams -> String
show :: GetResultParams -> String
$cshowList :: [GetResultParams] -> ShowS
showList :: [GetResultParams] -> ShowS
Show)

instance ToJSON GetResultParams where

  toJSON :: GetResultParams -> Value
toJSON = Options -> GetResultParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}

  toEncoding :: GetResultParams -> Encoding
toEncoding = Options -> GetResultParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

data CreateTicketsParams = CreateTicketsParams
  { CreateTicketsParams -> Key
ctp_apiKey     :: Key
  , CreateTicketsParams -> Int
ctp_n          :: Int
  , CreateTicketsParams -> Bool
ctp_showResult :: Bool
  } deriving (CreateTicketsParams -> CreateTicketsParams -> Bool
(CreateTicketsParams -> CreateTicketsParams -> Bool)
-> (CreateTicketsParams -> CreateTicketsParams -> Bool)
-> Eq CreateTicketsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTicketsParams -> CreateTicketsParams -> Bool
== :: CreateTicketsParams -> CreateTicketsParams -> Bool
$c/= :: CreateTicketsParams -> CreateTicketsParams -> Bool
/= :: CreateTicketsParams -> CreateTicketsParams -> Bool
Eq, (forall x. CreateTicketsParams -> Rep CreateTicketsParams x)
-> (forall x. Rep CreateTicketsParams x -> CreateTicketsParams)
-> Generic CreateTicketsParams
forall x. Rep CreateTicketsParams x -> CreateTicketsParams
forall x. CreateTicketsParams -> Rep CreateTicketsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateTicketsParams -> Rep CreateTicketsParams x
from :: forall x. CreateTicketsParams -> Rep CreateTicketsParams x
$cto :: forall x. Rep CreateTicketsParams x -> CreateTicketsParams
to :: forall x. Rep CreateTicketsParams x -> CreateTicketsParams
Generic, Int -> CreateTicketsParams -> ShowS
[CreateTicketsParams] -> ShowS
CreateTicketsParams -> String
(Int -> CreateTicketsParams -> ShowS)
-> (CreateTicketsParams -> String)
-> ([CreateTicketsParams] -> ShowS)
-> Show CreateTicketsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTicketsParams -> ShowS
showsPrec :: Int -> CreateTicketsParams -> ShowS
$cshow :: CreateTicketsParams -> String
show :: CreateTicketsParams -> String
$cshowList :: [CreateTicketsParams] -> ShowS
showList :: [CreateTicketsParams] -> ShowS
Show)

instance ToJSON CreateTicketsParams where

  toJSON :: CreateTicketsParams -> Value
toJSON = Options -> CreateTicketsParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}

  toEncoding :: CreateTicketsParams -> Encoding
toEncoding = Options -> CreateTicketsParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

data RevealTicketsParams = RevealTicketsParams
  { RevealTicketsParams -> Key
rtp_apiKey     :: Key
  , RevealTicketsParams -> TicketId
rtp_ticketId   :: TicketId
  } deriving (RevealTicketsParams -> RevealTicketsParams -> Bool
(RevealTicketsParams -> RevealTicketsParams -> Bool)
-> (RevealTicketsParams -> RevealTicketsParams -> Bool)
-> Eq RevealTicketsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RevealTicketsParams -> RevealTicketsParams -> Bool
== :: RevealTicketsParams -> RevealTicketsParams -> Bool
$c/= :: RevealTicketsParams -> RevealTicketsParams -> Bool
/= :: RevealTicketsParams -> RevealTicketsParams -> Bool
Eq, (forall x. RevealTicketsParams -> Rep RevealTicketsParams x)
-> (forall x. Rep RevealTicketsParams x -> RevealTicketsParams)
-> Generic RevealTicketsParams
forall x. Rep RevealTicketsParams x -> RevealTicketsParams
forall x. RevealTicketsParams -> Rep RevealTicketsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RevealTicketsParams -> Rep RevealTicketsParams x
from :: forall x. RevealTicketsParams -> Rep RevealTicketsParams x
$cto :: forall x. Rep RevealTicketsParams x -> RevealTicketsParams
to :: forall x. Rep RevealTicketsParams x -> RevealTicketsParams
Generic, Int -> RevealTicketsParams -> ShowS
[RevealTicketsParams] -> ShowS
RevealTicketsParams -> String
(Int -> RevealTicketsParams -> ShowS)
-> (RevealTicketsParams -> String)
-> ([RevealTicketsParams] -> ShowS)
-> Show RevealTicketsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevealTicketsParams -> ShowS
showsPrec :: Int -> RevealTicketsParams -> ShowS
$cshow :: RevealTicketsParams -> String
show :: RevealTicketsParams -> String
$cshowList :: [RevealTicketsParams] -> ShowS
showList :: [RevealTicketsParams] -> ShowS
Show)

instance ToJSON RevealTicketsParams where

  toJSON :: RevealTicketsParams -> Value
toJSON = Options -> RevealTicketsParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}

  toEncoding :: RevealTicketsParams -> Encoding
toEncoding = Options -> RevealTicketsParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

data ListTicketsParams = ListTicketsParams
  { ListTicketsParams -> Key
ltp_apiKey     :: Key
  , ListTicketsParams -> TicketType
ltp_ticketType :: TicketType
  } deriving (ListTicketsParams -> ListTicketsParams -> Bool
(ListTicketsParams -> ListTicketsParams -> Bool)
-> (ListTicketsParams -> ListTicketsParams -> Bool)
-> Eq ListTicketsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListTicketsParams -> ListTicketsParams -> Bool
== :: ListTicketsParams -> ListTicketsParams -> Bool
$c/= :: ListTicketsParams -> ListTicketsParams -> Bool
/= :: ListTicketsParams -> ListTicketsParams -> Bool
Eq, (forall x. ListTicketsParams -> Rep ListTicketsParams x)
-> (forall x. Rep ListTicketsParams x -> ListTicketsParams)
-> Generic ListTicketsParams
forall x. Rep ListTicketsParams x -> ListTicketsParams
forall x. ListTicketsParams -> Rep ListTicketsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListTicketsParams -> Rep ListTicketsParams x
from :: forall x. ListTicketsParams -> Rep ListTicketsParams x
$cto :: forall x. Rep ListTicketsParams x -> ListTicketsParams
to :: forall x. Rep ListTicketsParams x -> ListTicketsParams
Generic, Int -> ListTicketsParams -> ShowS
[ListTicketsParams] -> ShowS
ListTicketsParams -> String
(Int -> ListTicketsParams -> ShowS)
-> (ListTicketsParams -> String)
-> ([ListTicketsParams] -> ShowS)
-> Show ListTicketsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListTicketsParams -> ShowS
showsPrec :: Int -> ListTicketsParams -> ShowS
$cshow :: ListTicketsParams -> String
show :: ListTicketsParams -> String
$cshowList :: [ListTicketsParams] -> ShowS
showList :: [ListTicketsParams] -> ShowS
Show)

instance ToJSON ListTicketsParams where

  toJSON :: ListTicketsParams -> Value
toJSON = Options -> ListTicketsParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}

  toEncoding :: ListTicketsParams -> Encoding
toEncoding = Options -> ListTicketsParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

-- | Type representing types of tickets to list.

data TicketType
  = Singleton
    -- ^ No previous or next tickets.

  | Head
    -- ^ No previous ticket but next ticket.

  | Tail
    -- ^ Previous ticket but no next ticket.

  deriving (TicketType -> TicketType -> Bool
(TicketType -> TicketType -> Bool)
-> (TicketType -> TicketType -> Bool) -> Eq TicketType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TicketType -> TicketType -> Bool
== :: TicketType -> TicketType -> Bool
$c/= :: TicketType -> TicketType -> Bool
/= :: TicketType -> TicketType -> Bool
Eq, (forall x. TicketType -> Rep TicketType x)
-> (forall x. Rep TicketType x -> TicketType) -> Generic TicketType
forall x. Rep TicketType x -> TicketType
forall x. TicketType -> Rep TicketType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TicketType -> Rep TicketType x
from :: forall x. TicketType -> Rep TicketType x
$cto :: forall x. Rep TicketType x -> TicketType
to :: forall x. Rep TicketType x -> TicketType
Generic, Int -> TicketType -> ShowS
[TicketType] -> ShowS
TicketType -> String
(Int -> TicketType -> ShowS)
-> (TicketType -> String)
-> ([TicketType] -> ShowS)
-> Show TicketType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TicketType -> ShowS
showsPrec :: Int -> TicketType -> ShowS
$cshow :: TicketType -> String
show :: TicketType -> String
$cshowList :: [TicketType] -> ShowS
showList :: [TicketType] -> ShowS
Show)

instance ToJSON TicketType where

  toJSON :: TicketType -> Value
toJSON = Options -> TicketType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier = map toLower}

  toEncoding :: TicketType -> Encoding
toEncoding =
    Options -> TicketType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions  {constructorTagModifier = map toLower}

-- | Type representing parameters to the @getTicket@ API method.

newtype GetTicketParams = GetTicketParams
  { GetTicketParams -> TicketId
gtp_ticketId :: TicketId
  } deriving (GetTicketParams -> GetTicketParams -> Bool
(GetTicketParams -> GetTicketParams -> Bool)
-> (GetTicketParams -> GetTicketParams -> Bool)
-> Eq GetTicketParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetTicketParams -> GetTicketParams -> Bool
== :: GetTicketParams -> GetTicketParams -> Bool
$c/= :: GetTicketParams -> GetTicketParams -> Bool
/= :: GetTicketParams -> GetTicketParams -> Bool
Eq, (forall x. GetTicketParams -> Rep GetTicketParams x)
-> (forall x. Rep GetTicketParams x -> GetTicketParams)
-> Generic GetTicketParams
forall x. Rep GetTicketParams x -> GetTicketParams
forall x. GetTicketParams -> Rep GetTicketParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetTicketParams -> Rep GetTicketParams x
from :: forall x. GetTicketParams -> Rep GetTicketParams x
$cto :: forall x. Rep GetTicketParams x -> GetTicketParams
to :: forall x. Rep GetTicketParams x -> GetTicketParams
Generic, Int -> GetTicketParams -> ShowS
[GetTicketParams] -> ShowS
GetTicketParams -> String
(Int -> GetTicketParams -> ShowS)
-> (GetTicketParams -> String)
-> ([GetTicketParams] -> ShowS)
-> Show GetTicketParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetTicketParams -> ShowS
showsPrec :: Int -> GetTicketParams -> ShowS
$cshow :: GetTicketParams -> String
show :: GetTicketParams -> String
$cshowList :: [GetTicketParams] -> ShowS
showList :: [GetTicketParams] -> ShowS
Show)

instance ToJSON GetTicketParams where

  toJSON :: GetTicketParams -> Value
toJSON = Options -> GetTicketParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}

  toEncoding :: GetTicketParams -> Encoding
toEncoding = Options -> GetTicketParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

-- | Type representing parameters to the @getTicket@ API method.

data VerifySignatureParams = VerifySignatureParams
  { VerifySignatureParams -> Value
vsp_random    :: Value
  , VerifySignatureParams -> Signature
vsp_signature :: Signature
  } deriving (VerifySignatureParams -> VerifySignatureParams -> Bool
(VerifySignatureParams -> VerifySignatureParams -> Bool)
-> (VerifySignatureParams -> VerifySignatureParams -> Bool)
-> Eq VerifySignatureParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerifySignatureParams -> VerifySignatureParams -> Bool
== :: VerifySignatureParams -> VerifySignatureParams -> Bool
$c/= :: VerifySignatureParams -> VerifySignatureParams -> Bool
/= :: VerifySignatureParams -> VerifySignatureParams -> Bool
Eq, (forall x. VerifySignatureParams -> Rep VerifySignatureParams x)
-> (forall x. Rep VerifySignatureParams x -> VerifySignatureParams)
-> Generic VerifySignatureParams
forall x. Rep VerifySignatureParams x -> VerifySignatureParams
forall x. VerifySignatureParams -> Rep VerifySignatureParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VerifySignatureParams -> Rep VerifySignatureParams x
from :: forall x. VerifySignatureParams -> Rep VerifySignatureParams x
$cto :: forall x. Rep VerifySignatureParams x -> VerifySignatureParams
to :: forall x. Rep VerifySignatureParams x -> VerifySignatureParams
Generic, Int -> VerifySignatureParams -> ShowS
[VerifySignatureParams] -> ShowS
VerifySignatureParams -> String
(Int -> VerifySignatureParams -> ShowS)
-> (VerifySignatureParams -> String)
-> ([VerifySignatureParams] -> ShowS)
-> Show VerifySignatureParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerifySignatureParams -> ShowS
showsPrec :: Int -> VerifySignatureParams -> ShowS
$cshow :: VerifySignatureParams -> String
show :: VerifySignatureParams -> String
$cshowList :: [VerifySignatureParams] -> ShowS
showList :: [VerifySignatureParams] -> ShowS
Show)

instance ToJSON VerifySignatureParams where

  toJSON :: VerifySignatureParams -> Value
toJSON = Options -> VerifySignatureParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 4}

  toEncoding :: VerifySignatureParams -> Encoding
toEncoding = Options -> VerifySignatureParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 4}

-- | Type representing signatures.

newtype Signature = Signature
  { Signature -> ByteString
unSignature :: ByteString
  } deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show)

instance FromJSON Signature where

  parseJSON :: Value -> Parser Signature
parseJSON = String -> (Text -> Parser Signature) -> Value -> Parser Signature
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Signature" (Signature -> Parser Signature
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> Parser Signature)
-> (Text -> Signature) -> Text -> Parser Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Signature
Signature (ByteString -> Signature)
-> (Text -> ByteString) -> Text -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)

instance ToJSON Signature where

  toJSON :: Signature -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Signature -> Text) -> Signature -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (Signature -> ByteString) -> Signature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
unSignature
  toEncoding :: Signature -> Encoding
toEncoding = Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding)
-> (Signature -> Builder) -> Signature -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromByteString (ByteString -> Builder)
-> (Signature -> ByteString) -> Signature -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
unSignature

-- | Type representing types of tickets to list.

newtype GetUsageParams = GetUsageParams
  { GetUsageParams -> Key
usep_apiKey :: Key
  } deriving (GetUsageParams -> GetUsageParams -> Bool
(GetUsageParams -> GetUsageParams -> Bool)
-> (GetUsageParams -> GetUsageParams -> Bool) -> Eq GetUsageParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetUsageParams -> GetUsageParams -> Bool
== :: GetUsageParams -> GetUsageParams -> Bool
$c/= :: GetUsageParams -> GetUsageParams -> Bool
/= :: GetUsageParams -> GetUsageParams -> Bool
Eq, (forall x. GetUsageParams -> Rep GetUsageParams x)
-> (forall x. Rep GetUsageParams x -> GetUsageParams)
-> Generic GetUsageParams
forall x. Rep GetUsageParams x -> GetUsageParams
forall x. GetUsageParams -> Rep GetUsageParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetUsageParams -> Rep GetUsageParams x
from :: forall x. GetUsageParams -> Rep GetUsageParams x
$cto :: forall x. Rep GetUsageParams x -> GetUsageParams
to :: forall x. Rep GetUsageParams x -> GetUsageParams
Generic, Int -> GetUsageParams -> ShowS
[GetUsageParams] -> ShowS
GetUsageParams -> String
(Int -> GetUsageParams -> ShowS)
-> (GetUsageParams -> String)
-> ([GetUsageParams] -> ShowS)
-> Show GetUsageParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetUsageParams -> ShowS
showsPrec :: Int -> GetUsageParams -> ShowS
$cshow :: GetUsageParams -> String
show :: GetUsageParams -> String
$cshowList :: [GetUsageParams] -> ShowS
showList :: [GetUsageParams] -> ShowS
Show)

instance ToJSON GetUsageParams where

  toJSON :: GetUsageParams -> Value
toJSON = Options -> GetUsageParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 5}

  toEncoding :: GetUsageParams -> Encoding
toEncoding = Options -> GetUsageParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 5}

-- |Type representing responses from methods of the Basic API yielding random

-- data.

data RandomResponse a = RandomResponse
  { forall a. RandomResponse a -> a
randomData     :: a
  , forall a. RandomResponse a -> UTCTime
completionTime :: UTCTime
  , forall a. RandomResponse a -> Int
bitsUsed       :: Int
  , forall a. RandomResponse a -> Int
bitsLeft       :: Int
  , forall a. RandomResponse a -> Int
requestsLeft   :: Int
  , forall a. RandomResponse a -> Int
advisoryDelay  :: Int
  } deriving (RandomResponse a -> RandomResponse a -> Bool
(RandomResponse a -> RandomResponse a -> Bool)
-> (RandomResponse a -> RandomResponse a -> Bool)
-> Eq (RandomResponse a)
forall a. Eq a => RandomResponse a -> RandomResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RandomResponse a -> RandomResponse a -> Bool
== :: RandomResponse a -> RandomResponse a -> Bool
$c/= :: forall a. Eq a => RandomResponse a -> RandomResponse a -> Bool
/= :: RandomResponse a -> RandomResponse a -> Bool
Eq, Int -> RandomResponse a -> ShowS
[RandomResponse a] -> ShowS
RandomResponse a -> String
(Int -> RandomResponse a -> ShowS)
-> (RandomResponse a -> String)
-> ([RandomResponse a] -> ShowS)
-> Show (RandomResponse a)
forall a. Show a => Int -> RandomResponse a -> ShowS
forall a. Show a => [RandomResponse a] -> ShowS
forall a. Show a => RandomResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RandomResponse a -> ShowS
showsPrec :: Int -> RandomResponse a -> ShowS
$cshow :: forall a. Show a => RandomResponse a -> String
show :: RandomResponse a -> String
$cshowList :: forall a. Show a => [RandomResponse a] -> ShowS
showList :: [RandomResponse a] -> ShowS
Show)

instance FromJSON a => FromJSON (RandomResponse a) where
  parseJSON :: Value -> Parser (RandomResponse a)
parseJSON = String
-> (Object -> Parser (RandomResponse a))
-> Value
-> Parser (RandomResponse a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"random.org response" ((Object -> Parser (RandomResponse a))
 -> Value -> Parser (RandomResponse a))
-> (Object -> Parser (RandomResponse a))
-> Value
-> Parser (RandomResponse a)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Object
random <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"random"
    a
randomData <- Object
random Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    UTCTime
completionTime <- Object
random  Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completionTime"
    Int
bitsUsed <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bitsUsed"
    Int
bitsLeft <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bitsLeft"
    Int
requestsLeft <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requestsLeft"
    Int
advisoryDelay <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"advisoryDelay"
    RandomResponse a -> Parser (RandomResponse a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RandomResponse {a
Int
UTCTime
$sel:randomData:RandomResponse :: a
$sel:completionTime:RandomResponse :: UTCTime
$sel:bitsUsed:RandomResponse :: Int
$sel:bitsLeft:RandomResponse :: Int
$sel:requestsLeft:RandomResponse :: Int
$sel:advisoryDelay:RandomResponse :: Int
randomData :: a
completionTime :: UTCTime
bitsUsed :: Int
bitsLeft :: Int
requestsLeft :: Int
advisoryDelay :: Int
..}

-- |Type representing responses from methods of the Signed API yielding random

-- data.

data SignedRandomResponse a b = SignedRandomResponse
  { forall a b. SignedRandomResponse a b -> RandomResponse a
randomResponse :: RandomResponse a
  , forall a b. SignedRandomResponse a b -> Method
method         :: Method
  , forall a b. SignedRandomResponse a b -> b
params         :: b
  , forall a b. SignedRandomResponse a b -> Object
license        :: Object
  , forall a b. SignedRandomResponse a b -> Maybe LicenseData
licenseData    :: Maybe LicenseData
  , forall a b. SignedRandomResponse a b -> Maybe Object
userData       :: Maybe Object
  , forall a b. SignedRandomResponse a b -> Maybe TicketData
ticketData     :: Maybe TicketData
  , forall a b. SignedRandomResponse a b -> Int
serialNumber   :: Int
  , forall a b. SignedRandomResponse a b -> Signature
signature      :: Signature
  , forall a b. SignedRandomResponse a b -> CurrencyAmount
cost           :: CurrencyAmount
    -- ^ The cost of the request charged to the RANDOM.ORG account associated

    -- with the API key used in the request.

  } deriving (SignedRandomResponse a b -> SignedRandomResponse a b -> Bool
(SignedRandomResponse a b -> SignedRandomResponse a b -> Bool)
-> (SignedRandomResponse a b -> SignedRandomResponse a b -> Bool)
-> Eq (SignedRandomResponse a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
SignedRandomResponse a b -> SignedRandomResponse a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
SignedRandomResponse a b -> SignedRandomResponse a b -> Bool
== :: SignedRandomResponse a b -> SignedRandomResponse a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
SignedRandomResponse a b -> SignedRandomResponse a b -> Bool
/= :: SignedRandomResponse a b -> SignedRandomResponse a b -> Bool
Eq, Int -> SignedRandomResponse a b -> ShowS
[SignedRandomResponse a b] -> ShowS
SignedRandomResponse a b -> String
(Int -> SignedRandomResponse a b -> ShowS)
-> (SignedRandomResponse a b -> String)
-> ([SignedRandomResponse a b] -> ShowS)
-> Show (SignedRandomResponse a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b.
(Show a, Show b) =>
Int -> SignedRandomResponse a b -> ShowS
forall a b. (Show a, Show b) => [SignedRandomResponse a b] -> ShowS
forall a b. (Show a, Show b) => SignedRandomResponse a b -> String
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> SignedRandomResponse a b -> ShowS
showsPrec :: Int -> SignedRandomResponse a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => SignedRandomResponse a b -> String
show :: SignedRandomResponse a b -> String
$cshowList :: forall a b. (Show a, Show b) => [SignedRandomResponse a b] -> ShowS
showList :: [SignedRandomResponse a b] -> ShowS
Show)

-- | Type representing methods of the Signed API generating random data.

data Method
  = GenerateSignedIntegers
  | GenerateSignedIntegerSequences
  | GenerateSignedDecimalFractions
  | GenerateSignedGaussians
  | GenerateSignedStrings
  | GenerateSignedUUIDs
  | GenerateSignedBlobs
  deriving (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq, (forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Method -> Rep Method x
from :: forall x. Method -> Rep Method x
$cto :: forall x. Rep Method x -> Method
to :: forall x. Rep Method x -> Method
Generic, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show)

instance ToJSON Method where

  toJSON :: Method -> Value
toJSON = Options -> Method -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier = firstToLower}

  toEncoding :: Method -> Encoding
toEncoding =
    Options -> Method -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier = firstToLower}

instance FromJSON Method where

  parseJSON :: Value -> Parser Method
parseJSON =
    Options -> Value -> Parser Method
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  Options
defaultOptions {constructorTagModifier = firstToLower}

firstToLower :: String -> String
firstToLower :: ShowS
firstToLower String
"" = String
""
firstToLower (Char
x:String
xs) = Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

-- |Type representing data about tickets.

data TicketData = TicketData
  { TicketData -> TicketId
td_ticketId         :: TicketId
  , TicketData -> Maybe TicketId
td_previousTicketId :: Maybe TicketId
    -- ^ The previous ticket, if any, in the same chain as this ticket.

  , TicketData -> Maybe TicketId
td_nextTicketId     :: Maybe TicketId
    -- ^ The next ticket, if any, in the same chain as this ticket.

  } deriving (TicketData -> TicketData -> Bool
(TicketData -> TicketData -> Bool)
-> (TicketData -> TicketData -> Bool) -> Eq TicketData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TicketData -> TicketData -> Bool
== :: TicketData -> TicketData -> Bool
$c/= :: TicketData -> TicketData -> Bool
/= :: TicketData -> TicketData -> Bool
Eq, (forall x. TicketData -> Rep TicketData x)
-> (forall x. Rep TicketData x -> TicketData) -> Generic TicketData
forall x. Rep TicketData x -> TicketData
forall x. TicketData -> Rep TicketData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TicketData -> Rep TicketData x
from :: forall x. TicketData -> Rep TicketData x
$cto :: forall x. Rep TicketData x -> TicketData
to :: forall x. Rep TicketData x -> TicketData
Generic, Int -> TicketData -> ShowS
[TicketData] -> ShowS
TicketData -> String
(Int -> TicketData -> ShowS)
-> (TicketData -> String)
-> ([TicketData] -> ShowS)
-> Show TicketData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TicketData -> ShowS
showsPrec :: Int -> TicketData -> ShowS
$cshow :: TicketData -> String
show :: TicketData -> String
$cshowList :: [TicketData] -> ShowS
showList :: [TicketData] -> ShowS
Show)

instance ToJSON TicketData where

  toJSON :: TicketData -> Value
toJSON = Options -> TicketData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier = drop 3}

  toEncoding :: TicketData -> Encoding
toEncoding = Options -> TicketData -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier = drop 3}

instance FromJSON TicketData where

  parseJSON :: Value -> Parser TicketData
parseJSON = Options -> Value -> Parser TicketData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = drop 3}

instance (FromJSON a, FromJSON b) => FromJSON (SignedRandomResponse a b) where

  parseJSON :: Value -> Parser (SignedRandomResponse a b)
parseJSON = String
-> (Object -> Parser (SignedRandomResponse a b))
-> Value
-> Parser (SignedRandomResponse a b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"random.org signed response" ((Object -> Parser (SignedRandomResponse a b))
 -> Value -> Parser (SignedRandomResponse a b))
-> (Object -> Parser (SignedRandomResponse a b))
-> Value
-> Parser (SignedRandomResponse a b)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Object
random <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"random"
    Method
method <- Object
random Object -> Key -> Parser Method
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
    b
params <- Object
obj Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"random"
    a
randomData <- Object
random Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    Object
license <- Object
random Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"license"
    Maybe LicenseData
licenseData <- Object
random Object -> Key -> Parser (Maybe LicenseData)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"licenseData"
    Maybe Object
userData <- Object
random Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"userData"
    Maybe TicketData
ticketData <- Object
random Object -> Key -> Parser (Maybe TicketData)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ticketData"
    UTCTime
completionTime <- Object
random  Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completionTime"
    Int
serialNumber <- Object
random Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"serialNumber"
    Signature
signature <- Object
obj Object -> Key -> Parser Signature
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"signature"
    CurrencyAmount
cost <- Currency -> Double -> CurrencyAmount
CurrencyAmount Currency
USD (Double -> CurrencyAmount)
-> Parser Double -> Parser CurrencyAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cost"
    Int
bitsUsed <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bitsUsed"
    Int
bitsLeft <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bitsLeft"
    Int
requestsLeft <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requestsLeft"
    Int
advisoryDelay <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"advisoryDelay"
    let randomResponse :: RandomResponse a
randomResponse = RandomResponse {a
Int
UTCTime
$sel:randomData:RandomResponse :: a
$sel:completionTime:RandomResponse :: UTCTime
$sel:bitsUsed:RandomResponse :: Int
$sel:bitsLeft:RandomResponse :: Int
$sel:requestsLeft:RandomResponse :: Int
$sel:advisoryDelay:RandomResponse :: Int
randomData :: a
completionTime :: UTCTime
bitsUsed :: Int
bitsLeft :: Int
requestsLeft :: Int
advisoryDelay :: Int
..}
    SignedRandomResponse a b -> Parser (SignedRandomResponse a b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignedRandomResponse {b
Int
Maybe Object
Maybe TicketData
Maybe LicenseData
Object
Method
RandomResponse a
Signature
CurrencyAmount
$sel:randomResponse:SignedRandomResponse :: RandomResponse a
$sel:method:SignedRandomResponse :: Method
$sel:params:SignedRandomResponse :: b
$sel:license:SignedRandomResponse :: Object
$sel:licenseData:SignedRandomResponse :: Maybe LicenseData
$sel:userData:SignedRandomResponse :: Maybe Object
$sel:ticketData:SignedRandomResponse :: Maybe TicketData
$sel:serialNumber:SignedRandomResponse :: Int
$sel:signature:SignedRandomResponse :: Signature
$sel:cost:SignedRandomResponse :: CurrencyAmount
method :: Method
params :: b
license :: Object
licenseData :: Maybe LicenseData
userData :: Maybe Object
ticketData :: Maybe TicketData
serialNumber :: Int
signature :: Signature
cost :: CurrencyAmount
randomResponse :: RandomResponse a
..}

toJSONRandom :: (ToJSON a, ToJSON b) => SignedRandomResponse a b -> Value
toJSONRandom :: forall a b.
(ToJSON a, ToJSON b) =>
SignedRandomResponse a b -> Value
toJSONRandom SignedRandomResponse a b
srr =
  let paramsKeyMap :: Object
paramsKeyMap = case b -> Value
forall a. ToJSON a => a -> Value
toJSON (b -> Value) -> b -> Value
forall a b. (a -> b) -> a -> b
$ SignedRandomResponse a b -> b
forall a b. SignedRandomResponse a b -> b
params SignedRandomResponse a b
srr of
        Object Object
paramsKeyMap' -> Object
paramsKeyMap'
        Value
_ -> String -> Object
forall a. HasCallStack => String -> a
error String
"toJSONTandon: no params object!"
      hashedApiKey :: Value
hashedApiKey = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Map.lookup Key
"apiKey" Object
paramsKeyMap of
        Just Value
hashedApiKey' -> Value
hashedApiKey'
        Maybe Value
Nothing -> String -> Value
forall a. HasCallStack => String -> a
error String
"toJSONRandom: no apiKey!"
      otherParams :: Object
otherParams = Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
Map.delete Key
"apiKey" Object
paramsKeyMap
      rr :: RandomResponse a
rr = SignedRandomResponse a b -> RandomResponse a
forall a b. SignedRandomResponse a b -> RandomResponse a
randomResponse SignedRandomResponse a b
srr
  in  Object -> Value
Object
        (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$  Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"method" (Method -> Value
forall a. ToJSON a => a -> Value
toJSON (Method -> Value) -> Method -> Value
forall a b. (a -> b) -> a -> b
$ SignedRandomResponse a b -> Method
forall a b. SignedRandomResponse a b -> Method
method SignedRandomResponse a b
srr)
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"hashedApiKey" Value
hashedApiKey
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
otherParams
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"data" (a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> a -> Value
forall a b. (a -> b) -> a -> b
$ RandomResponse a -> a
forall a. RandomResponse a -> a
randomData RandomResponse a
rr)
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"license" (Object -> Value
forall a. ToJSON a => a -> Value
toJSON (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ SignedRandomResponse a b -> Object
forall a b. SignedRandomResponse a b -> Object
license SignedRandomResponse a b
srr)
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"licenseData" (Maybe LicenseData -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe LicenseData -> Value) -> Maybe LicenseData -> Value
forall a b. (a -> b) -> a -> b
$ SignedRandomResponse a b -> Maybe LicenseData
forall a b. SignedRandomResponse a b -> Maybe LicenseData
licenseData SignedRandomResponse a b
srr)
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"userData" (Maybe Object -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Object -> Value) -> Maybe Object -> Value
forall a b. (a -> b) -> a -> b
$ SignedRandomResponse a b -> Maybe Object
forall a b. SignedRandomResponse a b -> Maybe Object
userData SignedRandomResponse a b
srr)
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"ticketData" (Maybe TicketData -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe TicketData -> Value) -> Maybe TicketData -> Value
forall a b. (a -> b) -> a -> b
$ SignedRandomResponse a b -> Maybe TicketData
forall a b. SignedRandomResponse a b -> Maybe TicketData
ticketData SignedRandomResponse a b
srr)
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"completionTime" (DateTime -> Value
forall a. ToJSON a => a -> Value
toJSON (DateTime -> Value) -> DateTime -> Value
forall a b. (a -> b) -> a -> b
$ UTCTime -> DateTime
DateTime (UTCTime -> DateTime) -> UTCTime -> DateTime
forall a b. (a -> b) -> a -> b
$ RandomResponse a -> UTCTime
forall a. RandomResponse a -> UTCTime
completionTime RandomResponse a
rr)
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key -> Value -> Object
forall v. Key -> v -> KeyMap v
Map.singleton Key
"serialNumber"  (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ SignedRandomResponse a b -> Int
forall a b. SignedRandomResponse a b -> Int
serialNumber SignedRandomResponse a b
srr)

-- |Type representing responses from the method of the Signed API yielding

-- new tickets.

newtype CreateTicketsResponse = CreateTicketsResponse [TicketResponse]
  deriving (CreateTicketsResponse -> CreateTicketsResponse -> Bool
(CreateTicketsResponse -> CreateTicketsResponse -> Bool)
-> (CreateTicketsResponse -> CreateTicketsResponse -> Bool)
-> Eq CreateTicketsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTicketsResponse -> CreateTicketsResponse -> Bool
== :: CreateTicketsResponse -> CreateTicketsResponse -> Bool
$c/= :: CreateTicketsResponse -> CreateTicketsResponse -> Bool
/= :: CreateTicketsResponse -> CreateTicketsResponse -> Bool
Eq, Value -> Parser [CreateTicketsResponse]
Value -> Parser CreateTicketsResponse
(Value -> Parser CreateTicketsResponse)
-> (Value -> Parser [CreateTicketsResponse])
-> FromJSON CreateTicketsResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CreateTicketsResponse
parseJSON :: Value -> Parser CreateTicketsResponse
$cparseJSONList :: Value -> Parser [CreateTicketsResponse]
parseJSONList :: Value -> Parser [CreateTicketsResponse]
FromJSON, (forall x. CreateTicketsResponse -> Rep CreateTicketsResponse x)
-> (forall x. Rep CreateTicketsResponse x -> CreateTicketsResponse)
-> Generic CreateTicketsResponse
forall x. Rep CreateTicketsResponse x -> CreateTicketsResponse
forall x. CreateTicketsResponse -> Rep CreateTicketsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateTicketsResponse -> Rep CreateTicketsResponse x
from :: forall x. CreateTicketsResponse -> Rep CreateTicketsResponse x
$cto :: forall x. Rep CreateTicketsResponse x -> CreateTicketsResponse
to :: forall x. Rep CreateTicketsResponse x -> CreateTicketsResponse
Generic, Int -> CreateTicketsResponse -> ShowS
[CreateTicketsResponse] -> ShowS
CreateTicketsResponse -> String
(Int -> CreateTicketsResponse -> ShowS)
-> (CreateTicketsResponse -> String)
-> ([CreateTicketsResponse] -> ShowS)
-> Show CreateTicketsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTicketsResponse -> ShowS
showsPrec :: Int -> CreateTicketsResponse -> ShowS
$cshow :: CreateTicketsResponse -> String
show :: CreateTicketsResponse -> String
$cshowList :: [CreateTicketsResponse] -> ShowS
showList :: [CreateTicketsResponse] -> ShowS
Show)

-- |Type representing ticket responses from the Signed API.

data TicketResponse = TicketResponse
  { TicketResponse -> TicketData
tr_ticketData       :: TicketData
  , TicketResponse -> UTCTime
tr_creationTime     :: UTCTime
  } deriving (TicketResponse -> TicketResponse -> Bool
(TicketResponse -> TicketResponse -> Bool)
-> (TicketResponse -> TicketResponse -> Bool) -> Eq TicketResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TicketResponse -> TicketResponse -> Bool
== :: TicketResponse -> TicketResponse -> Bool
$c/= :: TicketResponse -> TicketResponse -> Bool
/= :: TicketResponse -> TicketResponse -> Bool
Eq, Int -> TicketResponse -> ShowS
[TicketResponse] -> ShowS
TicketResponse -> String
(Int -> TicketResponse -> ShowS)
-> (TicketResponse -> String)
-> ([TicketResponse] -> ShowS)
-> Show TicketResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TicketResponse -> ShowS
showsPrec :: Int -> TicketResponse -> ShowS
$cshow :: TicketResponse -> String
show :: TicketResponse -> String
$cshowList :: [TicketResponse] -> ShowS
showList :: [TicketResponse] -> ShowS
Show)

instance FromJSON TicketResponse where

  parseJSON :: Value -> Parser TicketResponse
parseJSON Value
v = do
    TicketData
tr_ticketData <- Value -> Parser TicketData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    String
-> (Object -> Parser TicketResponse)
-> Value
-> Parser TicketResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"TicketResponse"
      ( \Object
obj -> do
          UTCTime
tr_creationTime <- Object
obj Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creationTime"
          TicketResponse -> Parser TicketResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TicketResponse {UTCTime
TicketData
$sel:tr_ticketData:TicketResponse :: TicketData
$sel:tr_creationTime:TicketResponse :: UTCTime
tr_ticketData :: TicketData
tr_creationTime :: UTCTime
..}
      )
      Value
v

-- |Type representing responses from the method of the Signed API revealing

-- tickets.

newtype RevealTicketsResponse = RevealTicketsResponse Int
  deriving (RevealTicketsResponse -> RevealTicketsResponse -> Bool
(RevealTicketsResponse -> RevealTicketsResponse -> Bool)
-> (RevealTicketsResponse -> RevealTicketsResponse -> Bool)
-> Eq RevealTicketsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RevealTicketsResponse -> RevealTicketsResponse -> Bool
== :: RevealTicketsResponse -> RevealTicketsResponse -> Bool
$c/= :: RevealTicketsResponse -> RevealTicketsResponse -> Bool
/= :: RevealTicketsResponse -> RevealTicketsResponse -> Bool
Eq, Int -> RevealTicketsResponse -> ShowS
[RevealTicketsResponse] -> ShowS
RevealTicketsResponse -> String
(Int -> RevealTicketsResponse -> ShowS)
-> (RevealTicketsResponse -> String)
-> ([RevealTicketsResponse] -> ShowS)
-> Show RevealTicketsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevealTicketsResponse -> ShowS
showsPrec :: Int -> RevealTicketsResponse -> ShowS
$cshow :: RevealTicketsResponse -> String
show :: RevealTicketsResponse -> String
$cshowList :: [RevealTicketsResponse] -> ShowS
showList :: [RevealTicketsResponse] -> ShowS
Show)

instance FromJSON RevealTicketsResponse where

  parseJSON :: Value -> Parser RevealTicketsResponse
parseJSON = String
-> (Object -> Parser RevealTicketsResponse)
-> Value
-> Parser RevealTicketsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RevealTicketsResponse" ((Object -> Parser RevealTicketsResponse)
 -> Value -> Parser RevealTicketsResponse)
-> (Object -> Parser RevealTicketsResponse)
-> Value
-> Parser RevealTicketsResponse
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Int -> RevealTicketsResponse
RevealTicketsResponse (Int -> RevealTicketsResponse)
-> Parser Int -> Parser RevealTicketsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ticketCount"

-- | Type representing responses from the @listTickets@ or @getTicket@ API

-- methods.

data TicketInfoResponse = TicketInfoResponse
  { TicketInfoResponse -> TicketResponse
ltr_ticketResponse :: TicketResponse
  , TicketInfoResponse -> ApiKey
ltr_hashedApiKey   :: ApiKey
  , TicketInfoResponse -> Bool
ltr_showResult     :: Bool
  , TicketInfoResponse -> Maybe UTCTime
ltr_usedTime       :: Maybe UTCTime
  , TicketInfoResponse -> Maybe UTCTime
ltr_expirationTime :: Maybe UTCTime
  , TicketInfoResponse -> Maybe Int
ltr_serialNumber   :: Maybe Int
  } deriving (TicketInfoResponse -> TicketInfoResponse -> Bool
(TicketInfoResponse -> TicketInfoResponse -> Bool)
-> (TicketInfoResponse -> TicketInfoResponse -> Bool)
-> Eq TicketInfoResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TicketInfoResponse -> TicketInfoResponse -> Bool
== :: TicketInfoResponse -> TicketInfoResponse -> Bool
$c/= :: TicketInfoResponse -> TicketInfoResponse -> Bool
/= :: TicketInfoResponse -> TicketInfoResponse -> Bool
Eq, Int -> TicketInfoResponse -> ShowS
[TicketInfoResponse] -> ShowS
TicketInfoResponse -> String
(Int -> TicketInfoResponse -> ShowS)
-> (TicketInfoResponse -> String)
-> ([TicketInfoResponse] -> ShowS)
-> Show TicketInfoResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TicketInfoResponse -> ShowS
showsPrec :: Int -> TicketInfoResponse -> ShowS
$cshow :: TicketInfoResponse -> String
show :: TicketInfoResponse -> String
$cshowList :: [TicketInfoResponse] -> ShowS
showList :: [TicketInfoResponse] -> ShowS
Show)

instance FromJSON TicketInfoResponse where

  parseJSON :: Value -> Parser TicketInfoResponse
parseJSON Value
v = do
    TicketResponse
ltr_ticketResponse <- Value -> Parser TicketResponse
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    String
-> (Object -> Parser TicketInfoResponse)
-> Value
-> Parser TicketInfoResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ListTicketRespone"
      ( \Object
obj -> do
          ApiKey
ltr_hashedApiKey <- Object
obj Object -> Key -> Parser ApiKey
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hashedApiKey"
          Bool
ltr_showResult <- Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"showResult"
          Maybe UTCTime
ltr_usedTime <- Object
obj Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"usedTime"
          Maybe UTCTime
ltr_expirationTime <- Object
obj Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expirationTime"
          Maybe Int
ltr_serialNumber <- Object
obj Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"serialNumber"
          TicketInfoResponse -> Parser TicketInfoResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TicketInfoResponse {Bool
Maybe Int
Maybe UTCTime
ApiKey
TicketResponse
$sel:ltr_ticketResponse:TicketInfoResponse :: TicketResponse
$sel:ltr_hashedApiKey:TicketInfoResponse :: ApiKey
$sel:ltr_showResult:TicketInfoResponse :: Bool
$sel:ltr_usedTime:TicketInfoResponse :: Maybe UTCTime
$sel:ltr_expirationTime:TicketInfoResponse :: Maybe UTCTime
$sel:ltr_serialNumber:TicketInfoResponse :: Maybe Int
ltr_ticketResponse :: TicketResponse
ltr_hashedApiKey :: ApiKey
ltr_showResult :: Bool
ltr_usedTime :: Maybe UTCTime
ltr_expirationTime :: Maybe UTCTime
ltr_serialNumber :: Maybe Int
..}
      )
      Value
v

-- | Type representing responses from the @verifySignature@ API method.

newtype VerifySignatureResponse = VerifySignatureResponse
  { VerifySignatureResponse -> Bool
vsr_authenticity :: Bool
  } deriving (VerifySignatureResponse -> VerifySignatureResponse -> Bool
(VerifySignatureResponse -> VerifySignatureResponse -> Bool)
-> (VerifySignatureResponse -> VerifySignatureResponse -> Bool)
-> Eq VerifySignatureResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerifySignatureResponse -> VerifySignatureResponse -> Bool
== :: VerifySignatureResponse -> VerifySignatureResponse -> Bool
$c/= :: VerifySignatureResponse -> VerifySignatureResponse -> Bool
/= :: VerifySignatureResponse -> VerifySignatureResponse -> Bool
Eq, (forall x.
 VerifySignatureResponse -> Rep VerifySignatureResponse x)
-> (forall x.
    Rep VerifySignatureResponse x -> VerifySignatureResponse)
-> Generic VerifySignatureResponse
forall x. Rep VerifySignatureResponse x -> VerifySignatureResponse
forall x. VerifySignatureResponse -> Rep VerifySignatureResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VerifySignatureResponse -> Rep VerifySignatureResponse x
from :: forall x. VerifySignatureResponse -> Rep VerifySignatureResponse x
$cto :: forall x. Rep VerifySignatureResponse x -> VerifySignatureResponse
to :: forall x. Rep VerifySignatureResponse x -> VerifySignatureResponse
Generic, Int -> VerifySignatureResponse -> ShowS
[VerifySignatureResponse] -> ShowS
VerifySignatureResponse -> String
(Int -> VerifySignatureResponse -> ShowS)
-> (VerifySignatureResponse -> String)
-> ([VerifySignatureResponse] -> ShowS)
-> Show VerifySignatureResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerifySignatureResponse -> ShowS
showsPrec :: Int -> VerifySignatureResponse -> ShowS
$cshow :: VerifySignatureResponse -> String
show :: VerifySignatureResponse -> String
$cshowList :: [VerifySignatureResponse] -> ShowS
showList :: [VerifySignatureResponse] -> ShowS
Show)

instance FromJSON VerifySignatureResponse where

   parseJSON :: Value -> Parser VerifySignatureResponse
parseJSON =
      Options -> Value -> Parser VerifySignatureResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = drop 4}

-- | Types representing responses from the @getResult@ API method.

data GetResultResponse
  = Integers (SignedRandomResponse [Int] GenIntegersParams)
  | IntegerSequences (SignedRandomResponse [[Int]] GenIntegerSequencesParams)
  | IntegerSequencesMultiform
      (SignedRandomResponse [[Int]] GenIntegerSequencesMultiformParams)
  | DecimalFractions (SignedRandomResponse [Double] GenDecimalFractionsParams)
  | Gaussians (SignedRandomResponse [Double] GenGaussiansParams)
  | Strings (SignedRandomResponse [Text] GenStringsParams)
  | UUIDs (SignedRandomResponse [UUID] GenUUIDsParams)
  | Blobs (SignedRandomResponse [Blob] GenBlobsParams)
  deriving (GetResultResponse -> GetResultResponse -> Bool
(GetResultResponse -> GetResultResponse -> Bool)
-> (GetResultResponse -> GetResultResponse -> Bool)
-> Eq GetResultResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetResultResponse -> GetResultResponse -> Bool
== :: GetResultResponse -> GetResultResponse -> Bool
$c/= :: GetResultResponse -> GetResultResponse -> Bool
/= :: GetResultResponse -> GetResultResponse -> Bool
Eq, (forall x. GetResultResponse -> Rep GetResultResponse x)
-> (forall x. Rep GetResultResponse x -> GetResultResponse)
-> Generic GetResultResponse
forall x. Rep GetResultResponse x -> GetResultResponse
forall x. GetResultResponse -> Rep GetResultResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetResultResponse -> Rep GetResultResponse x
from :: forall x. GetResultResponse -> Rep GetResultResponse x
$cto :: forall x. Rep GetResultResponse x -> GetResultResponse
to :: forall x. Rep GetResultResponse x -> GetResultResponse
Generic, Int -> GetResultResponse -> ShowS
[GetResultResponse] -> ShowS
GetResultResponse -> String
(Int -> GetResultResponse -> ShowS)
-> (GetResultResponse -> String)
-> ([GetResultResponse] -> ShowS)
-> Show GetResultResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetResultResponse -> ShowS
showsPrec :: Int -> GetResultResponse -> ShowS
$cshow :: GetResultResponse -> String
show :: GetResultResponse -> String
$cshowList :: [GetResultResponse] -> ShowS
showList :: [GetResultResponse] -> ShowS
Show)

instance FromJSON GetResultResponse where

  parseJSON :: Value -> Parser GetResultResponse
parseJSON = Options -> Value -> Parser GetResultResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {sumEncoding = UntaggedValue}

-- |Type representing responses from the method of the Basic and Signed API

-- yielding information about the API usage.

data UsageResponse = UsageResponse
  { UsageResponse -> Status
ur_status        :: Status
  , UsageResponse -> UTCTime
ur_creationTime  :: UTCTime
  , UsageResponse -> Int
ur_bitsLeft      :: Int
  , UsageResponse -> Int
ur_requestsLeft  :: Int
  , UsageResponse -> Int
ur_totalBits     :: Int
  , UsageResponse -> Int
ur_totalRequests :: Int
  } deriving (UsageResponse -> UsageResponse -> Bool
(UsageResponse -> UsageResponse -> Bool)
-> (UsageResponse -> UsageResponse -> Bool) -> Eq UsageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UsageResponse -> UsageResponse -> Bool
== :: UsageResponse -> UsageResponse -> Bool
$c/= :: UsageResponse -> UsageResponse -> Bool
/= :: UsageResponse -> UsageResponse -> Bool
Eq, (forall x. UsageResponse -> Rep UsageResponse x)
-> (forall x. Rep UsageResponse x -> UsageResponse)
-> Generic UsageResponse
forall x. Rep UsageResponse x -> UsageResponse
forall x. UsageResponse -> Rep UsageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UsageResponse -> Rep UsageResponse x
from :: forall x. UsageResponse -> Rep UsageResponse x
$cto :: forall x. Rep UsageResponse x -> UsageResponse
to :: forall x. Rep UsageResponse x -> UsageResponse
Generic, Int -> UsageResponse -> ShowS
[UsageResponse] -> ShowS
UsageResponse -> String
(Int -> UsageResponse -> ShowS)
-> (UsageResponse -> String)
-> ([UsageResponse] -> ShowS)
-> Show UsageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UsageResponse -> ShowS
showsPrec :: Int -> UsageResponse -> ShowS
$cshow :: UsageResponse -> String
show :: UsageResponse -> String
$cshowList :: [UsageResponse] -> ShowS
showList :: [UsageResponse] -> ShowS
Show)

instance FromJSON UsageResponse where

  parseJSON :: Value -> Parser UsageResponse
parseJSON = Options -> Value -> Parser UsageResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = drop 3}

-- | Type representing the statuses of API keys.

data Status
  = Running
    -- ^ The API key is running.

  | Stopped
    -- ^ The API key is stopped.

  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, (forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

instance ToJSON Status where

   toJSON :: Status -> Value
toJSON = Options -> Status -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier = map toLower}

   toEncoding :: Status -> Encoding
toEncoding =
      Options -> Status -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier = map toLower}

instance FromJSON Status where

   parseJSON :: Value -> Parser Status
parseJSON =
      Options -> Value -> Parser Status
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON  Options
defaultOptions {constructorTagModifier = map toLower}

api :: Proxy JsonRpcAPI
api :: Proxy JsonRpcAPI
api = Proxy JsonRpcAPI
forall {k} (t :: k). Proxy t
Proxy

randomDotOrgApi :: BaseUrl
randomDotOrgApi :: BaseUrl
randomDotOrgApi = Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
"api.random.org" Int
443 String
""

-- |Type representing API keys.

newtype Key = Key
  { Key -> ByteString
unKey :: ByteString
  } deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show)

instance ToJSON Key where

  toJSON :: Key -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Key -> Text) -> Key -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Key -> ByteString) -> Key -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ByteString
unKey
  toEncoding :: Key -> Encoding
toEncoding = Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding) -> (Key -> Builder) -> Key -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromByteString (ByteString -> Builder) -> (Key -> ByteString) -> Key -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ByteString
unKey

instance FromJSON Key where

   parseJSON :: Value -> Parser Key
parseJSON = String -> (Text -> Parser Key) -> Value -> Parser Key
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Key" (Key -> Parser Key
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> Parser Key) -> (Text -> Key) -> Text -> Parser Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Key
Key (ByteString -> Key) -> (Text -> ByteString) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)

-- | Type representing API keys or hashed API keys.

data ApiKey
  = HashedApiKey ByteString
  | ApiKey Key
  deriving (ApiKey -> ApiKey -> Bool
(ApiKey -> ApiKey -> Bool)
-> (ApiKey -> ApiKey -> Bool) -> Eq ApiKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApiKey -> ApiKey -> Bool
== :: ApiKey -> ApiKey -> Bool
$c/= :: ApiKey -> ApiKey -> Bool
/= :: ApiKey -> ApiKey -> Bool
Eq, Int -> ApiKey -> ShowS
[ApiKey] -> ShowS
ApiKey -> String
(Int -> ApiKey -> ShowS)
-> (ApiKey -> String) -> ([ApiKey] -> ShowS) -> Show ApiKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiKey -> ShowS
showsPrec :: Int -> ApiKey -> ShowS
$cshow :: ApiKey -> String
show :: ApiKey -> String
$cshowList :: [ApiKey] -> ShowS
showList :: [ApiKey] -> ShowS
Show)

instance ToJSON ApiKey where

  toJSON :: ApiKey -> Value
toJSON (HashedApiKey ByteString
hashedApiKey) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
hashedApiKey
  toJSON (ApiKey Key
apiKey) = Key -> Value
forall a. ToJSON a => a -> Value
toJSON Key
apiKey

  toEncoding :: ApiKey -> Encoding
toEncoding (HashedApiKey ByteString
hashedApiKey) =
    Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding) -> Builder -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
hashedApiKey
  toEncoding (ApiKey Key
apiKey) = Key -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Key
apiKey

-- | Parsing of JSON will prefer the v'HashedApiKey' data constructor to the

-- v'ApiKey' data constructor. That is because the responses from the Signed

-- API include hashed API keys.

instance FromJSON ApiKey where

  parseJSON :: Value -> Parser ApiKey
parseJSON = String -> (Text -> Parser ApiKey) -> Value -> Parser ApiKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ApiKey" (ApiKey -> Parser ApiKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiKey -> Parser ApiKey)
-> (Text -> ApiKey) -> Text -> Parser ApiKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ApiKey
HashedApiKey (ByteString -> ApiKey) -> (Text -> ByteString) -> Text -> ApiKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)

-- |This method generates true random integers within a user-defined range. If

-- successful, the function yields the random data and the advised delay in

-- milliseconds.

genIntegers ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of integers requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Maybe ([Int], Int))
genIntegers :: Manager
-> Key -> Bool -> Int -> Int -> Int -> IO (Maybe ([Int], Int))
genIntegers Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> IO (Maybe ([Int], Int))
genWithSeedIntegers Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random integers within a user-defined range.

genIntegers' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of integers requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Either ClientError (RndResponse [Int]))
genIntegers' :: Manager
-> Key
-> Bool
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Int]))
genIntegers' Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Int]))
genWithSeedIntegers' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random integers within a user-defined range. If

-- successful, the function yields the random data and the advised delay in

-- milliseconds.

genWithSeedIntegers ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of integers requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Maybe ([Int], Int))
genWithSeedIntegers :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> IO (Maybe ([Int], Int))
genWithSeedIntegers Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
rangeMin Int
rangeMax =
  Either ClientError (RndResponse [Int]) -> Maybe ([Int], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [Int]) -> Maybe ([Int], Int))
-> IO (Either ClientError (RndResponse [Int]))
-> IO (Maybe ([Int], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Int]))
genWithSeedIntegers' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
rangeMin Int
rangeMax

-- |This method generates true random integers within a user-defined range.

genWithSeedIntegers' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of integers requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Either ClientError (RndResponse [Int]))
genWithSeedIntegers' :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Int]))
genWithSeedIntegers' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
rangeMin Int
rangeMax = ClientM (RndResponse [Int])
-> ClientEnv -> IO (Either ClientError (RndResponse [Int]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GenIntegersParams -> ClientM (RndResponse [Int])
generateIntegers GenIntegersParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenIntegersParams
params = GenIntegersParams
    { $sel:gip_apiKey:GenIntegersParams :: ApiKey
gip_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:gip_n:GenIntegersParams :: Int
gip_n                         = Int
n
    , $sel:gip_min:GenIntegersParams :: Int
gip_min                       = Int
rangeMin
    , $sel:gip_max:GenIntegersParams :: Int
gip_max                       = Int
rangeMax
    , $sel:gip_replacement:GenIntegersParams :: Bool
gip_replacement               = Bool
replacement
    , $sel:gip_base:GenIntegersParams :: Int
gip_base                      = Int
10
    , $sel:gip_pregeneratedRandomization:GenIntegersParams :: Maybe Seed
gip_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateIntegers :: GenIntegersParams -> ClientM (RndResponse [Int])

-- |This method generates true random integers within a user-defined range.

genSignedIntegers ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of integers requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (ClientSigResponse [Int] GenIntegersParams)
genSignedIntegers :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> Int
-> IO (ClientSigResponse [Int] GenIntegersParams)
genSignedIntegers Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> Int
-> IO (ClientSigResponse [Int] GenIntegersParams)
genWithSeedSignedIntegers Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random integers within a user-defined range.

genWithSeedSignedIntegers ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of integers requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (ClientSigResponse [Int] GenIntegersParams)
genWithSeedSignedIntegers :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> Int
-> IO (ClientSigResponse [Int] GenIntegersParams)
genWithSeedSignedIntegers
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Maybe LicenseData
mLicenseData
    Maybe Object
mUserData
    Maybe TicketId
mTicketId
    Bool
replacement
    Int
n
    Int
rangeMin
    Int
rangeMax
  = ClientM (SigRndResponse [Int] GenIntegersParams)
-> ClientEnv -> IO (ClientSigResponse [Int] GenIntegersParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (GenSigIntegersParams
-> ClientM (SigRndResponse [Int] GenIntegersParams)
generateSignedIntegers GenSigIntegersParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
      (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigIntegersParams
params = GenSigIntegersParams
    { $sel:sgip_params:GenSigIntegersParams :: GenIntegersParams
sgip_params =
        GenIntegersParams
          { $sel:gip_apiKey:GenIntegersParams :: ApiKey
gip_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:gip_n:GenIntegersParams :: Int
gip_n                         = Int
n
          , $sel:gip_min:GenIntegersParams :: Int
gip_min                       = Int
rangeMin
          , $sel:gip_max:GenIntegersParams :: Int
gip_max                       = Int
rangeMax
          , $sel:gip_replacement:GenIntegersParams :: Bool
gip_replacement               = Bool
replacement
          , $sel:gip_base:GenIntegersParams :: Int
gip_base                      = Int
10
          , $sel:gip_pregeneratedRandomization:GenIntegersParams :: Maybe Seed
gip_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sgip_data:GenSigIntegersParams :: SignedData
sgip_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedIntegers ::
     GenSigIntegersParams
  -> ClientM (SigRndResponse [Int] GenIntegersParams)

-- |This method generates sequences of true random integers within a

-- user-defined range. If successful, the function yields the random data and

-- the advised delay in milliseconds.

genIntegerSequences ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The length of the sequence. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Maybe ([[Int]], Int))
genIntegerSequences :: Manager
-> Key
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (Maybe ([[Int]], Int))
genIntegerSequences Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (Maybe ([[Int]], Int))
genWithSeedIntegerSequences Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates sequences of true random integers within a

-- user-defined range.

genIntegerSequences' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The length of the sequence. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Either ClientError (RndResponse [[Int]]))
genIntegerSequences' :: Manager
-> Key
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [[Int]]))
genIntegerSequences' Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequences' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates sequences of true random integers within a

-- user-defined range. If successful, the function yields the random data and

-- the advised delay in milliseconds.

genWithSeedIntegerSequences ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The length of the sequence. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Maybe ([[Int]], Int))
genWithSeedIntegerSequences :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (Maybe ([[Int]], Int))
genWithSeedIntegerSequences Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
l Int
rangeMin Int
rangeMax =
  Either ClientError (RndResponse [[Int]]) -> Maybe ([[Int]], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [[Int]]) -> Maybe ([[Int]], Int))
-> IO (Either ClientError (RndResponse [[Int]]))
-> IO (Maybe ([[Int]], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequences' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
l Int
rangeMin Int
rangeMax

-- |This method generates sequences of true random integers within a

-- user-defined range.

genWithSeedIntegerSequences' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The length of the sequence. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequences' :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequences' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
l Int
rangeMin Int
rangeMax =
  ClientM (RndResponse [[Int]])
-> ClientEnv -> IO (Either ClientError (RndResponse [[Int]]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
    (GenIntegerSequencesParams -> ClientM (RndResponse [[Int]])
generateIntegerSequences GenIntegerSequencesParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
    (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
    (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
    (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenIntegerSequencesParams
params = GenIntegerSequencesParams
    { $sel:gisp_apiKey:GenIntegerSequencesParams :: ApiKey
gisp_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:gisp_n:GenIntegerSequencesParams :: Int
gisp_n                         = Int
n
    , $sel:gisp_length:GenIntegerSequencesParams :: Int
gisp_length                    = Int
l
    , $sel:gisp_min:GenIntegerSequencesParams :: Int
gisp_min                       = Int
rangeMin
    , $sel:gisp_max:GenIntegerSequencesParams :: Int
gisp_max                       = Int
rangeMax
    , $sel:gisp_replacement:GenIntegerSequencesParams :: Bool
gisp_replacement               = Bool
replacement
    , $sel:gisp_base:GenIntegerSequencesParams :: Int
gisp_base                      = Int
10
    , $sel:gisp_pregeneratedRandomization:GenIntegerSequencesParams :: Maybe Seed
gisp_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateIntegerSequences ::
     GenIntegerSequencesParams
  -> ClientM (RndResponse [[Int]])

-- |This method generates sequences of true random integers within a

-- user-defined range.

genSignedIntegerSequences ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The length of the sequence. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (ClientSigResponse [[Int]] GenIntegerSequencesParams)
genSignedIntegerSequences :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (ClientSigResponse [[Int]] GenIntegerSequencesParams)
genSignedIntegerSequences Manager
mgr Key
key =
  Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (ClientSigResponse [[Int]] GenIntegerSequencesParams)
genWithSeedSignedIntegerSequences Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates sequences of true random integers within a

-- user-defined range.

genWithSeedSignedIntegerSequences ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> Int
     -- ^ The length of the sequence. Must be in the range [1, 10,000].

  -> Int
     -- ^ The lower boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> Int
     -- ^ The upper boundary for the range from which the random integers will

     -- be picked. Must be within the range [-1,000,000,000, 1,000,000,000].

  -> IO (ClientSigResponse [[Int]] GenIntegerSequencesParams)
genWithSeedSignedIntegerSequences :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> Int
-> Int
-> IO (ClientSigResponse [[Int]] GenIntegerSequencesParams)
genWithSeedSignedIntegerSequences
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Maybe LicenseData
mLicenseData
    Maybe Object
mUserData
    Maybe TicketId
mTicketId
    Bool
replacement
    Int
n
    Int
l
    Int
rangeMin
    Int
rangeMax
  = ClientM (SigRndResponse [[Int]] GenIntegerSequencesParams)
-> ClientEnv
-> IO (ClientSigResponse [[Int]] GenIntegerSequencesParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (GenSigIntegerSequencesParams
-> ClientM (SigRndResponse [[Int]] GenIntegerSequencesParams)
generateSignedIntegerSequences GenSigIntegerSequencesParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
      (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigIntegerSequencesParams
params = GenSigIntegerSequencesParams
    { $sel:sgisp_params:GenSigIntegerSequencesParams :: GenIntegerSequencesParams
sgisp_params =
        GenIntegerSequencesParams
          { $sel:gisp_apiKey:GenIntegerSequencesParams :: ApiKey
gisp_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:gisp_n:GenIntegerSequencesParams :: Int
gisp_n                         = Int
n
          , $sel:gisp_length:GenIntegerSequencesParams :: Int
gisp_length                    = Int
l
          , $sel:gisp_min:GenIntegerSequencesParams :: Int
gisp_min                       = Int
rangeMin
          , $sel:gisp_max:GenIntegerSequencesParams :: Int
gisp_max                       = Int
rangeMax
          , $sel:gisp_replacement:GenIntegerSequencesParams :: Bool
gisp_replacement               = Bool
replacement
          , $sel:gisp_base:GenIntegerSequencesParams :: Int
gisp_base                      = Int
10
          , $sel:gisp_pregeneratedRandomization:GenIntegerSequencesParams :: Maybe Seed
gisp_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sgisp_data:GenSigIntegerSequencesParams :: SignedData
sgisp_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedIntegerSequences ::
     GenSigIntegerSequencesParams
  -> ClientM (SigRndResponse [[Int]] GenIntegerSequencesParams)

-- |This method generates multiform sequences of true random integers within a

-- user-defined range. If successful, the function yields the random data and

-- the advised delay in milliseconds.

genIntegerSequencesMultiform ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacment?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> [Int]
     -- ^ The lengths of the sequences. Each must be in the range [1, 10,000].

  -> Boundary
     -- ^ The lower boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> Boundary
     -- ^ The upper boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> IO (Maybe ([[Int]], Int))
genIntegerSequencesMultiform :: Manager
-> Key
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO (Maybe ([[Int]], Int))
genIntegerSequencesMultiform Manager
mgr Key
key =
  Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO (Maybe ([[Int]], Int))
genWithSeedIntegerSequencesMultiform Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates multiform sequences of true random integers within a

-- user-defined range.

genIntegerSequencesMultiform' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> [Int]
     -- ^ The lengths of the sequences. Each must be in the range [1, 10,000].

  -> Boundary
     -- ^ The lower boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> Boundary
     -- ^ The upper boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> IO (Either ClientError (RndResponse [[Int]]))
genIntegerSequencesMultiform' :: Manager
-> Key
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO (Either ClientError (RndResponse [[Int]]))
genIntegerSequencesMultiform' Manager
mgr Key
key =
  Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequencesMultiform' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates multiform sequences of true random integers within a

-- user-defined range. If successful, the function yields the random data and

-- the advised delay in milliseconds.

genWithSeedIntegerSequencesMultiform ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> [Int]
     -- ^ The lengths of the sequences. Each must be in the range [1, 10,000].

  -> Boundary
     -- ^ The lower boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> Boundary
     -- ^ The upper boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> IO (Maybe ([[Int]], Int))
genWithSeedIntegerSequencesMultiform :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO (Maybe ([[Int]], Int))
genWithSeedIntegerSequencesMultiform
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Bool
replacement
    Int
n
    [Int]
ls
    Boundary
rangeMin
    Boundary
rangeMax
  = Either ClientError (RndResponse [[Int]]) -> Maybe ([[Int]], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [[Int]]) -> Maybe ([[Int]], Int))
-> IO (Either ClientError (RndResponse [[Int]]))
-> IO (Maybe ([[Int]], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequencesMultiform'
        Manager
mgr
        Key
key
        Maybe Seed
mSeed
        Bool
replacement
        Int
n
        [Int]
ls
        Boundary
rangeMin
        Boundary
rangeMax

-- |This method generates multiform sequences of true random integers within a

-- user-defined range.

genWithSeedIntegerSequencesMultiform' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> [Int]
     -- ^ The lengths of the sequences. Each must be in the range [1, 10,000].

  -> Boundary
     -- ^ The lower boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> Boundary
     -- ^ The upper boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range [-1,000,000,000,

     -- 1,000,000,000].

  -> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequencesMultiform' :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO (Either ClientError (RndResponse [[Int]]))
genWithSeedIntegerSequencesMultiform'
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Bool
replacement
    Int
n
    [Int]
ls
    Boundary
rangeMin
    Boundary
rangeMax
  = ClientM (RndResponse [[Int]])
-> ClientEnv -> IO (Either ClientError (RndResponse [[Int]]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (GenIntegerSequencesMultiformParams -> ClientM (RndResponse [[Int]])
generateIntegerSequencesMultiform GenIntegerSequencesMultiformParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
      (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenIntegerSequencesMultiformParams
params = GenIntegerSequencesMultiformParams
    { $sel:gismp_apiKey:GenIntegerSequencesMultiformParams :: ApiKey
gismp_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:gismp_n:GenIntegerSequencesMultiformParams :: Int
gismp_n                         = Int
n
    , $sel:gismp_length:GenIntegerSequencesMultiformParams :: [Int]
gismp_length                    = [Int]
ls
    , $sel:gismp_min:GenIntegerSequencesMultiformParams :: Boundary
gismp_min                       = Boundary
rangeMin
    , $sel:gismp_max:GenIntegerSequencesMultiformParams :: Boundary
gismp_max                       = Boundary
rangeMax
    , $sel:gismp_replacement:GenIntegerSequencesMultiformParams :: Bool
gismp_replacement               = Bool
replacement
    , $sel:gismp_base:GenIntegerSequencesMultiformParams :: Int
gismp_base                      = Int
10
    , $sel:gismp_pregeneratedRandomization:GenIntegerSequencesMultiformParams :: Maybe Seed
gismp_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateIntegerSequencesMultiform ::
     GenIntegerSequencesMultiformParams
  -> ClientM (RndResponse [[Int]])

-- |This method generates multiform sequences of true random integers within a

-- user-defined range.

genSignedIntegerSequencesMultiform ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> [Int]
     -- ^ The lengths of the sequences. Each must be in the range [1, 10,000].

  -> Boundary
     -- ^ The lower boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range

     -- [-1,000,000,000, 1,000,000,000].

  -> Boundary
     -- ^ The upper boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range

     -- [-1,000,000,000, 1,000,000,000].

  -> IO (ClientSigResponse [[Int]] GenIntegerSequencesMultiformParams)
genSignedIntegerSequencesMultiform :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO
     (ClientSigResponse [[Int]] GenIntegerSequencesMultiformParams)
genSignedIntegerSequencesMultiform Manager
mgr Key
key =
  Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO
     (ClientSigResponse [[Int]] GenIntegerSequencesMultiformParams)
genWithSeedSignedIntegerSequencesMultiform Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates multiform sequences of true random integers within a

-- user-defined range.

genWithSeedSignedIntegerSequencesMultiform ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of sequences requested. Must be in the range [1, 10,000].

  -> [Int]
     -- ^ The lengths of the sequences. Each must be in the range [1, 10,000].

  -> Boundary
     -- ^ The lower boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range

     -- [-1,000,000,000, 1,000,000,000].

  -> Boundary
     -- ^ The upper boundary (or boundaries) for the range from which the random

     -- integers will be picked. Must be within the range

     -- [-1,000,000,000, 1,000,000,000].

  -> IO (ClientSigResponse [[Int]] GenIntegerSequencesMultiformParams)
genWithSeedSignedIntegerSequencesMultiform :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> [Int]
-> Boundary
-> Boundary
-> IO
     (ClientSigResponse [[Int]] GenIntegerSequencesMultiformParams)
genWithSeedSignedIntegerSequencesMultiform
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Maybe LicenseData
mLicenseData
    Maybe Object
mUserData
    Maybe TicketId
mTicketId
    Bool
replacement
    Int
n
    [Int]
ls
    Boundary
rangeMin
    Boundary
rangeMax
  = ClientM (SigRndResponse [[Int]] GenIntegerSequencesMultiformParams)
-> ClientEnv
-> IO
     (ClientSigResponse [[Int]] GenIntegerSequencesMultiformParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (GenSigIntegerSequencesMultiformParams
-> ClientM
     (SigRndResponse [[Int]] GenIntegerSequencesMultiformParams)
generateSignedIntegerSequencesMultiform GenSigIntegerSequencesMultiformParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
      (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigIntegerSequencesMultiformParams
params = GenSigIntegerSequencesMultiformParams
    { $sel:sgismp_params:GenSigIntegerSequencesMultiformParams :: GenIntegerSequencesMultiformParams
sgismp_params =
        GenIntegerSequencesMultiformParams
          { $sel:gismp_apiKey:GenIntegerSequencesMultiformParams :: ApiKey
gismp_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:gismp_n:GenIntegerSequencesMultiformParams :: Int
gismp_n                         = Int
n
          , $sel:gismp_length:GenIntegerSequencesMultiformParams :: [Int]
gismp_length                    = [Int]
ls
          , $sel:gismp_min:GenIntegerSequencesMultiformParams :: Boundary
gismp_min                       = Boundary
rangeMin
          , $sel:gismp_max:GenIntegerSequencesMultiformParams :: Boundary
gismp_max                       = Boundary
rangeMax
          , $sel:gismp_replacement:GenIntegerSequencesMultiformParams :: Bool
gismp_replacement               = Bool
replacement
          , $sel:gismp_base:GenIntegerSequencesMultiformParams :: Int
gismp_base                      = Int
10
          , $sel:gismp_pregeneratedRandomization:GenIntegerSequencesMultiformParams :: Maybe Seed
gismp_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sgismp_data:GenSigIntegerSequencesMultiformParams :: SignedData
sgismp_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedIntegerSequencesMultiform ::
     GenSigIntegerSequencesMultiformParams
  -> ClientM (SigRndResponse [[Int]] GenIntegerSequencesMultiformParams)

-- |This method generates true random decimal fractions from a uniform

-- distribution across the interval [0, 1) with a user-defined number of decimal

-- places. If successful, the function yields the random data and the advised

-- delay in milliseconds.

genDecimalFractions ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of decimal fractions requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The number of decimal places. Must be within the range [1, 14].

  -> IO (Maybe ([Double], Int))
genDecimalFractions :: Manager -> Key -> Bool -> Int -> Int -> IO (Maybe ([Double], Int))
genDecimalFractions Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> IO (Maybe ([Double], Int))
genWithSeedDecimalFractions Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random decimal fractions from a uniform

-- distribution across the interval [0, 1) with a user-defined number of decimal

-- places.

genDecimalFractions' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of decimal fractions requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The number of decimal places. Must be within the range [1, 14].

  -> IO (Either ClientError (RndResponse [Double]))
genDecimalFractions' :: Manager
-> Key
-> Bool
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genDecimalFractions' Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genWithSeedDecimalFractions' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random decimal fractions from a uniform

-- distribution across the interval [0, 1) with a user-defined number of decimal

-- places. If successful, the function yields the random data and the advised

-- delay in milliseconds.

genWithSeedDecimalFractions ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of decimal fractions requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The number of decimal places. Must be within the range [1, 14].

  -> IO (Maybe ([Double], Int))
genWithSeedDecimalFractions :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> IO (Maybe ([Double], Int))
genWithSeedDecimalFractions Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
dps =
  Either ClientError (RndResponse [Double]) -> Maybe ([Double], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [Double])
 -> Maybe ([Double], Int))
-> IO (Either ClientError (RndResponse [Double]))
-> IO (Maybe ([Double], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genWithSeedDecimalFractions' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
dps

-- |This method generates true random decimal fractions from a uniform

-- distribution across the interval [0, 1) with a user-defined number of decimal

-- places.

genWithSeedDecimalFractions' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of decimal fractions requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The number of decimal places. Must be within the range [1, 14].

  -> IO (Either ClientError (RndResponse [Double]))
genWithSeedDecimalFractions' :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genWithSeedDecimalFractions' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
dps = ClientM (RndResponse [Double])
-> ClientEnv -> IO (Either ClientError (RndResponse [Double]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GenDecimalFractionsParams -> ClientM (RndResponse [Double])
generateDecimalFractions GenDecimalFractionsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenDecimalFractionsParams
params = GenDecimalFractionsParams
    { $sel:gdfp_apiKey:GenDecimalFractionsParams :: ApiKey
gdfp_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:gdfp_n:GenDecimalFractionsParams :: Int
gdfp_n                         = Int
n
    , $sel:gdfp_decimalPlaces:GenDecimalFractionsParams :: Int
gdfp_decimalPlaces             = Int
dps
    , $sel:gdfp_replacement:GenDecimalFractionsParams :: Bool
gdfp_replacement               = Bool
replacement
    , $sel:gdfp_pregeneratedRandomization:GenDecimalFractionsParams :: Maybe Seed
gdfp_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateDecimalFractions ::
     GenDecimalFractionsParams
  -> ClientM (RndResponse [Double])

-- |This method generates true random decimal fractions from a uniform

-- distribution across the interval [0, 1) with a user-defined number of decimal

-- places.

genSignedDecimalFractions ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of decimal fractions requested. Must be in the range

     -- [1, 10,000].

  -> Int
     -- ^ The number of decimal places. Must be within the range [1, 14].

  -> IO (ClientSigResponse [Double] GenDecimalFractionsParams)
genSignedDecimalFractions :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> IO (ClientSigResponse [Double] GenDecimalFractionsParams)
genSignedDecimalFractions Manager
mgr Key
key =
  Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> IO (ClientSigResponse [Double] GenDecimalFractionsParams)
genWithSeedSignedDecimalFractions Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random decimal fractions from a uniform

-- distribution across the interval [0, 1) with a user-defined number of decimal

-- places.

genWithSeedSignedDecimalFractions ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of decimal fractions requested. Must be in the range

     -- [1, 10,000].

  -> Int
     -- ^ The number of decimal places. Must be within the range [1, 14].

  -> IO (ClientSigResponse [Double] GenDecimalFractionsParams)
genWithSeedSignedDecimalFractions :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> IO (ClientSigResponse [Double] GenDecimalFractionsParams)
genWithSeedSignedDecimalFractions
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Maybe LicenseData
mLicenseData
    Maybe Object
mUserData
    Maybe TicketId
mTicketId
    Bool
replacement
    Int
n
    Int
dps
  = ClientM (SigRndResponse [Double] GenDecimalFractionsParams)
-> ClientEnv
-> IO (ClientSigResponse [Double] GenDecimalFractionsParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (GenSigDecimalFractionsParams
-> ClientM (SigRndResponse [Double] GenDecimalFractionsParams)
generateSignedDecimalFractions GenSigDecimalFractionsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
      (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigDecimalFractionsParams
params = GenSigDecimalFractionsParams
    { $sel:sgdfp_params:GenSigDecimalFractionsParams :: GenDecimalFractionsParams
sgdfp_params =
        GenDecimalFractionsParams
          { $sel:gdfp_apiKey:GenDecimalFractionsParams :: ApiKey
gdfp_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:gdfp_n:GenDecimalFractionsParams :: Int
gdfp_n                         = Int
n
          , $sel:gdfp_decimalPlaces:GenDecimalFractionsParams :: Int
gdfp_decimalPlaces             = Int
dps
          , $sel:gdfp_replacement:GenDecimalFractionsParams :: Bool
gdfp_replacement               = Bool
replacement
          , $sel:gdfp_pregeneratedRandomization:GenDecimalFractionsParams :: Maybe Seed
gdfp_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sgdfp_data:GenSigDecimalFractionsParams :: SignedData
sgdfp_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedDecimalFractions ::
     GenSigDecimalFractionsParams
  -> ClientM (SigRndResponse [Double] GenDecimalFractionsParams)

-- |This method generates true random numbers from a Gaussian distribution (also

-- known as a normal distribution). The method uses a Box-Muller Transform to

-- generate the Gaussian distribution from uniformly distributed numbers.  If

-- successful, the function yields the random data and the advised delay in

-- milliseconds.

genGaussians ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Int
     -- ^ The number of random numbers requested. Must be in the range [1,

     -- 10,000].

  -> Double
     -- ^ The mean. Must be in the range [-1,000,000, 1,000,000].

  -> Double
     -- ^ The standard deviation. Must be in the range [-1,000,000, 1,000,000].

  -> Int
     -- ^ The number of significant digits. Must be within the range [2, 14].

  -> IO (Maybe ([Double], Int))
genGaussians :: Manager
-> Key
-> Int
-> Double
-> Double
-> Int
-> IO (Maybe ([Double], Int))
genGaussians Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Int
-> Double
-> Double
-> Int
-> IO (Maybe ([Double], Int))
genWithSeedGaussians Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random numbers from a Gaussian distribution (also

-- known as a normal distribution). The method uses a Box-Muller Transform to

-- generate the Gaussian distribution from uniformly distributed numbers.

genGaussians' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Int
     -- ^ The number of random numbers requested. Must be in the range [1,

     -- 10,000].

  -> Double
     -- ^ The mean. Must be in the range [-1,000,000, 1,000,000].

  -> Double
     -- ^ The standard deviation. Must be in the range [-1,000,000, 1,000,000].

  -> Int
     -- ^ The number of significant digits. Must be within the range [2, 14].

  -> IO (Either ClientError (RndResponse [Double]))
genGaussians' :: Manager
-> Key
-> Int
-> Double
-> Double
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genGaussians' Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Int
-> Double
-> Double
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genWithSeedGaussians' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random numbers from a Gaussian distribution (also

-- known as a normal distribution). The method uses a Box-Muller Transform to

-- generate the Gaussian distribution from uniformly distributed numbers.  If

-- successful, the function yields the random data and the advised delay in

-- milliseconds.

genWithSeedGaussians ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Int      -- ^ The number of random numbers requested. Must be in the range

              --   [1, 10,000].

  -> Double   -- ^ The mean. Must be in the range [-1,000,000, 1,000,000].

  -> Double   -- ^ The standard deviation. Must be in the range [-1,000,000,

              --   1,000,000].

  -> Int      -- ^ The number of significant digits. Must be within the range

              --   [2, 14].

  -> IO (Maybe ([Double], Int))
genWithSeedGaussians :: Manager
-> Key
-> Maybe Seed
-> Int
-> Double
-> Double
-> Int
-> IO (Maybe ([Double], Int))
genWithSeedGaussians Manager
mgr Key
key Maybe Seed
mSeed Int
n Double
mean Double
sd Int
sds =
  Either ClientError (RndResponse [Double]) -> Maybe ([Double], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [Double])
 -> Maybe ([Double], Int))
-> IO (Either ClientError (RndResponse [Double]))
-> IO (Maybe ([Double], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager
-> Key
-> Maybe Seed
-> Int
-> Double
-> Double
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genWithSeedGaussians' Manager
mgr Key
key Maybe Seed
mSeed Int
n Double
mean Double
sd Int
sds

-- |This method generates true random numbers from a Gaussian distribution (also

-- known as a normal distribution). The method uses a Box-Muller Transform to

-- generate the Gaussian distribution from uniformly distributed numbers.

genWithSeedGaussians' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Int
     -- ^ The number of random numbers requested. Must be in the range [1,

     -- 10,000].

  -> Double
     -- ^ The mean. Must be in the range [-1,000,000, 1,000,000].

  -> Double
     -- ^ The standard deviation. Must be in the range [-1,000,000, 1,000,000].

  -> Int
     -- ^ The number of significant digits. Must be within the range [2, 14].

  -> IO (Either ClientError (RndResponse [Double]))
genWithSeedGaussians' :: Manager
-> Key
-> Maybe Seed
-> Int
-> Double
-> Double
-> Int
-> IO (Either ClientError (RndResponse [Double]))
genWithSeedGaussians' Manager
mgr Key
key Maybe Seed
mSeed Int
n Double
mean Double
sd Int
sds = ClientM (RndResponse [Double])
-> ClientEnv -> IO (Either ClientError (RndResponse [Double]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GenGaussiansParams -> ClientM (RndResponse [Double])
generateGaussians GenGaussiansParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenGaussiansParams
params = GenGaussiansParams
    { $sel:ggp_apiKey:GenGaussiansParams :: ApiKey
ggp_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:ggp_n:GenGaussiansParams :: Int
ggp_n                         = Int
n
    , $sel:ggp_mean:GenGaussiansParams :: Double
ggp_mean                      = Double
mean
    , $sel:ggp_standardDeviation:GenGaussiansParams :: Double
ggp_standardDeviation         = Double
sd
    , $sel:ggp_significantDigits:GenGaussiansParams :: Int
ggp_significantDigits         = Int
sds
    , $sel:ggp_pregeneratedRandomization:GenGaussiansParams :: Maybe Seed
ggp_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateGaussians :: GenGaussiansParams -> ClientM (RndResponse [Double])

-- |This method generates true random numbers from a Gaussian distribution (also

-- known as a normal distribution). The method uses a Box-Muller Transform to

-- generate the Gaussian distribution from uniformly distributed numbers.

genSignedGaussians ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Int
     -- ^ The number of random numbers requested. Must be in the range

     -- [1, 10,000].

  -> Double
     -- ^ The mean. Must be in the range [-1,000,000, 1,000,000].

  -> Double
     -- ^ The standard deviation. Must be in the range [-1,000,000, 1,000,000].

  -> Int
     -- ^ The number of significant digits. Must be within the range [2, 14].

  -> IO (ClientSigResponse [Double] GenGaussiansParams)
genSignedGaussians :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> Double
-> Double
-> Int
-> IO (ClientSigResponse [Double] GenGaussiansParams)
genSignedGaussians Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> Double
-> Double
-> Int
-> IO (ClientSigResponse [Double] GenGaussiansParams)
genWithSeedSignedGaussians Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random numbers from a Gaussian distribution (also

-- known as a normal distribution). The method uses a Box-Muller Transform to

-- generate the Gaussian distribution from uniformly distributed numbers.

genWithSeedSignedGaussians ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Int
     -- ^ The number of random numbers requested. Must be in the range

     -- [1, 10,000].

  -> Double
     -- ^ The mean. Must be in the range [-1,000,000, 1,000,000].

  -> Double
     -- ^ The standard deviation. Must be in the range [-1,000,000, 1,000,000].

  -> Int
     -- ^ The number of significant digits. Must be within the range [2, 14].

  -> IO (ClientSigResponse [Double] GenGaussiansParams)
genWithSeedSignedGaussians :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> Double
-> Double
-> Int
-> IO (ClientSigResponse [Double] GenGaussiansParams)
genWithSeedSignedGaussians
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Maybe LicenseData
mLicenseData
    Maybe Object
mUserData
    Maybe TicketId
mTicketId
    Int
n
    Double
mean
    Double
sd
    Int
sds
  = ClientM (SigRndResponse [Double] GenGaussiansParams)
-> ClientEnv -> IO (ClientSigResponse [Double] GenGaussiansParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (GenSigGaussiansParams
-> ClientM (SigRndResponse [Double] GenGaussiansParams)
generateSignedGaussians GenSigGaussiansParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
      (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigGaussiansParams
params = GenSigGaussiansParams
    { $sel:sggp_params:GenSigGaussiansParams :: GenGaussiansParams
sggp_params =
        GenGaussiansParams
          { $sel:ggp_apiKey:GenGaussiansParams :: ApiKey
ggp_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:ggp_n:GenGaussiansParams :: Int
ggp_n                         = Int
n
          , $sel:ggp_mean:GenGaussiansParams :: Double
ggp_mean                      = Double
mean
          , $sel:ggp_standardDeviation:GenGaussiansParams :: Double
ggp_standardDeviation         = Double
sd
          , $sel:ggp_significantDigits:GenGaussiansParams :: Int
ggp_significantDigits         = Int
sds
          , $sel:ggp_pregeneratedRandomization:GenGaussiansParams :: Maybe Seed
ggp_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sggp_data:GenSigGaussiansParams :: SignedData
sggp_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedGaussians ::
     GenSigGaussiansParams
  -> ClientM (SigRndResponse [Double] GenGaussiansParams)

-- |This method generates true random strings. If successful, the function

-- yields the random data and the advised delay in milliseconds.

genStrings ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of random strings requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The length of each string. Must be in the range [1, 32].

  -> [Char]
     -- ^ The set of characters that are allowed to occur in the random strings.

     -- The maximum number of characters is 128.

  -> IO (Maybe ([Text], Int))
genStrings :: Manager
-> Key -> Bool -> Int -> Int -> String -> IO (Maybe ([Text], Int))
genStrings Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> String
-> IO (Maybe ([Text], Int))
genWithSeedStrings Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random strings.

genStrings' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of random strings requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The length of each string. Must be in the range [1, 32].

  -> [Char]
     -- ^ The set of characters that are allowed to occur in the random strings.

     -- The maximum number of characters is 128.

  -> IO (Either ClientError (RndResponse [Text]))
genStrings' :: Manager
-> Key
-> Bool
-> Int
-> Int
-> String
-> IO (Either ClientError (RndResponse [Text]))
genStrings' Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> String
-> IO (Either ClientError (RndResponse [Text]))
genWithSeedStrings' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random strings. If successful, the function

-- yields the random data and the advised delay in milliseconds.

genWithSeedStrings ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of random strings requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The length of each string. Must be in the range [1, 32].

  -> [Char]
     -- ^ The set of characters that are allowed to occur in the random strings.

     -- The maximum number of characters is 128.

  -> IO (Maybe ([Text], Int))
genWithSeedStrings :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> String
-> IO (Maybe ([Text], Int))
genWithSeedStrings Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
l String
cs =
  Either ClientError (RndResponse [Text]) -> Maybe ([Text], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [Text]) -> Maybe ([Text], Int))
-> IO (Either ClientError (RndResponse [Text]))
-> IO (Maybe ([Text], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> String
-> IO (Either ClientError (RndResponse [Text]))
genWithSeedStrings' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
l String
cs

-- |This method generates true random strings.

genWithSeedStrings' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of random strings requested. Must be in the range [1,

     -- 10,000].

  -> Int
     -- ^ The length of each string. Must be in the range [1, 32].

  -> [Char]
     -- ^ The set of characters that are allowed to occur in the random strings.

     -- The maximum number of characters is 128.

  -> IO (Either ClientError (RndResponse [Text]))
genWithSeedStrings' :: Manager
-> Key
-> Maybe Seed
-> Bool
-> Int
-> Int
-> String
-> IO (Either ClientError (RndResponse [Text]))
genWithSeedStrings' Manager
mgr Key
key Maybe Seed
mSeed Bool
replacement Int
n Int
l String
cs = ClientM (RndResponse [Text])
-> ClientEnv -> IO (Either ClientError (RndResponse [Text]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GenStringsParams -> ClientM (RndResponse [Text])
generateStrings GenStringsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenStringsParams
params = GenStringsParams
    { $sel:gsp_apiKey:GenStringsParams :: ApiKey
gsp_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:gsp_n:GenStringsParams :: Int
gsp_n                         = Int
n
    , $sel:gsp_length:GenStringsParams :: Int
gsp_length                    = Int
l
    , $sel:gsp_characters:GenStringsParams :: String
gsp_characters                = String
cs
    , $sel:gsp_replacement:GenStringsParams :: Bool
gsp_replacement               = Bool
replacement
    , $sel:gsp_pregeneratedRandomization:GenStringsParams :: Maybe Seed
gsp_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateStrings :: GenStringsParams -> ClientM (RndResponse [Text])

-- |This method generates true random strings.

genSignedStrings ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of random strings requested. Must be in the range

     -- [1, 10,000].

  -> Int
     -- ^ The length of each string. Must be in the range [1, 32].

  -> [Char]
     -- ^ The set of characters that are allowed to occur in the random strings.

     -- The maximum number of characters is 128.

  -> IO (ClientSigResponse [Text] GenStringsParams)
genSignedStrings :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> String
-> IO (ClientSigResponse [Text] GenStringsParams)
genSignedStrings Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> String
-> IO (ClientSigResponse [Text] GenStringsParams)
genWithSeedSignedStrings Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random strings.

genWithSeedSignedStrings ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Bool
     -- ^ With replacement?

  -> Int
     -- ^ The number of random strings requested. Must be in the range

     -- [1, 10,000].

  -> Int
     -- ^ The length of each string. Must be in the range [1, 32].

  -> [Char]
     -- ^ The set of characters that are allowed to occur in the random strings.

     -- The maximum number of characters is 128.

  -> IO (ClientSigResponse [Text] GenStringsParams)
genWithSeedSignedStrings :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Bool
-> Int
-> Int
-> String
-> IO (ClientSigResponse [Text] GenStringsParams)
genWithSeedSignedStrings
    Manager
mgr
    Key
key
    Maybe Seed
mSeed
    Maybe LicenseData
mLicenseData
    Maybe Object
mUserData
    Maybe TicketId
mTicketId
    Bool
replacement
    Int
n
    Int
l
    String
cs
  = ClientM (SigRndResponse [Text] GenStringsParams)
-> ClientEnv -> IO (ClientSigResponse [Text] GenStringsParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
      (GenSigStringsParams
-> ClientM (SigRndResponse [Text] GenStringsParams)
generateSignedStrings GenSigStringsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
      (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
      (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
      (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigStringsParams
params = GenSigStringsParams
    { $sel:sgsp_params:GenSigStringsParams :: GenStringsParams
sgsp_params =
        GenStringsParams
          { $sel:gsp_apiKey:GenStringsParams :: ApiKey
gsp_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:gsp_n:GenStringsParams :: Int
gsp_n                         = Int
n
          , $sel:gsp_length:GenStringsParams :: Int
gsp_length                    = Int
l
          , $sel:gsp_characters:GenStringsParams :: String
gsp_characters                = String
cs
          , $sel:gsp_replacement:GenStringsParams :: Bool
gsp_replacement               = Bool
replacement
          , $sel:gsp_pregeneratedRandomization:GenStringsParams :: Maybe Seed
gsp_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sgsp_data:GenSigStringsParams :: SignedData
sgsp_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedStrings ::
     GenSigStringsParams
  -> ClientM (SigRndResponse [Text] GenStringsParams)

-- |This method generates true random version 4 Universally Unique IDentifiers

-- (UUIDs) in accordance with section 4.4 of RFC 4122. If successful, the

-- function yields the random data and the advised delay in milliseconds.

genUUIDs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Int
     -- ^ The number of random UUIDs requested. Must be in the range [1,

     -- 10,000].

  -> IO (Maybe ([UUID], Int))
genUUIDs :: Manager -> Key -> Int -> IO (Maybe ([UUID], Int))
genUUIDs Manager
mgr Key
key = Manager -> Key -> Maybe Seed -> Int -> IO (Maybe ([UUID], Int))
genWithSeedUUIDs Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random version 4 Universally Unique IDentifiers

-- (UUIDs) in accordance with section 4.4 of RFC 4122.

genUUIDs' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Int
     -- ^ The number of random UUIDs requested. Must be in the range [1,

     -- 10,000].

  -> IO (Either ClientError (RndResponse [UUID]))
genUUIDs' :: Manager
-> Key -> Int -> IO (Either ClientError (RndResponse [UUID]))
genUUIDs' Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Int
-> IO (Either ClientError (RndResponse [UUID]))
genWithSeedUUIDs' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random version 4 Universally Unique IDentifiers

-- (UUIDs) in accordance with section 4.4 of RFC 4122. If successful, the

-- function yields the random data and the advised delay in milliseconds.

genWithSeedUUIDs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Int
     -- ^ The number of random UUIDs requested. Must be in the range [1,

     -- 10,000].

  -> IO (Maybe ([UUID], Int))
genWithSeedUUIDs :: Manager -> Key -> Maybe Seed -> Int -> IO (Maybe ([UUID], Int))
genWithSeedUUIDs Manager
mgr Key
key Maybe Seed
mSeed Int
n = Either ClientError (RndResponse [UUID]) -> Maybe ([UUID], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [UUID]) -> Maybe ([UUID], Int))
-> IO (Either ClientError (RndResponse [UUID]))
-> IO (Maybe ([UUID], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager
-> Key
-> Maybe Seed
-> Int
-> IO (Either ClientError (RndResponse [UUID]))
genWithSeedUUIDs' Manager
mgr Key
key Maybe Seed
mSeed Int
n

-- |This method generates true random version 4 Universally Unique IDentifiers

-- (UUIDs) in accordance with section 4.4 of RFC 4122.

genWithSeedUUIDs' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Int
     -- ^ The number of random UUIDs requested. Must be in the range [1,

     -- 10,000].

  -> IO (Either ClientError (RndResponse [UUID]))
genWithSeedUUIDs' :: Manager
-> Key
-> Maybe Seed
-> Int
-> IO (Either ClientError (RndResponse [UUID]))
genWithSeedUUIDs' Manager
mgr Key
key Maybe Seed
mSeed Int
n = ClientM (RndResponse [UUID])
-> ClientEnv -> IO (Either ClientError (RndResponse [UUID]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GenUUIDsParams -> ClientM (RndResponse [UUID])
generateUUIDs GenUUIDsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenUUIDsParams
params = GenUUIDsParams
    { $sel:gup_apiKey:GenUUIDsParams :: ApiKey
gup_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:gup_n:GenUUIDsParams :: Int
gup_n                         = Int
n
    , $sel:gup_pregeneratedRandomization:GenUUIDsParams :: Maybe Seed
gup_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateUUIDs :: GenUUIDsParams -> ClientM (RndResponse [UUID])

-- |This method generates true random version 4 Universally Unique IDentifiers

-- (UUIDs) in accordance with section 4.4 of RFC 4122.

genSignedUUIDs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Int
     -- ^ The number of random UUIDs requested. Must be in the range

     -- [1, 10,000].

  -> IO (ClientSigResponse [UUID] GenUUIDsParams)
genSignedUUIDs :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> IO (ClientSigResponse [UUID] GenUUIDsParams)
genSignedUUIDs Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> IO (ClientSigResponse [UUID] GenUUIDsParams)
genWithSeedSignedUUIDs Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random version 4 Universally Unique IDentifiers

-- (UUIDs) in accordance with section 4.4 of RFC 4122.

genWithSeedSignedUUIDs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Int
     -- ^ The number of random UUIDs requested. Must be in the range

     -- [1, 10,000].

  -> IO (ClientSigResponse [UUID] GenUUIDsParams)
genWithSeedSignedUUIDs :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> IO (ClientSigResponse [UUID] GenUUIDsParams)
genWithSeedSignedUUIDs Manager
mgr Key
key Maybe Seed
mSeed Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId Int
n =
  ClientM (SigRndResponse [UUID] GenUUIDsParams)
-> ClientEnv -> IO (ClientSigResponse [UUID] GenUUIDsParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
    (GenSigUUIDsParams -> ClientM (SigRndResponse [UUID] GenUUIDsParams)
generateSignedUUIDs GenSigUUIDsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
    (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
    (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
    (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigUUIDsParams
params = GenSigUUIDsParams
    { $sel:sgup_params:GenSigUUIDsParams :: GenUUIDsParams
sgup_params =
        GenUUIDsParams
          { $sel:gup_apiKey:GenUUIDsParams :: ApiKey
gup_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:gup_n:GenUUIDsParams :: Int
gup_n                         = Int
n
          , $sel:gup_pregeneratedRandomization:GenUUIDsParams :: Maybe Seed
gup_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sgup_data:GenSigUUIDsParams :: SignedData
sgup_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedUUIDs ::
     GenSigUUIDsParams
  -> ClientM (SigRndResponse [UUID] GenUUIDsParams)

-- |This method generates true random Binary Large OBjects (BLOBs). The total

-- size of all BLOBs requested must not exceed 131,072 bytes (128 kilobytes).

-- If successful, the function yields the random data and the advised delay in

-- milliseconds.

genBlobs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Int
     -- ^ The number of random BLOBs requested. Must be in the range [1, 100].

  -> Int
     -- ^ The size of each blob, measured in bytes. Must be in the range [1,

     -- 131,072].

  -> BlobFormat
     -- ^ The format of the BLOBs.

  -> IO (Maybe ([Blob], Int))
genBlobs :: Manager
-> Key -> Int -> Int -> BlobFormat -> IO (Maybe ([Blob], Int))
genBlobs Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Int
-> Int
-> BlobFormat
-> IO (Maybe ([Blob], Int))
genWithSeedBlobs Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random Binary Large OBjects (BLOBs). The total

-- size of all BLOBs requested must not exceed 131,072 bytes (128 kilobytes).

genBlobs' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Int
     -- ^ The number of random BLOBs requested. Must be in the range [1, 100].

  -> Int
     -- ^ The size of each blob, measured in bytes (not bits). Must be in the

     -- range [1, 131,072].

  -> BlobFormat
     -- ^ The format of the BLOBs.

  -> IO (Either ClientError (RndResponse [Blob]))
genBlobs' :: Manager
-> Key
-> Int
-> Int
-> BlobFormat
-> IO (Either ClientError (RndResponse [Blob]))
genBlobs' Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Int
-> Int
-> BlobFormat
-> IO (Either ClientError (RndResponse [Blob]))
genWithSeedBlobs' Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random Binary Large OBjects (BLOBs). The total

-- size of all BLOBs requested must not exceed 131,072 bytes (128 kilobytes).

-- If successful, the function yields the random data and the advised delay in

-- milliseconds.

genWithSeedBlobs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Int
     -- ^ The number of random BLOBs requested. Must be in the range [1, 100].

  -> Int
     -- ^ The size of each blob, measured in bytes. Must be in the range [1,

     -- 131,072].

  -> BlobFormat
     -- ^ The format of the BLOBs.

  -> IO (Maybe ([Blob], Int))
genWithSeedBlobs :: Manager
-> Key
-> Maybe Seed
-> Int
-> Int
-> BlobFormat
-> IO (Maybe ([Blob], Int))
genWithSeedBlobs Manager
mgr Key
key Maybe Seed
mSeed Int
n Int
s BlobFormat
f =
  Either ClientError (RndResponse [Blob]) -> Maybe ([Blob], Int)
forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Either ClientError (RndResponse [Blob]) -> Maybe ([Blob], Int))
-> IO (Either ClientError (RndResponse [Blob]))
-> IO (Maybe ([Blob], Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager
-> Key
-> Maybe Seed
-> Int
-> Int
-> BlobFormat
-> IO (Either ClientError (RndResponse [Blob]))
genWithSeedBlobs' Manager
mgr Key
key Maybe Seed
mSeed Int
n Int
s BlobFormat
f

-- |This method generates true random Binary Large OBjects (BLOBs). The total

-- size of all BLOBs requested must not exceed 131,072 bytes (128 kilobytes).

genWithSeedBlobs' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Int
     -- ^ The number of random BLOBs requested. Must be in the range [1, 100].

  -> Int
     -- ^ The size of each blob, measured in bytes (not bits). Must be in the

     -- range [1, 131,072].

  -> BlobFormat
     -- ^ The format of the BLOBs.

  -> IO (Either ClientError (RndResponse [Blob]))
genWithSeedBlobs' :: Manager
-> Key
-> Maybe Seed
-> Int
-> Int
-> BlobFormat
-> IO (Either ClientError (RndResponse [Blob]))
genWithSeedBlobs' Manager
mgr Key
key Maybe Seed
mSeed Int
n Int
s BlobFormat
f = ClientM (RndResponse [Blob])
-> ClientEnv -> IO (Either ClientError (RndResponse [Blob]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GenBlobsParams -> ClientM (RndResponse [Blob])
generateBlobs GenBlobsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenBlobsParams
params = GenBlobsParams
    { $sel:gbp_apiKey:GenBlobsParams :: ApiKey
gbp_apiKey                    = Key -> ApiKey
ApiKey Key
key
    , $sel:gbp_n:GenBlobsParams :: Int
gbp_n                         = Int
n
    , $sel:gbp_size:GenBlobsParams :: Int
gbp_size                      = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
    , $sel:gbp_format:GenBlobsParams :: BlobFormat
gbp_format                    = BlobFormat
f
    , $sel:gbp_pregeneratedRandomization:GenBlobsParams :: Maybe Seed
gbp_pregeneratedRandomization = Maybe Seed
mSeed
    }

generateBlobs :: GenBlobsParams -> ClientM (RndResponse [Blob])

-- |This method generates true random Binary Large OBjects (BLOBs). The total

-- size of all BLOBs requested must not exceed 131,072 bytes (128 kilobytes).

genSignedBlobs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Int
     -- ^ The number of random BLOBs requested. Must be in the range [1, 100].

  -> Int
     -- ^ The size of each blob, measured in bytes (not bits). Must be in the

     -- range [1, 131,072].

  -> BlobFormat
     -- ^ The format of the BLOBs.

  -> IO (ClientSigResponse [Blob] GenBlobsParams)
genSignedBlobs :: Manager
-> Key
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> Int
-> BlobFormat
-> IO (ClientSigResponse [Blob] GenBlobsParams)
genSignedBlobs Manager
mgr Key
key = Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> Int
-> BlobFormat
-> IO (ClientSigResponse [Blob] GenBlobsParams)
genWithSeedSignedBlobs Manager
mgr Key
key Maybe Seed
forall a. Maybe a
Nothing

-- |This method generates true random Binary Large OBjects (BLOBs). The total

-- size of all BLOBs requested must not exceed 131,072 bytes (128 kilobytes).

genWithSeedSignedBlobs ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Maybe Seed
     -- ^ The optional seed.

  -> Maybe LicenseData
     -- ^ Data, if any, of relevance to the license that is associated with the

     -- API key.

  -> Maybe Object
     -- ^ Optional user data to be included in the signed response.

  -> Maybe TicketId
     -- ^ Optional unique ticket ID. Can be used only once.

  -> Int
     -- ^ The number of random BLOBs requested. Must be in the range [1, 100].

  -> Int
     -- ^ The size of each blob, measured in bytes (not bits). Must be in the

     -- range [1, 131,072].

  -> BlobFormat
     -- ^ The format of the BLOBs.

  -> IO (ClientSigResponse [Blob] GenBlobsParams)
genWithSeedSignedBlobs :: Manager
-> Key
-> Maybe Seed
-> Maybe LicenseData
-> Maybe Object
-> Maybe TicketId
-> Int
-> Int
-> BlobFormat
-> IO (ClientSigResponse [Blob] GenBlobsParams)
genWithSeedSignedBlobs Manager
mgr Key
key Maybe Seed
mSeed Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId Int
n Int
s BlobFormat
f =
  ClientM (SigRndResponse [Blob] GenBlobsParams)
-> ClientEnv -> IO (ClientSigResponse [Blob] GenBlobsParams)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
    (GenSigBlobsParams -> ClientM (SigRndResponse [Blob] GenBlobsParams)
generateSignedBlobs GenSigBlobsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
    (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
    (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
    (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GenSigBlobsParams
params = GenSigBlobsParams
    { $sel:sgbp_params:GenSigBlobsParams :: GenBlobsParams
sgbp_params =
        GenBlobsParams
          { $sel:gbp_apiKey:GenBlobsParams :: ApiKey
gbp_apiKey                    = Key -> ApiKey
ApiKey Key
key
          , $sel:gbp_n:GenBlobsParams :: Int
gbp_n                         = Int
n
          , $sel:gbp_size:GenBlobsParams :: Int
gbp_size                      = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
          , $sel:gbp_format:GenBlobsParams :: BlobFormat
gbp_format                    = BlobFormat
f
          , $sel:gbp_pregeneratedRandomization:GenBlobsParams :: Maybe Seed
gbp_pregeneratedRandomization = Maybe Seed
mSeed
          }
    , $sel:sgbp_data:GenSigBlobsParams :: SignedData
sgbp_data =
        Maybe LicenseData -> Maybe Object -> Maybe TicketId -> SignedData
SignedData Maybe LicenseData
mLicenseData Maybe Object
mUserData Maybe TicketId
mTicketId
    }

generateSignedBlobs ::
     GenSigBlobsParams
  -> ClientM (SigRndResponse [Blob] GenBlobsParams)

-- |Helper function to help simplify method functions

toMaybe :: Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe :: forall a. Either ClientError (RndResponse a) -> Maybe (a, Int)
toMaybe (Right (Result Word64
_ RandomResponse a
result')) =
  (a, Int) -> Maybe (a, Int)
forall a. a -> Maybe a
Just (RandomResponse a -> a
forall a. RandomResponse a -> a
randomData RandomResponse a
result', RandomResponse a -> Int
forall a. RandomResponse a -> Int
advisoryDelay RandomResponse a
result')
toMaybe Either ClientError (RndResponse a)
_                          = Maybe (a, Int)
forall a. Maybe a
Nothing

-- | Retrieve a previously generated result from its serial number.

getResult ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key.

  -> Int
     -- ^ The serial number.

  -> IO (Either ClientError (JsonRpcResponse Value GetResultResponse))
getResult :: Manager
-> Key
-> Int
-> IO
     (Either ClientError (JsonRpcResponse Value GetResultResponse))
getResult Manager
mgr Key
key Int
serialNumber = ClientM (JsonRpcResponse Value GetResultResponse)
-> ClientEnv
-> IO
     (Either ClientError (JsonRpcResponse Value GetResultResponse))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GetResultParams
-> ClientM (JsonRpcResponse Value GetResultResponse)
getResult' GetResultParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GetResultParams
params = GetResultParams
    { $sel:grp_apiKey:GetResultParams :: Key
grp_apiKey = Key
key
    , $sel:grp_serialNumber:GetResultParams :: Int
grp_serialNumber = Int
serialNumber
    }

getResult' ::
     GetResultParams
  -> ClientM (JsonRpcResponse Value GetResultResponse)

-- | Create unique tickets for use with the Signed API.

createTickets ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key

  -> Int
     -- ^ The number of tickets requested. Must be in the range [1, 50].

  -> Bool
     -- ^ Make full information about the ticket available?

  -> IO [TicketResponse]
createTickets :: Manager -> Key -> Int -> Bool -> IO [TicketResponse]
createTickets Manager
mgr Key
key Int
n Bool
showResult =
  Manager
-> Key
-> Int
-> Bool
-> IO
     (Either ClientError (JsonRpcResponse Value CreateTicketsResponse))
createTickets' Manager
mgr Key
key Int
n Bool
showResult IO
  (Either ClientError (JsonRpcResponse Value CreateTicketsResponse))
-> (Either
      ClientError (JsonRpcResponse Value CreateTicketsResponse)
    -> IO [TicketResponse])
-> IO [TicketResponse]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Result Word64
_ (CreateTicketsResponse [TicketResponse]
ticketResponses)) ->
      [TicketResponse] -> IO [TicketResponse]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TicketResponse]
ticketResponses
    Either ClientError (JsonRpcResponse Value CreateTicketsResponse)
_ -> [TicketResponse] -> IO [TicketResponse]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Create unique tickets for use with the Signed API.

createTickets' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key

  -> Int
     -- ^ The number of tickets requested. Must be in the range [1, 50].

  -> Bool
     -- ^ Make full information about the ticket available?

  -> IO (Either ClientError (JsonRpcResponse Value CreateTicketsResponse))
createTickets' :: Manager
-> Key
-> Int
-> Bool
-> IO
     (Either ClientError (JsonRpcResponse Value CreateTicketsResponse))
createTickets' Manager
mgr Key
key Int
n Bool
showResult = ClientM (JsonRpcResponse Value CreateTicketsResponse)
-> ClientEnv
-> IO
     (Either ClientError (JsonRpcResponse Value CreateTicketsResponse))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (CreateTicketsParams
-> ClientM (JsonRpcResponse Value CreateTicketsResponse)
createTickets'' CreateTicketsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: CreateTicketsParams
params = CreateTicketsParams
    { $sel:ctp_apiKey:CreateTicketsParams :: Key
ctp_apiKey = Key
key
    , $sel:ctp_n:CreateTicketsParams :: Int
ctp_n = Int
n
    , $sel:ctp_showResult:CreateTicketsParams :: Bool
ctp_showResult = Bool
showResult
    }

createTickets'' ::
     CreateTicketsParams
  -> ClientM (JsonRpcResponse Value CreateTicketsResponse)

-- | This method enables other methods to reveal greater information about the

-- given ticket.

revealTickets ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key

  -> TicketId
     -- ^ The ticketId to reveal.

  -> IO (Maybe Int)
revealTickets :: Manager -> Key -> TicketId -> IO (Maybe Int)
revealTickets Manager
mgr Key
key TicketId
ticketId =
  Manager
-> Key
-> TicketId
-> IO
     (Either ClientError (JsonRpcResponse Value RevealTicketsResponse))
revealTickets' Manager
mgr Key
key TicketId
ticketId IO
  (Either ClientError (JsonRpcResponse Value RevealTicketsResponse))
-> (Either
      ClientError (JsonRpcResponse Value RevealTicketsResponse)
    -> IO (Maybe Int))
-> IO (Maybe Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Result Word64
_ (RevealTicketsResponse Int
ticketCount)) ->
      Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ticketCount
    Either ClientError (JsonRpcResponse Value RevealTicketsResponse)
_ -> Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing

-- | This method enables other methods to reveal greater information about the

-- given ticket.

revealTickets' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key

  -> TicketId
     -- ^ The ticketId to reveal.

  -> IO (Either ClientError (JsonRpcResponse Value RevealTicketsResponse))
revealTickets' :: Manager
-> Key
-> TicketId
-> IO
     (Either ClientError (JsonRpcResponse Value RevealTicketsResponse))
revealTickets' Manager
mgr Key
key TicketId
ticketId = ClientM (JsonRpcResponse Value RevealTicketsResponse)
-> ClientEnv
-> IO
     (Either ClientError (JsonRpcResponse Value RevealTicketsResponse))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (RevealTicketsParams
-> ClientM (JsonRpcResponse Value RevealTicketsResponse)
revealTickets'' RevealTicketsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: RevealTicketsParams
params = RevealTicketsParams
    { $sel:rtp_apiKey:RevealTicketsParams :: Key
rtp_apiKey = Key
key
    , $sel:rtp_ticketId:RevealTicketsParams :: TicketId
rtp_ticketId = TicketId
ticketId
    }

revealTickets'' ::
     RevealTicketsParams
  -> ClientM (JsonRpcResponse Value RevealTicketsResponse)

-- | This method enables other methods to reveal greater information about the

-- given ticket.

listTickets ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key

  -> TicketType
     -- ^ The type of tickets to obtain information about.

  -> IO [TicketInfoResponse]
listTickets :: Manager -> Key -> TicketType -> IO [TicketInfoResponse]
listTickets Manager
mgr Key
key TicketType
ticketType =
  Manager
-> Key
-> TicketType
-> IO
     (Either ClientError (JsonRpcResponse Value [TicketInfoResponse]))
listTickets' Manager
mgr Key
key TicketType
ticketType IO
  (Either ClientError (JsonRpcResponse Value [TicketInfoResponse]))
-> (Either ClientError (JsonRpcResponse Value [TicketInfoResponse])
    -> IO [TicketInfoResponse])
-> IO [TicketInfoResponse]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Result Word64
_ [TicketInfoResponse]
listTicketsResponses) ->
      [TicketInfoResponse] -> IO [TicketInfoResponse]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TicketInfoResponse]
listTicketsResponses
    Either ClientError (JsonRpcResponse Value [TicketInfoResponse])
_ -> [TicketInfoResponse] -> IO [TicketInfoResponse]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | This method enables other methods to reveal greater information about the

-- given ticket.

listTickets' ::
     Manager
     -- ^ The connection manager.

  -> Key
     -- ^ The API key

  -> TicketType
     -- ^ The type of tickets to obtain information about.

  -> IO (Either ClientError (JsonRpcResponse Value [TicketInfoResponse]))
listTickets' :: Manager
-> Key
-> TicketType
-> IO
     (Either ClientError (JsonRpcResponse Value [TicketInfoResponse]))
listTickets' Manager
mgr Key
key TicketType
ticketType = ClientM (JsonRpcResponse Value [TicketInfoResponse])
-> ClientEnv
-> IO
     (Either ClientError (JsonRpcResponse Value [TicketInfoResponse]))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (ListTicketsParams
-> ClientM (JsonRpcResponse Value [TicketInfoResponse])
listTickets'' ListTicketsParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: ListTicketsParams
params = ListTicketsParams
    { $sel:ltp_apiKey:ListTicketsParams :: Key
ltp_apiKey = Key
key
    , $sel:ltp_ticketType:ListTicketsParams :: TicketType
ltp_ticketType = TicketType
ticketType
    }

listTickets'' ::
     ListTicketsParams
  -> ClientM (JsonRpcResponse Value [TicketInfoResponse])

-- | This method yields information about the given ticket.

getTicket ::
     Manager
     -- ^ The connection manager.

  -> TicketId
     -- ^ The ticket to obtain information about.

  -> IO (Maybe TicketInfoResponse)
getTicket :: Manager -> TicketId -> IO (Maybe TicketInfoResponse)
getTicket Manager
mgr TicketId
ticketId =
  Manager
-> TicketId
-> IO
     (Either ClientError (JsonRpcResponse Value TicketInfoResponse))
getTicket' Manager
mgr TicketId
ticketId IO (Either ClientError (JsonRpcResponse Value TicketInfoResponse))
-> (Either ClientError (JsonRpcResponse Value TicketInfoResponse)
    -> IO (Maybe TicketInfoResponse))
-> IO (Maybe TicketInfoResponse)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Result Word64
_ TicketInfoResponse
ticketInfoResponse) ->
      Maybe TicketInfoResponse -> IO (Maybe TicketInfoResponse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TicketInfoResponse -> IO (Maybe TicketInfoResponse))
-> Maybe TicketInfoResponse -> IO (Maybe TicketInfoResponse)
forall a b. (a -> b) -> a -> b
$ TicketInfoResponse -> Maybe TicketInfoResponse
forall a. a -> Maybe a
Just TicketInfoResponse
ticketInfoResponse
    Either ClientError (JsonRpcResponse Value TicketInfoResponse)
_ -> Maybe TicketInfoResponse -> IO (Maybe TicketInfoResponse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TicketInfoResponse
forall a. Maybe a
Nothing

-- | This method yields information about the given ticket.

getTicket' ::
     Manager
     -- ^ The connection manager.

  -> TicketId
     -- ^ The ticket to obtain information about.

  -> IO (Either ClientError (JsonRpcResponse Value TicketInfoResponse))
getTicket' :: Manager
-> TicketId
-> IO
     (Either ClientError (JsonRpcResponse Value TicketInfoResponse))
getTicket' Manager
mgr TicketId
ticketId = ClientM (JsonRpcResponse Value TicketInfoResponse)
-> ClientEnv
-> IO
     (Either ClientError (JsonRpcResponse Value TicketInfoResponse))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (GetTicketParams
-> ClientM (JsonRpcResponse Value TicketInfoResponse)
getTicket'' GetTicketParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GetTicketParams
params = GetTicketParams
    { $sel:gtp_ticketId:GetTicketParams :: TicketId
gtp_ticketId = TicketId
ticketId
    }

getTicket'' ::
     GetTicketParams
  -> ClientM (JsonRpcResponse Value TicketInfoResponse)

-- | This method verifies a response from the Signed API.

verifySignedResponse ::
     (ToJSON a, ToJSON b)
  => Manager
     -- ^ The connection manager.

  -> SignedRandomResponse a b
     -- ^ The ticket to obtain information about.

  -> IO (Maybe Bool)
verifySignedResponse :: forall a b.
(ToJSON a, ToJSON b) =>
Manager -> SignedRandomResponse a b -> IO (Maybe Bool)
verifySignedResponse Manager
mgr SignedRandomResponse a b
srr =
   Manager
-> SignedRandomResponse a b
-> IO
     (Either
        ClientError (JsonRpcResponse Value VerifySignatureResponse))
forall a b.
(ToJSON a, ToJSON b) =>
Manager
-> SignedRandomResponse a b
-> IO
     (Either
        ClientError (JsonRpcResponse Value VerifySignatureResponse))
verifySignedResponse' Manager
mgr SignedRandomResponse a b
srr IO
  (Either
     ClientError (JsonRpcResponse Value VerifySignatureResponse))
-> (Either
      ClientError (JsonRpcResponse Value VerifySignatureResponse)
    -> IO (Maybe Bool))
-> IO (Maybe Bool)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Result Word64
_ VerifySignatureResponse
vsr) ->
      Maybe Bool -> IO (Maybe Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ VerifySignatureResponse -> Bool
vsr_authenticity VerifySignatureResponse
vsr
    Either ClientError (JsonRpcResponse Value VerifySignatureResponse)
_ -> Maybe Bool -> IO (Maybe Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing

-- | This method verifies a response from the Signed API.

verifySignedResponse' ::
     (ToJSON a, ToJSON b)
  => Manager
     -- ^ The connection mannager.

  -> SignedRandomResponse a b
     -- ^ The ticket to obtain information about.

  -> IO (Either ClientError (JsonRpcResponse Value VerifySignatureResponse))
verifySignedResponse' :: forall a b.
(ToJSON a, ToJSON b) =>
Manager
-> SignedRandomResponse a b
-> IO
     (Either
        ClientError (JsonRpcResponse Value VerifySignatureResponse))
verifySignedResponse' Manager
mgr SignedRandomResponse a b
srr = ClientM (JsonRpcResponse Value VerifySignatureResponse)
-> ClientEnv
-> IO
     (Either
        ClientError (JsonRpcResponse Value VerifySignatureResponse))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (VerifySignatureParams
-> ClientM (JsonRpcResponse Value VerifySignatureResponse)
verifySignature VerifySignatureParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: VerifySignatureParams
params = VerifySignatureParams
    { $sel:vsp_random:VerifySignatureParams :: Value
vsp_random = SignedRandomResponse a b -> Value
forall a b.
(ToJSON a, ToJSON b) =>
SignedRandomResponse a b -> Value
toJSONRandom SignedRandomResponse a b
srr
    , $sel:vsp_signature:VerifySignatureParams :: Signature
vsp_signature = SignedRandomResponse a b -> Signature
forall a b. SignedRandomResponse a b -> Signature
signature SignedRandomResponse a b
srr
    }

verifySignature ::
     VerifySignatureParams
  -> ClientM (JsonRpcResponse Value VerifySignatureResponse)

-- |This method returns information related to the usage of a given API key.

getUsage ::
     Manager  -- ^ The connection manager.

  -> Key      -- ^ The API key

  -> IO (Maybe UsageResponse)
getUsage :: Manager -> Key -> IO (Maybe UsageResponse)
getUsage Manager
mgr Key
key =
  Manager
-> Key
-> IO (Either ClientError (JsonRpcResponse Value UsageResponse))
getUsage' Manager
mgr Key
key IO (Either ClientError (JsonRpcResponse Value UsageResponse))
-> (Either ClientError (JsonRpcResponse Value UsageResponse)
    -> IO (Maybe UsageResponse))
-> IO (Maybe UsageResponse)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Result Word64
_ UsageResponse
usageResponse) -> Maybe UsageResponse -> IO (Maybe UsageResponse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UsageResponse -> IO (Maybe UsageResponse))
-> Maybe UsageResponse -> IO (Maybe UsageResponse)
forall a b. (a -> b) -> a -> b
$ UsageResponse -> Maybe UsageResponse
forall a. a -> Maybe a
Just UsageResponse
usageResponse
    Either ClientError (JsonRpcResponse Value UsageResponse)
_ -> Maybe UsageResponse -> IO (Maybe UsageResponse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UsageResponse
forall a. Maybe a
Nothing

-- |This method returns information related to the usage of a given API key.

getUsage' ::
     Manager  -- ^ The connection manager.

  -> Key      -- ^ The API key

  -> IO (Either ClientError (JsonRpcResponse Value UsageResponse))
getUsage' :: Manager
-> Key
-> IO (Either ClientError (JsonRpcResponse Value UsageResponse))
getUsage' Manager
mgr Key
key = ClientM (JsonRpcResponse Value UsageResponse)
-> ClientEnv
-> IO (Either ClientError (JsonRpcResponse Value UsageResponse))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
  (GetUsageParams -> ClientM (JsonRpcResponse Value UsageResponse)
getUsage'' GetUsageParams
params)
-- middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
  (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr BaseUrl
randomDotOrgApi Maybe (TVar CookieJar)
forall a. Maybe a
Nothing BaseUrl -> Request -> IO Request
defaultMakeClientRequest ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
  (ClientEnv mgr randomDotOrgApi Nothing defaultMakeClientRequest)
#else
  (ClientEnv mgr randomDotOrgApi Nothing)
#endif
 where
  params :: GetUsageParams
params = GetUsageParams
             { $sel:usep_apiKey:GetUsageParams :: Key
usep_apiKey = Key
key
             }

getUsage'' :: GetUsageParams -> ClientM (JsonRpcResponse Value UsageResponse)

GenIntegersParams -> ClientM (RndResponse [Int])
generateIntegers
  :<|> GenIntegerSequencesParams -> ClientM (RndResponse [[Int]])
generateIntegerSequences
  :<|> GenIntegerSequencesMultiformParams -> ClientM (RndResponse [[Int]])
generateIntegerSequencesMultiform
  :<|> GenDecimalFractionsParams -> ClientM (RndResponse [Double])
generateDecimalFractions
  :<|> GenGaussiansParams -> ClientM (RndResponse [Double])
generateGaussians
  :<|> GenStringsParams -> ClientM (RndResponse [Text])
generateStrings
  :<|> GenUUIDsParams -> ClientM (RndResponse [UUID])
generateUUIDs
  :<|> GenBlobsParams -> ClientM (RndResponse [Blob])
generateBlobs
  :<|> GenSigIntegersParams
-> ClientM (SigRndResponse [Int] GenIntegersParams)
generateSignedIntegers
  :<|> GenSigIntegerSequencesParams
-> ClientM (SigRndResponse [[Int]] GenIntegerSequencesParams)
generateSignedIntegerSequences
  :<|> GenSigIntegerSequencesMultiformParams
-> ClientM
     (SigRndResponse [[Int]] GenIntegerSequencesMultiformParams)
generateSignedIntegerSequencesMultiform
  :<|> GenSigDecimalFractionsParams
-> ClientM (SigRndResponse [Double] GenDecimalFractionsParams)
generateSignedDecimalFractions
  :<|> GenSigGaussiansParams
-> ClientM (SigRndResponse [Double] GenGaussiansParams)
generateSignedGaussians
  :<|> GenSigStringsParams
-> ClientM (SigRndResponse [Text] GenStringsParams)
generateSignedStrings
  :<|> GenSigUUIDsParams -> ClientM (SigRndResponse [UUID] GenUUIDsParams)
generateSignedUUIDs
  :<|> GenSigBlobsParams -> ClientM (SigRndResponse [Blob] GenBlobsParams)
generateSignedBlobs
  :<|> GetResultParams
-> ClientM (JsonRpcResponse Value GetResultResponse)
getResult'
  :<|> CreateTicketsParams
-> ClientM (JsonRpcResponse Value CreateTicketsResponse)
createTickets''
  :<|> RevealTicketsParams
-> ClientM (JsonRpcResponse Value RevealTicketsResponse)
revealTickets''
  :<|> ListTicketsParams
-> ClientM (JsonRpcResponse Value [TicketInfoResponse])
listTickets''
  :<|> GetTicketParams
-> ClientM (JsonRpcResponse Value TicketInfoResponse)
getTicket''
  :<|> VerifySignatureParams
-> ClientM (JsonRpcResponse Value VerifySignatureResponse)
verifySignature
  :<|> GetUsageParams -> ClientM (JsonRpcResponse Value UsageResponse)
getUsage''
  = Proxy JsonRpcAPI -> Client ClientM JsonRpcAPI
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy JsonRpcAPI
api