git.iko.soy/typeable/random-token
on master help sign in
3 files changed+126−99
since splitsnapshots
unifiedsplit
LICENSE+2 random-token.cabal+107−99 src/Random/Token.hs+17
LICENSEnew file+2
@@ -0,0 +1,2 @@
1+Copyright © 2020, Antorica LLC
2+All rights reserved
random-token.cabal+107−99
@@ -1,103 +1,111 @@
1−name: random-token
2−version: 0.1.0.0
3−synopsis: Implementation of random token generation and parsing
4−-- description:
5−author: typeable.io
6−maintainer: s9gf4ult@gmail.com
7−copyright: 2020 Author name here
8−category: Web
9−build-type: Simple
10−cabal-version: >=1.10
1+cabal-version: 2.4
2+name: random-token
3+version: 0.1.0.0
4+synopsis: Implementation of random token generation and parsing
5+author: typeable.io
6+maintainer: s9gf4ult@gmail.com
7+license-file: LICENSE
8+category: Web
9+build-type: Simple
1110
1211library
13− hs-source-dirs: src
14− ghc-options: -Wall
15− exposed-modules: Random.Token
16− build-depends: base >= 4.7 && < 5
17− , QuickCheck
18− , aeson
19− , base64-bytestring
20− , bytestring
21− , deepseq
22− , http-api-data
23− , text
24− , cryptonite
25− , postgresql-simple
26− default-language: Haskell2010
27− default-extensions: CPP
28− , ConstraintKinds
29− , DataKinds
30− , DeriveFoldable
31− , DeriveFunctor
32− , DeriveGeneric
33− , DeriveTraversable
34− , DuplicateRecordFields
35− , FlexibleContexts
36− , FlexibleInstances
37− , FunctionalDependencies
38− , GADTs
39− , GeneralizedNewtypeDeriving
40− , LambdaCase
41− , MultiParamTypeClasses
42− , MultiWayIf
43− , NumDecimals
44− , OverloadedStrings
45− , PolyKinds
46− , QuasiQuotes
47− , RankNTypes
48− , RecordWildCards
49− , RoleAnnotations
50− , ScopedTypeVariables
51− , StandaloneDeriving
52− , TemplateHaskell
53− , TupleSections
54− , TypeApplications
55− , TypeFamilies
56− , TypeOperators
57− , UndecidableInstances
58− , ViewPatterns
12+ hs-source-dirs: src
13+ ghc-options: -Wall
14+ exposed-modules: Random.Token
15+ build-depends:
16+ , aeson
17+ , base >=4.9 && <5
18+ , base64-bytestring
19+ , bytestring >=0.10
20+ , deepseq
21+ , http-api-data
22+ , QuickCheck
23+ , text
24+
25+ if !(impl(ghcjs) || arch(javascript) || arch(wasm32))
26+ build-depends:
27+ , cryptonite
28+ , postgresql-simple
29+
30+ default-language: Haskell2010
31+ default-extensions:
32+ CPP
33+ ConstraintKinds
34+ DataKinds
35+ DeriveFoldable
36+ DeriveFunctor
37+ DeriveGeneric
38+ DeriveTraversable
39+ DuplicateRecordFields
40+ FlexibleContexts
41+ FlexibleInstances
42+ FunctionalDependencies
43+ GADTs
44+ GeneralizedNewtypeDeriving
45+ LambdaCase
46+ MultiParamTypeClasses
47+ MultiWayIf
48+ NumDecimals
49+ OverloadedStrings
50+ PolyKinds
51+ QuasiQuotes
52+ RankNTypes
53+ RecordWildCards
54+ RoleAnnotations
55+ ScopedTypeVariables
56+ StandaloneDeriving
57+ TemplateHaskell
58+ TupleSections
59+ TypeApplications
60+ TypeFamilies
61+ TypeOperators
62+ UndecidableInstances
63+ ViewPatterns
5964
6065test-suite spec
61− type: exitcode-stdio-1.0
62− hs-source-dirs: spec
63− main-is: Test.hs
64− other-modules: TokenSpec
65− default-language: Haskell2010
66− build-depends: base >= 4.10 && <4.13
67− , hspec
68− , random-token
69− ghc-options: -Wall
70− -threaded
71− -rtsopts
72− "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"
73− ghc-prof-options: -fprof-auto
74− default-extensions: ConstraintKinds
75− , DataKinds
76− , DeriveFoldable
77− , DeriveFunctor
78− , DeriveGeneric
79− , DeriveTraversable
80− , DuplicateRecordFields
81− , FlexibleContexts
82− , FlexibleInstances
83− , FunctionalDependencies
84− , GADTs
85− , GeneralizedNewtypeDeriving
86− , LambdaCase
87− , MultiParamTypeClasses
88− , MultiWayIf
89− , NumDecimals
90− , OverloadedStrings
91− , PolyKinds
92− , QuasiQuotes
93− , RankNTypes
94− , RecordWildCards
95− , ScopedTypeVariables
96− , StandaloneDeriving
97− , TemplateHaskell
98− , TupleSections
99− , TypeApplications
100− , TypeFamilies
101− , TypeOperators
102− , UndecidableInstances
103− , ViewPatterns
66+ type: exitcode-stdio-1.0
67+ hs-source-dirs: spec
68+ main-is: Test.hs
69+ other-modules: TokenSpec
70+ default-language: Haskell2010
71+ build-depends:
72+ , base >=4.10 && <5
73+ , hspec
74+ , random-token
75+
76+ build-tool-depends: hspec-discover:hspec-discover
77+ ghc-options:
78+ -Wall -threaded -rtsopts "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"
79+
80+ ghc-prof-options: -fprof-auto
81+ default-extensions:
82+ ConstraintKinds
83+ DataKinds
84+ DeriveFoldable
85+ DeriveFunctor
86+ DeriveGeneric
87+ DeriveTraversable
88+ DuplicateRecordFields
89+ FlexibleContexts
90+ FlexibleInstances
91+ FunctionalDependencies
92+ GADTs
93+ GeneralizedNewtypeDeriving
94+ LambdaCase
95+ MultiParamTypeClasses
96+ MultiWayIf
97+ NumDecimals
98+ OverloadedStrings
99+ PolyKinds
100+ QuasiQuotes
101+ RankNTypes
102+ RecordWildCards
103+ ScopedTypeVariables
104+ StandaloneDeriving
105+ TemplateHaskell
106+ TupleSections
107+ TypeApplications
108+ TypeFamilies
109+ TypeOperators
110+ UndecidableInstances
111+ ViewPatterns
src/Random/Token.hs+17
@@ -1,10 +1,15 @@
1+{-# LANGUAGE CPP #-}
12module Random.Token
23 ( Token
34 , tokenToAscii
45 , tokenToText
56 , asciiToToken
67 , textToToken
8+ , unsafeCoerceToken
9+ , tokenWithContents
10+#ifndef ghcjs_HOST_OS
711 , generateToken
12+#endif
813 ) where
914
1015import Control.DeepSeq
@@ -19,9 +24,12 @@ import Data.Typeable
1924import Test.QuickCheck.Arbitrary
2025import Web.HttpApiData
2126
27+
28+#ifndef ghcjs_HOST_OS
2229import Crypto.Random as R
2330import Database.PostgreSQL.Simple.FromField
2431import Database.PostgreSQL.Simple.ToField
32+#endif
2533
2634-- | 16 bytes lenght random value parametrized by label.
2735newtype Token (a :: k) = Token ByteString
@@ -38,6 +46,7 @@ instance FromJSON (Token a) where
3846instance ToJSON (Token a) where
3947 toJSON = toJSON . tokenToText
4048
49+#ifndef ghcjs_HOST_OS
4150instance forall a. (Typeable (Token a), Typeable a) => FromField (Token a) where
4251 fromField fld bs = do
4352 t <- fromField fld bs
@@ -51,6 +60,8 @@ instance ToField (Token a) where
5160generateToken :: (MonadRandom m) => m (Token a)
5261generateToken = Token <$> R.getRandomBytes 16
5362
63+#endif
64+
5465instance FromHttpApiData (Token a) where
5566 parseQueryParam = first T.pack . textToToken
5667
@@ -68,3 +79,9 @@ asciiToToken bs = Token <$> B64.decode bs
6879
6980textToToken :: Text -> Either String (Token a)
7081textToToken = asciiToToken . T.encodeUtf8
82+
83+tokenWithContents :: Text -> Token a
84+tokenWithContents = Token . T.encodeUtf8
85+
86+unsafeCoerceToken :: Token a -> Token b
87+unsafeCoerceToken (Token a) = Token a